#!/usr/bin/perl -w

$PROGNAME="PSX"; # Perl Scour eXchange
$VERSION="0.6";
# Copyright (C) 2000 Vince Busam
# This program is provided under the terms of the GPL
# If you don't know what those terms are, see http://www.gnu.org/
# Authors:
# Vince Busam <vince@cs.ucla.edu>
# Naveen Nalam <nalam@cs.ucla.edu>

#Import these

use Getopt::Long;
use IO::Socket;
use IO::Select;
use Digest::MD5 qw(md5_hex);

#Forward declarations
sub login;
sub newlogin;
sub checklogin;
sub get;
sub recvfile;
sub search;
sub searchresults;
sub connecttoserver;
sub readconfig;
sub getstats;
sub getcommand;
sub selectloop;
sub handlehelo;
sub getuserstatus;
sub handleinput;
sub acceptconn;
sub bindport;
sub sendfile;
sub adddir;
sub getfirewall;
sub usage;
sub sendqueue;
sub recvqueue;
sub getrecvqueue;
sub prompt;
sub showtran;
sub addhotlist;
sub remhotlist;
sub showuserstatus;
sub readhotlist;
sub writehotlist;
sub killtrans;
sub piperr;
sub md5file;
sub reconnect;

#CONSTANTS
#In results array
my $RESULTS = 0;
my $NAME = 1;
my $IP = 2;
my $PORT = 3;
my $SERVER = 4;
#In Transfer queue array
my $FH = 0;
my $SOCK = 3;
my $SENT = 4;
my $SIZE = 5;
my $USER = 6;
#Download block size
my $BSIZE = 1024;
my $MD5SIZE = 300*1024;
#Connect timeout
my $TO = 5;
#bandwidth identifier
$bwhash{0} = "Unknown";
$bwhash{1} = "14.4";
$bwhash{2} = "28.8";
$bwhash{3} = "33.6";
$bwhash{4} = "56.7";
$bwhash{5} = "64K ISDN";
$bwhash{6} = "128K ISDN";
$bwhash{7} = "Cable";
$bwhash{8} = "DSL";
$bwhash{9} = "T1";
$bwhash{10} = "T3";

#GLOBALS
my $username = "user";                 # Username, related info
my $pass = md5_hex("pass");
my $first = "first";
my $last = "last";
my $email = "me\@here.org";
my $useragent = "$PROGNAME/$VERSION";
my $downloaddir = "/tmp";
my $serverconn = STDOUT;               # Socket to server
my $myport = 10000;                    # Local port for serving
my $myip = "127.0.0.1";                # Local IP for serving
my $myspeed = 0;                       # Bandwidth identifier
my $searchid = 0;                      # Unique ID for each search
my $maxresults = 22;                   # Max resuls (to fit on one screen)
my $serveraddr = "stp.scour.net";      # Server address/port
my $serverport = "80";
my @res = ();                          # Search results
my $totalusers = 0;                    # Stats on connected users
my $totalfiles = 0;
my $totalsize = 0;
my $localsock = 0;                     # Local server socket
my %opts = ();                         # Command line opts
my $login = 0;                         # Login status
my $words = ();                        # Last search query
my $next = 0;                          # Offset of next search
my $shareddirs = "";                   # regex of shared dirs
my @sendfiles = ();                    # Files being sent / Info stored for time slicing
my @recvfiles = ();                    # Files being downloaded
my $fhq = 0;                           # File handle queue, uniqe id for each FH
my %hotlist = ();                      # hotlist of connected users
my $hotlistfile = "";                  # save hotlist here
my $type = "all";                      # search type
my $sharetype = "";                    # stuff to share
my $pipe = 0;                          # Broken pipe
my $fallback = 1;                      # Fallback time to reconnect to server

#Initialize
$res[$RESULTS] = 0;
$| = 1;
$SIG{PIPE} = \&piperr;

#MAIN

#Read in config file, command line options
Getopt::Long::Configure("no_ignore_case");
GetOptions(\%opts, 'new|n', 'server|s=s', 'port|p=i', 'conf|c=s', 'user|u=s', 'pass|P=s', 'version|v', 'help|h');
usage if $opts{help};
die "$PROGNAME/$VERSION\n" if $opts{version};
if ($opts{conf}) {
  readconfig $opts{conf};
} else {
  readconfig("$ENV{'HOME'}/.psxrc") || readconfig("/etc/psxrc") || readconfig;
}
$serverport = $opts{port} if ($opts{port});
$serveraddr = $opts{server} if ($opts{server});
$username = $opts{user} if ($opts{user});
$pass = md5_hex($opts{pass}) if ($opts{pass});

#Open connection to server, bind local server
$localsock = bindport || die "Unable to bind socket\n";
$myport = $localsock->sockport();
print "Connecting to Server...\n";
$serverconn = connecttoserver || die "Can't connect to server\n";
$myip = $serverconn->sockhost();
print "Bound to $myip:$myport\n";

#Login
if ($opts{new}) {
  print "Registering New User\n";
  newlogin;
} else {
  login;
}

#Handle HELO and 100 Authorized
#We're going to select, and answer the HELO if we get it
#otherwise, just check if authorized
#If we get the authorization first, the main loop will handle the HELO
my $sel = IO::Select->new();
$sel->add($serverconn);
$sel->add($localsock);
@ready = $sel->can_read;
foreach $fh (@ready) {
  if ($fh == $localsock) {
    acceptconn;
  }
  if ($fh == $serverconn) {
    checklogin;
  }
}
checklogin if (!$login); #If we got a HELO, run here
print "Connected\n";

foreach $dir (split /\|/, $shareddirs) {
  adddir $dir;
}

readhotlist;

#main loop
while (getcommand()) {}

#close up shop
writehotlist;
$serverconn->close() if ($serverconn);
$localsock->close();
exit(0);
#END MAIN

#SUBROUTINES

#Send the login packet
sub login {
  print $serverconn "STP/1.0 LOGIN\r\n";
  print $serverconn "User-Agent: $useragent\r\n";
  print $serverconn "Username: $username\r\n";
  print $serverconn "Password: $pass\r\n";
  print $serverconn "IP: $myip\r\n";
  #print $serverconn "IP: 12.3.4.5\r\n";
  #print $serverconn "Firewall: no\r\n";
  print $serverconn "Port: $myport\r\n";
  print $serverconn "Speed: $myspeed\r\n";
  print $serverconn "\r\n";

  return 1;  
}

#Register a user
sub newlogin {
  print $serverconn "STP/1.0 NEWLOGIN\r\n";
  print $serverconn "User-Agent: $useragent\r\n";
  print $serverconn "Username: $username\r\n";
  print $serverconn "First: $first\r\n";
  print $serverconn "Last: $last\r\n";
  print $serverconn "Email: $email\r\n";
  print $serverconn "Password: $pass\r\n";
  print $serverconn "IP: $myip\r\n";
  print $serverconn "Port: $myport\r\n";
  print $serverconn "Speed: $myspeed\r\n";
  print $serverconn "\r\n";

  return 1;  
}

#Connect to remote server, send file request, call recvfile to get it
sub get {
  my $num = shift;
  my $res = shift;
  print "Connecting to $res->[$IP][$num]:$res->[$PORT][$num]...\n";
  my $remoteconn = IO::Socket::INET->new (Proto => "tcp",
                                    PeerAddr => $res->[$IP][$num],
                                    PeerPort => $res->[$PORT][$num],
                                    Timeout => $TO) || return 0;
  print "Connected, requesting " . $res->[$NAME][$num]  . "\n";
  $res->[$NAME][$num] =~ /([^\/\\]+)$/;
  my $localfilename = $downloaddir . "/" . $1;
  print $remoteconn "STP/1.0 GET\r\n";
  print $remoteconn "User-Agent: $useragent\r\n";
  print $remoteconn "Username: $username\r\n";
  print $remoteconn "Filename: " . $res->[$NAME][$num] . "\r\n";
  print $remoteconn "\r\n";
  $remoteconn->autoflush(0);
  recvfile $remoteconn, $localfilename, $res->[$SERVER][$num];
  
  return 1;
}

sub getfirewall {
  my $num = shift;
  my $res = shift;
  print $serverconn "STP/1.0 GET\r\n";
  print $serverconn "User-Agent: $useragent\r\n";
  print $serverconn "Servername: $res->[$SERVER][$num]\r\n";
  print $serverconn "Filename: " . $res->[$NAME][$num] . "\r\n";
  print $serverconn "\r\n";
  print "Requested transfer from firewalled client\n";
  
  return 1;

}

#Send a search request
sub search {
  my $start = shift;
  my $qstr = shift;

  print $serverconn "STP/1.0 SEARCH\r\n";
  print $serverconn "Search-ID: " . $searchid++ . "\r\n";
  print $serverconn "Num-Results: $maxresults\r\n";
  print $serverconn "Offset: $start\r\n";
  print $serverconn "Type: $type\r\n";
  if ($qstr =~ /^USER/) {
    $qstr =~ s/^USER//;
    print $serverconn "Username: $qstr\r\n";
  } else {
    print $serverconn "Query: $qstr\r\n";
  }
  print $serverconn "\r\n";

  return 1;
}

#Open a socket to server
sub connecttoserver {
  my $sock = IO::Socket::INET->new (Proto => "tcp",
                                    PeerAddr => $serveraddr,
                                    PeerPort => $serverport,
                                    Timeout => $TO);
  return $sock;
}

#Bind a socket
sub bindport {
  my $sock = new IO::Socket::INET(Listen => 5);
  return $sock;
}

#Make sure we logged in correctly.
sub checklogin {
  my $response = <$serverconn>;
  if (defined($response) && ($response =~ /STP\/1.0 (\d+) (.*)$/)) {
    my $status = $1;
    my $message = $2;
    if ($status == 100) {
      $login = 1;
      $response = <$serverconn>;
      if ($response =~ /Firewall/) {
        $response = <$serverconn>;
      }
      return 1;
    } else {
      print "Server response: " . $response;
      $response = <$serverconn>;
      exit(1);
    }
  } else {
    print "Login Error: ";
    print chomp $response if defined($response);
    print " Server disconnected on login\n";
    exit(1);
  }
  return 1;
}

#Parse search results into 2 dimensional array
sub searchresults {
  my @names = ();
  my @ip = ();
  my @username = ();
  my @port = ();
  my @speed = ();
  my @md5 = ();
  my @size = ();
  my @results = ();
  my $count = -1;

  $result = <$serverconn>;
  while ($result =~ /^(Num-Results|Search-ID|Offset|Type):/) {
    if ($result =~ /^Num-Results:\s+(\d+)\r/) {
      print "\r$1 Results for $words                         \n";
    }
    $result = <$serverconn>;
  }

  while ($result =~ /^[A-Z]/) {
    if ($result =~ /^Filename: (.*)\r/) {
      $names[++$count] = $1;
      $speed[$count] = 0;
    }
    if ($result =~ /^IP: (.*)\r/) {
      $ip[$count] = $1;
    }
    if ($result =~ /^Username: (.*)\r/) {
      $username[$count] = $1;
    }
    if ($result =~ /^Port: (.*)\r/) {
      $port[$count] = $1;
    }
    if ($result =~ /^Speed: (.*)\r/) {
      $speed[$count] = $1;
    }
    if ($result =~ /^Size: (.*)\r/) {
      $size[$count] = $1;
    }
    if ($result =~ /^MD5: (.*)\r/) {
      $md5[$count] = $1;
    }
    $result = <$serverconn>;
  }
  for (my $i=0; $i < @names; $i++) {
    my $name = $names[$i];
    $name =~ s/^.*[\/\\](.*)$/$1/;
    print "$i: $name ";
    print "$username[$i] ";
    print "$bwhash{$speed[$i]} " if defined($bwhash{$speed[$i]});
    print "$size[$i]\n";
  }
  $results[$RESULTS] = $count + 1;
  $results[$NAME] = [ @names ];
  $results[$IP] = [ @ip ];
  $results[$PORT] = [ @port ];
  $results[$SERVER] = [ @username ];
  prompt;
  return @results;
}

#Read in config file
sub readconfig {
  my $filename = shift;
  $filename = "psx.cfg" if (!$filename);
  open(CFG,"$filename") || return 0;
  print "Reading configuration from $filename\n";
  while ($line = <CFG>) {
    if ($line =~ /^username\s+(.*)$/i) {
      $username = $1;
    }
    if ($line =~ /^password\s+(.*)$/i) {
      $pass = md5_hex($1);
    }
    if ($line =~ /^email\s+(.*)$/i) {
      $email = $1;
    }
    if ($line =~ /^first\s+(.*)$/i) {
      $first = $1;
    }
    if ($line =~ /^last\s+(.*)$/i) {
      $last = $1;
    }
    if ($line =~ /^server\s+(.*)$/i) {
      $serveraddr = $1;
    }
    if ($line =~ /^port\s+(.*)$/i) {
      $serverport = $1;
    }
    if ($line =~ /^downloaddir\s+(.*)$/i) {
      $downloaddir = $1;
    }
    if ($line =~ /^speed\s+(.*)$/i) {
      $myspeed = $1;
    }
    if ($line =~ /^sharedir\s+(.*)$/i) {
      if ($shareddirs) {
        $shareddirs = $shareddirs . "|" . $1;
      } else {
        $shareddirs = $1;
      }
      $shareddirs =~ s/\~/$ENV{'HOME'}/;
    }
    if ($line =~ /^hotlistfile\s+(.*)$/i) {
      $hotlistfile = $1;
      $hotlistfile =~ s/\~/$ENV{'HOME'}/;
    }
    if ($line =~ /^searchtype\s+(.*)$/i) {
      $type = $1;
    }
    if ($line =~ /^sharetype\s+(.*)$/i) {
      if ($sharetype) {
        $sharetype = $sharetype . "|" . $1;
      } else {
        $sharetype = $1;
      }
    }
  }
  close(CFG);
  return 1;
}

#Update server stats
sub getstats {
  my $ack = 0;
  while (($line = <$serverconn>) =~ /[A-Z]/) {
    if ($line =~ /^Total-Users: (\d+)/) {
      $totalusers = $1;
    }
    if ($line =~ /^Total-Files: (\d+)/) {
      $totalfiles = $1;
    }
    if ($line =~ /^Total-Size: (\d+)/) {
      $totalsize = $1;
    }
    if ($line =~ /^Ack-Required:.*yes/i) {
      $ack = 1;
    }
  }
  if ($ack) {
    print $serverconn "STP/1.0 ACK\r\n";
    print $serverconn "User-Agent: $useragent\r\n";
    print $serverconn "Username: $username\r\n";
    print $serverconn "\r\n";
  }
  return 1;
}

#Download a file
sub recvfile {
  my $conn = shift || return 0;
  my $localfile = shift;
  my $remuser = shift;
  my $result = "";
  if ($localfile) { # Direct download
    $result = <$conn>;
  }
  my $md5 = "";
  my $length = 0;
  if ($localfile && ($result !~ /STP\/1.0 200 OK/)) {
    print "Recieve File: " . $result;
    return 0;
  }
  $result = <$conn>;
  while ($result ne "\r\n") {
    if ($result =~ /^Content-Length:\s+(\d+)/) {
      $length = $1;
    }
    if ($result =~ /^MD5:\s+(.*)\r/) {
      $md5 = $1;
    }
    if ($result =~ /^Username:\s+(.*)\r/) {
      $remuser = $1;
    }
    if ($result =~ /^Filename:\s+(.*)\r/) {
      my $fname = $1;
      $fname =~ s/.*[\\\/](.*?)$/$1/;
      if (!$localfile) {
        $localfile = $downloaddir . "/" . $fname;
      }
    }
    $result = <$conn>;
  }
  if (!defined($remuser)) {
    $remuser = "Unknown";
  }
  print "Zero Length!\n" if (!$length);
  my $lfh = "FH" . $fhq++;
  open($lfh,">$localfile");
  my @fq = ();
  $fq[$FH] = $lfh;
  $fq[$SOCK] = $conn;
  $fq[$SENT] = 0;
  $fq[$SIZE] = $length;
  $fq[$NAME] = $localfile;
  $fq[$IP] = $conn->peerhost;
  $fq[$USER] = $remuser;
  push @recvfiles, [ @fq ];
  return 1;
}

#Main loop, Read in user command.
sub getcommand {
  prompt;
  while (!selectloop) {};
  my $line = <>;
  if (!defined($line)) {
    print "\n";
    return 0;
  }
  if ($line =~ /^q.*?\s+(.*)$/i) {
    return 0;
  }
  if ($line =~ /^d.*?\s+(.*)$/i) {
    if ($hotlist{$1}) {
      remhotlist $1;
      delete $hotlist{$1};
    }
    return 1;
  }
  if ($line =~ /^h/i) {
    print "Commands:\n";
    print "search <terms> - do a search\n";
    print "next - get next page of last search\n";
    print "get <number> - get from the last result set\n";
    print "kill [upload|download] <number> - kill transfer\n";
    print "add <directory> - share it\n";
    print "trans - show transfer progress\n";
    print "user <username> - add to hotlist, then search user's files\n";
    print "del <username> - take off hotlist\n";
    print "who - show hotlist status\n";
    print "filetype <type> - change default search file type\n";
    print "quit - leave\n";
    return 1;
  }
  if ($line =~ /^f.*?\s+(.*)$/i) {
    $type = $1;
    return 1;
  }
  if ($line =~ /^t.*?\s+(.*?)\s+(.*)$/i) {
    showtran $1, $2;
    return 1;
  }
  if ($line =~ /^t/i) {
    showtran;
    return 1;
  }
  if ($line =~ /^k.*?\s+(.*?)\s+(.*)$/i) {
    killtrans $1, $2;
    return 1;
  }
  if (!$login) {
    print "Server is disconnected.  Use q to exit.\n";
  }
  if ($line =~ /^s.*?\s+(.*)$/i) {
    $words = $1; # Save for next search
    $words =~ tr/A-Z/a-z/;
    search 0, $words;
    $next = $maxresults;
    return 1;
  }
  if ($line =~ /^n.*?$/i) {
    search $next, $words;
    $next += $maxresults;
    return 1;
  }
  if ($line =~ /^g.*?\s+(\d+)/i) {
    if ($res[$RESULTS] > $1) {
      if ($res[$PORT][$1]) {
        get $1, \@res;
      } else {
        getfirewall $1, \@res;
      }
    } else {
      print "No Search Results\n";
    }
    return 1;
  }
  if ($line =~ /^a.*?\s+(.*)$/i) {
    adddir $1;
    return 1;
  }
  if ($line =~ /^w/i) {
    showuserstatus;
    return 1;
  }
  if ($line =~ /^u.*?\s+(.*)$/i) {
    if ($hotlist{$1}) {
      $words = "USER" . $1;
      search 0, $words;
      $next = $maxresults;
    } else {
      addhotlist $1;
    }
    return 1;
  }
  if ($line =~ /^$/) {
    return 1;
  }
  print "Unrecognized Command\n";
  return 1;
}

#select between stdin, connection to server, and bound socket
sub selectloop {
  my $select = IO::Select->new();
  $select->add(\*STDIN);
  if ($serverconn) {
    $select->add($serverconn);
  } else {
    reconnect;
  }
  $select->add($localsock);
  my @recv = getrecvqueue;
  foreach $recvsock (@recv) {
    $select->add($recvsock);
  }

  #If we have anything in the send or recv queues, we won't block
  if (sendqueue) {
    @ready = $select->can_read(0);
  } elsif (!$serverconn) {
    @ready = $select->can_read($fallback);
    $fallback *= 2;
  } else {
    @ready = $select->can_read();
  }
  my $dorecv = 0;
  my @recvls = ();
  foreach $fh (@ready) {
    if (($serverconn) && ($fh == $serverconn)) {
      handleinput;
    } elsif ($fh == $localsock) {
      acceptconn;
    } elsif ($fh == \*STDIN) {
      return 1;
    } else { #Must have been in recvqueue
      push @recvls, $fh;
      $dorecv = 1;
    }
  }
  recvqueue @recvls if ($dorecv);
  return 0;
}

#Respond to request from server
sub handleinput {
  my $line = <$serverconn>;
  if (!defined($line)) {
    $serverconn->close();
    $serverconn=0;
    $login=0;
    reconnect;
    return 1;
  }
  if ($line =~ /STP\/1.0 HELO/) {
    handlehelo $serverconn;
  } elsif ($line =~ /STP\/1.0 STAT/) {
    getstats;
  } elsif ($line =~ /STP\/1.0 GET/) {
    sendfile $serverconn;
    prompt;
  } elsif ($line =~ /STP\/1.0 USER_STATUS/) {
    getuserstatus;
  } elsif ($line =~ /STP\/1.0 300 OK/) {
    @res = searchresults;
  } else {
    print "Server input: " . $line;
  }
  return 1;
}

#ACK the HELO
sub handlehelo {
  my $conn = shift;
  $line = <$conn>; #Read newline
  print $conn "STP/1.0 ACK\r\n";
  print $conn "User-Agent: $useragent\r\n";
  print $conn "Username: $username\r\n";
  print $conn "\r\n";
  return 1;
}

#Handle a connection to our bound port
sub acceptconn {
  my $sock = $localsock->accept;
  my $line = <$sock>;
  if (!defined($line)) {
    close($sock);
    return 1;
  }
  if ($line =~ /HELO/) {
    handlehelo $sock;
    $sock->close();
  }
  if ($line =~ /GET/) {
    sendfile $sock;
    prompt;
  }
  if ($line =~ /200\s+OK/) {
    recvfile $sock, 0;
  }
  return 1;
}

#Send file to Client
#Already read in STP/1.0 GET
sub sendfile {
  my $sock = shift;
  my $localfile = "";
  my $line = <$sock>;
  my $ip = 0;
  my $port = 0;
  my $remuser = "";
  while ($line =~ /^[A-Z]/) {
    if ($line =~ /^Filename:\s+(.*)\r/) {
      $localfile = $1;
    }
    if ($line =~ /^IP:\s+(.*)\r/) {
      $ip = $1;
    }
    if ($line =~ /^Port:\s+(.*)\r/) {
      $port = $1;
    }
    if ($line =~ /^Username:\s+(.*)\r/) {
      $remuser = $1;
    }
    $line = <$sock>;
  }
  if ($ip) {
    $sock = new IO::Socket::INET->new (Proto => "tcp",
                                       PeerAddr => $ip,
                                       PeerPort => $port,
                                       Timeout => $TO) || return 0;
  }
  my $lfh = "FH" . $fhq++;
  if (($localfile !~ /\.\./) &&
      ($localfile =~ /$shareddirs/) &&
      ($localfile =~ /($sharetype)$/i) &&
      (open($lfh,"$localfile"))) {
    my $size = -s $localfile;
    print $sock "STP/1.0 200 OK\r\n";
    print $sock "Filename: $localfile\r\n";
    print $sock "User-Agent: $useragent\r\n";
    print $sock "Content-Length: " . $size . "\r\n";
    print $sock "Content-Type: application/octet-stream\r\n";
    print $sock "\r\n";
    print "\nSending $localfile to ". $sock->peerhost . ":$remuser\n";
    my @fq = ();
    $fq[$FH] = $lfh;
    $fq[$SOCK] = $sock;
    $fq[$SENT] = 0;
    $fq[$SIZE] = $size;
    $fq[$NAME] = $localfile;
    $fq[$IP] = $sock->peerhost;
    $fq[$USER] = $remuser;
    push @sendfiles, [ @fq ];
  } else {
    print $sock "STP/1.0 404 File Not Found\r\n\r\n";
  }
  return 1;
}

# Opens a directory, lists the share file, and adds them to the server
sub adddir {
  my $dir = shift;
  my $mode = shift;
  if (opendir(DIR,$dir)) {
    print "Sharing $dir\n" if (!defined($mode));
    my @files = ();
    if (length($sharetype) > 0) {
      @files = grep /($sharetype)$/i, readdir(DIR);
    }
    close(DIR);
    $dir = $dir . "/" if ($dir !~ /\/$/);
    print $serverconn "STP/1.0 ADD\r\n";
    foreach $file (@files) {
      $file = $dir . $file;
      my @stat = stat($file);
      print $serverconn "Filename: $file\r\n";
      print $serverconn "Size: " . $stat[7] . "\r\n";
      print $serverconn "MD5: " . md5file($file) . "\r\n";
    }
    print $serverconn "\r\n";
    if ($shareddirs) {
      $shareddirs = $shareddirs . "|" . $dir;
    } else {
      $shareddirs = $1;
    }
  } else {
    print "Can't open $dir\n";
  }
  return 1;
}

# Print out command line opts
sub usage {
  print "$PROGNAME/$VERSION\n";
  print "$0 Usage:\n";
  print "--conf -c <filename>   - Use alternate config file\n";
  print "                         Defaults: ~/.psxrc /etc/psxrc psx.cfg\n";
  print "--server -s <hostname> - Use alternate SX server\n";
  print "--port -p <port>       - Use alternate port on SX server\n";
  print "--user -u <username>   - Use alternate username\n";
  print "--pass -P <password>   - Use alternate password\n";
  print "--new  -n              - Register new user\n";
  print "  All command line options will override config file\n";
  exit(0);
}

sub sendqueue {
  my $retval = 0;
  my $sel = IO::Select->new();

FILE: for (my $i=0; $i < @sendfiles; $i++) {
    if ($sendfiles[$i][$FH]) {
      $sel->add($sendfiles[$i][$SOCK]);
      my @ready = $sel->can_write(0);
      if (@ready < 1) {
	next FILE;
      }
      $retval=1;
      my $buf = "";
      if ((my $len = sysread $sendfiles[$i][$FH], $buf, $BSIZE) && ($sendfiles[$i][$SOCK])) {
        eval{$sendfiles[$i][$SOCK]->send($buf);};
        $sendfiles[$i][$SENT] += $len;
        if ($pipe) { # Caught SIGPIPE
          print "Broken upload\n";
          prompt;
          killtrans "upload", $i;
          $pipe = 0;
          $SIG{PIPE} = \&piperr;
        }
      } else {
        killtrans "upload", $i;
      }
    }
  }
  return $retval;
}

sub recvqueue {
  my %sockhash = ();
  my $add = 0;

  for (my $i=0; $i < @recvfiles; $i++) {
    if ($recvfiles[$i][$FH]) {
      # Add to list of files to check
      $sockhash{$recvfiles[$i][$SOCK]} = $i;
      $add = 1;
    }
  }
  if ($add) { # Only run if we have files in progress
    foreach $fh (@_) {
      $i = $sockhash{$fh};
      my $data = "";
      eval{$recvfiles[$i][$SOCK]->read($data,$BSIZE);};
      my $rl = length($data);
      if ($rl < 1) {
	killtrans "download", $i;
      } else {
        if ($pipe) { # Caught SIGPIPE
          print "Broken Download\n";
          prompt;
          $pipe = 0;
          $SIG{PIPE} = \&piperr;
          killtrans "download", $i;
        } else {
          syswrite $recvfiles[$i][$FH], $data, $rl;
          $recvfiles[$i][$SENT] += $rl;
        }
      }
    }
  }
  return $add;
}

sub prompt {
  print "${totalusers}u/${totalfiles}f Command: ";
  return 1;
}

sub showtran {
  my $dir = "";
  my $num = -1;
  $up=1;
  $down=1;
  if (@_) {
    $dir = shift;
    $num = shift;
    if ($dir =~ /^d/i) {
      $up=0;
    }
    if ($dir =~ /^u/i) {
      $down=0;
    }
  }
  if (@recvfiles && $down) {
    print "Downloads:\n" if ($num < 0);
    for (my $i=0; $i < @recvfiles; $i++) {
      if (($i==$num) || ($num < 0)) {
        print "$i: ";
        if ($recvfiles[$i][$FH]) {
          print "In Progress: ";
        } else {
          print "Done: ";
        }
        print "$recvfiles[$i][$NAME] $recvfiles[$i][$SENT]/$recvfiles[$i][$SIZE] $recvfiles[$i][$IP]:$recvfiles[$i][$USER]\n";
      }
    }
  }
  if (@sendfiles && $up) {
    print "Uploads:\n" if ($num < 0);
    for (my $i=0; $i < @sendfiles; $i++) {
      if (($i==$num) || ($num < 0)) {
        print "$i: ";
        if ($sendfiles[$i][$FH]) {
          print "In Progress: ";
        } else {
          print "Done: ";
        }
        print "$sendfiles[$i][$NAME] $sendfiles[$i][$SENT]/$sendfiles[$i][$SIZE] $sendfiles[$i][$IP]:$sendfiles[$i][$USER]\n";
      }
    }
  }
  return 1;
}

sub getuserstatus {
  while (($line = <$serverconn>) =~ /[A-Z]/) {
    if ($line =~ /^Username: (.*)\r/) {
      $statusname = $1;
    }
    if ($line =~ /^Status: (.*)\r/) {
      $hotlist{$statusname} = $1;
    }
  }
  return 1;
}

sub addhotlist {
  my @adduser = @_;
  print $serverconn "STP/1.0 ADDUSER\r\n";
  foreach $adduser (@adduser) {
    print $serverconn "Username: $adduser\r\n";
  }
  print $serverconn "\r\n";
  return 1;
}

sub remhotlist {
  my @remuser = @_;
  print $serverconn "STP/1.0 DELUSER\r\n";
  foreach $remuser (@remuser) {
    print $serverconn "Username: $remuser\r\n";
  }
  print $serverconn "\r\n";
  return 1;
}

sub showuserstatus {
  foreach $key (keys %hotlist) {
    print "$key $hotlist{$key}\n";
  }
  return 1;
}

sub readhotlist {
  if (($hotlistfile) && open(HLF,$hotlistfile)) {
    while (my $line=<HLF>) {
      chomp $line;
      addhotlist $line;
      $hotlist{$line} = "unknown";
    }
    close(HLF);
  }
  return 1;
}

sub writehotlist {
  if (($hotlistfile) && open(HLF,">$hotlistfile")) {
    foreach $key (keys %hotlist) {
      print HLF "$key\n";
    }
    close(HLF);
  }
  return 1;
}

sub killtrans {
  my $d = shift;
  my $num = shift;
  if ($d =~ /^u/i) {
    if ($num < @sendfiles) {
      close($sendfiles[$num][$FH]) if ($sendfiles[$num][$FH]);
      $sendfiles[$num][$SOCK]->close() if ($sendfiles[$num][$SOCK]);
      $sendfiles[$num][$FH] = 0;
    }
  }
  if ($d =~ /^d/i) {
    if ($num < @recvfiles) {
      close($recvfiles[$num][$FH]) if ($recvfiles[$num][$FH]);
      $recvfiles[$num][$SOCK]->close() if ($recvfiles[$num][$SOCK]);
      $recvfiles[$num][$FH] = 0;
    }
  }
  return 1;
}

sub piperr {
  $pipe = 1;
  return 1;
}

sub md5file {
  my $file = shift;
  if (open(CFH,$file)) {
    my $buf = "";
    sysread CFH, $buf, $MD5SIZE;
    close(CFH);
    return md5_hex($buf);
  } else {
    return 0;
  }
}

sub reconnect {
  if (!$serverconn) {
    $serverconn = connecttoserver || return 0;
    login;
    checklogin;
    my @dirs = split /\|/, $shareddirs;
    foreach $dir (@dirs) {
      adddir $dir, "quiet";
    }
    $fallback = 1;
    return 1;
  }
  return 1;
}

sub getrecvqueue {
  my @ret = ();
  for (my $i=0; $i < @recvfiles; $i++) {
    if ($recvfiles[$i][$FH]) {
      push @ret, $recvfiles[$i][$SOCK];
    }
  }
  return @ret;
}