#!/usr/bin/perl

#
# Perl-based Napster client... totally experimental. :)
#
# The program is designed to be highly modular, making it easy to add and
# remove functionality from the program.  I had documentation here, but
# it got way out of date, so I dumped it off. :)  Check out the examples
# for now... I'll try to write docs one day.
#
# Run with -h to see command-line parameters.
#

#
# First, import our library paths.  We assume the library directory is
# in either the same directory as the binary, or in ../lib (relative
# to the binary).  This allows the code to run straight from the tarball,
# installed in the system somewhere.
#

use FindBin;
use lib "$FindBin::Bin/libsnap";
use lib "$FindBin::Bin/../lib/libsnap";

#
# Now load the system libraries we need.
#

use Data::Dumper;
use IO::Select;
use IO::Socket;
use Net::hostent;
use Getopt::Long;
use Text::ParseWords;
use FileHandle;
use DirHandle;
use Fcntl;
use UNIVERSAL qw(isa);

#
# Hopefully this is somewhat portable... I need them, though.
#

use POSIX qw(_exit);
use POSIX "sys_wait_h";
use POSIX qw(strftime);

#
# Here is a neat little hack so we can attempt to load various optional
# libraries and recover if they don't exist.  I do it in a BEGIN block,
# since it seems Curses does some weird stuff that requires it to be
# loaded then... and I decided to be safe and load everything else then
# as well. :)
#

BEGIN
  {
    eval { require MD5; import MD5 };
    print "MD5 hash support not found... using dummy hash value.\n" if ($@);

    eval { require Time::HiRes; import Time::HiRes };

    if ($@)
      {
	print "HiRes timer support not found... UL throttling disabled.\n";
	undef %Time::HiRes::;
      }

    eval { require Net::SOCKS; import Net::SOCKS };

    if ($@)
      {
        print "SOCKS support not found... disabling SOCKS.\n";
        $SOCKS_LOADED = 0;
      }
    else
      {
        $SOCKS_LOADED = 1;
      }
  }

#
# Here we load the Snap libraries...
#

use SnapLib::Debug;
use SnapLib::NapSocket;
use SnapLib::Download;
use SnapLib::Upload;
use SnapLib::MessageTypes;
use MPEG::MP3Info;

# use strict 'vars';

#############################################################################

$SIG{INT} = sub { die_handler("SIGINT") };
$SIG{PIPE} = sub {       
                   my @call_info = caller;
                   my $info = "$call_info[1] line $call_info[2]";
                   die_handler("SIGPIPE: $! at $info") 
                 };

$SIG{CHLD} = \&reaper;

$SIG{__DIE__} = \&die_handler;
$SIG{__WARN__} = \&warn_handler;

my ($TRUE, $FALSE) = (1, 0);
my %SPEEDS = (0 => "Unknown", 1 => "14.4", 2 => "28.8", 3 => "33.6",
              4 => "56.7", 5 => "64K", 6 => "128K", 7 => "Cable",
              8 => "DSL", 9 => "T1", 10 => "T3+");

my $CLIENT_VERSION = "0.07";
my $CLIENT_ID = "Snap $CLIENT_VERSION";

my $REDIAL_DELAY = 60;
my $RC_FILE = "$ENV{HOME}/.snaprc";

my @SCRIPT_PATH = ("$FindBin::Bin/scripts",
		   "$FindBin::Bin/scripts/interfaces",

                   "$FindBin::Bin/../share/snap/scripts",
                   "$FindBin::Bin/../share/snap/scripts/interfaces");

my %command_hash = ("/quit" => [\&do_quit],
                    "/search" => [\&do_clear_results, \&do_search],
                    "/results" => [\&do_results],
                    "/get" => [\&do_send_download_request],
                    "/resume" => [\&do_resume],
                    "/dl" => [\&do_download_op],
                    "/ul" => [\&do_upload_op],
                    "/eval" => [\&do_eval],
                    "/reconnect" => [\&do_reconnect],
                    "/list" => [\&do_list_channels],
                    "/browse" => [\&do_clear_results, \&do_browse],
                    "/join" => [\&do_chan_join],
                    "/part" => [\&do_chan_part],
                    "/send" => [\&do_send_public],
                    "/whois" => [\&do_send_whois],
                    "/msg" => [\&do_send_private_msg],
                    "/users" => [\&do_get_user_list],
                    "/hotlist" => [\&do_hotlist],
                    "/exec" => [\&do_exec],
                    "/ping" => [\&do_ping],
                    "/speed" => [\&do_speed],
                    "/admin" => [\&do_admin],
                    "/me" => [\&do_emote],
                    "/op" =>[\&do_op_msg],
                    "/global" => [\&do_global_msg],
                    "/config" => [\&do_config],
                    "/help" => [\&do_help],
                    "/queue" => [\&do_queue],
		    "/alias" => [\&do_alias]);

my %help_hash = ("About" => \&do_about,
                 "/quit" => "Usage: /quit\n\n  Terminates the program.\n\n",
                 "/search" => \&do_search_help,
                 "/results" => \&do_results_help,
                 "/get" => \&do_get_help,
                 "/resume" => "Usage: /resume <num>\n\n  Resumes download file number <num> from search results.\n\n",
                 "/dl" => \&do_dl_help,
                 "/ul" => \&do_ul_help,
                 "/eval" => "Usage: /eval <expr> | -file <file>\n\n" .
                            "  Evaluates Perl expression or file.\n\n",
                 "/reconnect" => "Usage: /reconnect [host:port]\n\n  Connect to new server.\n\n",
                 "/list" => "Usage: /list\n\n  Lists channels on server.\n\n",
                 "/browse" => \&do_browse_help,
                 "/join" => "Usage: /join <chan>\n\n  Join channel <chan>\n\n",
                 "/part" => "Usage: /part [chan]\n\n  Part channel or current channel if none specified.\n\n",
                 "/send" => "Usage: /send <msg>\n\n  Send a message to the current channel.\n\n",
                 "/whois" => "Usage: /whois <user>\n\n  Do whois request on <user>.\n\n",
                 "/msg" => "Usage: /msg <user> <msg>\n\n  Send private message to <user>.\n\n",
                 "/users" => "Usage: /users\n\n  Get list of users in current channel.\n\n",
                 "/hotlist" => \&do_hotlist_help,
                 "/exec" => \&do_exec_help,
                 "/ping" => "Usage: /ping <user>\n\n  Send a ping to the specified user.\n\n",
                 "/speed" => "Usage: /speed <user>\n\n  Request the connection type of a given user.\n\n", 
                 "/admin" => \&do_admin_help,
                 "/me" => "Usage: /me <text>\n\n  Akin to IRC's /me command, this sends an emote to the channel.\n\n",
                 "/op" => "Usage: /op <text>\n\n  Attempt to send a message to all admins.\n\n",
                 "/global" => "Usage: /global <text>\n\n  Attempt to send a message to all users.\n\n",
                 "/config" => \&do_config_help,
                 "/queue" => \&do_queue_help,
		 "/alias" => \&do_alias_help,
                 "/help" => \&do_help_help);


my %code_hash = (&MSG_ERR => [\&print_text],
                 &MSG_LOGIN_ACK => [\&send_file_list, \&send_hotlist],
                 &MSG_SERVER_STATS => [],
                 &MSG_MOTD => [\&print_text],
                 &MSG_SEARCH_ACK => [\&get_search_result],
                 &MSG_SEARCH_END => [\&print_search_results],
                 &MSG_GET_ERR => [\&get_error],
                 &MSG_DL_ACK => [\&setup_download],
                 &MSG_QUEUE_LIMIT_REACHED => [\&download_rejected],
                 &MSG_LIST_CHANNELS_ENTRY => [\&get_channel],
                 &MSG_LIST_CHANNELS => [\&print_channels],
                 &MSG_BROWSE_ACK => [\&get_browse_result],
                 &MSG_BROWSE_END => [\&print_search_results],
                 &MSG_REG_OK => [\&nick_register_ok],
                 &MSG_REG_EALREADY => [\&nick_already_registered],
                 &MSG_REG_EINVALID => [\&nick_invalid],
                 &MSG_OP_EEXIST => [\&server_message],
                 &MSG_UPLOAD => [\&setup_upload],
                 &MSG_DL_ALT_ACK => [\&start_alt_upload],
                 &MSG_RCV_MSG => [\&print_public_message],
                 &MSG_JOIN_ACK => [\&join_channel],
                 &MSG_USER_LIST => [\&get_user_entry],
                 &MSG_USER_LIST_END => [\&print_user_list],
                 &MSG_JOIN_MSG => [\&user_joined],
                 &MSG_PART_MSG => [\&user_parted],
                 &MSG_CHAN_TOPIC => [\&print_chan_topic],
                 &MSG_WHOIS_ACK => [\&print_whois],
                 &MSG_WHOWAS_ACK => [\&print_whowas],
                 &MSG_PRIVATE => [\&print_private_msg],
                 &MSG_USER_LIST_2_ENTRY => [\&get_user_entry],
                 &MSG_USER_LIST_2 => [\&print_user_list],
                 &MSG_HOTLIST_ADD_ACK => [\&hotlist_add_ok],
                 &MSG_HOTLIST_ADD_ERR => [\&hotlist_add_err],
                 &MSG_USER_SIGNON => [\&user_sign_on],
                 &MSG_USER_SIGNOFF => [\&user_sign_off],
                 &MSG_PING => [\&ping_response],
                 &MSG_PONG => [\&pong_response],
                 &MSG_SPEED_ACK => [\&speed_response],
                 &MSG_EMOTE => [\&print_emote],
                 &MSG_OP_MSG => [\&print_op_msg],
                 &MSG_GLOBAL_MSG => [\&print_global_msg],
                 &MSG_OPENNAP_STATS => [\&print_server_stats],
                 &MSG_BANLIST_ENTRY => [\&get_banlist_entry],
                 &MSG_SHOW_BANLIST => [\&print_banlist],
                 &MSG_BAN_NOTIFY => [\&print_ban_notify],
                 &MSG_SET_PORT => [\&set_dataport],

                 &MSG_DISCONNECT => [\&server_disconnect],
		 
		 &MSG_RECV_DL_BLOCK => [],
		 &MSG_SENT_UL_BLOCK => [],
		 &MSG_DL_INIT => [],
		 &MSG_DL_START => [],
		 &MSG_DL_END => [\&queued_download_end],
		 &MSG_DL_ERR => [\&queued_download_end],
		 &MSG_UL_INIT => [],
		 &MSG_UL_START => [],
		 &MSG_UL_END => [],
		 &MSG_UL_ERR => [],
		 &MSG_SERVER_CONN => [],
		 &MSG_SERVER_CONN_ERR => [],

                 &MSG_SHUTDOWN => [ \&shutdown_prog ],

                 &MSG_INIT => [\&update_cache,
                               \&setup_socks,
                               \&setup_server, 
                               \&setup_new_connection,
			       \&login_to_napster]
                );

###########################################################################

my (@search_results, $search_sort_fields, @downloads, @uploads, @channels, 
    @connections, @hotlist, @banlist, @download_queue, %handles, @extensions, 
    %handler_trace);

my $active_channel;
my %user_lists;
my %pings;
my $cache;
my $search_pattern;
my $queue_transferring = 0;
my $queue_current;

my ($username, $password, $serverport, $speed, $email) = ('', '', 6699, 7, 'me@snap.com');
my $logname = "";
my $hotlist = "hotlist.txt";
my $cachefile = "cache.dat";
my $napster_sock;
my $server_sock;
my $metaserver = "server.napster.com";
my $metaport = "8875";
my $newuser = 0;
my $daemon = 0;
my $colours = 1;
my ($ul_speed, $ul_limit) = (-1, -1);
my @host;

my $socks_server = undef;
my ($socks_user, $socks_pass, $socks_version) = ("", "", 5);
my $socks = 0;
my $socks_ref;

Getopt::Long::config("pass_through");
Getopt::Long::config("no_ignore_case");

{
  my $snapname;
  my $help;
  my $eval_func;
  my @eval_file;
  my $daemon_mode;
  my @trace;
  my @log_messages;
  my $print_messages;

  my %optctl = ("i" => \$snapname,
                "e" => \$eval_func,
		"f" => \@eval_file,
                "d" => \$daemon_mode,
		"t" => \@trace,
		"w" => \@log_messages,
		"c" => \$print_messages);

  GetOptions(\%optctl, "i=s", "e=s", "f=s@", "d!", "t=s@", "w=s@", "c!");

  if ($print_messages)
    {
      my $i = 0;

      print "\nAvailable Callback Types:\n\n";

      foreach (grep {/^MSG.*$/} sort keys %SnapLib::MessageTypes::)
        {
	  print "$_"; $i++;
  
	  if ($i == 3)
	    { 
	      print "\n"; 
	      $i = 0;
	    }
	  else
	    { print " " x (25 - length($_)); }
        }

      print "\n";

      exit(0);
    }

  if (defined $daemon_mode) { $daemon = 1; }
  if (defined $snapname) { $RC_FILE = $snapname; }
  if (defined $eval_func) { eval $eval_func; print "$@\n" if ($@); }

  if ($#eval_file >= 0) 
    { 
      foreach (@eval_file) 
        { eval_file($_) }
    }

  if ($#trace >= 0) 
    { 
      foreach (@trace) 
        { 
	  eval("\$handler_trace{\&$_} = \"$_\""); 
        }
    }

  if ($#log_messages >= 0) 
    { 
      foreach (@log_messages)
        { SnapLib::Debug::add_debug_catagory($_); }
    }  
  else
    { SnapLib::Debug::add_debug_catagory("all"); }
}

if (! -e $RC_FILE)
  { 
    print "Error, unable to load RC file!  This could cause login errors.\n";
    print "Loading plain text interface by default...\n";

    eval_file('Plain.pl');
  }
else
  {
    eval_file($RC_FILE);
  }

Getopt::Long::config("no_pass_through");

{
  my $serverstr = "";
  my $mserver;
  my $redial;
  my $new;
  my $log;
  my $daemon_mode;
  my $help;
  my $bw;
  my %optctl = ("s" => \$serverstr,
                "m" => \$mserver,
                "r" => \$redial,
                "n" => \$new,
                "l" => \$log,
                "u" => \$username,
                "p" => \$password,
                "o" => \$serverport,
                "h" => \$help,
		"b" => \$bw,

                "S" => \$socks_server,
                "U" => \$socks_user,
                "P" => \$socks_pass,
                "v" => \$socks_version);

  if (!GetOptions(\%optctl, "s=s", "m=s", "r=f", "n!", "l=s", "i=s",
                  "u=s", "p=s", "o=i", "h!", "b!", "S=s", "U=s", "P=s",
                  "v=i"))
    {
      do_cmdline_help();
      exit(0);
    }

  if (defined $help)
    {
      do_cmdline_help();
      exit(0);
    }

  if ($serverstr ne undef)
    {
      if ($serverstr =~ /(.*):(.*)/)
        { 
          $host[0] = $1; $host[1] = $2; 
        }
      else
        {
          print "Invalid server specification: $serverstr\n";
          exit(0);
        }
    }

  if (defined $mserver)
    {
      if ($mserver =~ /(.*):(.*)/)
        {
          $metaserver = $1; $metaport = $2;
        }
      else
        { 
          print "Invalid metaserver specification: $mserver\n";
          exit(0);
        }
    }

  if (defined $redial)
    {
      $REDIAL_DELAY = $redial;
    }

  if (defined $new) { $newuser = $new; }
  if (defined $log) { $logname = $log; }
  if (defined $daemon_mode) { $daemon = $daemon_mode; }
  if (defined $bw) { $colours = 0; }
  if (defined $socks_server)
    {
      $socks = 1;
    }
}

STDOUT->autoflush(1);              # Set screen to autoflush.

debug_init($logname);
call_handler(MSG_INIT, $napster_sock);
main_loop();

############################### Signal Handlers ###########################

sub reaper
{
  my $child;
  my $trans;
  my $i;

  debug_print("Reaper", "Reaper started...\n");

  while(($pid = waitpid(-1, &WNOHANG)) > 0)
    {
      my @transfers = (@uploads, @downloads);

      debug_print("Reaper", "Finding $pid...\n");

      foreach (@transfers)
	{
	  if ($$_{"pid"} == $pid)
	    {
	      debug_print("Reaper", "Found entry: $_\n");

	      if (isa($_, 'SnapLib::Upload'))
		{ kill_ul($napster_sock, $_); }
	      elsif (isa($_, 'SnapLib::Download'))
		{ kill_dl($napster_sock, $_); }

	      debug_print("Reaper", "$pid died...\n");
	    }
         }
    }      
  
  debug_print("Reaper", "Done reaping...\n");

  $SIG{CHLD} = \&reaper;
};

sub warn_handler
{
  print $_[0];

  $SIG{__WARN__} = \&warn_handler;
}

sub die_handler
{
  call_handler(MSG_SHUTDOWN, $napster_sock, $_[0]) if (! $^S);

  $SIG{__DIE__} = \&die_handler;
}

################################# File Stuff ###############################

sub eval_file
{
  my $filename = shift;
  my $dir;

  foreach $dir (@SCRIPT_PATH)
    {
      if (-e "$dir/$filename")
        {
          $filename = "$dir/$filename";
          last;
        }
    }

  my $f = new FileHandle "<$filename";
  my $cmd;

  if (defined $f)
    {
      $cmd = join(" ", <$f>);
      $f->close();
    }
  else
    {
      print "Error opening $filename: $!\n";

      return;
    }

  no strict;

  my $old_handler = $SIG{__DIE__};
  
  $SIG{__DIE__} = sub { return; };
  eval $cmd;
  $SIG{__DIE__} = $old_handler;

  print "$filename: $@\n" if ($@);
}

######################### Napster Initialization #######################

sub setup_socks
{
  if ($socks && $SOCKS_LOADED)
    {
      my ($socks_addr, $socks_port) = split(/:/, $socks_server);

      $socks_ref = new Net::SOCKS(socks_addr => $socks_addr,
                                  socks_port => $socks_port,
                                  user_id => $socks_user,
                                  user_password => $socks_pass,
                                  protocol_version => $socks_version);

      $serverport = 0;
    }
  else
    {
      $socks = 0;
      $socks_ref = undef;
    }
}

sub setup_new_connection
{
  if (defined $napster_sock)
    {
      delete $handles{$napster_sock};
      $napster_sock->close();
    } 

  $napster_sock = SnapLib::NapSocket->new($metaserver, $metaport,
				       $host[0], $host[1], $REDIAL_DELAY, 
                                       $socks_ref);

  $handles{$napster_sock} = { Handle => $napster_sock,
			      Callback => \&check_napster };

  if (! defined $napster_sock)
    {
      call_handler(MSG_SHUTDOWN, $napster_sock, "Couldn't connect to server!\n");
    }
}

sub login_to_napster
{
  my $sock = shift;
  my $text;
  my $count = 0;

  if ($newuser)
    {
      print "Registering new user...\n";

      debug_print("Registration", "Requesting $username...\n");

      $text = "$username";
      $sock->send(MSG_REG, $text, 1);
    }
  else
    {
      my $client;

      print "Logging in...\n";

      debug_print("Login", "$username, $password, $serverport, $speed\n");

      $text = "$username $password $serverport \"$CLIENT_ID\" $speed";
      $sock->send(MSG_LOGIN, $text, 1);
    }
}

sub setup_server
{
  if ($serverport)
    { print "Running server on port $serverport...\n"; }
  else
    { print "Running server in push mode...\n"; }

  return if (! $serverport);

  $server_sock = IO::Socket::INET->new(Proto => 'tcp',
                                       LocalPort => $serverport,
                                       Listen => SOMAXCONN,
                                       Reuse => 1);

  $handles{$server_sock} = { Handle => $server_sock,
			     Callback => \&setup_server_conn };

  if (! $server_sock)
    {
      call_handler(MSG_SHUTDOWN, $napster_sock, 
                   "Couldn't create server socket (someone using the port?).");
    }
}

sub shutdown_server
{
  close($server_sock);
}

################################# Misc Code ##############################

sub shutdown_prog
{
  my $sock = shift;
  my $message = shift;

  while ($#uploads >= 0) { kill_ul($sock, 0); }
  while ($#downloads >= 0) { kill_dl($sock, 0); }

  if ($#hotlist >= 0)
    {
      my $file = new FileHandle ">$hotlist";

      if (defined $file)
        {
	  foreach (@hotlist)
	    { print $file "$_\n"; }
      
	  close $file;
	}
      else
        {
	  warn("Couldn't create hotlist: $!\n");
        }
    }

  shutdown_server();
  close($sock) if (defined $sock);

  debug_print("Shutdown", "Terminating...\n");
  debug_print("Shutdown", "Error: $message\n") if (defined $message);

  print STDERR "$message\n" if ($message);

  exit(0);
}

sub read_dir_tree
{
  my $dir = shift;
  my $handle = new DirHandle "$dir";

  if (! $handle)
    {
      debug_print("DirTree", "Couldn't read $dir, skipping...\n");
      print "Couldn't read $dir, skipping...\n";

      return;
    }

  my @list = $handle->read();
  my @results;

  close $handle;

  debug_print("DirTree", "Reading $dir...\n");

  foreach $entry (@list)
    {
      next if ($entry =~ /^\.{1,2}/);

      if ((-d "$dir/$entry") && (! -l "$dir/$entry"))
        {
          push @results, read_dir_tree("$dir/$entry");
        }
      else
        {
          push @results, "$dir/$entry";
        }
    }

  debug_print("DirTree", "Done reading $dir...\n");

  return @results;
}

sub read_cache_file
{
  my $fname = shift;
  my $file = new FileHandle "<$fname";
  my @lines = <$file>;
  my $line;
  my %cache;

  $file->close() if (defined $file);

  foreach $line (@lines)
    {
      my ($name, $id, $size, $bitrate, $freq, $time);

      $line =~ /\"(.+?)\" (.+?) (.+?) (.+?) (.+?) (.+?)/;

      $name = $1;

      $cache{$name}{"id"} = $2;
      $cache{$name}{"size"} = $3;
      $cache{$name}{"bitrate"} = $4;
      $cache{$name}{"freq"} = $5;
      $cache{$name}{"time"} = $6;
    }

  return \%cache;
}

sub write_cache_file
{
  my $fname = shift;
  my $cache = shift;
  my $file = new FileHandle ">$fname";
  my $entry;

  if (! $file)
    {
      warn("Couldn't create cache file: $!\n");
      return;
    }
  
  foreach $entry (keys %$cache)
    {
      next if ($entry eq "");

      print $file "\"$entry\" " .
                  "$$cache{$entry}{id} " .
                  "$$cache{$entry}{size} " .
                  "$$cache{$entry}{bitrate} " . 
                  "$$cache{$entry}{freq} " . 
                  "$$cache{$entry}{time}\n";
    }

  close $file;
}

sub getopts
{
  my $optref = shift;  
  my $paramref = shift;
  my $quiet = shift;
  my $ignore = shift;
  my %opts = %$optref;
  my @params = @$paramref;

  my ($curop, $curcount);
  my ($param, $entry);
  my $isopt;
  my %results;

  while ($#params >= 0)
    {
      $param = shift @params;
      $entry = $param;

      if ($entry =~ /^-/)
        {
          $isopt = 1;
          $entry =~ s/^-//;
        }
      else
        {
          $isopt = 0;
        }

      # First, check if we've run into a new option that makes sense.

      if ((defined $opts{lc($entry)}) && ($isopt))
        {
	  # We have, so... is the current option complete?

          if ($curcount < $opts{lc($curop)})
            { 
              warn "Error in parameters to $curop..." if (! defined $quiet);
              return undef; 
            }
          elsif (($curcount > $opts{lc($curop)}) &&
                 ($opts{lc($curop)} >= 0))  # Or overly complete?
            {
              if (defined $ignore)
                {
                  push @params, $param;
                  last;
                }
              else
                {
                  warn "Error in parameters to $curop..." if (! defined $quiet);
                  return undef;
                }
            }          

	  # Otherwise, the last option was fine, so we move onto this one.

          $curop = $entry;
          $curcount = 0;

          $results{lc($curop)} = [] if (! defined $results{lc($curop)});
        }
      elsif ((! defined $curop) || ($isopt))
        {
          warn "Invalid flag: $param" if (! defined $quiet);

	  if ($ignore)
	    {
	      unshift @params, $param;
	      last;
  	    }
	  else
  	    { return; }
        }  
      elsif (($curcount == $opts{lc($curop)}) && (defined $ignore))
        {
          unshift @params, $param;
          last;
        }
      elsif ($curcount == $opts{lc($curop)})
        {
          warn "Error in parameters to $curop..." if (! defined $quiet);
          return undef; 
        }
      else
        {
          push @{ $results{lc($curop)} }, $entry;
          $curcount++;
        }
    }

  if ($curcount < $opts{lc($curop)})
    { 
      warn "Error in parameters to $curop..." if (! defined $quiet);
      return undef; 
    }
  elsif (($curcount > $opts{lc($curop)}) && 
         ($opts{lc($curop)} >= 0) &&
         (! defined $ignore))
    {
      warn "Error in parameters to $curop..." if (! defined $quiet);
      return undef;
    }          

  @$paramref = @params;

  return \%results;
}

sub do_cmdline_help
{
  print '
Command-line params:

-h             Display this help page.
-m ip:port     Specify a metaserver to retrieve server ip/port from.
-s ip:port     Specify specific server to connect to.  
-r float       Specifies the redial delay in seconds.  Can take fractional
               values (ie 0.1 == 1 tenth of a second). Default: 60s.
-u name        Specify user name.
-p password    Specify password.
-o port        Specify local port number
-i rcfile      Specify alternate rc file to load.
-n             Register as new user.
-d             Run in server mode (no interface).
-b             Disable colours (b/w mode).
-e string      Evaluate <string> as a Perl program during startup.
-f file        Evaluate <file> as a Perl program within Snap.

-l logfile     Specify a logfile name for debug output.
-t cb_type     Enable debug tracing for specified callback type.
-c             Print available callback types.
-w log_cat     Debug catagory to log.  Default: all.
';

if ($SOCKS_LOADED)
  {
    print '
-S ip:port     Enable SOCKS with the specified server.
-U name        Specify the SOCKS user name.
-P password    Specify the SOCKS password.
-v version     Specify the SOCKS protocol version (4 or 5). Default: 5.
';
  }

print "\n";
}

sub perform_call
{
  my $handler = shift;

  if (ref($handler) eq "ARRAY")
    {
      foreach (@$handler) 
        { 
          perform_call($_, @_);
        }
    }
  elsif (ref($handler) eq "CODE")
    {
      &$handler(@_);
    }
  elsif (! ref($handler))
    {
      do_command($napster_sock, $handler);
    }  
}

sub call_handler
{
  my $cmd = shift;

  if (defined $handler_trace{$cmd})
    {
      my @dump_data = split(/\n/, Dumper(\@_));
      my @call_info = caller;
      my $info = "$call_info[1] line $call_info[2]";
      
      debug_print("Callback", "$cmd ($handler_trace{$cmd}) called at $info:\n");

      foreach (@dump_data)
        {
	  debug_print("Callback", "  $_\n");
        }
    }

  if (! defined $code_hash{$cmd})
    {
      debug_print("Callback", "!! Unknown command: $cmd\n");
      return undef;    
    }

  perform_call($code_hash{$cmd}, @_);

  return 1;
}

################### Routines for processing server commands #################

sub update_cache
{
  my ($sock, $text) = @_;
  my $file;

  return if ((! defined $upload) || ($upload eq ""));

  print "Loading share data...\n";

  my @list = read_dir_tree("$upload");
  $cache = read_cache_file("$cachefile");

  foreach $file (keys %$cache)
    {
      next if ((-e $file) && ($file =~ /^\Q$upload\E/));

      debug_print("Cache", "Removing $file...\n");      
      delete $$cache{$file};
    }

  foreach $file (@list)
    {
      next if ($file !~ /\.mp3$/);
      next if (defined $$cache{$file});

      debug_print("Cache", "Adding $file...\n");

      my $fhandle = new FileHandle("$file");

      if ((defined $fhandle) && (defined %MD5::))
        {
          my $md5 = new MD5;
          my $data;
          
          sysread($fhandle, $data, 299008);
          $fhandle->close();
          
          $md5->add($data);
          $$cache{$file}{"id"} = unpack("H*", $md5->digest());
        }
      else
        { $$cache{$file}{"id"} = '00000000000000000000000000000000'; }

      my @stat_info = stat "$file";
      my $info = get_mp3info("$file");

      $$cache{$file}{"size"} = $stat_info[7];
      $$cache{$file}{"bitrate"} = $$info{"BITRATE"};
      $$cache{$file}{"freq"} = $$info{"FREQUENCY"} * 1000;
      $$cache{$file}{"time"} = $$info{"MM"} * 60 + $$info{"SS"};      
    }

  my @keys = keys %$cache;

  write_cache_file("$cachefile", $cache) if ($#keys >= 0);

  foreach $file (sort keys %$cache)
    {
      my $mangled_name = $file;

      $mangled_name =~ s/^\Q$upload\E//g;
      $mangled_name =~ s/\//\\/g;

      $$cache{$file}{name} = $mangled_name;
    }
}

sub send_file_list
{
  my ($sock, $text) = @_;
  my $file;

  foreach $file (sort keys %$cache)
    {
      next if ($file eq "");

      $sock->send(MSG_FILE_INFO, "\"$$cache{$file}{name}\" " . 
                                           "$$cache{$file}{id} " .
                                           "$$cache{$file}{size} " . 
                                           "$$cache{$file}{bitrate} " . 
                                           "$$cache{$file}{freq} " .
                                           "$$cache{$file}{time}");
    }
}

sub print_text
{
  my ($sock, $text) = @_; 
  my $tabstr = " " x $TAB_WIDTH;

  $$text =~ s/\t/$tabstr/g;
  $$text =~ s/\015//g;

  print "$$text\n";
}

sub get_search_result
{
  my ($sock, $text) = @_; 
  my %song;

  $$text =~ /\"(.+?)\" (.+?) (\d+?) (\d+?) (\d+?) (\d+?) (.+?) (\d+?) (\d)/;

  $song{"name"} = $1;
  $song{"id"} = $2;
  $song{"size"} = $3;
  $song{"bitrate"} = $4;
  $song{"frequency"} = $5;      
  $song{"number"} = $6;
  $song{"user"} = $7;
  $song{"ip"} = $8;
  $song{"speed"} = $9;

  if ((! defined $search_pattern) ||
      ($song{"name"} =~ /$search_pattern/))
    {
      if ($search_sort_fields ne "")
        {
          my $i;
          my $point = $#search_results + 1;

          # I know, I know, this should be written as a binary search + insert,
          # but this works well enough... :)
          
          for ($i = 0; $i <= $#search_results; $i++)
            {
              my $current = do_results_sort($search_results[$i], \%song, $search_sort_fields);
              
              if ($current > 0)
                {
                  $point = $i;
                  
                  last;
                }
            }
          
          @search_results = (@search_results[0 .. $point - 1], 
                             \%song, 
                             @search_results[$point .. $#search_results]);
        }
      else
        {
          push @search_results, \%song;
        }
    }
}

sub get_browse_result
{
  my ($sock, $text) = @_; 
  my %song;

  $$text =~ /(.+?) \"(.*)\" (.+?) (\d+?) (\d+?) (\d+?) (\d+?)/;
  $song{"user"} = $1;
  $song{"name"} = $2;
  $song{"id"} = $3;
  $song{"size"} = $4;
  $song{"bitrate"} = $5;
  $song{"frequency"} = $6;      
  $song{"number"} = $7;
  $song{"speed"} = 0;

  if ((! defined $search_pattern) ||
      ($song{"name"} =~ /$search_pattern/))
    {
      if ($search_sort_fields ne "")
        {
          my $i;
          my $point = $#search_results + 1;
          
          for ($i = 0; $i <= $#search_results; $i++)
            {
              my $current = do_results_sort($search_results[$i], \%song, $search_sort_fields);
              
              if ($current > 0)
                {
                  $point = $i;
                  
                  last;
                }
            }
          
          @search_results = (@search_results[0 .. $point - 1], 
                             \%song, 
                             @search_results[$point .. $#search_results]);
        }
      else
        {
          push @search_results, \%song;
        }
    }
}

sub print_search_results
{
  my ($sock, $text) = @_; 
  my $id;
  my $count = 1;
  my $song;

  print "~2;Song | Size | Bitrate | Frequency | User | Speed~c;\n";
  print "~2;------------------------------------------------~c;\n";
  
  foreach $song (@search_results)
    {
      my $name;
      my $size;
      
      $$song{"name"} =~ /(.*\/|.*\\)?(.*\.mp3)/;

      print("~2;$count. " .
                      "$2 " .
                      sprintf("%.2f", $$song{"size"}/1000000) . "mb " .
                      "$$song{bitrate} $$song{frequeny} $$song{user} " .                      
                      $SPEEDS{$$song{"speed"}} . "~c;\n");

      $count++;
    }
}

sub get_error
{
  my ($sock, $text) = @_; 
  my ($user, $file);
  my $dl;

  $$text =~ /(.+?) (.+)/;
  $user = $1; $file = $2;

  foreach (@downloads)
    {
      $dl = $_ if (($_->{"sentname"} eq $user) &&
                   ($_->{"user"} eq $file));
    }

  @downloads = grep { $_ ne $dl } @downloads;

  print "Error getting $file from $user (perhaps he logged off).\n";

  debug_print("DL", "Error getting $file from $user...\n");

  call_handler(MSG_DL_ERR, $sock, { 'sentname' => $file, 'user' => $user });
}

sub setup_download
{
  my ($sock, $text) = @_; 
  my ($user, $filename, $sentname, $ip, $port, $id, $speed);
  my ($result, $song);
  my $dl_entry;
  my $dl = undef;
  my $found = 0;

  $$text =~ /(.+?) (\d+) (\d+) \"(.*)\" (.+) (\d)/;
  $user = $1; $ip = $2; $uport = $3; $sentname = $4; $id = $5; $speed = $6;
  $filename = $sentname;
  $filename =~ s/\\/\//g;

  foreach $dl_entry (@downloads)
    {
      if (($$dl_entry{"user"} eq $user) &&
          ($$dl_entry{"sentname"} eq $sentname))
        { 
          $found = 1;
          $dl = $dl_entry; last; 
        }
    }

  if (! defined $dl)
    {
      print "Error, no download request to match offer!  Ignoring...\n";
      return;
    }

  my ($a, $b, $c, $d) = unpack('C4', pack('V', $ip));
  $ip = "$a.$b.$c.$d";

  foreach $song (@search_results)
    {  
      $result = $song; 
      last if (($$song{"user"} eq $user) &&
               ($$song{"name"} eq $sentname)); 
    }

  $$dl{"ip"} = $ip;
  $$dl{"user"} = $user;
  $$dl{"filename"} = $filename;
  $$dl{"sentname"} = $sentname;
  $$dl{"size"} = $$result{"size"};
  $$dl{"pos"} = 0;
  $$dl{"received"} = 0;
  $$dl{"type"} = "DOWNLOAD";

  $filename =~ /(.*\/|.*\\)?(.*\.mp3)/i;
  my $local_name = $2;

  $$dl{"local_name"} = $local_name;

  if ($$dl{"resume"})
    {
      my @stat_info = stat "$download/$local_name";

      $$dl{"pos"} = $stat_info[7];
      $$dl{"received"} = $$dl{"pos"};
      $$dl{"file"} = new FileHandle ">>$download/$local_name";
    }
  else
    {
      $$dl{"file"} = new FileHandle ">$download/$local_name";
    }

  if (! defined $$dl{"file"})
    {
      print "Error, couldn't create file: $download/$local_name.\n";

      @downloads = grep { $_ ne $dl } @downloads;
      delete $handles{$$dl{"socket"}};

      debug_print("DL", "Error, couldn't create file: $download/$local_name.\n");

      call_handler(MSG_DL_ERR, $sock, $dl);

      return;
    }  

  $$dl{"file"}->autoflush(1);
  
  debug_print("DL", "New DL from $user ($ip:$uport), $filename " .
                 "($$result{size})" .
                 " -> $local_name\n");

  if (! $found) { push @downloads, $dl; }

  if ($uport == 0)
    {
      if ($serverport != 0)
        {
	  print "Firewalled user, using alternate download...\n";
	  debug_print("DL", "Alternate Download Method Used...\n");

	  $sock->send(MSG_DL_REQ_ALT, "$user \"$sentname\"");
	  $$dl{"status"} = 3;
	}
      else
        {
	  print "Firewalled user, unable to download...\n";

	  pop @downloads;

	  call_handler(MSG_DL_ERR, $sock, $dl);
        }

      return;
    }
  else
    {
      my $proto = getprotobyname("tcp");
      my $new_sock;

      if (! $socks)
        {
          $new_sock = IO::Socket::INET->new();

          if ($new_sock->socket(PF_INET, SOCK_STREAM, $proto))
            {
              fcntl($new_sock, F_SETFL, O_NONBLOCK);
              $new_sock->connect($uport, inet_aton($ip));
              fcntl($new_sock, F_SETFL, 0);
            }
          else
            {
              $new_sock = undef;
            }
        }
      else
        {
          $new_sock = $socks_ref->connect(peer_addr => $ip,
                                          peer_port => $uport);
        }

      if (! defined $new_sock)
        {
          print "Error opening download socket to $ip:$uport!\n";

          if (defined $socks)
            {
              print "Socks: ", 
              Net::SOCKS::status_message($socks_ref->param('status_num')),
              "\n";
            }

          pop @downloads;
          
          call_handler(MSG_DL_ERR, $sock, $dl);
          return;
        }

      $handles{$new_sock} = { Handle => $new_sock,
                              Callback => \&download_handshake };

      $$dl{"status"} = 0;
      $$dl{"socket"} = $new_sock;

      call_handler(MSG_DL_INIT, $sock, $dl);
    }
}

sub download_rejected
{
  my ($sock, $text) = @_; 
  my ($user, $filename, $size, $count);
  my $dl;

  $$text =~ /(.*?) \"(.*?)\" (\d+?) (\d+?)/;
  $user = $1; $filename = $2; $size = $3; $count = $4;

  foreach (@downloads)
    {
      $dl = $_ if (($_->{"sentname"} eq $filename) &&
                   ($_->{"user"} eq $user));
    }

  print "Download from $user for $filename rejected...\n";

  @downloads = grep { $_ ne $dl } @downloads;

  call_handler(MSG_DL_ERR, $sock, $dl);
}

sub print_channels
{
  my ($sock, $text) = @_; 
  my $entry;
  my $count = 1;
  
  foreach $entry (@channels)
    {
      print "$count. $$entry{name}\n";
      $count++;
    }
}

sub get_channel
{
  my ($sock, $text) = @_; 
  my %entry;

  $$text =~ /(.+?) (.+?) (.+?)/;

  $entry{"name"} = $1;
  $entry{"users"} = $2;
  $entry{"topic"} = $3;

  push @channels, \%entry;
}

sub nick_register_ok
{
  my ($sock, $text) = @_; 
  my $msg;

  $msg = "$username $password $serverport \"nap v0.6\" $speed $email";

  debug_print("Registration", "Sending user info:  $username, $password, $serverport, $speed, $email\n");
  $sock->send(MSG_REG_INFO, $msg, 1);
}

sub nick_already_registered
{
  my ($sock, $text) = @_; 

  debug_print("Registration", "Error, nick already registered!");
  print "Registration failure: Nick already registered!";
}

sub nick_invalid
{
  my ($sock, $text) = @_; 

  debug_print("Registration", "Error, invalid nick!");
  print "Registration failure: Nick invalid!";
}

sub server_message
{
  my ($sock, $text) = @_; 

  debug_print("Napster", "Server: $$text\n");
  print "Server: $$text\n";
}

sub setup_upload
{
  my ($sock, $text) = @_; 
  my %upload;
  my ($user, $filename, $sentname);

  $$text =~ /(.+?) "(.*)"/;
  $user = $1;
  $sentname = $2;

  debug_print("Server", "Got upload request from $user for $sentname... sending ack\n");
  print "Got upload request from $user for $sentname...\n";

  if (($ul_limit >= 0) && ($#uploads + 1 >= $ul_limit))
    {
      debug_print("Server", "Upload limit ($ul_limit uploads) reached, ignoring upload request...\n");
      print "Upload limit ($ul_limit uploads) reached, ignoring upload request...\n";

      $sock->send(MSG_QUEUE_LIMIT, "$user \"$sentname\" 0");

      return;
    }

  $upload{"user"} = $user;
  $upload{"sentname"} = $sentname;
  $upload{"socket"} = undef;
  $upload{"type"} = "UPLOAD";

  foreach (keys %$cache)
    { 
      if ($$cache{$_}{name} eq $sentname)
        {
          $upload{"filename"} = $_;
          last;
        }
    }

  if ($ul_speed >= 0) { $upload{"limit"} = $ul_speed; }

  push @uploads, \%upload;

  $sock->send(MSG_UPLOAD_ACK, $$text);

  call_handler(MSG_UL_INIT, $sock, \%upload);
}

sub start_alt_upload
{
  my ($sock, $text) = @_; 
  my ($upload, $up);

  my ($user, $filename, $sentname, $ip, $port, $id, $speed);
  my ($result, $song);
  my $filesize;

  $$text =~ /(.+?) (\d+) (\d+) \"(.*)\" (.+) (\d)/;
  $user = $1; $sentname = $4; $ip = $2; $port = $3; $id = $5; $speed = $6;

  my ($a, $b, $c, $d) = unpack('C4', pack('V', $ip));
  $ip = "$a.$b.$c.$d";

  foreach $up (@uploads)
    {
      if (($$up{"user"} eq $user) &&
          ($$up{"sentname"} eq $sentname))
        {
          $upload = $up; last;
        }
    }

  my @stat_info = stat "$$upload{filename}";
  $filesize = $stat_info[7];

  $filename = $$upload{filename};

  $$upload{"ip"} = $ip;
  $$upload{"size"} = $filesize;
  $$upload{"sent"} = 0;
  $$upload{"file"} = new FileHandle "$filename";
  $$upload{"status"} = 2;

  if (! defined $$upload{"file"})
    {
      print "Couldn't open upload file: $filename.\n";

      @uploads = grep { $_ ne $upload } @uploads;

      call_handler(MSG_UL_ERR, $sock, $upload);

      return;
    }  

  my $proto = getprotobyname("tcp");
  my $new_sock;

  if (! $socks)
    {
      $new_sock = IO::Socket::INET->new();
      
      if ($new_sock->socket(PF_INET, SOCK_STREAM, $proto))
        {     
          fcntl($new_sock, F_SETFL, O_NONBLOCK);
          $new_sock->connect($port, inet_aton($ip));
          fcntl($new_sock, F_SETFL, 0);
        } 
      else
        {
          $new_sock = undef;
        }
    }
  else
    {
      $new_sock = $socks_ref->connect(peer_addr => $ip,
                                      peer_port => $port);
    }

  if (! defined $new_sock)
    {
      print "Error, couldn't create upload socket to $ip:$port!\n";      

      if (defined $socks)
        {
          print "Socks: ", 
          Net::SOCKS::status_message($socks_ref->param('status_num')),
          "\n";
        }      

      @uploads = grep { $_ ne $upload } @uploads;
      
      call_handler(MSG_UL_ERR, $sock, $upload);
      
      return;
    }

  debug_print("UL", "New ALT UL to $user ($ip:$port), $filename.\n");
  print "New ALT Upload to $user for $filename...\n";

  $handles{$new_sock} = { Handle => $new_sock,
                          Callback => \&upload_handshake };

  $$upload{"socket"} = $new_sock;
}

sub join_channel
{
  my ($sock, $text) = @_; 

  $active_channel = $$text;
  push @channels, $active_channel;

  print "Joined $$text.\n";
}

sub print_public_message
{
  my ($sock, $text) = @_; 

  my ($channel, $nick, $msg);

  $$text =~ /(.+?) (.+?) (.*)/;

  $channel = $1; $nick = $2; $msg = $3;

  if ($channel eq $active_channel)
    {
      print "<$nick> $msg\n";
    }
}

sub get_user_entry
{
  my ($sock, $text) = @_; 
  my ($channel, $user, $sharing, $speed);
  my %user_entry;

  $$text =~ /(.+?) (.+?) (\d+?) (\d+)/;

  $channel = $1; $user = $2; $sharing = $3; $speed = $4;

  $user_entry{"user"} = $user;
  $user_entry{"sharing"} = $sharing;
  $user_entry{"speed"} = $speed;

  push @{ $user_lists{$channel} }, \%user_entry;
}

sub print_user_list
{
  my ($sock, $text) = @_; 
  my $channel = $$text;
  my $channel_list;
  my $user;
  
  $channel = $active_channel if ($channel eq "");

  $channel_list = $user_lists{$channel};

  print "Userlist for $channel:\n";

  foreach $user (@$channel_list)
    {
      print "$$user{user} ";
    }

  print "\n\n";
}

sub user_joined
{
  my ($sock, $text) = @_; 
  my ($channel, $user, $sharing, $speed);
  my %user_entry;

  $$text =~ /(.+?) (.+?) (\d+?) (\d+)/;

  $channel = $1; $user = $2; $sharing = $3; $speed = $4;

  $user_entry{"user"} = $user;
  $user_entry{"sharing"} = $sharing;
  $user_entry{"speed"} = $speed;

  push @{ $user_lists{$channel} }, \%user_entry;

  print "$user has joined $channel.\n";
}

sub user_parted
{
  my ($sock, $text) = @_; 
  my ($channel, $user, $sharing, $speed);
  my $channel_list;
  my $entry;
  my $count;

  $$text =~ /(.+?) (.+?) (\d+?) (\d+)/;

  $channel = $1; $user = $2; $sharing = $3; $speed = $4;

  foreach $entry (@{ $user_lists{$channel} })
    {
      last if ($$entry{"user"} eq $user);

      $count++;
    }

  splice (@{ $user_lists{$channel} }, $count, 1);

  print "$user has parted $channel.\n";
}

sub print_chan_topic
{
  my ($sock, $text) = @_; 
  my $channel;
  my $topic;

  $$text =~ /(.+?) (.*)/;
  $channel = $1; $topic = $2;

  print "Topic for $channel: $topic\n";
}

sub print_whois
{
  my ($sock, $text) = @_; 
  my ($nick, $level, $time, $channels, $status, $shared, 
      $downloads, $uploads, $speed, $client_info);
  my $title = "Whois Response:";

  $$text =~ /(.+?) \"?(.+?)\"? (.+?) "(.*?)" "(.+?)" (.+?) (.+?) (.+?) (.+?) "(.+?)"/;

  $nick = $1; $level = $2; $time = $3; $channels = $4; $status = $5;
  $shared = $6; $downloads = $7; $uploads = $8; $speed = $9;
  $client_info = $10;

  my $hours = int($time / 60);
  my $minutes = int($time % 60);

  $hours = "0" . $hours if ($hours < 10);
  $minutes = "0" . $minutes if ($minutes < 10);

  $time = "$hours:$minutes";

  print "\n$title\n" . "-" x length($title) . "\n" .
                  "User: $nick ($level)\n" .
                  "Time: $time\n" .
                  "Channels: $channels\n" .
                  "Status: $status\n" .
                  "Shared: $shared\n" .
                  "Downloads: $downloads\n" .
                  "Uploads: $uploads\n" .
                  "Speed: $SPEEDS{$speed}\n" .
                  "Client Info: $client_info\n\n";
}

sub print_whowas
{
  my ($sock, $text) = @_; 
  my ($nick, $level, $last_seen);
  my $title = "Whowas Response:";

  $$text =~ /(.+?) \"(.+?)\" (\d+)/;
  $nick = $1; $level = $2; $time = $3;

  print "\n$title\n" . "-" x length($title) . "\n" .
                  "User: $nick ($level)\n" .
                  "Last Seen: " . localtime($3) . "\n\n";
}

sub print_private_msg
{
  my ($sock, $text) = @_; 
  my ($nick, $msg);

  $$text =~ /(.+?) (.*)/;
  $nick = $1; $msg = $2;

  print "*$nick* $msg\n";
}

sub hotlist_add_ok
{
  my ($sock, $text) = @_;

  push @hotlist, $$text;

  print "Addition of $$text to hotlist successful!\n";
}

sub hotlist_add_err
{
  my ($sock, $text) = @_; 

  print "Error adding $$text to hotlist!\n";
} 

sub user_sign_on
{
  my ($sock, $text) = @_; 
  my ($user, $speed);

  $$text =~ /(.+?) (.+)/;

  $user = $1; $speed = $2;

  print "$1 just signed on with a $SPEEDS{$speed} connection.\n";
}

sub user_sign_off
{
  my ($sock, $text) = @_; 

  print "$$text just signed off.\n";
}

sub send_hotlist
{
  my ($sock, $text) = @_; 
  my $file = new FileHandle "$hotlist";
  my @users = <$file>;
  my $user;

  foreach $user (@users)
    {
      chomp($user);
      $sock->send(MSG_HOTLIST_ADD, $user);
    }
}

sub ping_response
{
  my ($sock, $text) = @_; 

  $sock->send(MSG_PONG, $$text);

  print "Ping from $$text...\n";
}

sub pong_response
{
  my ($sock, $text) = @_; 
  my $curtime = time();
  my $diff = $curtime - $pings{$$text};

  print "Ping response from $$text in $diff seconds.\n";

  delete $pings{$$text};
}

sub speed_response
{
  my ($sock, $text) = @_; 
  my ($user, $speed);

  $$text =~ /(.*?) (.*)/;
  $user = $1; $speed = $2;

  print "User: $user\n" . "Speed: $SPEEDS{$speed}\n\n";
}

sub print_emote
{
  my ($sock, $text) = @_; 
  my ($channel, $user, $msg);

  $$text =~ /(.*?) (.*?) \"(.*)\"/;
  $channel = $1; $user = $2; $msg = $3;

  print "* $user $msg\n";
}

sub print_op_msg
{
  my ($sock, $text) = @_; 
  my ($user, $msg);

  $$text =~ /(.*?) (.*)/;
  $user = $1; $msg = $2;

  print "<* $user *> $msg\n";
}

sub print_global_msg
{
  my ($sock, $text) = @_; 
  my ($user, $msg);

  $$text =~ /(.*?) (.*)/;
  $user = $1; $msg = $2;

  print "<* $user *> $msg\n";
}

sub print_server_stats
{
  my ($sock, $text) = @_; 
  my ($clients, $servers, $users, $files, $gigs, $chans, $starttime);
  my ($uptime, $mem);
  my $print = sub { my $i = shift; print "~2;$i~c;"; };

  $$text =~ /(.+?) (.+?) (.+?) (.+?) (.+?) (.+?) (.+?) (.+?) (.+?)/;

  $clients = $1; $servers = $2; $users = $3; $files = $4; $gigs = $5;
  $chans = $6; $starttime = $7; $uptime = $8; $mem = $9;

  &$print("Server Stats\n");
  &$print("------------\n");
  &$print("Clients: $clients\n");
  &$print("Servers: $servers\n");
  &$print("Users: $users\n");
  &$print("Files: $files\n");
  &$print("Gigs: $gigs\n");
  &$print("Channels: $chans\n");
  &$print("Time: " . localtime($time) . "\n");
  &$print("Uptime: $uptime\n");
  &$print("Memory: $mem\n\n");
}

sub get_banlist_entry
{
  my ($sock, $text) = @_; 
  my ($ip, $nick, $reason, $time);
  my %entry;

  push @banlist, $$text;
}

sub print_banlist
{
  my ($sock, $text) = @_; 
  my $entry;
  
  print "Banned Users\n";
  print "------------\n";

  foreach $entry (@banlist)
    {  
      print "$entry\n";
    }
}

sub print_ban_notify
{
  my ($sock, $text) = @_; 
  my ($ip, $nick, $reason, $time);
  my $realip;

  $$text =~ /(\d+?) (.+?) \"(.+?)\" (\d+)/;
  $ip = $1; $nick = $2; $reason = $3; $time = $4;

  my ($a, $b, $c, $d) = unpack('C4', pack('V', $ip));
  $realip = "$a.$b.$c.$d";
  
  print "$nick ($realip) banned on $time: $reason\n";
}

sub set_dataport
{
  my ($sock, $text) = @_; 

  $serverport = $$text;

  print "Server requests dataport change to $serverport...\n";

  shutdown_server;
  setup_server;
}

sub server_disconnect
{
  $napster_sock = undef;

  print "Server disconnected!\n";  
}

sub send_queued_request
{
  my $sock = shift;

  return if ($#download_queue < 0);

  my $entry = shift @download_queue;
  my $user = $entry->{"user"};
  my $filename = $entry->{"name"};
  my $textstr = "$user \"$filename\"";
  my ($msg, $len);

  debug_print("DL", "Sending queued request... user = $user, filename = $filename\n");

  push @downloads, { "sentname" => $filename, "user" => $user };
  $sock->send(MSG_DL_REQ, $textstr);

  $queue_transferring = 1;
  $queue_current = $entry;
}

sub queued_download_end
{
  my ($sock, $dl) = @_;

  if ($queue_current->{"name"} eq $dl->{"sentname"})
    { 
      if ($#download_queue < 0)
        {
          $queue_transferring = 0;
        }
      else
        {
          send_queued_request($sock);
        }
    }
}

####################### Code to perform actual functions ###################

sub do_quit
{
  my ($sock, $param_str, @params) = @_;
  
  call_handler(MSG_SHUTDOWN, $sock);
}

sub do_clear_results
{
  splice(@search_results, 0);   # Clear results list;
}

sub get_search_type
{
  my $value = shift;
  my $type;

  if ($value =~ /^(.+)\+/)
    {
      $value = $1;
      $type = "AT LEAST";
    }
  elsif ($value =~ /^(.+)\-/)
    {
      $value = $1;
      $type = "AT BEST";
    }
  else
    {
      $type = "EQUAL TO";
    }

  return ($value, $type);
}

sub do_search
{
  my ($sock, $param_str, @params) = @_;
  my ($textstr, $msg, $len);
  my $ok;
  my %opts = ("artist" => 1,
              "count" => 1,
              "name" => 1,
              "speed" => 1,
              "bitrate" => 1,
              "freq" => 1,
              "regex" => 1,
              "type" => 1,
              "encode" => 0,
              "sort" => 1);

  return if ($#params < 0);
  my $results = getopts(\%opts, \@params);
  return if (! defined $results);

  my $artist = shift @{ $results->{"artist"} };
  my $count = shift @{ $results->{"count"} };
  my $file = shift @{ $results->{"name"} };
  my $speed = shift @{ $results->{"speed"} };
  my $bitrate = shift @{ $results->{"bitrate"} };
  my $freq = shift @{ $results->{"freq"} };
  my $type = shift @{ $results->{"type"} };

  $search_pattern = shift @{ $results->{"regex"} };
  $search_sort_fields = shift @{ $results->{"sort"} };

  if ($ENCODER_LOADED)
    {
      $artist = encode($artist) if ((defined $artist) && 
                                    (defined $results->{"encode"}));

      $file = encode($file) if ((defined $file) && 
                                (defined $results->{"encode"}));
    }

  my @speed_params = get_search_type($speed);
  my @bitrate_params = get_search_type($bitrate);
  my @freq_params = get_search_type($freq);

  $textstr = "FILENAME CONTAINS \"$artist\" " if (defined $artist);
  if (defined $count) { $textstr .= "MAX_RESULTS $count "; }
  else { $textstr .= "MAX_RESULTS 100 "; }
  $textstr .= "FILENAME CONTAINS \"$file\" " if (defined $file);
  $textstr .= "LINESPEED \"$speed_params[1]\" $speed_params[0] " if (defined $speed);
  $textstr .= "BITRATE \"$bitrate_params[1]\" \"$bitrate_params[0]\" " if (defined $bitrate);
  $textstr .= "FREQ \"$freq_params[1]\" \"$freq_params[0]\" " if (defined $freq);
  $textstr .= "TYPE $type " if (defined $type);

  $textstr = substr($textstr, 0, -1);

  print "\nSearching... \n";

  $sock->send(MSG_SEARCH_REQ, $textstr);
}

sub do_search_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /search <options>\n\n");
  &$print("  Searches the server song database.\n\n");
  &$print("  Options:\n");
  &$print("    -ARTIST \"<string>\"  - Search for specific artist.\n");
  &$print("    -NAME \"<string>\"    - Search for specific name.\n");
  &$print("    -BITRATE <num><mod> - Limit bitrate to <num>.\n");
  &$print("    -FREQ <num><mod>    - Limit frequency to <num>.\n");
  &$print("    -SPEED <num><mod>   - User connection speed equals <num>.\n");
  &$print("    -COUNT <num>        - Limit count to <num> (max 100).\n");
  &$print("    -REGEX \"<pattern>\"  - Filter search results according to <pattern>.\n");
  &$print("    -SORT <sort_fields> - Sort results on specified fields.\n");
  &$print("    -TYPE <mime>        - File type specification.  (OpenNap only)\n");
  &$print("    -ENCODE             - Encode search request (based on encode script).\n\n");
  &$print("    Where <mod> is a modifier:\n\n");
  &$print("      <none> - EQUAL TO search.\n");
  &$print("      +      - AT LEAST search.\n");
  &$print("      -      - AT BEST search.\n\n");
  &$print("    And sort fields are one or more of (case-insensitive):\n\n");
  &$print("      N      - File name\n");
  &$print("      U      - User name\n");
  &$print("      S      - Connection speed\n");
  &$print("      B      - File bitrate\n");
  &$print("      F      - File frequency\n\n");
  &$print("    Note, the sort field order IS significant.\n\n");

  return $text;
}

sub get_filter_compare
{
  my $str = shift;
  my $expr;

  return if (! defined $str);

  $str =~ /(\w+)(.*)/;
  
  if ($2 eq "+")
    { $expr = ">= $1" }
  elsif ($2 eq "-")
    { $expr = "<= $1" }
  else
    { $expr = "== $1" }

  return $expr;
}

sub do_results_sort
{
  my ($a, $b, $fields) = @_;
  my @sort_fields = split(//, $fields);

  return -1 if ((! defined $fields) || ($#sort_fields < 0));

  foreach (@sort_fields)
    {
      if ($_ =~ /^n$/i)
        {
          my ($na, $nb);

          $$a{"name"} =~ /(.*\/|.*\\)?(.*\.mp3)/;
          $na = $2;

          $$b{"name"} =~ /(.*\/|.*\\)?(.*\.mp3)/;
          $nb = $2;

          return -1 if ($na lt $nb);
          return 1 if ($na gt $nb);
        }
      elsif ($_ =~ /^s$/i)
        {
          return -1 if ($$a{"speed"} < $$b{"speed"});
          return 1 if ($$a{"speed"} > $$b{"speed"});
        }
      elsif ($_ =~ /^b$/i)
        {
          return -1 if ($$a{"bitrate"} < $$b{"bitrate"});
          return 1 if ($$a{"bitrate"} > $$b{"bitrate"});
        }
      elsif ($_ =~ /^f$/i)
        {
          return -1 if ($$a{"frequency"} < $$b{"frequency"});
          return 1 if ($$a{"frequency"} > $$b{"frequency"});
        }
      elsif ($_ =~ /^u$/i)
        {
          return -1 if ($$a{"user"} lt $$b{"user"});
          return 1 if ($$a{"user"} gt $$b{"user"});
        }
      else
        { 
          return -1; 
        }
    }

  return 0;
}

sub do_results
{
  my ($sock, $param_str, @params) = @_;
  my ($textstr, $msg, $len);
  my $ok;

  my ($file, $user, $sort_fields);
  my ($speed_cmp, $bitrate_cmp, $freq_cmp);

  my %opts = ("name" => 1,
              "speed" => 1,
              "bitrate" => 1,
              "freq" => 1,
              "user" => 1,
              "sort" => 1);

  my $results;

  if ($#params < 0)
    {
      $results = getopts(\%opts, \@params);
      return if (! defined $results);
    }

  $file = shift @{ $results->{"file"} };
  $speed_cmp = get_filter_compare(shift @{ $results->{"speed"} });
  $bitrate_cmp = get_filter_compare(shift @{ $results->{"bitrate"} });
  $freq_cmp = get_filter_compare(shift @{ $results->{"freq"} });
  $user = shift @{ $results->{"user"} };
  $sort_fields = shift @{ $results->{"sort"} };

  my $i;
  my $title = "Search Results";
  my @final_results;

  $title .= "\n" . "-" x length($title) . "\n";

  print $title;

  for ($i = 0; $i <= $#search_results; $i++)
    {
      my $song = $search_results[$i];

      if ((($$song{"name"} =~ /$file/) || (! defined $file)) &&
          ((eval "$$song{speed} $speed_cmp") || (! defined $speed)) &&
          ((eval "$$song{bitrate} $bitrate_cmp") || (! defined $bitrate)) &&
          ((eval "$$song{frequency} $freq_cmp") || (! defined $freq)) &&
          (($$song{"user"} =~ /$user/) || (! defined $user)))
        {
          push @final_results, $i;
        }
    }

  foreach (sort { do_results_sort($search_results[$a], $search_results[$b], 
                                  $sort_fields) } @final_results)
    {
      my $song = $search_results[$_];

      $$song{"name"} =~ /(.*\/|.*\\)?(.*\.mp3)/;
      
      print "~2;" . ($_ + 1) . ". $2 " ,
            sprintf("%.2f", $$song{"size"}/1000000) , "mb ",
            "$$song{bitrate} $$song{frequency} $$song{user} ",
            $SPEEDS{$$song{"speed"}}, "~c;\n";
    }
}

sub do_results_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /results <options>\n\n");
  &$print("  Display search/browse results using various user-specified.\n\n");
  &$print("  Options:\n");
  &$print("    -NAME \"<regex>\"    - File name matches specified pattern.\n");
  &$print("    -SPEED <num><mod>    - Match user connection speed.\n");
  &$print("    -BITRATE <num><mod>  - Match the bitrate of the file.\n");
  &$print("    -FREQ <num><mod>     - Match the frequency of the file.\n");
  &$print("    -USER \"<regex>\"    - Match the name of user offering the file.\n");
  &$print("    -SORT <fields>       - Sort on provided fields.\n\n");
  &$print("  Options can be combined in any order.\n\n");

  return $text;
}

sub do_send_download_request
{
  my ($sock, $param_str, @params) = @_;

  my @entry_list = split(/[^\d\-]+/, $param_str);
  my @number_list;
  
  foreach $entry (@entry_list)
    {
      if ($entry =~ /(\d+?)-(\d+)/)
        {
          my $start = $1;
          my $end = $2;
          my $i;
           
          for ($i = $start; $i <= $end; $i++)
            { 
              $number_list[$i] = 1; 

              if (! defined $search_results[$i - 1])
                {
                  print "Error, entry number $i not found!\n";
                  return;
                }

            }
        }
      else
        { 
          $number_list[$entry] = 1; 

           if (! defined $search_results[$i - 1])
             {
               print "Error, entry number $i not found!\n";
               return;
             }
        }
    }

  for ($entry = 0; $entry <= $#number_list; $entry++)
    {
      if ($number_list[$entry])
        {
          my $user = ${ $search_results[$entry-1] }{"user"};  
          my $filename = ${ $search_results[$entry-1] }{"name"};
          my $textstr = "$user \"$filename\"";
          my ($msg, $len);
          
          debug_print("DL", "Sending request for entry $entry... entry = $entry, user = $user, filename = $filename\n");
          print "Sending request to $user for $filename...\n";

          push @downloads, { "sentname" => $filename, "user" => $user };

          $sock->send(MSG_DL_REQ, $textstr);
        }
    }

  print "\n";
}

sub do_get_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /get <entry>,<entry>,<entry>...\n\n");
  &$print("  Request download of the file entries indicated.  Entries numbers are\n");
  &$print("  those retrieved from a search or browse request.  As well, selections\n");
  &$print("  can be specified as individual entries, or in ranges (ie a-b).\n\n");
  &$print("    eg. /get 1, 3, 8-10, 12\n\n");

  return $text;
}

sub do_resume
{  
  my ($sock, $param_str, @params) = @_;
  my $entry = shift @params;
  my $user = ${ $search_results[$entry-1] }{"user"};  
  my $filename = ${ $search_results[$entry-1] }{"name"};
  my $textstr = "$user \"$filename\"";
  my ($msg, $len);
  my %download;

  $download{"user"} = $user;
  $download{"sentname"} = $filename;
  $download{"resume"} = 1;
  push @downloads, \%download;

  debug_print("DL", "Sending request... entry = $entry, user = $user, filename = $filename\n");
  print "Sending request to $user...\n";
  
  $sock->send(MSG_DL_REQ, $textstr);
}

sub do_download_list
{
  my ($sock, $param_str, @params) = @_;
  my $text = $param_str;
  my $dl;
  my $count = 1;
  my $title = "Downloads";
  my $filename;

  print "\n$title\n" . "-" x length($title) . "\n";

  foreach $dl (@downloads)
    {
      my $time;
      my $filename = $$dl{"filename"};

      if ($$dl{"speed"} > 0)
	{
	  my $total_time = ($$dl{"size"} - $$dl{"received"}) / 
	                   ($$dl{"speed"} * 1000);

	  my $minutes = int($total_time / 60);
	  my $seconds = int($total_time - $minutes * 60);

	  $time = "$minutes:$seconds";

	  $time = "$minutes:0$seconds" if ($seconds < 10);
	}

      $filename .= " " x (30 - length($filename)) if (length($filename) <= 40);
      $filename = substr($filename, 0, 30) if (length($filename) > 40);

      print "$count. $filename: $$dl{received} ($$dl{size}), $$dl{speed} Kb/s, $time left\n";
      $count++;
    }
}

sub do_upload_list
{
  my ($sock, $param_str, @params) = @_;
  my $text = $param_str;
  my $up;
  my $count = 1;
  my $title = "Uploads";

  print "\n$title\n" . "-" x length($title) . "\n";

  foreach $up (@uploads)
    {
      my $time;
      my $filename = $$up{"filename"};

      if ($$up{"speed"} > 0)
	{
	  my $total_time = ($$up{"size"} - $$up{"sent"}) / 
	                   ($$up{"speed"} * 1000);

	  my $minutes = int($total_time / 60);
	  my $seconds = int($total_time - $minutes * 60);

	  $time = "$minutes:$seconds";

	  $time = "$minutes:0$seconds" if ($seconds < 10);
	}

      $filename .= " " x (30 - length($filename)) if (length($filename) <= 40);
      $filename = substr($filename, -30) if (length($filename) > 40);

      print "$count. $filename: $$up{sent} ($$up{size}), $$up{speed} Kb/s, $time left\n";
      $count++;
    }
}

sub do_upload_op
{
  my ($sock, $param_str, @params) = @_;
  my ($speed, $kill);
  my $ok;

  my %opts = ("speed" => 2,
              "kill" => -1,
              "list" => 0);

  return if ($#params < 0);
  my $results = getopts(\%opts, \@params);
  return if (! defined $results);

  while ($#{ $results->{"speed"} } >= 0)
    {
      my $speed_ul = shift @{ $results->{"speed"} };
      my $speed = shift @{ $results->{"speed"} };
      my $ul = $uploads[$speed_ul - 1];

      if ((! defined $ul) && (defined $speed_ul))
        {
          print "Error, upload number $speed_ul not found!\n";
        }
      else
        {  
	  debug_print("UL", "Attempting to set upload $speed_ul to $speed b/s\n");

          print { $$ul{"write"} } "LIMIT $speed\n" if (defined $speed);
        }
    }

  while ($#{ $results->{"kill"} } >= 0)
    {
      my $kill_entry = shift @{ $results->{"kill"} };
      kill_ul($sock, $kill_entry - 1) if (defined $kill_entry);
    }

  if (defined $results->{"list"})
    {
      do_upload_list();
    }
}

sub do_ul_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /ul <command>\n\n");
  &$print("  Performs an operation on some upload(s).\n");
  &$print("  Upload numbers correspond to those from the /ul -list command.\n\n");
  &$print("  Commands:\n");
  &$print("    -KILL  <ul1> <ul2> ... - Kill the transfers specified\n");
  &$print("    -SPEED <ul> <rate>     - Set transfer speed for <ul> to <rate> b/s\n");
  &$print("    -LIST                  - List current uploads in progress\n\n");

  return $text;
}

sub do_download_op
{
  my ($sock, $param_str, @params) = @_;
  my $ok;
  my %opts = ("kill" => -1,
	      "info" => -1,
              "list" => 0);

  return if ($#params < 0);
  my $results = getopts(\%opts, \@params);
  return if (! defined $results);

  while ($#{ $results->{"kill"} } >= 0)
    {
      my $entry = shift @{ $results->{"kill"} };
      my $dl = $downloads[$entry - 1];
      
      if (! defined $dl)
        { 
          print "Error, download number $entry not found!\n";  
	  next;
        }
      
      if (defined $dl)
        {
          my $fname = "$download/$$dl{filename}";

          system("rm", "$fname");
          kill_dl($sock, $entry - 1);
        }
    }

  if (defined $results->{"list"})
    {
      do_download_list();
    }
}

sub do_dl_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /dl <command>\n\n");
  &$print("  Performs some operation on some download(s).\n");
  &$print("  Download numbers correspond to those from the /dl -list command.\n\n");
  &$print("  Commands:\n");
  &$print("    -KILL <dl1> <dl2> ...  - Kill the transfers specified.\n");
  &$print("    -LIST                  - List current downloads in progress.\n\n");

  return $text;
}

sub do_eval
{
  my ($sock, $param_str, @params) = @_;
  my $ok;
  
  my %opts = ("file" => 1);

  my $results = getopts(\%opts, \@params, 0) if ($#params >= 0);
  my $filename = shift @{ $results->{"file"} };

  if (defined $filename)
    {
      eval_file($filename);
    }
  else  
    {
      my $cmd = join(" ", $param_str);
      my $old_handler = $SIG{__DIE__};

      $SIG{__DIE__} = sub { return; };

      eval "$cmd";

      $SIG{__DIE__} = $old_handler;

      if (defined $@)
        {
	  print "$@";
        }
    }
}

sub do_reconnect
{
  my ($sock, $param_str, @params) = @_;

  $param_str =~ /(.*):(.*)/;
  $host[0] = $1;
  $host[1] = $2;

  setup_new_connection();
  login_to_napster($napster_sock);
}

sub do_list_channels
{
  my ($sock, $param_str, @params) = @_;

  splice(@channels, 0);

  $sock->send(MSG_LIST_CHANNELS, undef);  
}

sub do_chan_join
{
  my ($sock, $param_str, @params) = @_;

  if (grep /^\Q$param_str\E$/, @channels)
    {
      print "Switching to $param_str...\n";

      $active_channel = $param_str;
    }
  else
    {
      $sock->send(MSG_JOIN, $param_str);
    }
}

sub do_chan_part
{
  my ($sock, $param_str, @params) = @_;

  $sock->send(MSG_PART, $param_str);

  delete $user_lists{$param_str};
  @channels = grep(!/^$param_str$/, @channels);
  $active_channel = $channels[0];

  print "Now in $active_channel...\n" if (defined $active_channel);
}

sub do_send_public
{
  my ($sock, $param_str, @params) = @_;

  $sock->send(MSG_SEND_MSG, "$active_channel $param_str");
}

sub do_browse
{
  my ($sock, $param_str, @params) = @_;
  my %opts = ("regex" => 1,
              "sort" => 1);

  return if ($#params < 0);
  my $results = getopts(\%opts, \@params, 1, 1);
  return if (! defined $results);

  $search_pattern = shift @{ $results->{"regex"} };
  $search_sort_fields = shift @{ $results->{"sort"} };

  print "Sending browse request to $params[0]...\n";

  debug_print("Browse", "Requesting from $params[0]\n");
  $sock->send(MSG_BROWSE, $params[0]);
}

sub do_browse_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /browse <flags> <user>\n\n");
  &$print("  Browse files offered by <user>.  Flags include:\n\n");
  &$print("    -REGEX \"<pattern>\"  - Filter search results according to <pattern>.\n");
  &$print("    -SORT <sort_fields> - Sort results on specified fields.\n\n");
  &$print("    Where sort fields are one or more of (case-insensitive):\n\n");
  &$print("      N      - File name\n");
  &$print("      U      - User name\n");
  &$print("      S      - Connection speed\n");
  &$print("      B      - File bitrate\n");
  &$print("      F      - File frequency\n\n");
  &$print("    Note, the sort field order IS significant.\n\n");

  return $text;
}

sub do_send_whois
{
  my ($sock, $param_str, @params) = @_;

  $sock->send(MSG_WHOIS, $param_str);
}

sub do_send_private_msg
{
  my ($sock, $param_str, @params) = @_;
  my ($nick, $msg);

  $param_str =~ /(.+?) (.*)/;

  $sock->send(MSG_PRIVATE, "$1 $2");

  print ">$username< $2\n";
}

sub do_get_user_list
{
  my ($sock, $param_str, @params) = @_;

  splice(@{ $user_lists{$active_channel}}, 0);

  $sock->send(MSG_USER_LIST_2, "$active_channel");
}

sub do_hotlist
{
  my ($sock, $param_str, @params) = @_;
  my %opts = ("add" => -1,
              "del" => -1,
              "list" => 0);

  my $results = getopts(\%opts, \@params) if ($#params >= 0);
  return if (! defined $results);

  while ($#{ $results->{"add"} } >= 0)
    {
      my $add_name = shift @{ $results->{"add"} };

      print "Adding $add_name to hotlist...\n";
      $sock->send(MSG_HOTLIST_ADD, "$add_name");
    }

  while ($#{ $results->{"del"} } >= 0)
    {
      my $del_name = shift @{ $results->{"del"} };

      print "Removing $del_name from hotlist...\n";

      my $i;
      my $found = 0;

      for ($i = 0; $i <= $#hotlist; $i++)
        {
          if ($hotlist[$i] eq $del_name)
            {
              splice @hotlist, $i, 1;
              $found = 1;
              last;
            }
        }

      if (! $found)
        {
          print "Error, $del_name not in hotlist!\n";
        }
      else
        {
          $sock->send(MSG_HOTLIST_REMOVE, "$del_name");
        }
    }

  if (defined $results->{"list"})
    {
      my $t_name = "Hotlist";
      my $title = "\n" . $t_name . "\n" . "-" x length($t_name) . "\n";
      my $user;

      print $title;

      foreach $user (@hotlist)
        {
          print "$user\n";
        }

      print "\n";
    }
}

sub do_hotlist_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /hotlist <command>\n\n");
  &$print("  Used to manage hotlist entries.\n\n");
  &$print("  Commands:\n");
  &$print("    -ADD <user> <user1> ... - Add users to your hotlist.\n");
  &$print("    -DEL <user> <user1> ... - Remove users from your hotlist.\n");
  &$print("    -LIST                   - Display your current hotlist.\n\n"); 

  return $text;
}

sub do_about
{
  my ($sock, $param_str, @params) = @_;
  my $text;
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };
  my $title = "About Snap";

  &$print($title . "\n" . "-" x length($title) . "\n\n");

  &$print("Version: $CLIENT_VERSION\n");
  &$print("Author: Brett Kosinski\n\n");

  return $text;
}

sub do_help
{
  my ($sock, $param_str, @params) = @_;
  my $cmd = shift @params;

  $cmd = "/help" if (! defined $cmd);  
  $cmd = "/$cmd" if (! defined $help_hash{$cmd});

  my $help_info = $help_hash{$cmd};

  if (defined $help_info)
    {
      if (ref($help_info) =~ /^CODE/)
        {
          $help_info = &$help_info();
        }
      
      print "$help_info";
    }
  else
    {
      print "Error, help catagory not found!\n";
    }
}

sub do_help_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };  
  my $cmd;
  my $line;

  &$print("Usage: /help <cmd>\n\n");
  &$print("  The following catagories are available.  Note, names are case\n");
  &$print("  sensitive\n\n");
  &$print("  Commands:\n\n    ");
  
  foreach $cmd (sort(keys %help_hash))
    {
      my $cmd_text = $cmd . " " x (20 - length($cmd));
      my $width = 80;
      
      if (length($line) + length($cmd_text) < $width - 4)
        {
	  &$print($cmd_text);
	  $line .= $cmd_text;
	  
	  next;
        }
      
      &$print("\n    $cmd_text");
      
      $line = "    $cmd_text";
    }
  
  &$print("\n\n");
  
  return $text;
}

sub do_exec
{
  my ($sock, $param_str, @params) = @_;
  my %opts = ("out" => 0,
              "msg" => 1);

  my $results = getopts(\%opts, \@params, 1, 1) if ($#params >= 0);
  return if (! defined $results);

  my $cmd = join(" ", @params) . "|";
  my $handle = new FileHandle;
  my $line;
  my $out = $results->{"out"};
  my $user = shift @{ $results->{"msg"} };

  debug_print("Exec", "Launching $cmd...\n");
  open($handle, $cmd);

  while ($line = <$handle>)
    {
      print $line if ((! defined $out) && (! defined $user));

      do_send_public($sock, $line) if (defined $out);
      do_send_private_msg($sock, "$user $line") if (defined $user);
    }
}

sub do_exec_help
{
  my ($sock) = @_;
  my $text;
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /exec [options] <command>\n\n");
  &$print("  Executes a system command.  With no options specified, output\n");
  &$print("  goes to the screen.  Other options are:\n\n");
  &$print("  Options:\n");
  &$print("    -OUT        - Display output to current channel.\n");
  &$print("    -MSG <user> - Send output to specified user.\n\n");
  &$print("  Note, output options can be combined.\n\n");

  return $text;
}

sub do_ping
{
  my ($sock, $param_str, @params) = @_;
  my $user = shift @params;

  $sock->send(MSG_PING, $user);

  $pings{$user} = time();

  print "Sending ping to $user...\n";
}

sub do_speed
{
  my ($sock, $param_str, @params) = @_;
  my $user = shift @params;

  $sock->send(MSG_SPEED, $user);

  print "Request $user\'s speed...\n";
}

sub do_admin
{
  my ($sock, $param_str, @params) = @_;
  my %opts = ("kill" => -1,
              "ban" => -1,
              "unban" => -1,
              "banlist" => 0,
              "nuke" => -1,
              "unnuke" => -1,
              "level" => 2,
              "connect" => 1,
              "disconnect" => 2,
              "kills" => 2,
              "remove" => 2,
              "stats" => 0,
              "config" => 1,
              "reset" => 1,
              "setport" => 2,
              "version" => 0);
  
  my $results = getopts(\%opts, \@params);

  return if (! defined $results);  

  while ($#{ $results->{"kill"} } >= 0)
    {
      my $user = shift @{ $results->{"kill"} };

      $sock->send(MSG_USER_KILL, "$user");
      print "Requesting disconnect for $user...\n";
    }

  while ($#{ $results->{"ban"} } >= 0)
    {
      my $user = shift @{ $results->{"ban"} };

      $sock->send(MSG_USER_BAN, "$user");
      print "Requesting ban of $user...\n";
    }

  while ($#{ $results->{"unban"} } >= 0)
    {
      my $user = shift @{ $results->{"unban"} };

      $sock->send(MSG_USER_UNBAN, "$user");
      print "Requesting unban of $user...\n";
    }

  while ($#{ $results->{"nuke"} } >= 0)
    {
      my $user = shift @{ $results->{"nuke"} };

      $sock->send(MSG_USER_NUKE, "$user");
      print "Requesting account deletion for $user...\n";
    }

  while ($#{ $results->{"unnuke"} } >= 0)
    {
      my $user = shift @{ $results->{"unnuke"} };

      $sock->send(MSG_USER_UNNUKE, "$user");
      print "Requesting account restore for $user...\n";      
    }

  while ($#{ $results->{"level"} } >= 0)
    {
      my $user = shift @{ $results->{"level"} };
      my $level = shift @{ $results->{"level"} };

      $sock->send(MSG_MOD_USER_LEVEL, "$user $level");
      print "Attempting to set $user to $level...\n";
    }

  while ($#{ $results->{"connect"} } >= 0)
    {
      my $name = shift @{ $results->{"connect"} };
      my ($server, $port);

      if ($name =~ /(.*):(.*)/)
        {
          $server = $1; $port = $2;

          $sock->send(MSG_SERVER_CONNECT, "$server $port");
          print "Attempting to connect to $name\n";
        }
      else
        {
          print "Invalid server specified!\n";
        }
    }

  while ($#{ $results->{"disconnect"} } >= 0)
    {
      my $server = shift @{ $results->{"disconnect"} };
      my $reason = shift @{ $results->{"disconnect"} };

      $sock->send(MSG_SERVER_DISCONNECT, "$server $reason");
      print "Attempting to disconnect $server\n";
    }

  while ($#{ $results->{"kills"} } >= 0)
    {
      my $server = shift @{ $results->{"kills"} };
      my $reason = shift @{ $results->{"kills"} };

      $sock->send(MSG_SERVER_KILL, "$server $reason");
      print "Attempting to kill $server\n";
    }

  while ($#{ $results->{"remove"} } >= 0)
    {
      my $server = shift @{ $results->{"remove"} };
      my $reason = shift @{ $results->{"remove"} };

      $sock->send(MSG_SERVER_REMOVE, "$server $reason");
      print "Attempting to remove $server\n";
    }

  while ($#{ $results->{"config"} } >= 0)
    {
      my $cfgstring = shift @{ $results->{"config"} };

      $sock->send(MSG_SERVER_CFG, "$cfgstring");
      print "Sending configuration to server...\n";
    }

  while ($#{ $results->{"reset"} } >= 0)
    {
      my $cfgvar = shift @{ $results->{"reset"} };

      $sock->send(MSG_SERVER_RELOAD_CFG, "$cfgvar");
      print "Requesting reset of $cfgvar...\n";
    }

  while ($#{ $results->{"setport"} } >= 0)
    {
      my $user = shift @{ $results->{"setport"} };
      my $port = shift @{ $results->{"setport"} };

      $sock->send(MSG_SET_PORT, "$user $port");
      print "Requesting $user set dataport to $port...\n";
    }

  if (defined $results->{"stats"})
    {
      $sock->send(MSG_OPENNAP_STATS, "");
      print "Requesting server stats...\n";
    }

  if (defined $results->{"banlist"})
    {
      $sock->send(MSG_SHOW_BANLIST, "");
      print "Requesting server ban list...\n";

      splice(@banlist, 0);
    }

  if (defined $results->{"version"})
    {
      $sock->send(MSG_GET_SERVER_VERSION, "");
      print "Requesting server version...\n";
    }
}

sub do_admin_help
{
  my ($sock) = @_;
  my $text;
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /admin <command> <val> <command2> <val2> ...\n\n");
  &$print("  Various administrative functions. * == Opennap only\n\n");
  &$print("    -KILL <user1> <user2> ...     - Request disconnect of users.\n");
  &$print("    -BAN <user1> <user2> ...      - Request ban of users.\n");
  &$print("    -UNBAN <user> <user2> ...     - Request unban of users.\n");
  &$print("    -BANLIST                      - Show ban list for server.\n");
  &$print("    -NUKE <user1> <user2> ...     - Request deletion of users.\n");
  &$print("    -UNNUKE <user1> <user2> ...   - Request restoration of users.\n");
  &$print("    -LEVEL <user> <level>         - Set <user> to level <level>.\n");
  &$print("    -SETPORT <user> <port>        - Request user set dataport to <port>.\n");
  &$print("    -CONFIG \"<config string>\"     - Send configuration string to server.\n");
  &$print("    -RESET <config variable>      - Reset config variable to default value.\n");
  &$print("    -VERSION                      - Request the server version.\n");
  &$print("  * -STATS                        - Request server statistics.\n");
  &$print("  * -CONNECT <server>             - Attempt to connect to <server>.\n");
  &$print("  * -DISCONNECT <server> <reason> - Sever connection to <server>.\n");
  &$print("  * -KILLS <server> <reason>      - Cause <server> to shut down.\n");
  &$print("  * -REMOVE <server> <reason>     - Requests <server> be removed from table.\n\n");

  return $text;
}

sub do_emote
{
  my ($sock, $param_str, @params) = @_;

  $sock->send(MSG_EMOTE, "$active_channel \"$param_str\"");
}

sub do_op_msg
{
  my ($sock, $param_str, @params) = @_;

  $sock->send(MSG_OP_MSG, "$param_str");
}

sub do_global_msg
{
  my ($sock, $param_str, @params) = @_;

  $sock->send(MSG_GLOBAL_MSG, "$param_str");
}

sub do_config
{
  my ($sock, $param_str, @params) = @_;
  my %opts = ("speed" => 1,
              "pass" => 1,
              "email" => 1,
              "port" => 1);
  my $results = getopts(\%opts, \@params);
  return if (! defined $results);

  my $speed = shift @{ $results->{"speed"} };
  my $pass = shift @{ $results->{"pass"} };
  my $email = shift @{ $results->{"email"} };
  my $port = shift @{ $results->{"port"} };

  if (defined $speed)
    {
      print "Changing speed to $SPEEDS{$speed}...\n";
      $sock->send(MSG_CHANGE_SPEED, $speed);
    }

  if (defined $pass)
    {
      print "Changing password to $pass...\n";
      $sock->send(MSG_CHANGE_PASSWORD, $pass);
    }

  if (defined $email)
    {
      print "Changing email to $email...\n",;
      $sock->send(MSG_CHANGE_EMAIL, $email);
    }

  if (defined $port)
    {
      print "Changing port to $port...\n";
      $sock->send(MSG_CHANGE_PORT, $port);

      $serverport = $port;

      shutdown_server;
      setup_server;
    }
}

sub do_config_help
{
  my ($sock) = @_;
  my $text;
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /config <setting> <val> <setting> <val2> ...\n\n");
  &$print("  This command is used to change various user settings on the\n");
  &$print("  fly.  Note, you must still change your RC file to reflect\n");
  &$print("  any changes you make here.\n\n");
  &$print("    -SPEED    - Change reported speed.\n");
  &$print("    -PASSWORD - Change login password.\n");
  &$print("    -EMAIL    - Change email address.\n");
  &$print("    -PORT     - Change local server port.\n\n");

  return $text;
}

sub do_request_version
{
  my ($sock) = @_;

  print "Requesting server version...\n";

  $sock->send(MSG_GET_SERVER_VERSION, "");
}

sub do_queue
{
  my ($sock, $param_str, @params) = @_;

  my %opts = ("add" => -1,
              "list" => 0,
	      "pop" => 0,
	      "del" => 1,
              "clear" => 0);
  my $results = getopts(\%opts, \@params);

  return if (! defined $results);

  if (defined $results->{"clear"})
    {
      splice(@download_queue, 0);
      return;
    }

  if (defined $results->{"add"})
    {
      $param_str = "";

      foreach (@{ $results->{"add"} })
        {
          $param_str .= "$_,";
        }

      chop($param_str);

      my @entry_list = split(/[^\d\-]+/, $param_str);
      my @number_list;
  
      foreach $entry (@entry_list)
        {
          if ($entry =~ /(\d+?)-(\d+)/)
            {
              my $start = $1;
              my $end = $2;
              my $i;
              
              for ($i = $start; $i <= $end; $i++)
                { 
                  $number_list[$i] = 1; 
                  
                  if (! defined $search_results[$i - 1])
                    {
                      print "Error, entry number $i not found!\n";
                      return;
                    }
                  
                }
            }
          else
            { 
              $number_list[$entry] = 1; 
              
              if (! defined $search_results[$i - 1])
                {
                  print "Error, entry number $i not found!\n";
                  return;
                }
            }
        }

      for ($entry = 0; $entry <= $#number_list; $entry++)
        {
          if ($number_list[$entry])
            {
              my $user = $search_results[$entry - 1]->{"user"};
              my $name = $search_results[$entry - 1]->{"name"};

              my %queue_entry = ( "user" => $user,
                                  "name" => $name );
              
              push @download_queue, \%queue_entry;
            }
        }
      
      send_queued_request($sock) if (! $queue_transferring);
    }
  
  if (defined $results->{"list"})
    {
      my $i;

      print "Download Queue\n";
      print "--------------\n";

      for ($i = 1; $i <= $#download_queue; $i++)
        {
          my $entry = $download_queue[$i];
          my $num = $i;

          print "$num. $entry->{name}\n";
        }
    }

  if (defined $results->{"pop"})
    {
      shift @download_queue;

      if ($#download_queue >= 0)
        {
          send_queued_request($sock); 
        }
      else
        {
          $queue_transferring = 0;
        }
    }

  while ($#{ $results->{"del"} } >= 0)
    {
      my $entry = pop @{ $results->{"del"} };
      
      if (($entry > ($#download_queue + 1)) ||
	  ($entry < 1))
        {
	  print "Queue entry $entry doesn't exist...\n";
	  next;
        }

      splice(@download_queue, $entry - 1, 1);

      print "Removed entry $entry from download queue...\n";
    }
}

sub do_queue_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /queue <command> <options>\n\n");
  &$print("  Perform operations on download queue.\n\n");
  &$print("    -ADD <selections> - Queue files for d/l.  Selection syntax like /get.\n");
  &$print("    -DEL <entry>      - Delete the specified entry from the queue.\n");
  &$print("    -POP              - Starts the next entry in the queue.\n");
  &$print("    -LIST             - Display the current queue.\n");
  &$print("    -CLEAR            - Clear the download queue.\n\n");

  return $text;
}

sub do_alias
{
  my ($sock, $param_str, @params) = @_;
  my $cmd = shift @params;

  $param_str =~ s/^$cmd\s+//g;

  if ($#params < 1)
    {
      print "Error, invalid parameters!\n";
      return;
    }

  $command_hash{"/$cmd"} = $param_str;

  print "Aliasing \"/$cmd\" -> \"$param_str\"\n";
}

sub do_alias_help
{
  my $text = "";
  my $print = sub { my $i = shift; $text .= "~2;$i~c;"; };

  &$print("Usage: /alias <command> <target>s\n\n");
  &$print("  Set up a command alias.  eg\n\n");
  &$print("    /alias dk /dl -kill\n\n");

  return $text;
}

sub do_command
{
  my ($sock, $text) = @_;
  my $cmd;
  my $params;
  my $param_str;
  my @arr;
  my @parts;

  if ($text =~ /^\//)
    {
      my $result = &quotewords("\s+", 1, $text);

      if (! defined $result)
        {
          @parts = split(/\s+/, $text);
          $cmd = shift @parts;
          $param_str = join(" ", @parts);
        }
      else
        {
          @parts = &quotewords('\s+', 1, $text);
          shift @parts;
          $param_str = join(" ", @parts);

          @parts = &quotewords('\s+', 0, $text);
          $cmd = shift @parts;
        }
    }
  else
    {    
      $cmd = "/send";
      $param_str = $text;
    }  

  my $func;
  my @temp_arr;

  foreach (@parts)
    {
      push @temp_arr, $_ if (! /^\s*$/);
    }

  @parts = @temp_arr;

  if (ref($command_hash{$cmd}) eq "ARRAY")
    {
      @arr = @{ $command_hash{$cmd} };    

      foreach $func (@arr)
        {
          &$func($sock, $param_str, @parts); 
        }
    }
  elsif (ref($command_hash{$cmd}) eq "CODE")
    {
      $func = $command_hash{$cmd};

      &$func($sock, $param_str, @parts);
    }
  elsif (! ref($command_hash{$cmd}))
    {
      do_command($sock, $command_hash{$cmd} . " " . $param_str);
    }
}

############################### Main Program Loop ##########################

sub kill_dl
{  
  my ($sock, $dl_entry) = @_;

  return if (! defined $dl_entry);

  if (! isa($dl_entry, 'SnapLib::Download'))
    {
      if (defined $downloads[$dl_entry])
	{
	  my $dl = $downloads[$dl_entry];
	  
	  splice(@downloads, $dl_entry, 1);
	  if (defined $$dl{"pid"}) { kill 2, $$dl{"pid"}; }
	  
	  delete $handles{$$dl{"socket"}} if (defined $$dl{"socket"});
	  delete $handles{$$dl{"read"}} if (defined $$dl{"read"});
	  
	  print "Killed download number " . ($dl_entry + 1) . "...\n";
	  debug_print("DL", "Killed download number " . ($dl_entry + 1) . "...\n");
	  
	  $sock->send(MSG_DONE_DOWNLOADING);
	  
	  call_handler(MSG_DL_END, $sock, $dl);
	}
      else
	{
	  print "No such download entry!\n";
	}
    }
  else
    {
      my $i;

      for ($i = 0; $i <= $#downloads; $i++)
	{
	  kill_dl($sock, $i) if ($downloads[$i] eq $dl_entry);
	}
    }
}

sub kill_ul
{
  my ($sock, $ul_entry) = @_;

  return if (! defined $ul_entry);

  if (! isa($ul_entry, 'SnapLib::Upload'))
    {
      if (defined $uploads[$ul_entry])
	{
	  my $ul = $uploads[$ul_entry];
	  
	  splice(@uploads, $ul_entry, 1);
	  if (defined $$ul{"pid"}) { kill 2, $$ul{"pid"}; }
	  
	  delete $handles{$$ul{"socket"}} if (defined $$ul{"socket"});
	  delete $handles{$$ul{"read"}} if (defined $$ul{"read"});
	  
	  print "Killed upload number " . ($ul_entry + 1) . "...\n";
	  debug_print("UL", "Killed upload $ul_entry...\n");
	  $sock->send(MSG_DONE_UPLOADING);

	  call_handler(MSG_UL_END, $sock, $ul);
	}
      else
	{
	  print "No such upload entry!\n";
	}
    }
  else
    {
      my $i;

      for ($i = 0; $i <= $#uploads; $i++)
	{
	  if ($uploads[$i] eq $ul_entry) { kill_ul($sock, $i); }
	}
    }
}

sub download_handshake
{
  my ($sock, $dlsock) = @_;
  my ($rcv, $len, $msg);
  my ($dl, $dnum, $i);

  for ($i = 0; $i <= $#downloads; $i++)
    {
      my $dl_entry = $downloads[$i];

      next if (! defined $$dl_entry{"socket"});

      if ($$dl_entry{"socket"} eq $dlsock)
        {
          $dl = $dl_entry;
	  $dnum = $i;
          last;
        }
    }

  if (! defined $dl) { return; }

  if ($$dl{"status"} == 0)
    {
      $len = $$dl{"socket"}->sysread($rcv, 1);

      if (($len == 0) || (! defined $len))
        {
	  @downloads = grep { $_ ne $dl } @downloads;
          delete $handles{$$dl{"socket"}};
	  call_handler(MSG_DL_ERR, $sock, $dl);

	  return;
        }
      
      my $msg = "GET";

      if ($$dl{"socket"}->syswrite($msg, length($msg)) eq undef)
	{
	  @downloads = grep { $_ ne $dl } @downloads;
          delete $handles{$$dl{"socket"}};
	  call_handler(MSG_DL_ERR, $sock, $dl);

	  return;
	}

      debug_print("DL", "Sending $msg\n");

      $msg = "$username \"" . $$dl{"sentname"} . "\" $$dl{pos}";

      if ($$dl{"socket"}->syswrite($msg, length($msg)) eq undef)
	{
	  @downloads = grep { $_ ne $dl } @downloads;
          delete $handles{$$dl{"socket"}};
	  call_handler(MSG_DL_ERR, $sock, $dl);

	  return;
	}

      debug_print("DL", "Sending $msg\n");

      $$dl{"status"} = 1;
      return;
    }
  elsif ($$dl{"status"} == 1)
    {
      $len = $$dl{"socket"}->sysread($rcv, 1);
      $$dl{"buffer"} .= $rcv;

      if (($len == 0) || (! defined $len))
        {
	  @downloads = grep { $_ ne $dl } @downloads;
          delete $handles{$$dl{"socket"}};
	  call_handler(MSG_DL_ERR, $sock, $dl);

	  return;
        }

      return if (length($$dl{"buffer"}) < length($$dl{"size"}));

      if ($$dl{"buffer"} != $$dl{"size"})
	{
	  print "Error, size received is incorrect!\n";

	  @downloads = grep { $_ ne $dl } @downloads;
          delete $handles{$$dl{"socket"}};
	  call_handler(MSG_DL_ERR, $sock, $dl);

	  return;
	}

      print "Transferring $$dl{filename}...\n";
      debug_print("DL", "Transferring $$dl{filename}...\n");

      $$dl{"received"} = 1;
      $$dl{"status"} = 2;
    }

  delete $handles{$$dl{"socket"}};

  SnapLib::Download->new($dl);

  $handles{$$dl{"read"}} = { Handle => $$dl{"read"},
			     Callback => \&transfer_cmd };

  call_handler(MSG_DL_START, $sock, $dl);
  $sock->send(MSG_DOWNLOADING);
}

sub upload_handshake
{
  my ($sock, $upsock) = @_;
  my $up = undef;
  my $unum = -1;
  my $filename;
  my $i;

  for ($i = 0; $i <= $#uploads; $i++)
    {
      $up = $uploads[$i];

      next if (! defined $$up{"socket"});

      if ($$up{"socket"} eq $upsock)
        {
	  $unum = $i;
          last;
        }

      $up = undef;
    }  

  return if (! defined $up);

  if ($$up{"status"} == 2)
    {
      my ($len, $data);
      $len = $$up{"socket"}->sysread($data, 1);

      if (($len == 0) || (! defined $len))
        {
	  @uploads = grep { $_ ne $up } @uploads;
          delete $handles{$$up{"socket"}};
	  call_handler(MSG_UL_ERR, $sock, $up);

	  return;
        }

      if ($$up{"socket"}->syswrite("SEND", length("SEND")) eq undef)
	{
	  @uploads = grep { $_ ne $up } @uploads;
          delete $handles{$$up{"socket"}};
	  call_handler(MSG_UL_ERR, $sock, $up);

	  return;
	}

      debug_print("UL", "Sending SEND...\n");

      my $msg = "$username \"$$up{sentname}\" $$up{size}";          

      if ($$up{"socket"}->syswrite($msg, length($msg)) eq undef)
	{
	  @uploads = grep { $_ ne $up } @uploads;
          delete $handles{$$up{"socket"}};
	  call_handler(MSG_UL_ERR, $sock, $up);

	  return;
	}

      debug_print("UL", "Sending info... $msg\n");

      $$up{"status"} = 5;

      return;
    }
  elsif ($$up{"status"} == 5)
    {
      my ($data, $len);
      $len = $$up{"socket"}->sysread($data, 1024);
      $$up{"pos"} = $data;

      if (($len == 0) || (! defined $len))
        {
	  @uploads = grep { $_ ne $up } @uploads;
          delete $handles{$$up{"socket"}};
	  call_handler(MSG_UL_ERR, $sock, $up);

	  return;
        }

      debug_print("UL", "Got upload position: $$up{pos}\n");
    }

  delete $handles{$$up{"socket"}};

  SnapLib::Upload->new($up);

  $handles{$$up{"read"}} = { Handle => $$up{"read"},
                             Callback => \&transfer_cmd };

  $sock->send(MSG_UPLOADING);
  call_handler(MSG_UL_START, $sock, $up);
}

sub transfer_cmd
{
  my ($sock, $fh) = @_;
  my $trans;
  my $trans_entry;
  my $num;
  my @transfers = @downloads;
  push @transfers, @uploads;

  $trans = undef;

  foreach $trans_entry (@transfers)
    {
      $num++;

      if ($$trans_entry{"read"} eq $fh)
        {
          $trans = $trans_entry;
          last;
        }
    }

  if (! defined $trans) { return; }

  my $line = <$fh>;
  my @lines = split(/\n/, $line);
  my $mesg;

  $mesg = MSG_RECV_DL_BLOCK if (isa($trans, 'SnapLib::Download'));
  $mesg = MSG_SENT_UL_BLOCK if (isa($trans, 'SnapLib::Upload'));
  
  foreach $line (@lines)
    {
      if ($line =~ /^PRINT (.*)/)
        {
          print "$1\n";
        }
      elsif ($line =~ /^LENGTH (.*)/)
        {
          my $mesg;
          my $func;

          $$trans{"received"} = $1 if (isa($trans, 'SnapLib::Download'));
          $$trans{"sent"} = $1 if (isa($trans, 'SnapLib::Upload'));
        }
      elsif ($line =~ /^SPEED (.*)/)
        {
          $$trans{"speed"} = $1;
        }
    }

  call_handler($mesg, $sock, $trans);

  return;
}

sub setup_server_conn
{
  my ($napsock, $sock) = @_;
  my ($socket, $addr) = $sock->accept();
  my ($port, $iaddr) = sockaddr_in($addr);
  my ($a, $b, $c, $d) = unpack('C4', $iaddr);

  my $ip = "$a.$b.$c.$d";
  my %new_conn;

  $new_conn{"socket"} = $socket;
  $new_conn{"ip"} = $ip;
  $new_conn{"status"} = 0;

  push @connections, \%new_conn;

  handle_server_request($napsock, $socket);

  call_handler(MSG_SERVER_CONN, $sock, \%new_conn);

  $handles{$socket} = { Handle => $socket,
			Callback => \&handle_server_request };
}

sub handle_server_request
{
  my ($napsock, $socket) = @_;
  my ($conn_entry, $conn);
  my $conn_num = 0;
  my $dl;
  my $up;

  foreach $conn_entry (@connections)
    {
      if ($$conn_entry{"socket"} eq $socket)
        {
          $conn = $conn_entry;
          last;
        }

      $conn_num++;
    }

  return if (! defined $conn);

  if ($$conn{"status"} == 0)
    {
      debug_print("Server", "Connect from $$conn{ip}, sending ack...\n");
      print "Connect from $$conn{ip}...\n";

      if ($$conn{"socket"}->syswrite("1", 1) eq undef)
	{
	  @connections = grep {$_ ne $conn_num} @connections;
	  delete $handles{$$conn{"socket"}};

	  call_handler(MSG_SERVER_CONN_ERR, $sock, $conn);	  

          debug_print("Server", "Connection error, shutting down...\n");
          print "Connection error, shutting down...\n";

          return;
	}

      $$conn{"status"} = 1;
    }
  elsif ($$conn{"status"} == 1)
    {
      my ($len, $line);

      $len = $$conn{"socket"}->sysread($line, 3);

      if ($len == 0)
        {
	  @connections = grep {$_ ne $conn_num} @connections;
	  delete $handles{$$conn{"socket"}};

	  call_handler(MSG_SERVER_CONN_ERR, $sock, $conn);	  

          debug_print("Server", "Connection error, shutting down...\n");
          print "Connection error, shutting down...\n";

          return;
        }

      if ($line ne "GET")
        {
          my ($data, $len);
          $len = $$conn{"socket"}->sysread($data, 1);

	  if ($len == 0)
	    {
	      @connections = grep {$_ ne $conn_num} @connections;
	      delete $handles{$$conn{"socket"}};
	      
	      call_handler(MSG_SERVER_CONN_ERR, $sock, $conn);	  
	      
	      debug_print("Server", "Connection error, shutting down...\n");
	      print "Connection error, shutting down...\n";
	      
	      return;	      
	    }

          $line .= $data;
        }

      debug_print("Server", "From $$conn{ip}, got $line...\n");

      $$conn{"status"} = 2 if ($line eq "GET");
      $$conn{"status"} = 3 if ($line eq "SEND");
    }
  elsif ($$conn{"status"} == 2)
    {
      my ($len, $data);

      $len = $$conn{"socket"}->sysread($data, 1024);

      if ($len == 0)
        {
	  @connections = grep {$_ ne $conn} @connections;
	  delete $handles{$$conn{"socket"}};

	  call_handler(MSG_SERVER_CONN_ERR, $sock, $conn);

          debug_print("Server", "Connection error, shutting down...\n");
          print "Connection error, shutting down...\n";
          return;
        }

      $data =~ /(.+?) "(.+?)" (\d+)/;

      my $up;
      my $username = $1;
      my $filename = $2;
      my $pos = $3;
      my $found = $FALSE;

      debug_print("Server", "Upload info from user... user: $1, file: $2, pos: $3\n");

      foreach $up (@uploads)
        {
          if (($$up{"user"} =~ /\Q$username\E/i) &&
              ($$up{"sentname"} eq $filename))
            {
              my @stat_info = stat "$$up{filename}";
	      my $old_up = $up;

              debug_print("Server", "Creating new upload of $$up{filename} ($stat_info[7])...\n");
              print "New upload of $$up{filename} to $$up{user} started...\n";

              $$up{"pos"} = $pos;
              $$up{"socket"} = $$conn{"socket"};
              $$up{"file"} = FileHandle->new("$$up{filename}");
              $$up{"size"} = $stat_info[7];

	      if ($$up{"socket"}->syswrite("$$up{size}", length("$$up{size}")) eq undef)
		{
		  @uploads = grep { $_ ne $up } @uploads;
		  delete $handles{$$up{"socket"}};
		  call_handler(MSG_UL_ERR, $sock, $up);
		  
		  return;		  
		}

	      SnapLib::Upload->new($up);

	      $napster_sock->send(MSG_UPLOADING);

              splice(@connections, $conn_num, 1);
	      delete $handles{$$conn{"socket"}};

	      call_handler(MSG_UL_START, $sock, $up);

	      $handles{$$up{"read"}} = { Handle => $$up{"read"},
					 Callback => \&transfer_cmd };

	      $found = $TRUE;
	    }
        }
 
      if (! $found)
        {
	  debug_print("Server", "Couldn't find matching upload!\n");    

	  @connections = grep {$_ ne $conn} @connections;
	  delete $handles{$$conn{"socket"}};

	  call_handler(MSG_SERVER_CONN_ERR, $sock, $conn);
        }
    }
  elsif ($$conn{"status"} == 3)
    {
      my ($len, $line);
      my $found = $FALSE;

      $len = $$conn{"socket"}->sysread($line, 1024);

      if ($len == 0)
	{
	  @connections = grep {$_ ne $conn} @connections;
	  delete $handles{$$conn{"socket"}};	  

	  call_handler(MSG_SERVER_CONN_ERR, $sock, $conn);

          debug_print("Server", "Connection error, shutting down...\n");
          print "Connection error, shutting down...\n";
	}

      debug_print("Server", "Got an upload message: $line\n");

      $line =~ /(.+?) "(.+?)" (\d+)/;

      my $user = $1; $filename = $2; $size = $3;

      foreach $dl (@downloads)
        {
          debug_print("Server", "Finding DL: $$conn{ip} vs $$dl{ip}, $filename vs $$dl{sentname}, $user vs $$dl{user}, $size vs $$dl{size}\n");

          if (
              ($filename eq $$dl{"sentname"}) &&
              ($user eq $$dl{"user"}) &&
              ($size eq $$dl{"size"}))
	    {              
	      my $old_dl = $dl;

              foreach (keys %$conn)
                {
                  $old_dl->{$_} = $conn->{$_};
                }

              $found = $TRUE;

              $$dl{"socket"} = $$conn{"socket"};
              debug_print("Server", "Upload established\n");
              
              if ($$dl{"socket"}->syswrite("$$dl{pos}", length($$dl{"pos"})) eq undef)
		{
		  @downloads = grep { $_ ne $dl } @downloads;
		  delete $handles{$$dl{"socket"}};
		  call_handler(MSG_DL_ERR, $sock, $dl);
		  
		  return;
		}

	      SnapLib::Download->new($dl);

              splice(@connections, $conn_num, 1);
	      delete $handles{$$conn{"socket"}};

              $napster_sock->send(MSG_DOWNLOADING);

	      call_handler(MSG_DL_INIT, $sock, $dl);
	      call_handler(MSG_DL_START, $sock, $dl);

	      $handles{$$dl{"read"}} = { Handle => $$dl{"read"},
					 Callback => \&transfer_cmd };
            }
        }

      if (! $found)
        {
	  debug_print("Server", "Couldn't find matching download!\n");

	  delete $handles{$$conn{"socket"}};

	  @connections = grep {$_ ne $conn} @connections;
	  call_handler(MSG_SERVER_CONN_ERR, $sock, $conn);
        }
    }
}

sub check_napster
{
  my ($sock) = @_;
  my ($cmd, $string) = $sock->get();

  return if ($cmd < 0);  # Packet was fragmented...
  
  if (! defined $cmd)
    {
      delete $handles{$sock};
      call_handler(MSG_DISCONNECT);
      return;
    }

  call_handler($cmd, $sock, \$string);
}

sub wait_for_input
{
  my @ready;
  my $s = new IO::Select;

  foreach (keys %handles)
    { $s->add($handles{$_}->{Handle}); }

  @ready = IO::Select->select($s, undef, undef);  

  foreach (@{ $ready[0] })
    { 
      $handles{$_}->{Callback}->($napster_sock, $_) if (defined $handles{$_});
    }
}

sub main_loop
{
  while(1)
    { wait_for_input(); }
}


