#!/u3/thesis/clipper/pl/perl
# A simple ftp client in perl.
# Copyright 1990 Khun Yee Fung (clipper@csd.uwo.ca)
# see the end of this program for warranty information
# $Id: nftp,v 1.15 90/05/23 20:14:43 clipper Exp Locker: clipper $
# $Source: /u3/thesis/clipper/pl/RCS/nftp,v $

$DATA = 1;
$SUCCESS = 2;
$CONTINUE = 3;
$ERROR = 4;
$FAIL = 5;
@marks = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
$NOCR = 1;

do 'sys/socket.h' || die "can\'t do sys/socket.h: $@";
do 'sys/ioctl.pl' || die "Can't do sys/ioctl.pl: $@";
#do 'telnet.h' || die "can\'t do telnet.h: $@";
do 'pathname.pl' || die "can\'t do pathname.pl: $@";
do 'getopts.pl' || die "can\'t do getopts.pl: $@";
#do 'cbreak2.pl' || die "can't do cbreak2.pl: $@";
do 'resolver.pl' || die "Can't do resolver.pl: $@";
do Getopts('h:as');
$background = 0;
if ($#ARGV < $[) {
  if (defined($opt_s)) {
    $noread = 1;
  }
  else {
    do 'termcap.pl' || die "Can't do termcap.pl: $@";
    do 'readline.pl' || die "Can't do readline.pl: $@";
  }
  $interactive = 1;
}
elsif (defined($opt_s)) {
  print "-s option ignored for non-interactive ftp\n";
}

@prog = split("/", $0);
$sockaddr = 'S n a4 C8';
$connecting = 0;
if (defined($opt_h)) {
  do connect($opt_h);
}
if ($interactive && !$noread) {
  do prep_terminal();
}
if ($interactive) {
  $pwd = $ENV{'PWD'};
  $prompt = $pwd;
  $prompt =~ s|$ENV{'HOME'}|~|;
}
$SIG{'INT'} = 'again';
while ($in = &getinput(":$prompt> ")) {
  $in =~ s/^\s+//g;
  $in =~ s/\s+/ /g;
  $in =~ s/\s+$//g;
  next if ($in eq "");
  study($in);
  $in =~ /^LMKDIR (.+)/i && ((do domkdir($1)), next);
  $in =~ /^RM (.+)/i && ((do rm($1)), next);
  $in =~ /^LCD (.+)/i && ((do dochdir($1)), next);
  $in =~ /^LCD/i && ((do dochdir("")), next);
  $in =~ /^QUIT/i && do doquit($1);
  $in =~ /^HISTORY/i && !$noread && (do printhistory(), next);
  $in =~ /^OPEN (.+)/i && !$connecting && (do connect($1), next);
  if (!$background) {
    $in =~ /^BACK (.+)/i && (do background($1), next);
    $in =~ /^BACK/i && (do background(), next);
  }
  if (!$connecting) {
    print "Not connecting\n";
    next;
  }
  $in =~ /^MPUT (.+)/i && (do mput($1), next);
  $in =~ /^NLST (.+)/i && (do scheme2("NLST", undef, $1), next);
  $in =~ /^OPEN/i && ((print "Connected. Use close first\n"), next);
  $in =~ /^LS (.+)/i && (do scheme2("LIST", undef, $1), next);
  $in =~ /^LS/i && (do scheme2("LIST", undef), next);
  $in =~ /^CD (.+)/i && (do scheme1("CWD", $1), next);
  $in =~ /^CD/i && (do scheme1("CWD"), next);
  $in =~ /^TYPE (.)/i && (do scheme1("TYPE", $1), next);
  $in =~ /^GET ([^ \n]+) ([^ \n]+)/i && (do scheme2("RETR", ">$2", $1), next);
  $in =~ /^GET (.+)/i && (do scheme2("RETR", ">$1", $1), next);
  $in =~ /^PUT ([^ \n]+) ([^ \n]+)/i && (do scheme2("STOR", $1, $2), next);
  $in =~ /^PUT ([^ \n]+)/i && (do scheme2("STOR", $1, $1), next);
  $in =~ /^REGET (.+)/i && (do restoffile($1), next);
  $in =~ /^MGET (.+)/i && (do mget($1), next);
  $in =~ /^LOGIN (.+) (.+)/i && (do ilogin($1, $2, ""), next);
  $in =~ /^LOGIN/i && (do ilogin(), next);
  $in =~ /^CDUP/i && (do scheme1("CDUP"), next);
  $in =~ /^CLOSE/i && (do scheme1("QUIT"), $connecting = 0, $NOCR = 1, next);
  $in =~ /^RENAME (.+) (.+)/i && (do rename($1, $2), next);
  $in =~ /^DEL ([^ \n]+)/i && (do scheme1("DELE", $1), next);
  $in =~ /^RMDIR ([^ \n]+)/i && (do scheme1("RMD"), next);
  $in =~ /^MKDIR ([^ \n]+)/i && (do scheme1("MKD", $1), next);
  $in =~ /^PWD/i && (do scheme1("PWD"), next);
  $in =~ /^SYST/i && (do scheme1("SYST"), next);
  $in =~ /^STATUS/i && (do scheme1("STAT"), next);
  $in =~ /^HELP/i && (do scheme1("HELP"), next);
  $in =~ /^NOOP/i && (do scheme1("NOOP"), next);
  $in =~ /^BINARY/i && (do scheme1("TYPE", "I"), $NOCR = 0, next);
  $in =~ /^ASCII/i && (do scheme1("TYPE", "A"), $NOCR = 1, next);
  $in =~ /^TENEX/i && (do scheme1("TYPE", "L", "8"), $NOCR = 1, next);
  $in =~ /^BACK/i && (do background(), next);
  if (!$interactive) {
    print "Unrecognised Command: $in\n";
    do scheme1("QUIT");
    exit(255);
  }
  print "Unrecognised command: Pass directly to the server (y/n)? ";
  $answer = <STDIN>;
  if ($answer =~ /^[yY]/) {
    @command = split(' ', $in);
    do scheme1(@command);
  }
}
continue {
  if ($interactive || $noread) {
    $prompt = $pwd;
    $prompt =~ s|$ENV{'HOME'}|~|;
  }
}
if ($connecting) {
  do scheme("QUIT");
}
&getreply();
close SERVER;

sub getreply {
  local($code);
  local($answer);
  $answer = <SERVER> || ((print "Lost connection\n"), close SERVER,
    $connecting = 0, return $FAIL);
  $answer =~ s/\r//g;
  local($reply) = $answer;
  while ($reply ne "") {
    if ($reply =~ /^\d\d\d\-/) {
      print $reply;
      while ($reply = <SERVER>) {
        $reply =~ s/\r//g;
        $answer = $reply;
        if ($reply =~ /^\d\d\d/) { last; }
        print $reply;
      }
    }
    ($reply =~ /^1/) && ($code = $DATA, last);
    ($reply =~ /^2/) && ($code = $SUCCESS, last);
    ($reply =~ /^3/) && ($code = $CONTINUE, last);
    ($reply =~ /^4/) && ($code = $ERROR, last);
    ($reply =~ /^5/) && ($code = $FAIL, last);
    ($reply =~ /^&IAC&WILL(.)/) && ((print SERVER "&IAC&WONT$1"), $reply = $');
    ($reply =~ /^&IAC&DO(.)/) && ((print SERVER "&IAC&DONT$1"), $reply = $');
    $answer = "ERROR: $answer"; $code = $ERROR;
  }
  print $answer;
  $code;
}


sub scheme1 {
  local($command) = $_[0];
  for ($index = 1; $index <= $#_; $index++){
    $command .= " " . $_[$index];
  }
  print "    $command\n";
  print SERVER $command, "\r\n";
  $code = &getreply();
}

sub scheme2 {
  local($command) = $_[0];
  local($hfile) = defined($_[1]);
  local($file) = $_[1];
  local($index) = 2;
  local($read) = !defined($_[1]) || $file =~ /^>/;
  local($code) = &setup();
  local($numhash) = 0;
  local($buf);
  if ($code != 2) { return; }
  for ($index = 2; $index <= $#_; $index++) {
    $command .= " " . $_[$index];
  }
  print "    $command\n";
  print SERVER $command, "\r\n";
  $code = &getreply();
  if ($code != 1) { return; }
  ($addr = accept(DATA1, DATA)) || ((print "accept:$!\n"), return);
  if ($hfile) {
    open(FILE, $file) || ((print "open:$!\n"), close(DATA1), return);
    select(FILE); $| = 1; select(STDOUT); $| = 1;
    $bytes = 0; $hash = 0; $numhash = 0;
  }
  elsif (! $read) {
    close(DATA1);
    return;
  }
  if ($read) {
    $SIG{'INT'} = 'abort';
    while (read(DATA1, $buf, 1000) > 0) {
      $buf =~ s/\r//g if ($NOCR);
      if ($hfile) {
        print FILE $buf;
        if ($interactive) {
          $bytes += length($buf);
          if ($bytes > 1000) {
            ($hash == 9) ? $hash = 0 : $hash++;
            print $marks[$hash];
            $bytes -= 1000;
            $numhash++;
            if ($numhash > 69) {
              print "\n";
              $numhash = 0;
            }
          }
        }
      }
      else {
        print $buf;
      }
    }
    $SIG{'INT'} = 'again';
    if ($hfile) {
      if ($interactive || $noread) {
        print "\n";
      }
      close FILE;
    }
  }
  else {
    $SIG{'INT'} = 'abort';
    $bytes = 0;
    while (read(FILE, $buf, 1000) > 0) {
      if ($interactive || $noread) {
        $bytes += length($buf);
        if ($bytes > 1000) {
          print '%';
          $bytes -= 1000;
          if ($numhash++ > 70) {
            print "\n";
            $numhash = 0;
          }
        }
      }
      print DATA1 $buf;
    }
    if ($interactive || $noread) {
      print "\n";
    }
    $SIG{'INT'} = 'again';
  }
  close DATA1;
  $code = &getreply();
}

sub rename {
  local($from, $to) = @_;
  local($code);

  print "    RNFR $from\n";
  print SERVER "RNFR $from\r\n";
  $code = &getreply();
  if ($code != 3) { return; }
  print "    RNTO $to\n";
  print SERVER "RNTO $to\r\n";
  $code = &getreply();
}

sub restoffile {
  local($code);
  local(@size) = stat($_[0]);

  print "    REST $size[7]\n";
  print SERVER "REST ", $size[7], "\r\n";
  $code = &getreply();
  if ($code != 3) { return; }
  do scheme2("RETR", ">>$_[0]", $_[0]);
}

sub ilogin {
  if (defined($opt_a)) {
    print "Ah, but you specified -a option.\n";
  }
  else {
    &login (@_);
  }
}

sub login {
  local($user, $pass, $acct) = @_;
  local($code);

  if (! defined($_[0])) {
    print "login:";
    $user = <>;
    chop($user);
  }
  print "    USER $user\n";
  print SERVER "USER ", $user, "\r\n";
  $code = &getreply();
  if ($code == 2) { $connecting = 1; $NOCR = 1; return; }
  if ($code != 3) { return; }
  $NOCR = 1;
  if (! defined($_[1])) {
    do set_cbreak(1);
    print "Password:";
    $pass = <>;
    do set_cbreak(0);
    print "\n";
    chop($pass);
  }
  print "    PASS\n";
  print SERVER "PASS ", $pass, "\r\n";
  $code = &getreply();
  if ($code == 2) { $connecting = 1; return; }
  if ($code != 3) { return; }

  print "    ACCT\n";
  print SERVER "ACCT ", $acct, "\r\n";
  $code = &getreply();
  if ($code == 2) { $connecting = 1; return; }
  do login($user, $pass);
}

sub setup {
  socket(DATA, &PF_INET, &SOCK_STREAM, 0) || ((print "socket:$!\n"), return 0);
  $sockname = getsockname(SERVER) || ((print "getsockname:$!\n"), return 0);
  ($family, $port, $addr) =  unpack($sockaddr, $sockname);
  @port = unpack("CC", $port);
  $sout = pack($sockaddr, &AF_INET, 0, $addr);
  bind(DATA, $sout) || ((print "bind:$!\n"), return $FAIL);
  listen(DATA, 1) || ((print "listen:$!\n"), return $FAIL);
  $sockname = getsockname(DATA) || ((print "getsockname:$!\n"), return $FAIL);
  ($family, $port, $addr) =  unpack($sockaddr, $sockname);
  $port[0] = int($port / 256);
  $port[1] = $port % 256;
  print "PORT $addr[0],$addr[1],$addr[2],$addr[3],$port[0],$port[1]\n";
  print SERVER "PORT $addr[0],$addr[1],$addr[2],$addr[3],$port[0],$port[1]\r\n";
  &getreply();
}

sub connect {
  $port = 21;
  if ($_[0] =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
    $saddr = pack("CCCC", $1, $2, $3, $4);
  }
  elsif (!(($name, $aliases, $type, $len, $saddr) = gethostbyname($_[0]))) {
    $saddr = &resolver($_[0]) || ((print "No such host\n"), return);
  }
  $sin = pack($sockaddr, 2, $port, $saddr);

  socket(SERVER, 2, 1, 0) || ((print "socket:$!\n"), return $FAIL);
  connect(SERVER, $sin) || ((print "connect:$!\n"), return $FAIL);
  $sockname = getsockname(SERVER) || ((print "getsockname:$!\n"), return $FAIL);
  ($family, $port, $addr) =  unpack($sockaddr, $sockname);
  @addr = unpack("CCCC", $addr);

  select(SERVER); $| = 1; select(STDOUT); $| = 1;
  $connecting = 1;
  &getreply();
  if ($opt_a) {
    do login("ftp", "guest");
  }
}

sub domkdir {
  mkdir($_[0], 0700) || ((print "lmkdir: $!\n"), return);
  print "created: $_[0]\n";
}

sub rm {
  unlink($_[0]);
}

sub dochdir {
  local($path2) = $_[0];
  if ($path2 eq "~") {
    $path2 = $ENV{'HOME'};
  }
  if ($path2 =~ m|^~([^/]*)|) {
    if ($1 eq "") {
      $path2 = $ENV{'HOME'} . $';
    }
    else {
      @ent = getpwnam($1);
      $path2 = $ent[7] . $';
    }
  } 
  if ($path2 eq "") {
    $path2 = $ENV{'HOME'};
  }
  chdir $path2 || ((print "lcd: $!\n"), next);
  $pwd = &pathname($pwd, $path2);
}

sub doquit {
  if ($connecting) {
    do scheme1("QUIT");
    unlink ("/tmp/nftp$$");
    close SERVER;
  }
  print "<End of nftp session>\n";
  close STDOUT;
  exit 0;
}

sub abort {
  printf SERVER pack("CC", &IAC, &IP);
  send(SERVER, pack("C", &IAC), 1, &MSG_OOB);
  printf SERVER pack("%C", &DM);
  do scheme1("ABOR");
  close DATA1;
  $inter = 1;
  $SIG{'INT'} = 'again';
}
  
sub again {
  $in = "";
  print "\n";
}

sub mget {
  do scheme2("NLST", ">/tmp/nftp$$", $_[0]);
  open(NLIST, "/tmp/nftp$$");
  $inter = 0;
  $reg = $_[0];
  $reg =~ s/\?/./g;
  $reg =~ s/([^\\]*)([\*\+])/\1.\2/g;
  while ($name = <NLIST>) {
    chop($name);
    $name =~ /$reg/ && do scheme2("RETR", ">$name", "$name");
    if ($inter) {
      print "Continue with mget? ";
      $c = <STDIN>;
      if ($c =~ /^[yY]/) {
        $inter = 0;
        next;
      }
      else {
         last;
      }
    }
  }
  unlink("/tmp/nftp$$");
}

sub mput {
  local($names) = $_[0];
  local($_, @file);
  while (<${names}>) {
    if ($inter) {
      print "Continue with mget? ";
      $c = <STDIN>;
      if ($c =~ /^[yY]/) {
        $inter = 0;
        next;
      }
      else {
         last;
      }
    }
    @file = split('/', $_);
    do scheme2("STOR", $_, $file[$#file]);
  }
}

sub getinput {
  if ($interactive) {
    if ($noread) {
      print $_[0];
      if ($_ = <>) {
        $_;
      }
      else {
        "quit";
      }
    }
    else {
      &readline($_[0]);
    }
  }
  elsif ($background) {
    if ($_ = <STDIN>) {
      $_;
    }
    else {
      "quit";
    }
  }
  elsif ($_ = <>) {
    $_;
  }
  else {
    "quit";
  }
}

sub background {
  $background = 1;
  $interactive = 0;
  $noread = 0;
  open (COMM, ">/tmp/nftpback$$");
  print "Input commands. Finish by a single dot on the line.\n";
  print "> ";
  $comm = <STDIN>;
  while ($comm !~ /^\.$/) {
    print COMM $comm;
  }
  continue {
    print "> ";
    $comm = <STDIN>;
  }
  close(COMM);
  open(STDIN, "/tmp/nftpback$$");
  if (defined($_[0])) {
    $file = "$_[0]";
  }
  else {
    $file = "/tmp/nftpback$$.stdout";
  }
  if ($child = fork()) {
    print "[nftp log file: $file  process: $child]\n";
    exit(0);
  }
  $SIG{'HUP'} = 'IGNORE';
  open(STDOUT, ">$file");
  open(TTY, '/dev/tty');
  ioctl(TTY, $TIOCNOTTY, 0);
  close(TTY);
}

# Copyright 1990 Khun Yee Fung <clipper@csd.uwo.ca>
#
# Permission to use, copy, modify, and distribute, this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation, and that the name of the copyright holders be used in
# advertising or publicity pertaining to distribution of the software with
# specific, written prior permission, and that no fee is charged for further
# distribution of this software, or any modifications thereof.  The copyright
# holder make no representations about the suitability of this software for
# any purpose.  It is provided "as is" without express or implied warranty.
#
# THE COPYRIGHT HOLDER DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
# EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY SPECIAL, INDIRECT OR
# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE,
# DATA, PROFITS, QPA OR GPA, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE 
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.