#!/usr/bin/perl -w

$PROGNAME="PSX"; # Perl Scour eXchange
$VERSION="0.11a";
# 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>

#Import these

use Getopt::Long;
use IO::Socket;
use IO::Select;
use MD5;
use MIME::Base64;

# We need FIONREAD to download without blocking
# If it's not in 'sys/ioctl.pl', grep through the headers to find FIONREAD
# And hard-code it's value in here.
# If you've ran h2ph, use this
my $usefionread = 1;
require 'sys/ioctl.ph'; # Needed for FIONREAD
# Hard-coded (Linux value)
#eval 'sub FIONREAD () {0x541b;}' unless defined(&FIONREAD);
# Solaris/BSD=0x4004667f

# Or, if you want to have your downloads block, comment out all of the above, 
# and uncomment the following:
# my $usefionread = 0;
    
#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 acceptcntl;
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;
sub results;
sub sigint;
sub cancelsearch;
sub resume;
sub writemd5cache;
sub readmd5cache;
sub sendmessage;
sub recvmessage;
sub failmessage;
sub autoconfigure;

#CONSTANTS
#In results array
my $RESULTS = 0;
my $NAME = 1;
my $IP = 2;
my $PORT = 3;
my $SERVER = 4;
my $SIZE = 5;
my $HEIGHT = 6;
my $WIDTH = 7;
my $BITRATE = 8;
my $FREQ = 9;
my $DURATION = 10;
my $FPS = 11;
my $MD5 = 12;
#In Transfer queue array
my $FH = 0;
my $SOCK = 3;
my $SENT = 4;
my $USER = 6;
my $AGENT = 7;
my $RESINDEX = 8;
#Download block size
my $BSIZE = 1024; # Block size to send
my $MD5SIZE = 300*1024; # MD5 first x bytes of file
my $MAXADD = 200; # Only add this many files per ADD
#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 = "";                    # Username, related info
my $pass = MD5->hexhash("pass");
my $first = "";
my $last = "";
my $email = "";
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 $autoconf = 1;                      # Should we auto-configure?
my $autoconfurl = "http://sx.scour.com/Configure/";
my $serveraddr = "stp.scour.net";      # Server address/port
my $serverport = "80";
my $sserveraddr = "stp.scour.net";     # Backup address/port
my $sserverport = "8080";
my @res = ();                          # Search results
my $totalusers = 0;                    # Stats on connected users
my $totalfiles = 0;
my $totalsize = 0;
my $localsock = 0;                     # Local server socket
my $cntlsock = 0;                      # Control server socket
my $cntlport = 0;                      # Default control port, not active if 0
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 = 2;                      # Fallback time to reconnect to server
my $blockstr = "";                     # Where we'd be blocking right now
my $sigints = 0;                       # How many times we've Cntrl-C'd
my $noreconnect = 0;                   # don't try to reconnect
my %reshash = ();                      # Store filename we want to recv for firewall transfer
my $getadd = 0;                        # Add this to the number given to get to current index in @res
my %md5cache = ();                     # Store MD5 sums of files
my $md5cachefile = "";                 # File to store MD5 sums in
my $numadded = 0;                      # Number of files we've added
my $msgseq = 0;                        # Message sequence
my @searchsock = ();                   # Socket to return search results on
my %sharehash = ();                    # Hash of files shared under different names

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

#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', 'auto|a', '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->hexhash($opts{pass}) if ($opts{pass});
autoconfigure() if ((!$opts{server} && !$opts{port}) && (($opts{auto}) || $autoconf));

#Open connection to server, bind local server
$localsock = bindport || die "Unable to bind socket\n";
$myport = $localsock->sockport();
if ($cntlport) {
  print "Setting up control port localhost:$cntlport\n";
  $cntlsock = bindport $cntlport || die "Unable to bind to control port\n";
}
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

readmd5cache;

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

readhotlist;

#main loop
while (getcommand()) {}

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

#SUBROUTINES

#Send the login packet
sub login {
  $blockstr = "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 "Port: $myport\r\n";
  print $serverconn "Speed: $myspeed\r\n";
  print $serverconn "\r\n";

  return 1;  
}

#Register a user
sub newlogin {
  $blockstr = "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 $range = shift;
  print "Connecting to $res[$IP][$num]:$res[$PORT][$num]...\n";
  $blockstr = "Connecting to $res[$IP][$num]:$res[$PORT][$num]";
  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;
  $blockstr = "Sending GET to client";
  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 "Range: bytes=" . $range . "\r\n" if ($range);
  print $remoteconn "\r\n";
  #$remoteconn->autoflush(0);
  recvfile $remoteconn, $localfilename, $res[$SERVER][$num], $num;
  
  return 1;
}

sub getfirewall {
  my $num = shift;
  my $range = shift;
  $blockstr = "Sending GET to server";
  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 "Range: bytes=" . $range . "\r\n" if ($range);
  print $serverconn "\r\n";
  print "Requested transfer from firewalled client\n";
  $reshash{$res[$NAME][$num]} = $num;
  return 1;

}

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

  if ($sock) {
    $searchsock[$searchid] = $sock;
  } else {
    $searchsock[$searchid] = 0;
  }
  $blockstr = "Sending SEARCH";
  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 $addr = shift;
  my $port = shift;
  $addr = $serveraddr if (!defined($addr));
  $port = $serverport if (!defined($port));
  $blockstr = "Connecting to $serveraddr:$serverport";
  my $sock = IO::Socket::INET->new (Proto => "tcp",
                                    PeerAddr => $addr,
                                    PeerPort => $port,
                                    Timeout => $TO);
  if (!$sock) {
    $blockstr = "Connecting to $sserveraddr:$sserverport";
    $sock = IO::Socket::INET->new (Proto => "tcp",
                                   PeerAddr => $sserveraddr,
                                   PeerPort => $sserverport,
                                   Timeout => $TO);
  }
  return $sock;
}

#Bind a socket
sub bindport {
  my $port = shift || 0;
  my $lip = "";
  if ($port) { $lip = "localhost"; }
  my $blockstr = "binding";
  my $sock = new IO::Socket::INET(Listen => 5, Timeout => $TO, LocalPort => $port, LocalAddr => $lip);
  return $sock;
}

#Make sure we logged in correctly.
sub checklogin {
  $blockstr = "Waiting for login response";
  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>;
      $serverconn->close() if ($serverconn);
      $serverconn = 0;
      $login = 0;
      $fallback *= 2;
    }
  } else {
    print "Login Error: ";
    if (defined($response)) {
      chomp $response;
      print $response;
    }
    print " Server disconnected on login, will retry login\n";
    $login = 0;
    $serverconn->close() if ($serverconn);
    $serverconn = 0;
    $fallback *= 2;
    if (defined($response) && ($response =~ /HTTP/)) {
      reconnect $sserveraddr, $sserverport;
    }
  }
  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 @width = ();
  my @height = ();
  my @bitrate = ();
  my @duration = ();
  my @freq = ();
  my @fps = ();
  my $count = -1;
  my $resid = -1;
  my $numres = 0;
  $blockstr = "Reading SEARCH results";
  $result = <$serverconn>;
  while ($result =~ /^(Num-Results|Search-ID|Offset|Type):/) {
    if ($result =~ /^Num-Results:\s+(\d+)\r/) {
      $numres = $1;
    }
    if ($result =~ /^Search-ID:\s+(.*)\r/) {
      $resid = $1;
    }
    $result = <$serverconn>;
  }

  while ($result =~ /^[A-Z]/) {
    if ($result =~ /^Filename: (.*)\r/) {
      $names[++$count] = $1;
      $speed[$count] = 0;
      $ip[$count] = "";
      $username[$count] = "";
      $port[$count] = 0;
      $size[$count] = 0;
      $md5[$count] = "";
      $height[$count] = 0;
      $width[$count] = 0;
      $bitrate[$count] = 0;
      $duration[$count] = 0;
      $freq[$count] = 0;
      $fps[$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;
    }
    if ($result =~ /^Height: (.*)\r/) {
      $height[$count] = $1;
    }
    if ($result =~ /^Width: (.*)\r/) {
      $width[$count] = $1;
    }
    if ($result =~ /^Bitrate: (.*)\r/) {
      $bitrate[$count] = $1;
    }
    if ($result =~ /^Duration: (.*)\r/) {
      $duration[$count] = $1;
    }
    if ($result =~ /^Freq: (.*)\r/) {
      $freq[$count] = $1;
    }
    if ($result =~ /^Fps: (.*)\r/) {
      $fps[$count] = $1;
    }
    $result = <$serverconn>;
  }
  print "\r$numres Results for $words                         \n" if (!$searchsock[$resid]);
  for (my $i=0; $i < @names; $i++) {
    my $name = $names[$i];
    $name =~ s/^.*[\/\\](.*)$/$1/;
    if ($searchsock[$resid]) {
      print {$searchsock[$resid]} $size[$i] . " stp://" . $username[$i] . ":" . $ip[$i] . ":" . $port[$i] . "/" . $names[$i] . "\n";
    } else {
      print "$i: ";
      print "$name ";
      print "$username[$i] ";
      print "$bwhash{$speed[$i]} " if defined($bwhash{$speed[$i]});
      print "$size[$i]\n";
    }
  }
  if ($searchsock[$resid]) {
    close ($searchsock[$resid]);
  } else {
    $getadd = $res[$RESULTS];
    $res[$RESULTS] += $count + 1; # Count starts at -1
    push @{$res[$NAME]}, @names;
    push @{$res[$IP]}, @ip;
    push @{$res[$PORT]}, @port;
    push @{$res[$SERVER]}, @username;
    push @{$res[$HEIGHT]}, @height;
    push @{$res[$WIDTH]}, @width;
    push @{$res[$BITRATE]}, @bitrate;
    push @{$res[$DURATION]}, @duration;
    push @{$res[$FREQ]}, @freq;
    push @{$res[$FPS]}, @fps;
    push @{$res[$SIZE]}, @size;
    push @{$res[$MD5]}, @md5;
    prompt;
  }
  return 1;
}

#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->hexhash($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;
      $autoconf = 0;
    }
    if ($line =~ /^port\s+(.*)$/i) {
      $serverport = $1;
      $autoconf = 0;
    }
    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 =~ /^md5cachefile\s+(.*)$/i) {
      $md5cachefile = $1;
      $md5cachefile =~ s/\~/$ENV{'HOME'}/;
    }
    if ($line =~ /^searchtype\s+(.*)$/i) {
      $type = $1;
    }
    if ($line =~ /^sharetype\s+(.*)$/i) {
      if ($sharetype) {
        $sharetype = $sharetype . "|" . $1;
      } else {
        $sharetype = $1;
      }
    }
    if ($line =~ /^controlport\s+(.*)$/i) {
      $cntlport = $1;
    }
  }
  close(CFG);
  return 1;
}

#Update server stats
sub getstats {
  my $ack = 0;
  $blockstr = "reading STATS";
  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 {
  $blockstr = "reading download response";
  my $conn = shift || return 0;
  my $localfile = shift;
  my $remuser = shift;
  my $resindex = shift;
  my $result = "";
  my $agent = "";
  my $remfile = "";
  my $resume = 0;
  my $start = 0;
  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 ($length == 0); # file size, Content-Range overrides this
    }
    if ($result =~ /^MD5:\s+(.*)\r/) {
      $md5 = $1;
    }
    if ($result =~ /^Username:\s+(.*)\r/) {
      $remuser = $1;
    }
    if ($result =~ /^User-Agent:\s+(.*)\r/) {
      $agent = $1;
    }
    if ($result =~ /^Filename:\s+(.*)\r/) {
      my $fname = $1;
      $remfile = $fname;
      $fname =~ s/.*[\\\/](.*?)$/$1/;
      if (!$localfile) {
        $localfile = $downloaddir . "/" . $fname;
      }
    }
    if ($result =~ /^Content-Range:\s+bytes\=(\d+)\-(\d+)\/(\d+)/) {
      $resume = 1;
      $start = $1;
      $length = $3;
    }
    $result = <$conn>;
  }
  if (!defined($remuser)) {
    $remuser = "Unknown";
  }
  if (!defined($resindex) && !($resindex = $reshash{$remfile})) {
    print "Didn't ask for $remfile\n";
    $conn->close();
    return 0;
  } else {
    $reshash{$remfile} = ""; # Don't accept this file anymore
  }
  print "Zero Length!\n" if (!$length);
  my $lfh = "FH" . $fhq++;
  my $oret=0;
  if ($resume) {
    $oret=open($lfh,">>$localfile");
  } else {
    while (-e $localfile) {
      $localfile = $localfile.".1";
    }
    $oret=open($lfh,">$localfile");
  }
  if(!$oret) {
    print "Can't open $localfile\n";
    $conn->close;
    return 0;
  }
  my @fq = ();
  $fq[$FH] = $lfh;
  $fq[$SOCK] = $conn;
  $fq[$SENT] = $start;
  $fq[$SIZE] = $length;
  $fq[$NAME] = $localfile;
  $fq[$IP] = $conn->peerhost;
  $fq[$USER] = $remuser;
  $fq[$MD5] = $md5;
  $fq[$AGENT] = $agent;
  $fq[$RESINDEX] = $resindex;
  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;
  }
  $line =~ s/^\s+//;
  if ($line =~ /^$/) {
    return 1;
  }
  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, blank cancels the last search\n";
    print "results <number> - get details on file from last 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 "resume <number> - resume download\n";
    print "add <directory> - share it\n";
    print "trans (up|down|number|cur|all) (number) - 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 "message <username> <message> - send message\n";
    print "filetype <type> - change default search file type\n";
    print "logoff - log off server\n";
    print "reconnect - reconnect to server\n";
    print "quit - leave\n";
    return 1;
  }
  if ($line =~ /^f.*?\s+(.*)$/i) {
    $type = $1;
    return 1;
  }
  if ($line =~ /^t.*?\s+(.+?)\s+(\d*)$/i) {
    showtran $1, $2;
    return 1;
  }
  if ($line =~ /^t/i) {
    showtran;
    return 1;
  }
  if ($line =~ /^rec/i) {
    $noreconnect = 0;
    reconnect;
    return 1;
  }
  if ($line =~ /^k.*?\s+(.+?)\s+(\d*)$/i) {
    killtrans $1, $2;
    return 1;
  }
  if (!$login && (length($line) > 0)) {
    return 1; # Don't do anything else since we're not connected
  }
  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 =~ /^s/i) {
    cancelsearch;
    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+$getadd);
      } else {
        getfirewall ($1+$getadd);
      }
    } 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 =~ /^resul.*?\s+(\d+)/i) {
    results ($1+$getadd);
    return 1;
  }
  if ($line =~ /^l/i) {
    $noreconnect = 1;
    $login = 0;
    $serverconn->close() if ($serverconn);
    $serverconn = 0;
    return 1;
  }
  if ($line =~ /^resum.*?\s+(\d+)/i) {
    resume $1;
    return 1;
  }
  if ($line =~ /^m.*?\s(\S+)\s(.*)/i) {
    sendmessage $1, $2;
    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);
  }
  $select->add($localsock);
  $select->add($cntlsock) if ($cntlsock);
  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) {
    $blockstr = "main select loop, send queue on\n";
    @ready = $select->can_read(0);
  } elsif (!$serverconn) {
    $blockstr = "main select loop, server disconnected $fallback\n";
    @ready = $select->can_read($fallback);
    if (@ready < 1) {
      $fallback *= 2;
      reconnect;
    }
  } else {
    $blockstr = "main select loop, waiting for input\n";
    @ready = $select->can_read();
  }
  my $dorecv = 0;
  my @recvls = ();
  foreach $fh (@ready) {
    if (($serverconn) && ($fh == $serverconn)) {
      handleinput;
    } elsif ($fh == $localsock) {
      acceptconn;
    } elsif ($cntlsock && ($fh == $cntlsock)) {
      acceptcntl;
    } 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 {
  $blockstr = "reading input from server";
  my $line = <$serverconn>;
  if (!defined($line)) {
    $serverconn->close() if ($serverconn);
    $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/) {
    searchresults;
  } elsif ($line =~ /STP\/1.0 SERVER_MESSAGE/) {
    recvmessage;
  } elsif ($line =~ /STP\/1.0 MESSAGE_FAIL/) {
    failmessage;
  } else {
    print "Server input: " . $line;
  }
  return 1;
}

#ACK the HELO
sub handlehelo {
  $blockstr = "reading HELO";
  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 {
  $blockstr = "handling incoming connection";
  my $sock = $localsock->accept;
  return 0 if (!$sock);
  $sock->timeout($TO);
  my $line = <$sock>;
  if (!defined($line)) {
    $sock->close();
    return 1;
  }
  if ($line =~ /HELO/) {
    handlehelo $sock;
    $sock->close();
  }
  if ($line =~ /GET/) {
    sendfile $sock;
    prompt;
  }
  if ($line =~ /200\s+OK/) {
    #$sock->autoflush(0);
    recvfile $sock, 0;
  }
  return 1;
}

sub acceptcntl {
  $blockstr = "handling control connection";
  my $sock = $cntlsock->accept;
  return 0 if (!$sock);
  $sock->timeout($TO);
  my $line = <$sock>;
  if (!defined($line)) {
    $sock->close();
    return 1;
  }
  if ($line =~ /^SEARCH (.*?) (.*)[\r\n]/i) {
    my $stype = $type;
    $type = $1;
    search 0, $2, $sock;
    $type = $stype;
  }
  if ($line =~ /^ADD (.*?) (.*)[\r\n]/i) {
    addfile $1 $2;
    close($sock);
  }
  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 = "";
  my $agent = "";
  my $range = "";
  my $start = 0;
  my $end = 0;
  $blockstr = "reading GET request";
  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;
    }
    if ($line =~ /^User-Agent:\s+(.*)\r/) {
      $agent = $1;
    }
    if ($line =~ /^Range:\s+(.*)\r/) {
      $range = $1;
      if ($range =~ /bytes\=(\d+)\-(\d+)/) {
	$start = $1;
	$end = $2;
      }
    }
    $line = <$sock>;
  }
  if ($ip) {
    $blockstr = "connecting to $ip:$port to send file";
    $sock = new IO::Socket::INET->new (Proto => "tcp",
                                       PeerAddr => $ip,
                                       PeerPort => $port,
                                       Timeout => $TO) || return 0;
  }
  my $lfh = "FH" . $fhq++;
  my $sharename = $localfile;
  if ($sharehash{$localfile}) {
    $sharename = $localfile;
    $localfile = $sharehash{$localfile};
  }
  if (($localfile !~ /\.\./) &&
      ($localfile =~ /$shareddirs/) &&
      ($localfile =~ /($sharetype)$/i) &&
      (open($lfh,"$localfile"))) {
    my $size = -s $localfile;
    my $fsize = $size;
    if (($range) && ($start < $size) && ($end <= $size)) {
      sysseek $lfh, $start, 0;
      $size = $end;
    } else { $range = ""; $start = 0; }
    $blockstr = "sending GET response";
    print $sock "STP/1.0 200 OK\r\n";
    print $sock "Filename: $sharename\r\n";
    print $sock "User-Agent: $useragent\r\n";
    print $sock "Content-Length: " . ($size-$start) . "\r\n";
    print $sock "Content-Type: application/octet-stream\r\n";
    print $sock "Content-Range: $range/$fsize\r\n" if ($range);
    print $sock "MD5: " . $md5cache{$localfile} . "\r\n";
    print $sock "\r\n";
    print "\nSending $localfile to ". $sock->peerhost . ":$remuser\n";
    my @fq = ();
    $fq[$FH] = $lfh;
    $fq[$SOCK] = $sock;
    $fq[$SENT] = $start;
    $fq[$SIZE] = $size;
    $fq[$NAME] = $localfile;
    $fq[$IP] = $sock->peerhost;
    $fq[$USER] = $remuser;
    $fq[$AGENT] = $agent;
    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;
  return 0 if (!$login);
  if (opendir(DIR,$dir)) {
    $blockstr = "Adding $dir\n";
    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 !~ /\/$/);
    if ($shareddirs) {
      $shareddirs = $shareddirs . "|" . $dir;
    } else {
      $shareddirs = $1;
    }
    print $serverconn "STP/1.0 ADD\r\n";
    foreach $file (@files) {
      $file = $dir . $file;
      my @stat = stat($file);
      my $md5sum = "";
      if ($md5cache{$file}) {
        $md5sum = $md5cache{$file};
      } else {
        $md5sum = md5file($file);
        $md5cache{$file} = $md5sum;
      }
      print $serverconn "Filename: $file\r\n";
      print $serverconn "Size: " . $stat[7] . "\r\n";
      print $serverconn "MD5: " . $md5sum . "\r\n";
      $numadded++;
      if ($numadded >= $MAXADD) {
      	print $serverconn "\r\n";
      	print $serverconn "STP/1.0 ADD\r\n";
      	$numadded = 0;
      }
    }
    print $serverconn "\r\n";
  } else {
    print "Can't open $dir\n";
  }
  return 1;
}

sub addfile {
  my $key = shift;
  my $file = shift;
  return 0 if (!login);
  return 0 if (!-e $file);
  my @stat = stat($file);
  my $md5sum = md5file($file);
  $md5cache{$file} = $md5sum;
  print $serverconn "STP/1.0 ADD\r\n";
  print $serverconn "Filename: $key\r\n";
  print $serverconn "Size: " . $stat[7] . "\r\n";
  print $serverconn "MD5: " . $md5sum . "\r\n";
  print $serverconn "\r\n";
  $sharehash{$key} = $file;
  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 "--auto -a              - Connect to Scour server for configuration\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();
  $blockstr = "running through send queue";

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])) {
	if (($sendfiles[$i][$SENT] + $len) > $sendfiles[$i][$SIZE]) {
	  eval{$sendfiles[$i][$SOCK]->send($buf,$sendfiles[$i][$SENT] + $len - $sendfiles[$i][$SIZE])};
	} else {
          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;
  $blockstr = "in recv queue";

  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 = "";
      # Find out how much data we have to read
      # Just reading in a fixed size can cause blocking
      my $rl = pack("L",0);
      if ($usefionread) {
        ioctl($recvfiles[$i][$SOCK], FIONREAD(), $rl);
        $rl = unpack("L",$rl);
      } else {
        $rl = $BSIZE;
      }
      eval{$recvfiles[$i][$SOCK]->read($data,$rl);};
      $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 {
  if ($login && $serverconn) {
    print "${totalusers}u/${totalfiles}f ";
  } else {
    print "Not connected ";
  }
  print "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 ($dir =~ /^n/i) {
      print "Downloads: " . scalar @recvfiles . " Uploads: " . scalar @sendfiles . "\n";
      return 1;
    }
    if ($dir !~ /^[audn]/i) {
      print "Bad Option\n";
      return 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]";
	print " $recvfiles[$i][$AGENT]" if (length($recvfiles[$i][$AGENT]) && ($num > -1));
	print "\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]";
	print " $sendfiles[$i][$AGENT]" if (length($sendfiles[$i][$AGENT]) && ($num > -1));
	print "\n";
      }
    }
  }
  return 1;
}

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

sub addhotlist {
  my @adduser = @_;
  $blockstr = "sending 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 = @_;
  $blockstr = "sending DELUSER";
  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 {
  print "Username: " . $username . "\n";
  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 if ($login);
      $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;
      if ((length($recvfiles[$num][$MD5]) > 0) && ((my $md5 = md5file($recvfiles[$num][$NAME])) ne $recvfiles[$num][$MD5])) {
	print "$recvfiles[$num][$NAME] md5 mismatch\n";
	print "$md5:$recvfiles[$num][$MD5]\n";
	prompt;
      }
    }
  }
  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->hexhash($buf);
  } else {
    return 0;
  }
}

sub reconnect {
  my $addr = shift;
  my $port = shift;
  return 1 if ($noreconnect);
  if (!$serverconn) {
    $blockstr = "reconnect";
    $serverconn = connecttoserver $addr, $port || return 0;
    login;
    checklogin;
    return 0 if (!$login);
    $numadded = 0;
    my @dirs = split /\|/, $shareddirs;
    foreach $dir (@dirs) {
      adddir $dir, "quiet";
    }
    $fallback = 2;
    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;
}

sub results {
  my $num = shift;
  if ($num > $res[$RESULTS]) {
    print "Out of range $num $res[$RESULTS]\n";
    return 0;
  }
  print "$num: ";
  print $res[$NAME][$num] . " " if defined($res[$NAME][$num]);
  print "size: " . $res[$SIZE][$num] . " " if defined($res[$SIZE][$num]);
  print "ip: " . $res[$IP][$num] . " " if defined($res[$IP][$num]);
  print "port: " . $res[$PORT][$num] . " " if defined($res[$PORT][$num]);
  print "user: " . $res[$SERVER][$num] . " " if defined($res[$SERVER][$num]);
  print "height: " . $res[$HEIGHT][$num] . " " if defined($res[$HEIGHT][$num]);
  print "width: " . $res[$WIDTH][$num] . " " if defined($res[$WIDTH][$num]);
  print "bitrate: " . $res[$BITRATE][$num] . " " if defined($res[$BITRATE][$num]);
  print "frequency: " . $res[$FREQ][$num] . " " if defined($res[$FREQ][$num]);
  print "duration: " . $res[$DURATION][$num] . " " if defined($res[$DURATION][$num]);
  print "frames per second: " . $res[$FPS][$num] . " " if defined($res[$FPS][$num]);
  print "md5sum: " . $res[$MD5][$num] . " " if defined($res[$MD5][$num]);
  print "\n";
  return 1;
}

sub sigint {
  my $exitat = 4;
  print "Blocked in " . $blockstr . "\n";
  $SIG{INT} = \&sigint;
  $sigints++;
  exit(0) if ($sigints > $exitat);
  print $exitat - $sigints + 1 . " more until exit\n";
  return 1;
}

sub cancelsearch {
  $blockstr = "CANCEL_SEARCH";
  print $serverconn "STP/1.0 CANCEL_SEARCH\r\n";
  print $serverconn "\r\n";
  return 1;
}

sub resume {
  my $num = shift;
  if (@recvfiles < 1) {
    print "No files downloaded yet\n";
    return 0;
  }
  if (($num+1) > @recvfiles) {
    print "$num out of range\n";
    return 0;
  }
  if ($recvfiles[$num][$SENT] == $recvfiles[$num][$SIZE]) {
    print "File is already done\n";
    return 0;
  }
  my $range = $recvfiles[$num][$SENT] . "-" . $recvfiles[$num][$SIZE];
  my $ri = $recvfiles[$num][$RESINDEX];
  if ($res[$PORT][$ri]) {
    get $ri, $range;
  } else {
    getfirewall $ri, $range;
  }
  return 1;
}

sub writemd5cache {
  return 0 if (!$md5cachefile);
  return 0 if !open(MD5CACHE,">$md5cachefile");
  foreach $key (keys %md5cache) {
    print MD5CACHE $md5cache{$key} . " " . $key . "\n";
  }
  close(MD5CACHE);
  return 1;
}

sub readmd5cache {
  return 0 if (!$md5cachefile);
  return 0 if !open(MD5CACHE,$md5cachefile);
  while (my $line = <MD5CACHE>) {
    chomp $line;
    if ($line =~ /(.*?)\s(.*)/) {
      $md5cache{$2} = $1;
    }
  }
  close(MD5CACHE);
  return 1;
}

sub sendmessage {
  my $recip = shift;
  my $message = shift;
  print $serverconn "STP/1.0 MESSAGE\r\n";
  print $serverconn "Username: $recip\r\n";
  print $serverconn "Transfer-Encoding: base64\r\n";
  print $serverconn "Sequence: " . $msgseq++ . "\r\n";
  print $serverconn "Data: " . encode_base64($message,"") . "\r\n";
  print $serverconn "\r\n";
  return 1;
}

sub recvmessage {
  while ((my $line = <$serverconn>) =~ /^A-Z/) {
    if ($line =~ /^Transfer-Encoding: (.*)\r/) {
    }
    if ($line =~ /^Data: (.*)\r/) {
      print "\rMessage............\n";
      print decode_base64($1) . "\n";
    }
  }
  return 1;
}

sub failmessage {
  my $un = "";
  my $err = "";
  my $line = <$serverconn>;
  while ($line =~ /^[A-Z]/) {
    if ($line =~ /^Username: (.*)\r/) {
      $un = $1;
    }
    if ($line =~ /^Sequence: (.*)\r/) {
    }
    if ($line =~ /^Type: (.*)\r/) {
      $err = $1;
    }
    $line = <$serverconn>;
  }
  print "\rSend message to $un error: $err\n";
  prompt;
  return 1;
}

sub autoconfigure {

  print "Getting server address\n";
  my $host=$autoconfurl;
  $host =~ s/(http:\/\/)?(.*?)\/.*$/$2/;
  my $url=$autoconfurl;
  $url =~ s/(http:\/\/)?.*?(\/.*$)/$2/;

  my $conn = IO::Socket::INET->new ("$host:80");
  return 0 if (!$conn);
  print $conn "GET ".$url."?application_name=$PROGNAME&application_version=$VERSION&application_platform=Perl HTTP/1.0\r\n";
  print $conn "Host: $host\r\n";
  print $conn "\r\n";
  while (my $line=<$conn>) {
    if ($line =~ /^Connect-Host: (.*)\r$/) { $serveraddr = $1; }
    if ($line =~ /^Connect-Port: (.*)\r$/) { $serverport = $1; }
    if ($line =~ /^Secondary-Connect-Host: (.*)\r$/) { $sserveraddr = $1; }
    if ($line =~ /^Secondary-Connect-Port: (.*)\r$/) { $sserverport = $1; }
  }
  close($conn);

  return 1;
}