package chat;
#: Version: 2.0.0
#: Description: Chat directly to other people
#: Author: Eduardo M Kalinowski

BEGIN {
  $::world->requireplugin('KCWin');
}

use Glib;
use IO::Socket::INET;
use Encode;
use bytes;


sub help {
  $::world->echonl(<<'EOHELP');
Making and receiving calls (commands used in main window)
---------------------------------------------------------
/chat::accept                Accept calls on default port, 4050
/chat::accept(port)          Accept calls on given port
/chat::noaccept              Stop accepting calls

/chat::call("host")          Call host (or ip address) on default port, 4050
/chat::call("host", port)    Call host (or ip address) on given port
/chat::zcall("host")         Call host (or ip address) on default port, 4050,
                             using the zChat protocol
/chat::zcall("host", port)   Call host (or ip address) on given port,
                             using the zChat protocol


Commands valid in the chat windows
----------------------------------
To send some text, just type it and press ENTER. Some other actions are
available with commands that start with /:

/emote text         Sends text as an emote
/chatall text       Sends text to all connections
/emoteall text      Sends text as an emote to all connections
/group group_name   Set the group that this chat belongs
/cg text            Sends text to all connections in this group
/eg text            Sends text as an emote to all connections in this group
/name new_name      Changes the name used in chats
/color new_color    Changes the color used in chats. new_color is a color
                    valid for the colorize() function
/stripansi          Ignore colors on received messages from this chat
/nostripansi        Display colors on received messages from this chat
/ping               Pings the chat peer
/sendfile           Sends a file to the peer
/stopfile           Stops a file transfer in progress
/snoop              Requests to start snooping your peer
/allowsnoop         Allow the peer to snoop us
/noallowsnoop       Disallow the peer to snoop us
/info               Shows information about this chat session
/hangup             Hangs this chat session up


Chat commands to be used in main window
---------------------------------------
When a command requires "name" as an argument, you should provide the
name of a person with whom you are chatting (as a string).

/chat::chat(name, text)            Sends some text
/chat::chatall(text)               Sends some text to all chats
/chat::emote(name, text)           Sends some text as an emote
/chat::emoteall(text)              Sends some text as an emote to all chats
/chat::setgroup(name, group)       Sets the group that this chat belongs
/chat::chatgroup(group, text)      Sends some text to the group
/chat::emotegroup(group, text)     Sends some text as an emote to the group
/chat::ping(name)                  Pings the connection
/chat::sendfile(name, [file])      Sends a file to the peer
/chat::stopfile(name)              Stops a file transfer in progress
/chat::snoop(name)                 Request to start snooping
/chat::setallowsnoop(name, value)  Sets whether the peer can or cannot
                                   snoop us
/chat::info(name)                  Displays info on the connection
/chat::hangup(name)                Hangs up a connection
/chat::setstripansi(name, value)   Sets whether the chat displays received
                                   colors: 1 to ignore them, 0 to display
/chat::setencoding(name, encoding) Sets the character encoding for that
                                   chat session

/chat::setname(name)               Sets the nick name used in chats
/chat::setcolor(color)             Sets the color used in chats. color is a
                                   color string valid for the colorize()
                                   function

Variables controlling the chat
------------------------------
$chat::auto_accept_calls   If true, chat calls are accepted without you
                           being prompted.
$chat::default_encoding    The default character encoding to use in
                           new chats.
EOHELP
}



#################################################################
# Constants
#
use constant {
  # Chat types
  MM    => 0,
  ZCHAT => 1,
  # Chat commands of both protocols
  NAME_CHANGE         => 1,
  REQUEST_CONNECTIONS => 2,
  CONNECTION_LIST     => 3,
  TEXT_EVERYBODY      => 4,
  TEXT_PERSONAL       => 5,
  TEXT_GROUP          => 6,
  MESSAGE             => 7,
  VERSION             => 19,
  FILE_START          => 20,
  FILE_DENY           => 21,
  FILE_BLOCK_REQUEST  => 22,
  FILE_BLOCK          => 23,
  FILE_END            => 24,
  FILE_CANCEL         => 25,
  PING_REQUEST        => 26,
  PING_RESPONSE       => 27,
  # Chat commans specific of the zChat protocol
  PEEK_CONNECTIONS    => 28,
  PEEK_LIST           => 29,
  SNOOP               => 30,
  SNOOP_DATA          => 31,
  ICON                => 100,
  STATUS              => 101,
  EMAIL               => 102,
  REQUEST_PGP_KEY     => 103,
  PGP_KEY             => 104,
  SEND_COMMAND        => 105,
  STAMP               => 106,
  # Used in MM chat protocol
  MMCHAT_END_OF_COMMAND => 255,
  # For file transfer
  MM_FILE_BLOCK_SIZE    => 500,
  ZCHAT_FILE_BLOCK_SIZE => 1024,
  RECEIVING => 1,
  SENDING   => 2,
  # Chat destinations
  PERSONAL  => 0,
  EVERYBODY => 1,
  GROUP     => 2,
};


#################################################################
# Variables
#
our $my_name;
$my_name = 'KildClient' unless ($my_name);
$::world->makepermanent('$chat::my_name');

our $chat_color;
$chat_color = '&R' unless ($chat_color);
$::world->makepermanent('$chat::chat_color');

our $default_encoding;
$default_encoding = "iso-8859-1" unless ($default_encoding);
$::world->makepermanent('$chat::default_enconding');

our $auto_accept_calls;
$::world->makepermanent('$chat::auto_accept_calls');

our $chat_port = 4050;
our $accept_sock;
our $accept_id;
our @chats;
our $zchat_stamp = int(rand(2**32 - 1));   # The stamp is a 32-bit number
our $n_snoopers = 0;



#################################################################
# Hooks (for snooping)
#
$::world->hook('OnReceivedText',
               '/chat::send_snoop_data($hookdata)',
               { name    => 'chat:snoop',
                 enabled => 0 });
$::world->hook('OnSentCommand',
               '/chat::send_snoop_data($hookdata)',
               { name    => 'chat:snoop',
                 enabled => 0 });


#################################################################
# The $chat_session (reference to a) hash members:
#
# socket           => The socket used for communications
# type             => Type: MudMaster or zChat
# window           => The KCWin that holds the chat
# window_has_focus => Whether the window is focused
# io_watch_id      => Id for the IO Watch callback
# timeout_id       => Id for the timeout callback (to close connections that
#                     are not established after some time)
# id               => zChat ID (not used for anything, really)
# group            => Group name
# remotename       => Remote nickname of chat peer
# remoteip         => Remote advertised ip
# remoteport       => Remote advertised port (used for incoming connections)
# remoteemail      => E-mail of peer (just for displaying)
# remotestamp      => peer's zChat stamp
# remoteversion    => Version of the peer's client
# remotestatus     => Status of the peer's client
# allowsnoop       => Whether the peer can snoop us
# is_snooped       => 1 if we are being snooped
# stripansi        => Strip ANSI sequences from received data?
# pingtime         => Time (as returned by time() function) of last sent ping
# pingstamp        => A random value sent in each ping, to detect the correct
#                     reply, if several pings are sent
# filedirection    => If file is being sent or received
# filename         => Name of file being transfered
# filehandle       => File handle of file being transfered
# filetotalsize    => Total file size
# filesize         => Size transfered so far
# pending_op       => Operation code that has been read, but that has not
#                     been processed
# pending_size     => Size of data for pending operation
# buffer           => Buffer to hold incoming data in the connection
# closed           => 1 if the connection is not open anymore




#################################################################
# User callable routines
#
sub call {
  #
  # Makes a call to the given ip and port, using the MudMaster protocol
  #

  my $ip = shift;
  my $port = shift || 4050;

  generic_call($ip, $port, MM);
}


sub zcall {
  #
  # Makes a call to the given ip and port, using the MudMaster protocol
  #

  my $ip = shift;
  my $port = shift || 4050;

  generic_call($ip, $port, ZCHAT);
}


sub accept {
  #
  # Marks the chat system as accepting new connections
  #

  if ($accept_sock) {
    $::world->echonl(::colorize("${chat_color}Already listening for chat connections on port $chat_port"));
    return;
  }

  $chat_port = shift || 4050;

  $accept_sock = IO::Socket::INET->new(Listen    => 5,
                                       LocalPort => $chat_port,
                                       Proto     => 'tcp',
                                       ReuseAddr => 1);

  $accept_id = Glib::IO->add_watch($accept_sock->fileno,
                                   'in',
                                   \&accept_connection,
                                   $accept_sock);

  $::world->echonl(::colorize("${chat_color}Listening for chat connections on port $chat_port"));
}


sub noaccept {
  #
  # Stop accepting calls
  #

  Glib::Source->remove($accept_id) if $accept_id;
  $accept_id = undef;
  close $accept_sock;
  $::world->echonl(::colorize("${chat_color}Not accepting chat connections."));
}


sub setname {
  #
  # Set the name used for chats
  #

  $my_name = $_[0];

  broadcast(NAME_CHANGE, $my_name);
}


sub chat {
  #
  # Sends something to a chat session
  #

  my ($chat_session, $text) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  send_command($chat_session,
               TEXT_PERSONAL,
               format_text($text, 0, PERSONAL));
  $chat_session->{window}->feed(::colorize("\n${chat_color}You chat to $chat_session->{remotename}, '$text'\n"));
}


sub emote {
  #
  # Sends something as an emote to a chat session
  #

  my ($chat_session, $text) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  send_command($chat_session,
               TEXT_PERSONAL,
               format_text($text, 1, PERSONAL));
  $chat_session->{window}->feed(::colorize("\n${chat_color}You emote to $chat_session->{remotename}: $my_name $text\n"));
}


sub chatall {
  #
  # Chats something to all open connections
  #

  my ($text, $chat_session) = @_;

  broadcast(TEXT_EVERYBODY,
            format_text($text, 0, EVERYBODY));

  my $output = ::colorize("\n${chat_color}You chat to everybody, '$text'\n");
  if ($chat_session) {
    $chat_session->{window}->feed($output);
  } else {
    $::world->echo($output);
  }
}


sub emoteall {
  #
  # Emotes something to all open connections
  #
  my ($text, $chat_session) = @_;

  broadcast(TEXT_EVERYBODY,
            format_text($text, 1, EVERYBODY));

  my $output = ::colorize("\n${chat_color}You emote to everybody: $my_name $text\n");
  if ($chat_session) {
    $chat_session->{window}->feed($output);
  } else {
    $::world->echo($output);
  }
}


sub chatgroup {
  #
  # Chats something to a group
  #

  my ($group, $text, $chat_session) = @_;

  $groupformat = sprintf("%-15.15s", $group);
  broadcast(TEXT_GROUP,
            $groupformat . format_text($text, 0, GROUP),
            $group);

  my $output = ::colorize("\n${chat_color}You chat to the group $group, '$text'\n");
  if ($chat_session) {
    $chat_session->{window}->feed($output);
  } else {
    $::world->echo($output);
  }
}


sub emotegroup {
  #
  # Emotes something to a group
  #

  my ($group, $text, $chat_session) = @_;

  $groupformat = sprintf("%-15.15s", $group);
  broadcast(TEXT_GROUP,
            $groupformat . format_text($text, 1, GROUP),
            $group);

  my $output = ::colorize("\n${chat_color}You emote to the group $group: $my_name $text\n");
  if ($chat_session) {
    $chat_session->{window}->feed($output);
  } else {
    $::world->echo($output);
  }
}


sub setgroup {
  #
  # Sets a chat session to be part of a group
  #

  my ($chat_session, $group) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  $chat_session->{group} = substr($group, 0, 15);
}


sub ping {
  #
  # Pings a chat connection
  #

  my ($chat_session) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  $chat_session->{pingstamp} = int(rand(2**32 - 1));
  $chat_session->{pingtime}  = time();
  send_command($chat_session,
               PING_REQUEST,
               $chat_session->{pingstamp});
}


sub sendfile {
  #
  # Sends a file to the chat peer
  #

  my ($chat_session, $file) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  if ($chat_session->{filedirection}) {
    feed_and_show($chat_session,
                  "${chat_color}A file transfer is already in progress.\n");
    return;
  }

  if (!$file) {
    my $dialog = Gtk3::FileChooserDialog->new('Select file',
                                              undef,
                                              'open',
                                              '_Cancel' => 'cancel',
                                              '_Open'   => 'accept');
    my $response = $dialog->run();
    $dialog->hide();
    return if ($response ne 'accept');
    $file = $dialog->get_filename();
  }

  if(!open($chat_session->{filehandle}, $file)) {
    feed_and_show($chat_session,
                  "${chat_color}Could not open '$file': $!\n");
    return;
  }
  $chat_session->{filename}      = $file;
  $chat_session->{filedirection} = SENDING;
  $chat_session->{filetotalsize} = -s $file;
  $chat_session->{filesize}      = 0;

  # There must be a better way to extract the file name from a path
  if ($file =~ m{.*/([^/]+)$}) {
    $basefilename = $1;
  } else {
    $basefilename = $file;
  }
  send_command($chat_session,
               FILE_START,
               "$basefilename,$chat_session->{filetotalsize}");
  feed_and_show($chat_session,
                "${chat_color}Sending file $file to $chat_session->{remotename}\n");
}


sub stopfile {
  #
  # Stops a file transfer
  #

  my ($chat_session, $file) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  if (!$chat_session->{filedirection}) {
    feed_and_show($chat_session,
                  "${chat_color}No file is being transfered.\n");
    return;
  }

  send_command($chat_session, FILE_CANCEL, '');
  file_stop($chat_session,
            "${chat_color}Transfer of file $chat_session->{filename} aborted.\n");
}


sub snoop {
  #
  # Tries to start snooping the remote party
  #

  my ($chat_session) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  if ($chat_session->{type} != ZCHAT) {
    feed_and_show($chat_session, "${chat_color}Only the zChat protocol supports snooping.\n");
    return;
  }

  send_command($chat_session, SNOOP, '');
  feed_and_show($chat_session, "${chat_color}Requested to start snooping $chat_session->{remotename}\n");
}


sub info {
  #
  # Prints information about the chat session
  #

  my ($chat_session, $text) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);
  my $window = $chat_session->{window};

  my $chatheader = "Chat with $chat_session->{remotename}";
  $window->feed(::colorize("&w$chatheader\n"));
  $window->feed("-" x length($chatheader) . "\n");
  $window->feed("Connection IP    : " . $chat_session->{socket}->peerhost()
                                      . "\n");
  $window->feed("Advertised IP    : $chat_session->{remoteip}\n");
  $window->feed("Call port        : $chat_session->{remoteport}\n");
  $window->feed("Type             : " . ($chat_session->{type} == MM
                                         ? "MudMaster" : "zChat")
                                      . "\n");
  $window->feed("Group            : $chat_session->{group}\n");
  $window->feed("Remote version   : " . ($chat_session->{remoteversion} ?
                                         $chat_session->{remoteversion} :
                                         "Unknown")
                                       . "\n");
  $window->feed("Peer e-mail      : $chat_session->{remoteemail}\n")
    if ($chat_session->{remoteemail});
  $window->feed("They can snoop   : " . ($chat_session->{allowsnoop}
                                         ? "yes" : "no")
                                      . "\n");
  $window->feed("They are snooping: " . ($chat_session->{is_snooped}
                                         ? "yes" : "no")
                                      . "\n");
  $window->feed("Strip ANSI       : " . ($chat_session->{stripansi}
                                         ? "yes" : "no")
                                      . "\n");
  if ($chat_session->{filedirection}) {
    if ($chat_session->{filedirection} == SENDING) {
      $window->feed("Sending file     : $chat_session->{filename}\n");
    } else {
      $window->feed("Receiving file   : $chat_session->{filename}\n");
    }
    $window->feed("File size:       : $chat_session->{filetotalsize}\n");
    $window->feed("Bytes transfered : $chat_session->{filesize}\n");
    my $remaining_bytes =
      $chat_session->{filetotalsize} - $chat_session->{filesize};
    $window->feed("Bytes left       : $remaining_bytes ("
                                      . sprintf("%.0f", 100*($remaining_bytes/$chat_session->{filetotalsize}))
                                      . "%) \n");
  }

  feed_and_show($chat_session, "$chat_color");
}


sub hangup {
  #
  # Closes a connection
  #

  my ($chat_session) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  close $chat_session->{socket};
  Glib::Source->remove($chat_session->{io_watch_id});
  feed_and_show($chat_session,
                "${chat_color}Chat session closed.\n");
  remove_session($chat_session);
}


sub setcolor {
  #
  # Sets the color used for chat messages.
  #

  $chat_color = $_[0];
}


sub setstripansi {
  #
  # Sets whether to strip ANSI sequences or not
  #

  my ($chat_session, $value) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  $chat_session->{stripansi} = $value;
}


sub setallowsnoop {
  #
  # Sets whether our peer can snoop us
  #

  my ($chat_session, $value) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  if ($chat_session->{type} != ZCHAT) {
    feed_and_show($chat_session, "${chat_color}Only the zChat protocol supports snooping.\n");
    return;
  }

  $chat_session->{allowsnoop} = $value;
  if ($value) {
    send_command($chat_session, MESSAGE,
                 ::colorize("${chat_color}You can now snoop $my_name.\n"));
    feed_and_show($chat_session, "${chat_color}Snooping allowed.\n");
  } else {
    send_command($chat_session, MESSAGE,
                 ::colorize("${chat_color}You can no longer snoop $my_name.\n"));
    feed_and_show($chat_session, "${chat_color}Snooping disallowed.\n");
    stop_snooped($chat_session);
  }
}


sub setencoding {
  #
  # Sets the encoding for that chat session
  #

  my ($chat_session, $encoding) = @_;

  $chat_session = find_session($chat_session) unless ref($chat_session);

  $chat_session->{encoding} = $encoding;
}



#################################################################
# Internal functions
#
sub generic_call {
  #
  # Makes a chat call, of the specified type
  #

  my ($ip, $port, $type) = @_;

  my $socket = IO::Socket::INET->new(PeerAddr => $ip,
                                     PeerPort => $port,
                                     Proto    => 'tcp');
  if (!defined($socket)) {
    $::world->echonl(::colorize("${chat_color}Could not connect to $ip, port $port: $!\n"));
    return 0;
  }

  my $chat_session = { socket     => $socket,
                       type       => $type,
                       remoteip   => $ip,
                       remoteport => $port,
                       group      => '',
                       encoding   => $default_encoding};

  $chat_session->{io_watch_id}
    = Glib::IO->add_watch($socket->fileno,
                          'in',
                          \&call_establishment_data_ready_cb,
                          $chat_session);
  $chat_session->{timeout_id}
    = Glib::Timeout->add(60000,       # That's 60 seconds in ms
                       \&kill_pending_connection_cb,
                       $chat_session);
  $chat_session->{window} = new_chat_window($ip,
                                            $chat_session);
  $chat_session->{window}->feed(::colorize("${chat_color}Calling $ip on port $port...\n"));
  $chat_session->{window}->show_all;

  if ($type == MM) {
    $proposal = sprintf("CHAT:$my_name\n%s%-5u",
                        $socket->sockhost(),
                        $chat_port);
  } else {
    $proposal = sprintf("ZCHAT:$my_name\t0\n%s%05u",
                        $socket->sockhost(),
                        $chat_port);
  }
  syswrite($socket, $proposal);

  push(@chats, $chat_session);

  return 1;
}


sub accept_connection {
  #
  # accept()'s an incoming connection. accept() won't block because this
  # is only called when there is an incoming connection (because of the
  # IO watch).
  #

  my ($fileno, $condition, $sock) = @_;

  my $client_sock = $sock->accept();
  my $chat_session = { socket   => $client_sock,
                       group    => '',
                       encoding => $default_encoding };
  $chat_session->{io_watch_id} =
    Glib::IO->add_watch($client_sock->fileno,
                        'in',
                        \&receive_establishment_data_ready_cb,
                        $chat_session);
  $chat_session->{timeout_id} =
    Glib::Timeout->add(60000,       # That's 60 seconds in ms
                       \&kill_pending_connection_cb,
                       $chat_session);
  push(@chats, $chat_session);

  return 1;
}


sub call_establishment_data_ready_cb {
  #
  # Called when data is ready in a chat socket, for which no connection
  # has yet been established, when we making a call.
  #

  my ($fileno, $condition, $chat_session) = @_;
  my $socket = $chat_session->{socket};

  my $tempbuffer;
  my $bytes_read = sysread($socket, $tempbuffer, 1024);

  if (!defined($bytes_read) || $bytes_read <= 0) {
    close $socket;
    remove_session($chat_session);
    return 0;
  }

  $chat_session->{buffer} .= $tempbuffer;

  while (1) {
    my $nlpos = index($chat_session->{buffer}, "\n");
    return 1 if ($nlpos == -1);    # Wait for more data

    if ($chat_session->{buffer} =~ /^YES:(.*)/) {
      change_remote_name($chat_session, $1, 1);
      substr($chat_session->{buffer}, 0, $nlpos + 1) = '';

      send_command($chat_session, VERSION, get_version());
      if ($chat_session->{type} == ZCHAT) {
        send_command($chat_session,
                     STATUS, chr(1));     # We're always available for now
        send_command($chat_session,
                     STAMP, pack("L", $zchat_stamp));
      }

      $chat_session->{io_watch_id} =
        Glib::IO->add_watch($socket->fileno,
                            'in',
                            $chat_session->{type} == MM ? \&mmchat_data_ready_cb : \&zchat_data_ready_cb,
                            $chat_session);
      # Remove timeout
      Glib::Source->remove($chat_session->{timeout_id});

      $chat_session->{window}->feed(::colorize("${chat_color}Chat session to '$chat_session->{remotename}' at $chat_session->{remoteip} port $chat_session->{remoteport} established\n"));

      return 0;
    } elsif ($chat_session->{buffer} =~ /^NO/) { # Refused
      $chat_session->{window}->feed(::colorize("${chat_color}Remote party refused chat session\n"));
      Glib::Source->remove($chat_session->{timeout_id});
      close $socket;
      remove_session($chat_session);

      return 0;
    } else {
      # Wrong reply. Let's ignore this line and wait for another one
      substr($chat_session->{buffer}, 0, $nlpos + 1) = '';
    }
  }

  return 1;                 # Continue processing
}


sub receive_establishment_data_ready_cb {
  #
  # Called when data is ready in a chat socket, for which no connection
  # has yet been established, when we are accepting a call.
  #

  my ($fileno, $condition, $chat_session) = @_;
  my $socket = $chat_session->{socket};

  my $tempbuffer;
  my $bytes_read = sysread($socket, $tempbuffer, 1024);

  if (!defined($bytes_read) || $bytes_read <= 0) {
    close $socket;
    remove_session($chat_session);
    return 0;
  }

  $chat_session->{buffer} .= $tempbuffer;

  while (1) {
    if (!defined($chat_session->{type})) { # First line
      my $nlpos = index($chat_session->{buffer}, "\n");
      return 1 if ($nlpos == -1);    # Wait for more data

      if ($chat_session->{buffer} =~ /^ZCHAT:(.*)\t(.*)/) {
        $chat_session->{type}       = ZCHAT;
        $chat_session->{remotename} = $1;
        $chat_session->{id}         = $2;

        substr($chat_session->{buffer}, 0, $nlpos + 1) = '';
      } elsif ($chat_session->{buffer} =~ /^CHAT:(.*)/) {
        $chat_session->{type}       = MM;
        $chat_session->{remotename} = $1;
        $chat_session->{id}         = 0;

        substr($chat_session->{buffer}, 0, $nlpos + 1) = '';
      } else {
        # Wrong header. Let's ignore this line and wait for another one
        substr($chat_session->{buffer}, 0, $nlpos + 1) = '';
      }
    } else {                      # Second line
      unless ($auto_accept_calls) {
        my $dialog = Gtk3::MessageDialog->new(undef,
                                              [],
                                              'question',
                                              'yes-no',
                                              "Accept chat call with '$chat_session->{remotename}' from " . $socket->peerhost() . "?");
        $dialog->set_default_response('yes');
        my $response = $dialog->run();
        $dialog->destroy;
        if ($response ne 'yes') {
          syswrite($socket, "NO\n");
          close $socket;
          Glib::Source->remove($chat_session->{timeout_id});
          remove_session($chat_session);
          return 0;
        }
      }

      $chat_session->{remoteip}   = substr($chat_session->{buffer}, 0,
                                           length($chat_session->{buffer}) - 5);
      $chat_session->{remoteport} = int(substr($chat_session->{buffer}, -5, 5));

      $chat_session->{buffer} = '';

      syswrite($socket, "YES:$my_name\n");
      send_command($chat_session, VERSION, get_version());
      if ($chat_session->{type} == ZCHAT) {
        send_command($chat_session,
                     STATUS, chr(1));     # We're always available for now
        send_command($chat_session,
                     STAMP, pack("L", $zchat_stamp));
      }

      $chat_session->{window} = new_chat_window($chat_session->{remotename},
                                                $chat_session);
      $chat_session->{io_watch_id} =
        Glib::IO->add_watch($socket->fileno,
                            'in',
                            $chat_session->{type} == MM ? \&mmchat_data_ready_cb : \&zchat_data_ready_cb,
                            $chat_session);
      # Remove timeout
      Glib::Source->remove($chat_session->{timeout_id});

      $chat_session->{window}->feed(::colorize("${chat_color}Chat session with '$chat_session->{remotename}' from $chat_session->{remoteip} port $chat_session->{remoteport}\n"));
      $chat_session->{window}->show_all;

      return 0;                   # Remove callback
    }
  }

  return 1;                 # Continue processing
}


sub kill_pending_connection_cb {
  #
  # Kills connections that have been open for some time but have not yet
  # been sucessfully established.
  #

  my ($chat_session) = @_;

  if ($chat_session->{window}) {
    feed_and_show($chat_session,
                  "${chat_color}No reply from remote party, chat closed.\n");
  }

  Glib::Source->remove($chat_session->{io_watch_id});
  close $chat_session->{socket};
  remove_session($chat_session);

  return 0;
}


sub mmchat_data_ready_cb {
  #
  # Called when data is ready from a mudmaster chat session.
  #

  my ($fileno, $condition, $chat_session) = @_;
  my $socket = $chat_session->{socket};

  my $tempbuffer;
  my $bytes_read = sysread($socket, $tempbuffer, 1024);

  if (!defined($bytes_read) || $bytes_read <= 0) {
    close $socket;
    feed_and_show($chat_session,
                  "${chat_color}Chat session closed.\n");
    remove_session($chat_session);
    return 0;
  }

  $chat_session->{buffer} .= $tempbuffer;

  while (1) {
    if (!defined($chat_session->{pending_op})) { # Get the command code
      return 1 if (length($chat_session->{buffer}) < 1); # Wait for more

      $chat_session->{pending_op} = ord($chat_session->{buffer});
      substr($chat_session->{buffer}, 0, 1) = '';
    } else {
      # Unfortunately, FILE_BLOCK blocks have a different structure
      if ($chat_session->{pending_op} == FILE_BLOCK) {
        # +1 is because there is an END_OF_COMMAND after the block.
        # This has been discovered in practice (and MudMaster does send
        # this byte), even though the specs says there is no
        # END_OF_COMMAND in this message.
        return 1 if length($chat_session->{buffer}) < MM_FILE_BLOCK_SIZE + 1;

        file_block_received($chat_session,
                            substr($chat_session->{buffer},
                                   0, MM_FILE_BLOCK_SIZE));
        substr($chat_session->{buffer}, 0, MM_FILE_BLOCK_SIZE + 1) = '';
        $chat_session->{pending_op} = undef;
      } else {
        my $end_data_pos = index($chat_session->{buffer}, chr(MMCHAT_END_OF_COMMAND));
        return 1 if ($end_data_pos == -1);    # Wait for more data

        dispatch_command($chat_session,
                         substr($chat_session->{buffer}, 0, $end_data_pos));
        substr($chat_session->{buffer}, 0, $end_data_pos + 1) = '';
        $chat_session->{pending_op} = undef;
      }
    }
  }

  return 1;                     # Continue processing
}


sub zchat_data_ready_cb {
  #
  # Called when data is ready from a zChat session.
  #

  my ($fileno, $condition, $chat_session) = @_;
  my $socket = $chat_session->{socket};

  my $tempbuffer;
  my $bytes_read = sysread($socket, $tempbuffer, 1024);

  if (!defined($bytes_read) || $bytes_read <= 0) {
    close $socket;
    feed_and_show($chat_session,
                  "${chat_color}Chat session closed.\n");
    remove_session($chat_session);
    return 0;
  }

  $chat_session->{buffer} .= $tempbuffer;

  while (1) {
    if (!defined($chat_session->{pending_op})) { # Get the command code
      return 1 if (length($chat_session->{buffer}) < 2); # Wait for more

      $chat_session->{pending_op} = unpack("v",
                                           substr($chat_session->{buffer}, 0, 2));
      substr($chat_session->{buffer}, 0, 2) = '';
    } elsif (!defined($chat_session->{pending_size})) { # Get the size
      return 1 if (length($chat_session->{buffer}) < 2); # Wait for more

      $chat_session->{pending_size} = unpack("v",
                                             substr($chat_session->{buffer}, 0, 2));
      substr($chat_session->{buffer}, 0, 2) = '';
    } elsif (length($chat_session->{buffer}) >= $chat_session->{pending_size}) {
      dispatch_command($chat_session,
                       substr($chat_session->{buffer}, 0, $chat_session->{pending_size}));
      substr($chat_session->{buffer}, 0, $chat_session->{pending_size}) = '';
      $chat_session->{pending_op} = undef;
      $chat_session->{pending_size} = undef;
    } else {
      return 1;                 # Wait for more data
    }
  }

  return 1;                     # Continue processing
}


sub dispatch_command {
  #
  # Determines the command to be executed
  #

  my ($chat_session, $data) = @_;

  my $op = $chat_session->{pending_op};

  if ($op == VERSION) {
    $chat_session->{remoteversion} = $data;

  } elsif ($op == STATUS) {
    $chat_session->{remotestatus} = ord($data);

  } elsif ($op == EMAIL) {
    $chat_session->{remoteemail} = $data;

  } elsif ($op == STAMP) {
    $chat_session->{remotestamp} = unpack("L", $data);
    if ($chat_session->{remotestamp} == $zchat_stamp) {
      $zchat_stamp = int(rand(2**32 - 1));
      broadcast(STAMP, pack("L", $zchat_stamp));
    }

  } elsif ($op == NAME_CHANGE) {
    change_remote_name($chat_session, $data);

  } elsif ($op == PING_REQUEST) {
    send_command($chat_session, PING_RESPONSE, $data);

  } elsif ($op == TEXT_EVERYBODY || $op == TEXT_PERSONAL || $op == TEXT_GROUP) {
    process_text_message($chat_session, $data, $op);

  } elsif ($op == MESSAGE) {
    Encode::from_to($data, $chat_session->{encoding}, 'UTF-8');
    feed_and_show($chat_session, "${chat_color}Message from $chat_session->{remotename}: $data\n");

  } elsif ($op == PING_RESPONSE) {
    if ($data == $chat_session->{pingstamp}) {
      my $elapsedsecs = time() - $chat_session->{pingtime};
      feed_and_show($chat_session, "${chat_color}Ping replyied in $elapsedsecs second(s)\n");
    } # If not equal, let's ignore this reply

  } elsif ($op == SNOOP_DATA) {
    $data = substr($data, 4);
    Encode::from_to($data, $chat_session->{encoding}, 'UTF-8');
    feed_and_show($chat_session, "&c>&w" . $data . "\n");

  } elsif ($op == SNOOP) {
    start_snooped($chat_session);

  } elsif ($op == FILE_START) {
    receive_file($chat_session, $data);

  } elsif ($op == FILE_BLOCK) {
    file_block_received($chat_session, $data);

  } elsif ($op == FILE_END) {
    file_end($chat_session);

  } elsif ($op == FILE_CANCEL) {
    if ($chat_session->{filedirection}) {
      file_stop($chat_session,
                "${chat_color}Transfer of file $chat_session->{filename} aborted by remote party.\n");
    } else {
      file_stop($chat_session, '');
    }

  } elsif ($op == FILE_DENY) {
    file_stop($chat_session,
              "${chat_color}$chat_session->{remotename} rejected the file transfer: $data\n");

  } elsif ($op == FILE_BLOCK_REQUEST) {
    file_send_next_block($chat_session);

  } else {
    Encode::from_to($data, $chat_session->{encoding}, 'UTF-8');
    $chat_session->{window}->feed("Received unknown command #$op, data: <$data>\n");
    send_command($chat_session,
                 MESSAGE,
                 ::colorize("${chat_color}KildClient chat does not support command $op at this time, sorry.\n"));
  }
}


sub process_text_message {
  #
  # Processes a text message (personal, to everybody or to group). If the
  # zChat procotol is being used, this means checking the stamp.
  #

  my ($chat_session, $data, $op) = @_;

  my $message;
  if ($chat_session->{type} == ZCHAT) {
    my $stamp = unpack("L", substr($chat_session, 0, 4));
    if ($stamp != $zchat_stamp) {
      $message = substr($data, 4);
    } else {
      return;
    }
  } else {
    $message = $data;
  }

  $message = substr($message, 15) if ($op == TEXT_GROUP);
  Encode::from_to($message, $chat_session->{encoding}, 'UTF-8');
  $message = ::stripansi($message) if ($chat_session->{stripansi});
  feed_and_show($chat_session, "$chat_color$message");
}


sub change_remote_name {
  #
  # Changes the name of peer for a chat.
  # If $quit is defined, does not print anything in the window.
  #

  my ($chat_session, $name, $quiet) = @_;

  my $oldname = $chat_session->{remotename};
  $chat_session->{remotename} = $name;
  $chat_session->{window}->set_title("Chat: $name");
  unless ($quiet) {
    $chat_session->{window}->feed(::colorize("${chat_color}$oldname is now known as $name.\n"));
  }
}


sub process_input {
  #
  # Processes input typed in the Chat window
  #

  my ($entry, $chat_session) = @_;

  if ($chat_session->{closed}) {
    feed_and_show($chat_session,
                  "${chat_color}This chat session is closed.\n");
    return;
  }

  my $text = $entry->get_text;
  if ($text =~ m<^/emote\s+(.*)>i) {
    emote($chat_session, $1);

  } elsif($text =~ m<^/chatall\s+(.*)>i) {
    chatall($1, $chat_session);

  } elsif($text =~ m<^/emoteall\s+(.*)>i) {
    emoteall($1, $chat_session);

  } elsif($text =~ m<^/cg\s+(.*)>i) {
    if ($chat_session->{group} eq '') {
      feed_and_show($chat_session,
                    "${chat_color}This chat does not belong to a group.\n");
    } else {
      chatgroup($chat_session->{group}, $1, $chat_session);
    }

  } elsif($text =~ m<^/eg\s+(.*)>i) {
    if ($chat_session->{group} eq '') {
      feed_and_show($chat_session,
                    "${chat_color}This chat does not belong to a group.\n");
    } else {
      emotegroup($chat_session->{group}, $1, $chat_session);
    }

  } elsif($text =~ m<^/name\s+(.*)>i) {
    setname($1);

  } elsif($text =~ m<^/color\s+(.*)>i) {
    setcolor($1);

  } elsif($text =~ m<^/group\s+(.*)>i) {
    setgroup($chat_session, $1);

  } elsif($text =~ m<^/stripansi\s*>i) {
    setstripansi($chat_session, 1);

  } elsif($text =~ m<^/nostripansi\s*>i) {
    setstripansi($chat_session, 0);

  } elsif($text =~ m<^/ping\s*>i) {
    ping($chat_session);

  } elsif($text =~ m<^/sendfile\s*>i) {
    sendfile($chat_session);

  } elsif($text =~ m<^/stopfile\s*>i) {
    stopfile($chat_session);

  } elsif($text =~ m<^/snoop\s*>i) {
    snoop($chat_session);

  } elsif($text =~ m<^/allowsnoop\s*>i) {
    setallowsnoop($chat_session, 1);

  } elsif($text =~ m<^/noallowsnoop\s*>i) {
    setallowsnoop($chat_session, 0);

  } elsif ($text =~ m</info\s*>i) {
    info($chat_session);

  } elsif ($text =~ m</hangup\s*>i) {
    hangup($chat_session);

  } else {
    chat($chat_session, $text);
  }

  $entry->set_text('');
}


sub send_command {
  #
  # Packs a command in the appropriate representation and sends it
  #

  my ($chat_session, $op, $data) = @_;

  if ($op != FILE_BLOCK) {
    $data = encode($chat_session->{encoding}, $data);
  }

  if (($op == TEXT_PERSONAL || $op == TEXT_EVERYBODY)
      && $chat_session->{type} == ZCHAT) {
    $data = pack("L", $zchat_stamp) . $data;
  }

  my $command;
  if ($chat_session->{type} == MM) {
    $command = chr($op) . $data . chr(MMCHAT_END_OF_COMMAND);
  } elsif ($chat_session->{type} == ZCHAT) {
    $command = pack("vv", $op, length($data)) . $data;
  }

  syswrite($chat_session->{socket}, $command);
}


sub broadcast {
  #
  # Broadcasts a command to all open chat sessions
  #

  my ($command, $data, $group) = @_;

  $group = substr($group, 0, 15) if ($group);

  foreach $chat (@chats) {
    next if $chat->{closed};
    next if ($chat->{type} == MM && $command >= PEEK_CONNECTIONS);
    next if ($group && $chat->{group} ne $group);

    send_command($chat, $command, $data);
  }
}


sub format_text {
  #
  # Formats a message to be sent as a TEXT_PERSONAL, TEXT_GROUP,
  # or TEXT_EVERYBODY command
  #

  my ($text, $isemote, $dest) = @_;

  my $destname;
  $destname = "you"       if ($dest == PERSONAL);
  $destname = "everybody" if ($dest == EVERYBODY);
  $destname = "the group" if ($dest == GROUP);

  my $string;
  if (!$isemote) {
    $string = ::colorize("\n${chat_color}$my_name chats to $destname, '$text'\n");
  } else {
    if ($dest == PERSONAL) {
      $string = ::colorize("\n${chat_color}$my_name $text\n");
    } else {
      $string = ::colorize("\n${chat_color}(To $destname) $my_name $text\n");
    }
  }

  return $string;
}


sub start_snooped {
  #
  # Starts a snooping session, in which we send all received data
  #

  my ($chat_session) = @_;

  if (!$chat_session->{allowsnoop}) {
    send_command($chat_session,
                 MESSAGE,
                 ::colorize("${chat_color}$my_name does not allow you to snoop him/her.\n"));
    feed_and_show($chat_session, "${chat_color}$chat_session->{remotename} has tried to snoop you.\n");
    return;
  }

  $chat_session->{is_snooped} = 1;
  if ($n_snoopers++ == 0) {
    $::world->enahook('OnReceivedText', 'chat:snoop');
    $::world->enahook('OnSentCommand', 'chat:snoop');
  }
  send_command($chat_session,
               MESSAGE,
               ::colorize("${chat_color}You are now snooping $my_name.\n"));
  feed_and_show($chat_session,
                "${chat_color}$chat_session->{remotename} is snooping you.\n");
}


sub stop_snooped {
  #
  # Stops a snooping session, no more data is sent
  #

  my ($chat_session) = @_;

  if ($chat_session->{is_snooped}) {
    $chat_session->{is_snooped} = 0;
    if (--$n_snoopers == 0) {
      $::world->dishook('OnReceivedText', 'chat:snoop');
      $::world->dishook('OnSentCommand', 'chat:snoop');
    }
  }
}


sub send_snoop_data {
  #
  # Sends data that has been received to the people that are snooping
  # us
  #

  my ($data) = @_;

  foreach my $chat (@chats) {
    next if     ($chat->{closed});
    next unless ($chat->{is_snooped});

    send_command($chat,
                 SNOOP_DATA,
                 $data);
  }
}


sub receive_file {
  #
  # Prompts the user if he wants to accept a file, and if he does,
  # start the transfer
  #

  my ($chat_session, $data) = @_;

  # It should never happen that another file is offered while a file
  # transfer is still in progress, but let's play safe
  if ($chat_session->{filedirection}) {
    send_command($chat_session,
                 FILE_DENY,
                 "A file transfer is already in progress.");
    return;
  }

  my ($file, $length) = split(",", $data);

  my $dialog = Gtk3::MessageDialog->new(undef,
                                        [],
                                        'question',
                                        'yes-no',
                                        "$chat_session->{remotename} wants to send you file '$file', length $length bytes. Accept it?");
  $dialog->set_default_response('no');
  my $response = $dialog->run();
  $dialog->destroy;
  if ($response ne 'yes') {
    send_command($chat_session,
                 FILE_DENY,
                 "$my_name rejected the file transfer.");
    return;
  }

  $dialog = Gtk3::FileChooserDialog->new('Save file as',
                                         undef,
                                         'save',
                                         '_Cancel' => 'cancel',
                                         '_Save'   => 'accept');
  $dialog->set_current_name($file);
  $response = $dialog->run();
  $dialog->hide();
  if ($response ne 'accept') {
    send_command($chat_session,
                 FILE_DENY,
                 "$my_name rejected the file transfer.");
    return;
  }

  my $filename = $dialog->get_filename();
  if (!open ($chat_session->{filehandle}, ">$filename")) {
    feed_and_show($chat_session,
                  "${chat_color}Could not open '$filename': $!\n");
    send_command($chat_session,
                 FILE_DENY,
                 "$my_name rejected the file transfer.");
    return;
  }

  $chat_session->{filedirection} = RECEIVING;
  $chat_session->{filename} = $filename;
  $chat_session->{filetotalsize} = $length;
  $chat_session->{filesize} = 0;

  feed_and_show($chat_session,
                "${chat_color}Started transfer of file $filename.\n");
  send_command($chat_session, FILE_BLOCK_REQUEST, '');
}


sub file_block_received {
  #
  # Called when a FILE_BLOCK message is received
  #

  my ($chat_session, $block) = @_;

  # It should never happen that we receive a block when a file
  # transfer is not in progress, but let's play safe
  if (!defined($chat_session->{filedirection})) {
    send_command($chat_session, FILE_CANCEL, '');
    return;
  }

  my $length = length($block);
  my $remaining_size =
    $chat_session->{filetotalsize} - $chat_session->{filesize};
  my $bytes_to_write = $remaining_size < $length
                       ? $remaining_size
                       : $length;

  syswrite($chat_session->{filehandle}, $block, $bytes_to_write);
  $chat_session->{filesize} += $length;

  send_command($chat_session, FILE_BLOCK_REQUEST, '');
}


sub file_end {
  #
  # Called when a FILE_END message is received
  #

  my ($chat_session) = @_;

  feed_and_show($chat_session,
                "${chat_color}Transfer of file $chat_session->{filename} finished.\n");

  close($chat_session->{filehandle});
  $chat_session->{filehandle}    = undef;
  $chat_session->{filename}      = undef;
  $chat_session->{filedirection} = undef;
}


sub file_stop {
  #
  # Called when a file transfer is to be stopped, either because one
  # of the parties aborted it, or because of an error, or because the
  # sending of the file has finished.
  #

  my ($chat_session, $message) = @_;

  # At least one client sends a FILE_CANCEL in reply to our denying a
  # file, and in this case the file transfer has not been initiated here.
  return unless defined($chat_session->{filedirection});

  feed_and_show($chat_session, $message);

  if ($chat_session->{filedirection} == RECEIVING) {
    unlink($chat_session->{filename});
  }

  close($chat_session->{filehandle});
  $chat_session->{filehandle}    = undef;
  $chat_session->{filename}      = undef;
  $chat_session->{filedirection} = undef;
}


sub file_send_next_block {
  #
  # Sends the next block in the file transfer
  #

  my ($chat_session) = @_;

  # It should never happen that we receive a block when a file
  # transfer is not in progress, but let's play safe
  if (!defined($chat_session->{filedirection})) {
    send_command($chat_session, FILE_CANCEL, '');
    return;
  }

  my $remaining_size =
    $chat_session->{filetotalsize} - $chat_session->{filesize};
  #print "send block: size $chat_session->{filesize}, remaining: $remaining_size\n";

  if ($remaining_size == 0) {
    send_command($chat_session, FILE_END, '');
    file_stop($chat_session, "${chat_color}Finished transfer of file $chat_session->{filename}.\n");
    return;
  }

  my $block_size = $chat_session->{type} == MM
                   ? MM_FILE_BLOCK_SIZE : ZCHAT_FILE_BLOCK_SIZE;
  my $bytes_to_read = $remaining_size < $block_size
                      ? $remaining_size
                      : $block_size;
  #print "send block: block size is $block_size, we read $bytes_to_read\n";

  my $buffer;
  my $nread = sysread($chat_session->{filehandle},
                      $buffer, $bytes_to_read);
  #print "send block: read $nread bytes\n";
  if ($nread != $bytes_to_read) {
    # We have a problem
    send_command($chat_session,
                 MESSAGE,
                 ::colorize("${chat_color}Error while reading file.\n"));
    send_command($chat_session, FILE_CANCEL, '');
    file_stop($chat_session, "${chat_color}Error while reading file. File transfer canceled.\n");
    return;
  }

  #print "send block: adding " . ($block_size - $bytes_to_read) . " padding bytes.\n";
  my $block = $buffer . chr(0) x ($block_size - $bytes_to_read);
  send_command($chat_session, FILE_BLOCK, $block);
  $chat_session->{filesize} += $bytes_to_read;
  #print "send block: sent\n\n";
}



sub new_chat_window {
  #
  # Creates a new chat window.
  #

  my ($remotename, $chat_session) = @_;

  my $window = KCWin->new;
  $window->{chat_session} = $chat_session;
  $window->set_title("Chat: $remotename");
  $window->signal_connect(delete_event => sub {
                            $window->hide();
                            return 1;
                          });
  $window->signal_connect(focus_in_event => sub {
                            $window->{chat_session}->{window_has_focus} = 1;
                            if ($window->{chat_session}->{remotename}) {
                              $window->set_title("Chat: $window->{chat_session}->{remotename}");
                            }
                          });
  $window->signal_connect(focus_out_event => sub {
                            $window->{chat_session}->{window_has_focus} = 0;
                          });

  $window->{ENTRY}->signal_connect(activate => \&process_input, $chat_session);

  return $window;
}


sub feed_and_show {
  #
  # Feeds text to the window and shows the window. The text can have
  # color codes, colorize will be called automatically.
  #

  my ($chat_session, $text) = @_;

  my $window = $chat_session->{window};

  $window->feed(::colorize($text));
  unless ($chat_session->{window_has_focus}) {
    $window->set_title("(*) Chat: $chat_session->{remotename}");
  }
  $window->show;
}


sub get_version {
  #
  # Returns a version string sent to the other part
  #

  return "KildClient "    . ::getversion()
       . ", chat plugin " . $::world->getpluginversion(__PACKAGE__);
}


sub find_session {
  #
  # Finds a chat session for the given name
  #

  my ($name) = @_;

  foreach $chat (@chats) {
    next if $chat->{closed};
    return $chat if ($chat->{remotename} eq $name);
  }

  die("Could not find chat session '$name'");
}


sub remove_session {
  #
  # Removes the chat session from the list of connection
  #

  my ($chat_session) = @_;

  # FIXME: Actually remove it, and change UNLOAD correspondingly
  $chat_session->{closed} = 1;

  stop_snooped($chat_session);
}


#################################################################
# Automatic functions
#
sub UNLOAD {
  Glib::Source->remove($accept_id) if $accept_id;
  foreach my $chat (@chats) {
    next if $chat->{closed};
    $chat->{socket}->close;
    Glib::Source->remove($chat->{io_watch_id});
    $chat->{window}->destroy;
  }
}