#!/usr/bin/perl

# --- profxp v2 ---------------------------------------------------------- #
# this godly code is released under the GPL. please mail fixes, changes,
# additions, ideas, blanco cheques and everything else back to
#
#       Tom Kistner <tom@duncanthrax.net>
#
# thx. long live FTP.
# ------------------------------------------------------------------------ #


print "\n";
print Term::ANSIColor::color("reset bold green").":: ";
print "=---------------------------------------------------=\n";
print Term::ANSIColor::color("reset bold green").":: ";
print Term::ANSIColor::color("reset")." profxp v2   -   [tom kistner <tom\@duncanthrax.net>]\n";
print Term::ANSIColor::color("reset bold green").":: ";
print "=---------------------------------------------------=\n";
print Term::ANSIColor::color("reset bold green")."::\n";

# ----------------------------------------------------------- #
# modules and imported functions

use Time::HiRes;
use Term::ANSIColor;
use IO::Socket;
use Fcntl;
use Net::SOCKS;
use Term::ReadKey;
BEGIN{ $ENV{PERL_RL} = 'Perl' };
use Term::ReadLine;
use Term::ReadLine::Perl;
use Term::ReadLine::readline;
use Storable;

# ----------------------------------------------------------- #
# some global vars

# like $!, only for us
my $errortext = "NO_ERROR_DESC";

# colors to be used, may be static later
  my %c = ();

  $c{0} 	= Term::ANSIColor::color("reset green");
  $c{1} 	= Term::ANSIColor::color("reset cyan");
  $c{reset} = Term::ANSIColor::color("reset");

  $c{red}	= Term::ANSIColor::color("reset bold red");
  $c{yellow}	= Term::ANSIColor::color("reset bold yellow");
  $c{green}	= Term::ANSIColor::color("reset bold green");

  $c{blue}	= Term::ANSIColor::color("reset bold blue");
  $c{white}	= Term::ANSIColor::color("reset white");
  $c{magenta}	= Term::ANSIColor::color("reset bold magenta");
  $c{lila}	= Term::ANSIColor::color("reset magenta");

# connection mode description text

  my %ctmode = ();
  $ctmode{0} = "Direct passive";
  $ctmode{1} = "Direct active";
  $ctmode{2} = "SOCKS passive";
  $ctmode{3} = "SOCKS active";

# listing mode description text

  my %lsmode = ();
  $lsmode{0} = "unsorted";
  $lsmode{1} = "literal";
  $lsmode{2} = "date";
  $lsmode{3} = "size";

# fxp mode desc. text

  my %fxpmode = ();
  $fxpmode{0} = "normal";
  $fxpmode{1} = "alt";

# the command line handler
my $t = new Term::ReadLine 'pfxp';
if (!($t->ReadLine() =~ /Perl/)) {
  error("Please install Term::Readline::Perl");
  exit(0);
};
my $tattribs = $t->Attribs;

# ----------------------------------------------------------- #
# Global Settings

# set STDOUT to autoflush
  $| = 1;

# chdir to ~/.profxp (working) directory
if (!(chdir($ENV{"HOME"} || $ENV{"LOGDIR"} || (getpwuid($<))[7]))) {

  error("cannot chdir to your home directory !");
  exit(0);

}

MAKECONFIGDIR: if (!(chdir(".profxp"))) {

  if (!(mkdir(".profxp"))) {
    error("~can't CWD to /.profxp, and cannot create it either");
    exit(0);
  };

  # repeat 
  goto MAKECONFIGDIR;

};

# ----------------------------------------------------------- #
# load configuration and sites

my %site = ();
my %config = ();
my $hashref;

if (eval {$hashref = retrieve('config');}) {

  %config = % { $hashref };
  info("configuration loaded");

}
else {

  # ----------------------------------------------------------- #
  # defaults for all global configuration vars

  $config{maxlines} = 25;
  $config{localaddr} = '0.0.0.0';
  my @tmpsocks = ('0.0.0.0',
                   1080,
                   4,
                   "", 
                   "");
  $config{socks} 	= \@tmpsocks;
  $config{viewer}	= "less";
  $config{cmode}	= 0;
  $config{lmode}	= 1;
  $config{fmode}  = 0;
  $config{idletime}	= 60;
  $config{noopcmd}	= "PWD";

  store \%config, 'config';
  warning("config file '~/.profxp/config' not found - default file created");
  info(" ");
  info("it looks like you are starting profxp.v2 for the first time.");
  info("some useful tips:");
  info("1. set your local interface name with the 'lh' command");
  info("2. type 'he' for help");
  info("3. read the docs !");
  info(" ");

};

if (eval {$hashref = retrieve('sites');}) {

  %site = % { $hashref };	
  info("site info loaded");

}
else {

  # ----------------------------------------------------------- #
  # save the default site

  $site{'DISCONNECTED'}{name} = "DISCONNECTED";
  $site{'DISCONNECTED'}{addr} = "0.0.0.0";
  $site{'DISCONNECTED'}{port} = 21;
  $site{'DISCONNECTED'}{user} = "anonymous";
  $site{'DISCONNECTED'}{pass} = "aol\@aol.com";
  $site{'DISCONNECTED'}{mode} = "0";
  $site{'DISCONNECTED'}{path} = "NO_PATH";  
  $site{'DISCONNECTED'}{sock} = 0;
  $site{'DISCONNECTED'}{slot} = "";

  store \%site, 'sites';
  warning("site file '~/.profxp/sites' not found - default file created");
  
};

# the 'active' site
my $active = 0;

# the line count
my $lcount = 999999;

# prevent SIGPIPE from killing us (for now)
$SIG{PIPE} = 'IGNORE';

# set 'NOOP' idle loop
$SIG{ALRM} = \&do_noop;
alarm $config{idletime};

# fill empty site descriptors
disconnect($active);
disconnect(($active^1));


# ----------------------------------------------------------
# set up TAB completion function

$tattribs->{completion_function} = sub {

  my @tmplist = ();
  my $cand = '';
  
  # trim whitespace from cmdline frag
  $_[1] =~ s/^ +//g;
  $_[1] =~ s/ +$//g;

  # --------------------------------------------------------
  # sitename completion for the "op", "ss" and "sd" commands

  if ( ($_[1] =~ /^op/) ||
       ($_[1] =~ /^ss/) ||
       ($_[1] =~ /^sd/) ) {

    # do not allow regexp chars in site names
    return(0) if ($_[0] =~ /\W/);    

    foreach $cand (keys(%site)) {
      
      next if (!($site{$cand}{bmrk}));            
      next if (!($site{$cand}{name} =~ /^$_[0]/));
      
      push @tmplist, ($site{$cand}{name});      
    };

    return @tmplist;
  };


  # --------------------------------------------------------
  # file/dir completion

  if ($site{$active}{sock}) {
    my %completionlist = ();	
    print "[getting list]";
    %completionlist = getlist($site{$active}{sock});
  
    foreach $cand (keys(%completionlist)) {
      next if (!($cand =~ /^$_[0]/i));
      push @tmplist, $cand;
    };

    print chr(8) x 14;
    print " " x 14;
    print chr(8) x 14;

    # planned removal of the extra space
    # does not work correctly
    if ($#tmplist == 0) {
      #$tmplist[0] .= chr(255);
      return @tmplist;
    }
    else {
      return @tmplist;
    };
  };

  return(());
};

info("");

# ********************** MAIN LOOP ************************** #
# main loop
MAIN: while (1) {

  # get CWD for both sites

  if ($site{$active}{sock}) {
    $site{$active}{path} = getcwd($site{$active}{sock},0);
    if ($site{$active}{path} eq "NO_PATH") {
      error("Connection to '$site{$active}{name}' lost or timeout");
      closechannel($site{$active}{sock});
      disconnect($active);
    }; 
  };

  if ($site{($active^1)}{sock}) {
    $site{($active^1)}{path} = getcwd($site{($active^1)}{sock},0);
    if ($site{($active^1)}{path} eq "NO_PATH") {
      error("Connection to '$site{($active^1)}{name}' lost or timeout");
      closechannel($site{($active^1)}{sock});
      disconnect(($active^1));
    }; 
  };

  # ----------------------------------------------------------- #
  # print the status line
  # but only if $lcount > $config{maxlines}
  # or if path/sites have changed

  if ($lcount > $config{maxlines}) {
     
    print "$c{green}\[$c{reset}$c{red}-$c{reset}$c{lila} [$c{magenta}cm$c{lila}:$c{reset}$ctmode{$config{cmode}}$c{lila}]-[$c{magenta}lh$c{lila}:$c{reset}$config{localaddr}$c{lila}]-[$c{magenta}ds$c{lila}:$c{reset}$config{socks}[0]$c{lila}]\n";
    
    print "$c{green}\[$c{reset}$c{red}-$c{reset}$c{lila} [$c{magenta}lm$c{lila}:$c{reset}$lsmode{$config{lmode}}$c{lila}]-[$c{magenta}fm$c{lila}:$c{reset}$fxpmode{$config{fmode}}$c{lila}]\n";

    print "$c{green}\[$c{reset}$c{red}i$c{reset} ";
    print "[$c{($active^1)}$site{($active^1)}{name}$c{reset}]-\[$c{($active^1)}$site{($active^1)}{path}$c{reset}\]\n";

    print "$c{green}\[$c{reset}$c{red}a$c{reset} ";
    print "[$c{$active}$site{$active}{name}$c{reset}]-\[$c{$active}$site{$active}{path}$c{reset}\]\n";

    $lcount = 0;
    
  };

  # set 'NOOP' idle loop
  $SIG{ALRM} = \&do_noop;
  alarm $config{idletime};

  # get command line
  my $cmd = $t->readline('[> ');

  # disable NOOP alarm
  alarm 0;

  # raise line count
  $lcount++;

  # cut leading spaces from command
  $cmd =~ s/^ +//;

  my @params = ();

  # ----------------------------------------------------------- #
  # swap active <-> inactive connections on ENTER
  if (!($cmd)) {
    $active = ($active^1);
    $lcount = 99999;
    
    next MAIN;
  };

  # ----------------------------------------------------------- #
  # CAPS = Send as-is to server

  if ($cmd =~ /^[A-Z]./) {
    if ($site{$active}{sock}) {
      command($site{$active}{sock},"$cmd","...",1);
    }
    else {
      error("Cannot send command, site is not open");
    }; 
  
    next MAIN;
  };

  # ----------------------------------------------------------- #
  # sl - print site list
 
  if ($cmd =~ /^sl/) {

    # find all slots
    my $lsite = '';
    my %slots = ();
    my %break_counter = ();
    foreach $lsite (keys(%site)) {
    
      next if (!($site{$lsite}{bmrk}));
      
      if ($break_counter{$site{$lsite}{slot}}== 5) {
        $slots{$site{$lsite}{slot}} .= "\n$c{green}::$c{reset} ";
        $slots{$site{$lsite}{slot}} .= " " x length($site{$lsite}{slot});
        $slots{$site{$lsite}{slot}} .= "  ";
        $break_counter{$site{$lsite}{slot}} = 0;
      };
      $break_counter{$site{$lsite}{slot}}++;
      
      $slots{$site{$lsite}{slot}} .= "$lsite  " if (!defined($slots{$lsite}));
    };

    # print all 
    info("-/-------------------------------------------------------------/-");
    my $lslot = '';
    PRINTSLOT: foreach $lslot (keys(%slots)) {
      next PRINTSLOT if (!($lslot));
      print "$c{green}::$c{reset} $c{red}$lslot$c{reset}: $slots{$lslot}\n";
      $lcount++;      
    };
    info("-/-------------------------------------------------------------/-");
  
    next MAIN;
  };
  

  # ----------------------------------------------------------- #
  # set SOCKS server
  # <IP> [PORT] [TYPE] [USER] [PASS]
  
  if ($cmd =~ /^ds/) {
    @params = getparams($cmd,5,0);

    if (defined($params[0])) {
      my @tmpsocks = ($params[0],
                     ($params[1] || 1080),
                     ($params[2] || 4),
                     ($params[3] || ""),
                     ($params[4] || "") );
      
      $config{socks} = \@tmpsocks;
      info("SOCKS proxy now at $config{socks}[0]:$config{socks}[1]");
      info("type SOCKS$config{socks}[2], username \"$config{socks}[3]\" password \"$config{socks}[4]\"");
      store \%config, 'config';
    }
    else {
      info("SOCKS proxy is at $config{socks}[0]:$config{socks}[1]");
      info("type SOCKS$config{socks}[2], username \"$config{socks}[3]\" password \"$config{socks}[4]\""); 
    };
    
    next MAIN;
  };
  
  # ----------------------------------------------------------- #
  # set local interface
  
  if ($cmd =~ /^lh/) {
    @params = getparams($cmd,1);
    if ($params[0]) {
      my $lname = inet_aton("$params[0]");
      my ($a,$b,$c,$d) = unpack('C4', $lname);
      my $dotaddr = $a.".".$b.".".$c.".".$d;
      # try to reserve a socket
      my $localsocket = openchannel(undef,undef,$dotaddr,undef,2);
      if (!($localsocket)) {
        error("cannot reserve a local socket with this address ($dotaddr)");
        next MAIN;
      };
      
      $localsocket->close();
      $config{localaddr} = $params[0];
      info("local interface is now '$config{localaddr}' ($dotaddr)");
      store \%config, 'config';
    }
    else {
      error("Syntax: lh <hostname/IP>");
    };
  
    next MAIN;
  };
  
  # ----------------------------------------------------------- #
  # define viewer
  
  if ($cmd =~ /^dv/) {
    @params = getparams($cmd,1);
    if ($params[0]) {
      $config{viewer} = $params[0];
      info("file/dir viewer is now '$config{viewer}'");
      store \%config, 'config';
    }
    else {
      error("Syntax: dv <executablename>");
    };
  
    next MAIN;
  };
  

  # ----------------------------------------------------------- #
  # set default connection mode
  # 0 = straight full passive
  # 1 = straight active
  # 2 = full passive via proxy, both control
  #     and data connections via SOCKS
  # 3 = half proxy, control connect via SOCKS,
  #     data connections active

  if ($cmd =~ /^cm/) {
    @params = getparams($cmd,0);
    if (defined($params[0])) {
      if ($params[0] =~ /^[0-3]$/) {
      	$config{cmode} = $params[0];
        
      }
      else {
        error("no such connection mode");
        next MAIN;
      };
    }
    else {
      $config{cmode}++;
      if (!($ctmode{$config{cmode}})) {
        $config{cmode} = 0;
      };  
    };
    
    info("connection mode set to $config{cmode} ('$ctmode{$config{cmode}}')");
    store \%config, 'config';
    
    next MAIN;
  };

  # ----------------------------------------------------------- #
  # set fxp mode

  if ($cmd =~ /^fm/) {
    @params = getparams($cmd,0);
    if ($params[0]) {
      if ($params[0] =~ /^[0-1]$/) {
      	$config{fmode} = $params[0];
      }
      else {
        error("No such FXP mode");
        next MAIN;
      };      
    }
    else {
      $config{fmode}++;
      if (!($fxpmode{$config{fmode}})) {
        $config{fmode} = 0;
      };
    };
    info("FXP mode set to $config{fmode} ('$fxpmode{$config{fmode}}')");
    store \%config, 'config';

    next MAIN;
  };



  # ----------------------------------------------------------- #
  # set listing mode

  if ($cmd =~ /^lm/) {
    @params = getparams($cmd,0);
    if (defined($params[0])) {
      if ($params[0] =~ /^[0-3]$/) {
      	$config{lmode} = $params[0];
      }
      else {
        error("No such listing mode");
        next MAIN;
      };      
    }
    else {
      $config{lmode}++;
      if (!($lsmode{$config{lmode}})) {
        $config{lmode} = 0;
      };
    };
    
    info("list mode set to $config{lmode} ('$lsmode{$config{lmode}}')");
    store \%config, 'config';

    next MAIN;
  };


  # ----------------------------------------------------------- #
  # list

  if ($cmd =~ /ls/) {
    if ($site{$active}{sock}) {
      info("$c{yellow}>>>$c{reset} getting dir list $c{yellow}<<<$c{reset}");
      getlist($site{$active}{sock},1);
    }
    else {
      error("cannot list, site is not open");
    };
    
    next MAIN;
  };  

  # ----------------------------------------------------------- #
  # raw list

  if ($cmd =~ /lr/) {
    @params = getparams($cmd,1,1,1);
    my $lflags = $params[0] || "-la";
    if ($site{$active}{sock}) {
      info("$c{yellow}>>>$c{reset} getting dir list $c{yellow}<<<$c{reset}");
      getlist($site{$active}{sock},2,$lflags);
    }
    else {
      error("cannot list, site is not open");
    };
    
    next MAIN;
  };  


  # ----------------------------------------------------------- #
  # open connection to a new site
  # "on <name/ip> [port] [user] [pass]"
  
  if ($cmd =~ /^on/) {
    @params = getparams($cmd,4,1);
    if (!(defined($params[0]))) {
      error("Syntax: on <hostname/IP> [port] [user] [pass]");
      next MAIN;
    };
    
    my $port = $params[1] || 21;
    my $user = $params[2] || 'anonymous';
    my $pass = $params[3] || 'aol@aol.com';
    
    # see if we can open the control connection
    my $cmode = 0;
    # use proxy if connection mode > 1;
    $cmode = 1 if ($config{cmode} > 1);

    info("attempting to connect to $params[0]:$port");
    if ($cmode) { info("via proxy at $config{socks}[0]") };

    my $socket = openchannel($params[0],$port,$config{localaddr},0,
                             $cmode, @{$config{socks}});

    if ($socket) {
      info("Connected");
      # map socket to site number
      $site{$socket} = $active;
    }
    else {
      error("connection failed ($errortext)");
     next MAIN;
    };

    # set preliminary color for socket
    $c{$socket} = $c{yellow};

    # attempt to log in
    my $path = "NO_PATH";
    if (!($path = login($socket,$user,$pass))) {
      error("login to $params[0] failed ($errortext)");
     next MAIN;
    };
 
    # logged in, save site data
    $site{$active}{name} = "$params[0]";
    $site{$active}{addr} = "$params[0]";
    $site{$active}{port} = $port;
    $site{$active}{user} = $user;
    $site{$active}{pass} = $pass;
    $site{$active}{mode} = $config{cmode};
    $site{$active}{path} = $path;
    $site{$active}{sock} = $socket;

    # set color
    $c{$socket} = $c{$active};

    # set lcount to print status lines
    $lcount = 999999;

    info("logged into $params[0], use 'ss <sitename> [slotname]' to save site data and remote path");

    next MAIN;
  };


  # ----------------------------------------------------------- #
  # open connection to a saved site
  # "op <name>"
  
  if ($cmd =~ /^op/) {
    @params = getparams($cmd,1);
    
    if (!(defined($params[0]))) {
      error("Syntax: op <sitename>");
      next MAIN;
    };
    
    if (!(defined($site{$params[0]}))) {
      error("no such site");
      next MAIN;
    };
    
    my $port = $site{$params[0]}{port} || 21;
    my $user = $site{$params[0]}{user} || 'anonymous';
    my $pass = $site{$params[0]}{pass} || 'aol@aol.com';

    # see if we can open the control connection
    my $cmode = 0;
    # use proxy if connection mode > 1;
    #$cmode = 1 if ($site{$params[0]}{mode} > 1);
    $cmode = 1 if ($config{cmode} > 1);
    
    info("attempting to connect to $site{$params[0]}{addr}:$site{$params[0]}{port}");
    if ($cmode) { info("via proxy at $config{socks}[0]") };

    my $socket = openchannel($site{$params[0]}{addr},$port,$config{localaddr},0,
                             $cmode, @{$config{socks}});

    if ($socket) {
      info("Connected");
      # map socket to site number
      $site{$socket} = $active;      
    }
    else {
      error("connection failed ($errortext)");
     next MAIN;
    };

    # set preliminary color for socket
    $c{$socket} = $c{yellow};

    # attempt to log in and set initial path
    my $path = "NO_PATH";
    if (!($path = login($socket,$user,$pass,$site{$params[0]}{path}))) {
      error("login to $params[0] failed ($errortext)");
     next MAIN;
    };
 
    # logged in, save site data
    $site{$active}{name} = $site{$params[0]}{name};
    $site{$active}{addr} = $site{$params[0]}{addr};
    $site{$active}{port} = $port;
    $site{$active}{user} = $user;
    $site{$active}{pass} = $pass;
    #$site{$active}{mode} = $site{$params[0]}{mode};
    $site{$active}{mode} = $config{cmode};
    $site{$active}{path} = $site{$params[0]}{path};
    $site{$active}{sock} = $socket;

    # set color
    $c{$socket} = $c{$active};

    # set lcount to print status lines
    $lcount = 999999;

    info("logged into $params[0]");
    
    next MAIN;

  };

  # ----------------------------------------------------------- #
  # close connections
  
  if ($cmd =~ /^cl/) {
    
    if ($site{$active}{sock}) {
      logout($site{$active}{sock});
      disconnect($active);
      
      $lcount = 9999;
    }
    else {
      error("cannot close when site not open");
    };
    
    next MAIN;
  };
  
  # ----------------------------------------------------------- #
  # cd - change CWD
  
  if ($cmd =~ /^cd/) {
    if ($site{$active}{sock}) {
      @params = getparams($cmd,1);
      if (defined($params[0])){
        $lcount = 9999 if (command($site{$active}{sock},"CWD $params[0]","2..",1));
      }
      else {
        error("cd to limbo, eh ?");
      };
    }
    else {
      error("cannot chdir when site not open");
    };
    
    next MAIN;
  };
  
  # ----------------------------------------------------------- #
  # sd - delete site

  if ($cmd =~ /^sd/) {
    @params = getparams($cmd,1);
    if (defined($params[0])){
      if (defined($site{$params[0]})) {
        delete $site{$params[0]};
        # ugly hack: remove the sockets from the hash,
        # because Storable hates them
        my $tmpsockactive = $site{$active}{sock};
	      my $tmpsockinactive = $site{($active^1)}{sock};
        $site{$active}{sock} = 0;
        $site{($active^1)}{sock} = 0;
        store \%site, 'sites';
        $site{$active}{sock} = $tmpsockactive;
        $site{($active^1)}{sock} = $tmpsockinactive;
        info("site '$params[0]' deleted");
      }
      else {
        error('no such site');      
      };
    }
    else {
      error("please give a site name to delete");
    };
    
    next MAIN;
  };
  

  # ----------------------------------------------------------- #
  # ss - save site
  # ss <name> [slot]

  if ($cmd =~ /^ss/) {
    if ($site{$active}{sock}) {
      @params = getparams($cmd,2,1);
      if (!defined($params[0])) {
        error("Syntax: ss <sitename> [slotname]");
       next MAIN;
      };
      
      if (!($params[0] =~ /\W/)) {
        $site{$active}{name} = $params[0];
        if (defined($params[1])) {
          $site{$active}{slot} = $params[1];
        }
        else {
          $site{$active}{slot} = 'default';
        };

        $site{$site{$active}{name}}{name} = $site{$active}{name};
        $site{$site{$active}{name}}{addr} = $site{$active}{addr};
        $site{$site{$active}{name}}{port} = $site{$active}{port};
        $site{$site{$active}{name}}{user} = $site{$active}{user};
        $site{$site{$active}{name}}{pass} = $site{$active}{pass};
        $site{$site{$active}{name}}{mode} = $config{cmode};
        $site{$site{$active}{name}}{path} = $site{$active}{path};
        $site{$site{$active}{name}}{sock} = 0;
        $site{$site{$active}{name}}{slot} = $site{$active}{slot};
        # the "bookmark" flag. only set on saved sites
        $site{$site{$active}{name}}{bmrk} = 1;

        info("Saved site '$site{$active}{name}'");

        # ugly hack: remove the sockets from the hash,
        # because Storable hates them
        my $tmpsockactive = $site{$active}{sock};
	      my $tmpsockinactive = $site{($active^1)}{sock};
        $site{$active}{sock} = 0;
        $site{($active^1)}{sock} = 0;
        store \%site, 'sites';
        $site{$active}{sock} = $tmpsockactive;
        $site{($active^1)}{sock} = $tmpsockinactive;

	      $lcount = 99999;
      }
      else {
        error("sitenames can only contain letters, sorry. and keep em short !");
      };
    }
    else {
      error("cannot save site when no site open");
    };
    next MAIN;
  };

  # ----------------------------------------------------------- #
  # view ascii file

  if ($cmd =~ /^vf/) {
    if ($site{$active}{sock}) {
      @params = getparams($cmd,1);
      if (!defined($params[0])) {
        error("Syntax: vf <filename>");
       next MAIN;
      };
      
      viewfile($site{$active}{sock},$params[0]);
    }
    else {
      error("cannot view a file when site not open");
    };
    next MAIN;
  };

  # ----------------------------------------------------------- #
  # delete

  if ($cmd =~ /^rm/) {
    if ($site{$active}{sock}) {
      @params = getparams($cmd,1);
      
      if (!defined($params[0])) {
        error("Syntax: rm <entryname> [dir]      wildcards: * and ?");
       next MAIN;
      };
      
      error ("no such file or directory found.") if (!del($params[0],$site{$active}{sock}));
    }
    else {
      error("cannot delete when site not open");
    };
    
    next MAIN;
  };

  # ----------------------------------------------------------- #
  # help

  if ($cmd =~ /^he/) {
    @params = getparams($cmd,0);
    if (!($params[0])) {
      info("-/-------------------------------------------------------------/-");
      info(" profxp v2 short reference                                       ");
      info(" -------------------------------------site management commands-- ");
      info(" on <hostname/IP> [port] [user] [pass]        open new site with ");
      info("                                                current default  ");
      info("                                                conn. settings.  ");
      info(" op <sitename>                                open saved site    ");
      info("                                                (tab completion).");
      info(" cl                                           close active site. ");
      info(" ss <sitename> [slotname]                     save open site.    ");
      info(" sd <sitename>                                delete site.       ");
      info(" sl                                           site list.         ");
      info(" -------------------------------------nav/list commands--------- ");
      info(" lm [mode]                                    set listing mode.  ");
      info(" ls                                           dir listing.       ");
      info(" lr <flags>                                   raw listing with   ");
      info("                                                custom flags.    ");
      info(" cd <dir>                                     CWD to dir (doh!)  ");
      info(" -------------------------------------fxp commands-------------- ");
      info(" fm                                           set fxp mode.      ");
      info(" xi <dir/file>                                recursive xfer     ");
      info("                                                 Wildcards: */?  ");
      info(" -------------------------------------misc commands------------- ");
      info(" vf <filename>                                view file          ");
      info(" rm <entry>                                   recursive delete   ");
      info("                                                 Wildcards: */?  ");
      info(" lh <hostname/IP>                             set local address  ");
      info("                                                                 ");
      info(" *** Everything typed IN CAPS goes as-is to the server.          ");
      info(" *** ENTER toggles active/inactive connections.                  ");
      info("-/-------------------------------------------------------------/-");
    };
    
    next MAIN;
  };


  # ----------------------------------------------------------- #
  # exit
  
  if ($cmd =~ /^ex/) {
    info("Exiting .. ");
    logout($site{$active}{sock});
    logout($site{($active^1)}{sock});
    info("profxp v2 signing off");
    exit(0);
  };

  # ----------------------------------------------------------- #
  # xi - single entry xfer
  
  if ($cmd =~ /^xi/) {
    if (($site{$active}{sock}) &&
        ($site{$active^1}{sock}) ) {
      @params = getparams($cmd,1);
      if (!defined($params[0])) {
        error("Syntax: xi <entryname>     Wildcards: * and ?");
       next MAIN;
      };
            
      error ("no such file or directory found.") if (!fxp($params[0],$site{$active}{sock},$site{$active^1}{sock}));
    };
    
    next MAIN;
  };
  
    
  #**************************************************************
  
  error("no such command. type 'he' for help.");
  
};
# ******************* END OF MAIN LOOP ********************** #

# ----------------------------------------------------------- 3
# do_noop
# sends anti-idle. hooked into SIGALARM.

sub do_noop {

  alarm 0;

  if ($site{$active}{sock}) {
    print "[Sending anti-idle, please wait]";
    command($site{$active}{sock},$config{noopcmd},"...",0);
  };

  if ($site{($active^1)}{sock}) {
    print "[Sending anti-idle, please wait]" if (!($site{$active}{sock}));
    command($site{($active^1)}{sock},$config{noopcmd},"...",0);
  };

  # clean up
  if ( ($site{$active}{sock}) || ($site{($active^1)}{sock}) ) {
    print chr(8) x 32;
    print " " x 32;
    print chr(8) x 32;
  };

  # re-set alarm
  $SIG{ALRM} = \&do_noop; 
  alarm $config{idletime};

};


# ----------------------------------------------------------- #
# getparams
# cuts entered command into pieces
#  in: 0<COMMANDSTRING> 1<NUMPIECES> 2<MINPIECES> 3<LastParamChop>
# out: array of parameters, undef on failure

sub getparams {

  if (!(defined($_[2]))) { $_[2] = $_[1]; };

  # chop all but last 2 params
  my @p1 = split / +/, $_[0], $_[1];

  # chop last 2 params at ONE space
  # (we may need leading spaces in the last param)
  my @p2 = split / /, $p1[$#p1], 2;

  pop(@p1);
  push @p1,@p2;
  my $c = shift(@p1);
  
  # if $_[3] is NOT defined, we also chop leading/trailing
  # spaces off the last parameter (good for completion)
  
  if ((!defined($_[3])) && (defined($p1[$#p1]))) {
    $p1[$#p1] =~ s/^ +//;
    $p1[$#p1] =~ s/ +$//;
  };

  if (($#p1+1) < $_[2]) {
    return(undef);
  };

  return(@p1);

};



# ----------------------------------------------------------- #
# login
# performs FTP server login sequence, option setting
# and CWD to initial directory
#
#  in: 0<SOCKET> 1<USERNAME> 2<PASSWORD> 3<PATH>
# out: CWD on success, 0 on failure

sub login {

  if ( (command($_[0],undef,"220",1,20)) && 
       (command($_[0],"USER $_[1]","331",1)) &&
       (command($_[0],"PASS $_[2]","230",1)) ) {

    # turn on unix-like directory listings
    # for windows servers
    if (command($_[0], "SYST","...",1) =~ /Windows/) {
       if (!(command($_[0], "SITE DIRSTYLE","...",1) =~ /off/i)) {
         command($_[0], "SITE DIRSTYLE","...",1);
       };
    };

    # CWD to initial path, if given
    if ($_[3]) {
      if (!command($_[0], "CWD $_[3]","25.",1)) {
        warning("Could not CWD to $_[3]");
      };
    };

    return(getcwd($_[0]));

  }
  else {

    $errortext = "user/pass not accepted";
    return(0);

  };

};


# ----------------------------------------------------------- #
# logout
# performs FTP server logout sequence

sub logout {

  if ($_[0]) {
    command($_[0],"QUIT","...",1);
    closechannel($_[0]);
  };

};


# ----------------------------------------------------------- #
# disconnect
# performs site data copy to "DISCONNECT" site

sub disconnect {

  $site{$_[0]}{name} = "DISCONNECTED";
  $site{$_[0]}{addr} = "0.0.0.0";
  $site{$_[0]}{port} = 21;
  $site{$_[0]}{user} = "anonymous";
  $site{$_[0]}{pass} = "aol\@aol.com";
  $site{$_[0]}{mode} = "0";
  $site{$_[0]}{path} = "NO_PATH";
  $site{$_[0]}{sock} = 0;
  $site{$_[0]}{slot} = '';

};

# ----------------------------------------------------------- #
# getcwd
# returns current working directory
# 'NO_PATH' on failure, 'PWD_ERROR' on 500 response
#  in: 0<SOCKET> 1<verbose>

sub getcwd {

  my $path = command($_[0],"PWD","...",$_[1]);
  
  return('NO_PATH') if (!($path));
  return('PWD_ERROR') if ($path =~ /^5/);
  
  $path =~ s/\"(.*)\"//g;
  $path = $1;
  return($path);
};


# -------------------------------------------------------- #
# viewfile - view a file
# 0<SOCKET>
# returns 0 on failure

sub viewfile {

  my $listsocket = undef;
  my @list = ();
  
  return 0 if (!(command($_[0],"TYPE A","200",0)));

  if ( ($site{$active}{mode} == 0) ||
       ($site{$active}{mode} == 2)) {
     my $response = command($_[0],"PASV","227",0);
     if ($response) {

       # calculate IP/port from response to PASV
       my ($rest,$port,$rest2) = split /\(|\)/, $response;
       my @addrs = split /\,/, $port;
       my $ipaddr = $addrs[0].".".$addrs[1].".".$addrs[2].".".$addrs[3];
       $port = ($addrs[4]*256)+$addrs[5];

       my $cmode = 0;
       # use proxy if connection mode > 1;
       $cmode = 1 if ($site{$active}{mode} > 1);
       # make data socket
       $listsocket = openchannel($ipaddr,$port,$config{localaddr},0,$cmode,@{$config{socks}});
       if (!(defined($listsocket))) {
         error("passive connection failed - site behind firewall ?") if ($_[1]);
         return(0);
       };

       # send LIST, expect '1..'
       if (!(command($_[0],"RETR $_[1]","1..",0))) {
         error("passive connect ok, but LIST command failure") if ($_[1]);
         return(0);
       };
    }
    else {
      error("passive mode failure") if ($_[1]);
      return(0);
    };
  }
  else {
    # resolve own hostname
    my $lname = inet_aton($config{localaddr});
    my ($a,$b,$c,$d) = unpack('C4', $lname);
    my $dotaddr = $a.".".$b.".".$c.".".$d;
    # reserve a socket
    my $localsocket = openchannel(undef,undef,$dotaddr,undef,2);
    if (!($localsocket)) {
      error("cannot reserve local socket (addr $dotaddr)") if ($_[1]);
      return(0);
    };

    # get true local IP address
    $myaddr = $localsocket->sockhost();
    $myport = $localsocket->sockport();
       
    # send PORT command
    my $highport = int $myport/256;
    my $lowport = $myport - ((int $myport/256)*256);
    $dotaddr = $myaddr;
    $dotaddr =~ s/\./\,/g;
    $dotaddr .= ",".$highport.",".$lowport;			
    my $response = command($_[0],"PORT $dotaddr","2..",0);
    if ($response) {

      # send LIST
      if (!(command($_[0],"RETR $_[1]","1..",0))) {   
         error("listen OK, but LIST command failure.") if ($_[1]);
         return(0);
      }; 
      
      # make data socket
      $listsocket = openchannel($localsocket,undef,undef,undef,3);
      if (!(defined($listsocket))) {
        error("cannot accept on $dotaddr:$myport") if ($_[1]);
        abort($_[0]);
        abort_finish($_[0]);
        return(0);
      };
    }
    else {
      error("port command failure") if ($_[1]);
      return(0);
    };
  };


  # get LIST
  @list = getascii($listsocket);

  # expect '2..' for transfer complete
  if (!(command($_[0],undef,"2..",0))) {
    error("list data connection timeout, sending ABOR") if ($_[1]);
    abort($_[0]);
    abort_finish($_[0]);
    return(0);
  };

  open(TMP,"> /tmp/profxp.tmp");
  $, = "\n";
  print TMP @list;
  $, = "";
  print TMP "\n";
  close(TMP);
  system("$config{viewer} /tmp/profxp.tmp");

};

# -------------------------------------------------------- #
# getlist - get list and print it
# 0<SOCKET> 1[verbose]
# returns 0 on failure or filename/size hash of all files

sub getlist {

  my $verbose = 0;
  $verbose = 1 if ($_[1] == 2);
  my $listsocket = undef;
  my @list = ();
  my $listflags = "-la";
  if (defined($_[2])) {
    $listflags = $_[2];
  };

  return 0 if (!(command($_[0],"TYPE A","200",$verbose)));

  if ( ($site{$active}{mode} == 0) ||
       ($site{$active}{mode} == 2)) {
     my $response = command($_[0],"PASV","227",$verbose);
     if ($response) {

       # calculate IP/port from response to PASV
       my ($rest,$port,$rest2) = split /\(|\)/, $response;
       my @addrs = split /\,/, $port;
       my $ipaddr = $addrs[0].".".$addrs[1].".".$addrs[2].".".$addrs[3];
       $port = ($addrs[4]*256)+$addrs[5];

       my $cmode = 0;
       # use proxy if connection mode > 1;
       $cmode = 1 if ($site{$active}{mode} > 1);
       # make data socket
       $listsocket = openchannel($ipaddr,$port,$config{localaddr},0,$cmode,@{$config{socks}});
       if (!(defined($listsocket))) {
         error("passive connection failed - site behind firewall ?") if ($_[1]);
         return(0);
       };

       # send LIST, expect '1..'
       if (!(command($_[0],"LIST $listflags","1..",$verbose))) {
         error("passive connect ok, but LIST command failure") if ($_[1]);
         return(0);
       };
    }
    else {
      error("passive mode failure") if ($_[1]);
      return(0);
    };
  }
  else {
    # resolve own hostname
    my $lname = inet_aton($config{localaddr});
    my ($a,$b,$c,$d) = unpack('C4', $lname);
    my $dotaddr = $a.".".$b.".".$c.".".$d;
    # reserve a socket
    my $localsocket = openchannel(undef,undef,$dotaddr,undef,2);
    if (!($localsocket)) {
      error("cannot reserve local socket (addr $dotaddr)") if ($_[1]);
      return(0);
    };

    # get true local IP address
    $myaddr = $localsocket->sockhost();
    $myport = $localsocket->sockport();
       
    # send PORT command
    my $highport = int $myport/256;
    my $lowport = $myport - ((int $myport/256)*256);
    $dotaddr = $myaddr;
    $dotaddr =~ s/\./\,/g;
    $dotaddr .= ",".$highport.",".$lowport;			
    my $response = command($_[0],"PORT $dotaddr","2..",$verbose);
    if ($response) {

      # send LIST
      if (!(command($_[0],"LIST $listflags","1..",$verbose))) {   
         error("listen OK, but LIST command failure.") if ($_[1]);
         return(0);
      }; 
      
      # make data socket
      $listsocket = openchannel($localsocket,undef,undef,undef,3);
      if (!(defined($listsocket))) {
        error("cannot accept on $dotaddr:$myport") if ($_[1]);
        abort($_[0]);
        abort_finish($_[0]);
        return(0);
      };
    }
    else {
      error("port command failure") if ($_[1]);
      return(0);
    };
  };


  # get LIST
  @list = getascii($listsocket);

  # expect '2..' for transfer complete
  if (!(command($_[0],undef,"2..",$verbose))) {
    error("list data connection timeout, sending ABOR") if ($_[1]);
    abort($_[0]);
    abort_finish($_[0]);
    return(0);
  };

  my %fdate = ();
  my %fsize = ();
  my %fuid = ();
  my %fgid = ();
  my %fperms = ();
  my @tmplist = ();
  my @printlist;
  my $line;
	my $screweddir = 0;
	
  foreach $line (@list) {
		
    # filter non-dir stuff
    next if (!($line =~ /^[l||d||\-]/));
		
		PARSE:
    # chop the line into its pieces
    my $timename;
    my ($perms,$number,$uid,$gid,$size,$month,$day,$timename) = split / +/,$line, 8;
		
		# split time and name at ONE space
		my ($time,$name) = split / /, $timename, 2;
		
    # fix broken lines when no UID/GID/Number present
    if ($screweddir) {
      ($perms,$number,$uid,$size,$month,$day,$time,$name) = split / +/,$line, 8;
      $gid = "????";
      $uid = "????";
      $number = "?";
    };
		
    # kick out "." and "..", if present
    next if (($name eq ".") || ($name eq ".."));

    # sanitize month	
    for ($month) {
      /jan/i	and do { $month = "01"; last; };
      /feb/i	and do { $month = "02"; last; };
      /mar/i	and do { $month = "03"; last; };
      /apr/i	and do { $month = "04"; last; };
      /may/i	and do { $month = "05"; last; };
      /jun/i	and do { $month = "06"; last; };
      /jul/i	and do { $month = "07"; last; };
      /aug/i	and do { $month = "08"; last; };
      /sep/i	and do { $month = "09"; last; };
      /oct/i	and do { $month = "10"; last; };
      /nov/i	and do { $month = "11"; last; };
      /dec/i	and do { $month = "12"; last; };
      
      # at this point, something stinks ..
      # one field may be missing. set the
      # screwed dir flag and start again.
      if (!$screweddir) {
        $screweddir = 1;
        goto PARSE;
      };
    };

    # sanitize day
    $day = sprintf("%02.0ld", $day);
		
    # sanitize time/year
    my $year;
    if (!($time =~ /\:/)) {
      $year = $time;
      $time = "00:00";
    }
    else {
      my ($tsec,$tmin,$thour,$tmday,$tmon,$tyear,$twday,$tyday,$tisdst) = localtime(time);
      $year = $tyear + 1900;
    };
		
    if (length($time) == 4) {
      $time = "0".$time;
    };
		
    # build complete timestamp
    $fdate{$name} = "$year-$month-$day $time";

    # handle directories
    if ($line =~ /^d/) {
      $fsize{$name} = "<<<-DIR->>>";
    }
    else {
      $fsize{$name} = sprintf("%10.0ld",$size);
    };
		
    # fix size
    if (length($fsize{$name}) < 4) {
      $fsize{$name} .= "   ";
    };
		
    # fix perms
    $perms =~ s/^.//;
		
    # perms/uid/gid
    $fperms{$name} = $perms;
    $fuid{$name} = substr($uid,0,5);
    $fgid{$name} = substr($gid,0,5);
		
    # temporary list for sorting later
    push @tmplist, $name;

  };

  my $sortlist;
  if (defined($_[1])) {
    # sorting routines
    if ($config{lmode} == 2) {
      @sortlist = sort {$fdate{$a} cmp $fdate{$b}} @tmplist;
    }
    elsif ($config{lmode} == 1) {
      @sortlist = sort {$a cmp $b} @tmplist;
    }
    elsif ($config{lmode} == 3) {
      @sortlist = sort {$fsize{$a} cmp $fsize{$b}} @tmplist;
    }
    elsif ($config{lmode} == 0) {
      @sortlist = @tmplist;
    };
    
	
    if ($_[1] < 2) {		
      info("-/----------------------------------------------------------------->>");
      foreach $line (@sortlist) {
        info("$fperms{$line} $fuid{$line}\t$fgid{$line}\t$fdate{$line} $fsize{$line}\t$line");
      };
      info("-/----------------------------------------------------------------->>");
    }
    elsif ($_[1] == 2) {
      open(TMP,"> /tmp/profxp.tmp");
      $, = "\n";
      print TMP @list;
      $, = "";
      print TMP "\n";
      close(TMP);
      system("$config{viewer} /tmp/profxp.tmp");
    };
		
    print $c{reset};
		
  };
	
  return(%fsize);

};


# -------------------------------------------------------- #
# getascii - retrieves LIST or ascii file

sub getascii {

  my @list = ();

  eval {
    local $SIG{ALRM} = sub { die "alarm\n" };
    alarm 30;

    my $response = "";
    my $char = "";

    do {		
      $response = "";
      do {
        $char = "";
        do {
          recv $_[0], $char, 1, 0; 
          if (ord($char) == 0) { goto break; };
        } 
        while ($char eq "");
				
        $response .= $char;

      }
      while (!($char eq chr(10)));
			
      chop($response); chop($response);
      push @list, $response;
    } 
    while ((ord($char) > 0));
	
    break:			
	
    eval {
      $_[0]->close();                                        
    };
	
    alarm 0;
  };

  return undef if ($@ eq "alarm\n");
		
  return(@list);

};


# ----------------------------------------------------------- #
# command
# sends an ftp command and waits for answers
#
#  in: 0<SOCKET> 1<COMMAND> 2<RETURNPATTERN> 3<VERBOSE> 4[TIMEOUT]
# out: last line of server output on success, 0 on failure
#
# Set command to undef to receive only.

my $pipe_active = 0;
my $sigpipe = 0;
sub command {

  my $f = $_[0];
  # default to 10 seconds timeout
  my $timeout = $_[4] || 10;

  # set SIGPIPE handler to
  # handle broken sockets
  # but ignore it for non-verbose commands
  if ($_[3]) {
    $pipe_active = $site{$f};
    $SIG{PIPE} = \&dead_socket;
  }
  else {
    $SIG{PIPE} = 'IGNORE';
  };
  
  # set up timeout
  eval {
  local $SIG{ALRM} = sub { die "alarm\n" };
  alarm $timeout;
  
  if (defined($_[1])) {
    # clear recieve buffer
    fcntl $f, F_SETFL, O_NONBLOCK;
    my $l;
    while($f->recv($_,1,MSG_PEEK)) {
      $l = <$f>;
      
      last if (!$l);
      # remove CRLF
      chop $l;chop $l;
      warning($l) if ($_[3]);
    };
    fcntl $f, F_SETFL, 0;
    return 0 if $sigpipe;
    # send command
    print $f "$_[1]".chr(13).chr(10);
    return 0 if $sigpipe;
    print "$c{$f}>>$c{reset} $_[1]\n" if ($_[3]);
    $lcount++;
  };

  # wait for final response
  while(<$f>) {
   return 0 if $sigpipe;
    # remove CRLF
    chop;chop; 
    print "$c{$f}<<$c{reset} $_\n" if ($_[3]);
    $lcount++;
    last if ($_ =~ /^[1-9][0-9][0-9] /);
  };

  # reset SIGPIPE
  $SIG{PIPE} = 'IGNORE';

  alarm 0;
  };
  
  if ($@ eq "alarm\n") {
    return 0;
  };

  if ($_ =~ /^$_[2]/) {
    # return last line of output
    return($_);
  }
  else {
    return 0;
  };

};


# ----------------------------------------------------------- #
# dead_socket
# handles broken sockets for 'command'
# SIGPIPE handler gets active site out of $pipe_active global

sub dead_socket {

  # reset pending alarms
  alarm 0;

  # prevent double SIGPIPE
  $SIG{PIPE} = 'IGNORE';

  error("connection to '$site{$pipe_active}{name}' lost");

  closechannel($site{$pipe_active}{sock});
  disconnect($pipe_active);

  $lcount = 99999;

  # raise pipe exception flag
  $sigpipe = 1;

};


# ----------------------------------------------------------- #
# openchannel
# creates a channel to a remote server or listens and
# accepts a connection.
# 
#  in: 0<REMOTE IP/NAME> 1<REMOTE PORT> 2<LOCAL IP/NAME> 3<LOCAL PORT>
#      4<MODE> 5[SOCKS_IP] 6[SOCKS_PORT]
#      7[SOCKS_VERSION] 8[SOCKS_USER] 9[SOCKS_PASS]
# out: open socket, 0 on error
#
# MODE: 0-direct 1-SOCKS 2-listen 3-accept

sub openchannel {

  my $socket;

#  eval {
#  local $SIG{ALRM} = sub { die "alarm\n" };
#  alarm 10;

  if ($_[4] == 0) {

    # ----------------------------------------------------------- #
    # direct connection  method

    $socket = IO::Socket::INET->new(PeerAddr => $_[0],
                                    PeerPort => $_[1],
                                    LocalAddr=> $_[2],
                                    Timeout  => 20,
                                    Proto    => 'tcp');

    if (!defined($socket)) {
      $errortext = "connection failed";
      alarm 0; return(0);
    };

  }
  elsif ($_[4] == 1) {

    # ----------------------------------------------------------- #
    # SOCKS method

    if ($_[7] == 5) {

      # SOCKS5
      my $socks = new Net::SOCKS(socks_addr         => $_[5],
                                 socks_port         => $_[6],
                                 user_id            => $_[8],
                                 user_password      => $_[9],
                                 force_nonanonymous => 0,
                                 protocol_version   => 5);

      $socket = $socks->connect(peer_addr =>$_[0], peer_port => $_[1]);
 
      if (!defined($socket)) {
        $errortext = "connection failed";
        alarm 0; return(0);
      };

    }
    else {

      # SOCKS4
      my $socks = new Net::SOCKS(socks_addr         => $_[5],   
                                 socks_port         => $_[6],      
                                 protocol_version   => 4);

      $socket = $socks->connect(peer_addr =>$_[0], peer_port => $_[1]);

      if (!defined($socket)) {
        $errortext = "connection failed";
        alarm 0; return(0);
      };

    };

  }
  else {

    # ----------------------------------------------------------- #
    # listen + accept methods  

    
    if (@_[4] == 2) {
      
      my $listensocket;

      $listensocket = IO::Socket::INET->new(Listen    => 5,
                                            Reuse     => 1,
                                            LocalAddr => $_[2],
                                            Timeout   => 20,
                                            Proto     => 'tcp');

      if (!defined($listensocket)) {
        $errortext = "can't listen";
        alarm 0; return(0);
      };

      alarm 0; return($listensocket);

    }
    else {

      my $listensocket = $_[0];
    
      if (!defined($socket = $listensocket->accept())) {
        $errortext = "can't accept connection";
        alarm 0; return(0);
      };

      if (!defined($socket->connected())) {
        $errortext = "connection failed";
        alarm 0; return(0);
      };

      $listensocket->close();

    };
  };

#  };

#  if ($@ eq "alarm\n") {
#    $errortext = "no answer or timeout";
#    return 0;
#  };

  # ----------------------------------------------------------- #
  # return the open socket symbol

  return($socket);

};


# ----------------------------------------------------------- #
# closechannel
# close an open channel
#
#  in: 0<SOCKETSYMBOL>
# out: always 1
#

sub closechannel {

  my $f = $_[0];

  eval {
    $f->close();
  };

  return(1);

};


# ----------------------------------------------------------- #
# warning
# prints a warning
#
#  in: 0<TEXT>
# out: nothing

sub warning {

  print "$c{yellow}\?\?$c{reset} $_[0]\n";
  $lcount++;

};


# ----------------------------------------------------------- #
# info
# prints an info
#
#  in: 0<TEXT>
# out: nothing

sub info {

  print "$c{green}\:\:$c{reset} $_[0]\n";
  $lcount++;
  
};


# ----------------------------------------------------------- #
# error
# prints an error
#
#  in: 0<TEXT>
# out: nothing

sub error {

  print "$c{red}\!\!$c{reset} $_[0]\n";
  $lcount++;
  
};


# ----------------------------------------------------------- #
# fxp_file
# transfers a file
# <0> filename <1> Socket Source <2> Socket Target <3> mode [4] Filesize
# Results: 0 - xfer ok  1 - error  2 - user abort or fatal error

sub fxp_file {
	
	if (defined($_[4])) {
	  info("$c{yellow}-=-$c{reset} XFER start for '$_[0]', size $_[4] bytes $c{yellow}-=-$c{reset}");
	}
	else {
	  info("$c{yellow}-=-$c{reset} XFER start for '$_[0]' $c{yellow}-=-$c{reset}");
	};
	
	
  # -----------------------------------------------------------
	# set type to binary on both servers
  
  if (!(command($_[1],"TYPE I","2..",1))) {
    error("setting binary type failed on SRC server");
    return(2);
  };
  
  if (!(command($_[2],"TYPE I","2..",1))) {
    error("setting binary type failed on DST server");
    return(2);
  };
  
	# -----------------------------------------------------------
	# run FXP
  
  my $fxpmode = $_[3];
  my $response = '';
  my $swapretry = 2;
  my $xferok = 1;
  my $userabort = 0;
  
  while ($swapretry) {
    
    $swapretry--;
    if (!$swapretry) {
      # toggle fxpmode and try again
      $fxpmode ^= 1;
      warning("now trying other FXP mode");
    };

    if ($fxpmode) {
      # alt
      $response = command($_[2],"PASV","227",1);
    }
    else {
      # normal
      $response = command($_[1],"PASV","227",1);
    };

	  if (!($response)) {
      warning("PASV command failure");
      next;
    };
  	
	  # get PASV IP/Port  
    my ($dummy,$port,$dummy2) = split /\(|\)/, $response;
   
    # send it to the other server
    if ($fxpmode) {
      # alt
      $response = command($_[1],"PORT $port","200",1);
    }
    else {
      # normal
      $response = command($_[2],"PORT $port","200",1);
    };
    
	  if (!$response) {
      warning("PORT command failure");
      next;
    };
	  
	  # send first RETR or STOR
	  if ($fxpmode) {
      # alt
      $response = command($_[1],"RETR $_[0]","1..",1);
    }
    else {
      # normal
      $response = command($_[2],"STOR $_[0]","1..",1);
    };
	 
	  if (!($response)) {
      error("STOR/RETR failed (permission problem ?)");
      next;     
    };
    
    # send 2nd RETR or STOR
    if ($fxpmode) {
      # alt
      $response = command($_[2],"STOR $_[0]","1..",1);
    }
    else {
      # normal
      $response = command($_[1],"RETR $_[0]","1..",1);
    };
	 
	  if (!($response)) {
      error("STOR/RETR failed (timeout/firewall/permission problem ?)");
      if ($fxpmode) {
        # alt
        abort($_[1]);
        abort_finish($_[1]);
      }
      else {
        # normal
        abort($_[2]);
        abort_finish($_[2]);
      };
      next;
    };
    
	  # fxp should be running now, start benchmark
		my $start = time();
		
		info("$c{yellow}>>>$c{reset} XFER running, hit 'a' to abort $c{yellow}<<<$c{reset}");
		
		# set non-blocking operation
		fcntl $_[1], F_SETFL, O_NONBLOCK;
		fcntl $_[2], F_SETFL, O_NONBLOCK;
		
		# wait-for-action-loop
		my $action = 0;
		my $keyclick = 0;
    while (!$action) {
      # check for data on SRC control connection
      if ($_[1]->recv($_,1,MSG_PEEK)) {
        $action = 1;
      };
      # check for data on DST control connection
      if ($_[2]->recv($_,1,MSG_PEEK)) {
        $action = 2;
      };
    
      # user abort
      if (!($userabort)) {
        ReadMode 5;
        $keyclick = ReadKey(-1);
        if ($keyclick =~ /a/i) {
          abort($_[1],$_[2]);
          #error("User abort");
          $userabort = 1;
        };
        ReadMode 0;
      };
    
      # be nice to the CPU
      select undef, undef, undef, 0.01;
    };
    
    # stop time
    my $xfertime = time() - $start;
    
    # set blocking operation
    fcntl $_[1], F_SETFL, 0;
		fcntl $_[2], F_SETFL, 0;
		
		# handle user abort 
		if ($userabort) {
      abort_finish($_[1],$_[2]);
      return(2);
		};
		
		# get response from server that showed action first
		if (!(command($_[$action],undef,"2..",1))) {
		  error("Transfer error (disk full / timeout ?), sending ABOR");
      abort($_[1],$_[2]);
      abort_finish($_[1],$_[2]);
      return(1);
    };

    # get response from other end
    if ($action == 1) {
		  $response = command($_[2],undef,"2..",1);
		}
		else {
	    $response = command($_[1],undef,"2..",1);
	  };
	  # send ABOR if failed
		if (!$response) {
		  error("Transfer error (disk full / timeout ?), sending ABOR");
      abort($_[1],$_[2]);
      abort_finish($_[1],$_[2]);
      return(1);
    };
		
  	# only show benchmark with files > 50kB
		if ($_[4] > 50000) {
      my $kbsec = sprintf("%.0ld kB/sec", $_[4]/1024/$xfertime);
      info("$c{yellow}-=-$c{reset} XFER of '$_[0]' complete ($c{red} $kbsec $c{reset}) $c{yellow}-=-$c{reset}");
    }
    else {
      info("$c{yellow}-=-$c{reset} XFER of '$_[0]' complete $c{yellow}-=-$c{reset}");
    };
			
		# if we swapped the FXP mode, make the change permanent for this session
		if (!$swapretry) {
		  warning("setected successful FXP mode swap, keeping this mode for other transfers.");
		  $config{fmode} = $fxpmode;
		};
		
		$xferok = 0;
		last;
  };

  return($xferok);
};


# -----------------------------------------------------------
# abort - send telnet IP and SYNCH + 'ABORT'

sub abort {
  
  my $f1 = $_[0];
  my $f2 = $_[1];
  
  my $IP = chr(255).chr(244);
  my $SYNCH = chr(255).chr(242);
    
  # send "Interrupt process"
  print $f1 $IP;
  # send "synch" with TCP Urgent
  $f1->send($SYNCH,MSG_OOB);
  # send ABOR\r\n
  print $f1 "ABOR".chr(13).chr(10);
  
  if (defined($f2)) {
    # send "Interrupt process"
    print $f2 $IP;
    # send "synch" with TCP Urgent
    $f2->send($SYNCH,MSG_OOB);
    # send ABOR\r\n
    print $f2 "ABOR".chr(13).chr(10);
  };
  
};

# -----------------------------------------------------------
# abort_finish - wait until server(s) are in sync again

sub abort_finish {
  
  my $f1 = $_[0];
  my $f2 = $_[1];
  
  info("$c{yellow}>>>$c{reset} Waiting for ABORT to finish $c{yellow}<<<$c{reset}");
  command($f1,undef,"...",1,20);
  command($f1,undef,"2..",1,2);
  
  if (defined($f2)) {
    command($f2,undef,"...",1,20);
    #command($f2,undef,"2..",1,2);
  };
  
};

# -----------------------------------------------------------
# fxp_dir - recursive xfer of dirs
# <0> dirname <1> src socket <2> dst socket
# 
# return: 0 - xfer ok   1 - error   2 - user abort

sub fxp_dir {
  
  my $response;
  
  info("$c{yellow}-=-$c{reset} recursive DIR transfer of '$_[0]' starting $c{yellow}-=-$c{reset}");

	# ----------------------------------------------
	# CWD to the source dir, abort if failure
	
	$response = command($_[1],"CWD $_[0]","2..",1);
  if (!($response)) {
		error("can't CWD to source dir '$_[0]'");
		return 1;
	};

	# ----------------------------------------------
	# attempt to make the dir, command will fail if
	# it is already there, but we don't care

	command($_[2],"MKD $_[0]","...",1);

	# ----------------------------------------------
	# CWD to the target dir, abort if failure
	
	  $response = command($_[2],"CWD $_[0]","2..",1);
    if (!($response)) {
		  error("can't CWD to target dir $_[0]");
		  # bail out of source dir
		  command($_[1],"CDUP","...",1);
		  return 0;
	};

	# ----------------------------------------------
	# get listing and transfer all files/dirs

  info("$c{yellow}>>>$c{reset} Retrieving file listings $c{yellow}<<<$c{reset}");
	my %srclist = ();
	my %dstlist = ();
	%srclist = getlist($_[1]);
	%dstlist = getlist($_[2]);
	
	my $entry;
	my $exitcode = 0;
	# sort literally
	my @sortedsrclist = sort {$a cmp $b} keys(%srclist);
	XFER: foreach $entry (@sortedsrclist) {
		
		if ($srclist{$entry} =~ /DIR/) {
		  $response = fxp_dir($entry,$_[1],$_[2]);
			if ($response) {
			  $exitcode = $response;
			  last XFER;
			};
			next;
		};
		
		if (! ($srclist{$entry} == $dstlist{$entry}) ) {
			$response = fxp_file($entry,$_[1],$_[2],$config{fmode},$srclist{$entry});
			if ($response == 2) {
			  error("User aborted recursive XFER, stopping");
			  $exitcode = $response;
			  last XFER;
			}
			elsif ($response == 1) {
			  # error with one file .. lets continue
			  
			};
			
		}
		else {
			info("skipping file '$entry', already present with same size.");
		};
	
	};

	# ----------------------------------------------
	# CWD back

	command($_[1],"CDUP","...",1);
	command($_[2],"CDUP","...",1);
  
  return($exitcode);
  
};

# -----------------------------------------------------------
# fxp - run FXP (with wildcards)
# <0> entryname <1> src socket <2> dst socket

sub fxp {
  
  my $result = 0;
  my $regex = $_[0];
  
  # replace '*' by '.*'
  $regex =~ s/\*/\.\*/g;
  
  # replace '?' by '.'
  $regex =~ s/\?/\./g;

  info("$c{yellow}>>>$c{reset} Retrieving file listing $c{yellow}<<<$c{reset}");
	my %srclist = ();
	%srclist = getlist($_[1]);
	
	my $match = '';
	foreach $match (sort keys(%srclist)) {
	  if ($match =~ /$regex/) {
	    $result = 1;
	    if ($srclist{$match} =~ /DIR/) {
        fxp_dir($match,$_[1],$_[2]);
      }
      else {
        fxp_file($match,$_[1],$_[2],$config{fmode},$srclist{$_[0]});
      };
    };
	};
	
	return($result);
};


# -----------------------------------------------------------
# rdeldir - recursive dir delete
# <0> entryname <1> socket

sub rdeldir {

  # enter dir
  return 0 if (!command($_[1],"CWD ./$_[0]","2..",1));

  # get dir list
  info("$c{yellow}>>>$c{reset} Retrieving file listing $c{yellow}<<<$c{reset}");
	my %srclist = ();
	%srclist = getlist($_[1]);

  my $entry;
  foreach $entry (sort keys(%srclist)) {
    if ($srclist{$entry} =~ /DIR/) {
      
      rdeldir($entry,$_[1]);;      
    }
    else {
      command($_[1],"DELE $entry","...",1);
    };
  };
  
  command($_[1],"CDUP","...",1);
  command($_[1],"RMD $_[0]","...",1);
  
  return(1);
};


# -----------------------------------------------------------
# del - delete with wildcards * and ?

sub del {

  my $result = 0;
  my $regex = $_[0];
  
  # replace '*' by '.*'
  $regex =~ s/\*/\.\*/g;
  
  # replace '?' by '.'
  $regex =~ s/\?/\./g;
  
  # get file/dir listing
  info("$c{yellow}>>>$c{reset} Retrieving file listing $c{yellow}<<<$c{reset}");
	my %srclist = ();
	%srclist = getlist($_[1]);

	# collect the matches
	my $match = '';
	foreach $match (sort keys(%srclist)) {
	  if ($match =~ /$regex/) {
	    $result = 1;
	    if ($srclist{$match} =~ /DIR/) {
        rdeldir($match,$_[1]);
      }
      else {
        command($_[1],"DELE $match","2..",1);
      };
	  };
	};
		
	return($result);
	
};
