#! /usr/bin/perl
use Socket;
socket (S,PF_INET,SOCK_STREAM,getprotobyname("tcp")) || die "Socket $!";
setsockopt(S,SOL_SOCKET,SO_REUSEADDR,1);

$ip=INADDR_ANY;
$port=1025;
$root="";
$debug=1;
$writable=1;
$siteshell=0;

$ru="sesame";
$rp="secret";
 
bind S,pack('S n a4 x8',AF_INET,$port,$ip) || die "Bind $!";
listen S,1;

while (1) {
accept T,S;
$a=select T;$|=1;select $a;
$user="";
$auth=0;
$pp=0;
$pwd="/";
$typ="A";
print T "220 Hi.\r\n";
while (<T>) {
  chop;chop;
  /^([^ ]*)( |$)(.*)$/;
  $cmd=uc($1);
  $parm=$3;
  print "$_\n" if $debug; 
  if ($cmd eq "QUIT") {
    print T "221 Goodbye.\r\n";
    last;
  } elsif (!$auth) {
    if ($cmd eq "USER") {
      $user=$parm;
      print T "331 Password required for $user.\r\n";
    } elsif ($cmd eq "PASS") {
      if (!$user) {
        print T "503 Login with USER first\r\n";
      } else {
        if ( ($user eq $ru)&&($parm eq $rp) ) {
          print T "230 User $user logged in.\r\n";
          $auth=1;
        } else {
          print T "530 Login incorrect.\r\n";
        }
      }
    } else {
      print T "500 '$cmd".($parm?(" $parm"):(""))."': command not understood.\r\n";
    }
  } else {
    if ($cmd eq "SYST") {
      print T "215 UNIX Type: L8\r\n";
    } elsif ($cmd eq "PASV") {
      socket (L,PF_INET,SOCK_STREAM,getprotobyname("tcp"));
      bind L,pack('S n N4 x8',AF_INET,0,$ip);
      listen L,1;
      ($b,$a)=sockaddr_in(getsockname(L));
      ($c,$a)=sockaddr_in(getsockname(T));
      $a=inet_ntoa($a);
      $a=~s/[.]/,/g;
      print T "227 Entering Passive Mode (".$a.",".(($b>>8)&0xff).",".($b&0xff).")\r\n";
      $pp=-1;
    } elsif ($cmd eq "PWD") {
      print T "257 \"$pwd\" is current directory.\r\n";
    } elsif ( ($cmd eq "CWD")||($cmd eq "CDUP") ) {
      if ($cmd eq "CDUP") {
        $parm="..";
      }
      if ($parm=~/^\//) {
        $newpwd=$parm;
      } else {
        $newpwd="$pwd/$parm";
      }
      if (!(-d $newpwd)) {
        print T "550 $parm: No such directory.\r\n";
        next;
      }
      $newpwd=~s/\/\//\//g;
      $newpwd=~s/^\///g;
      $prepwd="/";
      $pwd="/";
      while ($newpwd) {
        $newpwd=~s/^([^\/]*)(\/|$)(.*)/$3/;
        if ($1 eq "..") {
          $pwd=$prepwd;
        } else {
          $prepwd=$pwd;
          $pwd.="/$1";
        }
      }      
      $pwd=~s/\/\//\//g;
      print T "250 $cmd command successful.\r\n";
    } elsif ($cmd eq "PORT") {
      $pp=$parm;
      print T "200 PORT command successful.\r\n";
    } elsif ( ($cmd eq "TYPE")&&(uc($parm)=~/(I|A)/) ) {
      $typ=$1;
      print T "200 Type set to $typ.\r\n";
    #  $cmd RNFR RNTO   DELE
    #  $cmd MKD RMD
    #  $cmd HELP
    } elsif ( ($cmd eq "SITE")&&($siteshell) ) {
      print T "200- $parm\r\n";
      if (open F, "$parm |") {
        while (<F>) { chomp; print T " $_\r\n"; }
        close F;
      } else {
        print T "ERROR: $!\r\n";
      }
      print T "200\r\n";
    } elsif ( ($cmd eq "LIST")||($cmd eq "RETR")||($cmd eq "STOR")||($cmd eq "NLST") ) {
      if ($parm=~/^\//) {
        $fn=$parm;
      } else {
        $fn="$pwd/$parm";
      }
      $fn=~s/[.][.]\/?//g;
      if ( ($cmd eq "RETR")&&(!(-f "$root/$fn")) ) {
        print T "550 $parm: No such file.\r\n";
      } elsif ($pp) {
        if ($pp!=-1) {
          ($a,$b,$c,$d,$e,$f)=split(',',$pp,6);
          socket (P,PF_INET,SOCK_STREAM,getprotobyname("tcp"));
          connect P,pack('S n N4 x8',AF_INET,$e*256+$f,((($a*256)+$b)*256+$c)*256+$d);
        } else {
          accept P,L;
        }
        print T "150 Opening ".($typ eq "A"?"ASCII":"BINARY")." mode data connection.\r\n";
        if ($cmd eq "LIST") {
          opendir D, "$root/$pwd";
          while ($a=readdir D) {
            if (-d "$root/$pwd/$a") {
              if ($a=~/[^.]/) {
                print P "drwx------    1 root     root         1024 Jan  1  2000 $a\r\n";
              }
            } else {
              $siz=(stat("$root/$pwd/$a"))[7];
              print P "-rwx------    1 root     root        $siz Jan  1  2000 $a\r\n";
            }
          }
#          open F,"ls -l $root/$pwd |";
#          while (<F>) { chomp; print P "$_\r\n";}
          closedir D;
        } elsif ($cmd eq "NLST") {
          opendir D, "$root/$pwd";
          while ($a=readdir D) {
            print P "$a\r\n";
          }
          closedir D;
        } elsif ($cmd eq "STOR") {  # cmd APPE ?
          if ($writable) {
            if (open F, ">$root/$fn") {
              print F <P>;
              close F;
            } else {
              print T "553 Could not create file.\r\n";
            }
          } else {
            print T "553 Not writeable.\r\n";
          }
        } else { # RETR
          open F, "$root/$fn";
#          while (<F>) { chomp; print P "$_\r\n";}
          print P <F>;
          close F;
        }
        shutdown P,0;
        print T "226 Transfer Complete.\r\n";
        close P;
        if ($pp==-1) {
          close L;
        }
        $pp="";
      } else {
        print T "425 Can't build data connection: $!.\r\n";
      }
    } elsif ($cmd eq "NOOP") {
      print T "200 NOOP command successful.\r\n";
    } else {
      print T "500 '$cmd".($parm?(" $parm"):(""))."': command not understood.\r\n";
    }
  }
}
shutdown T,0;
}
shutdown S,2;
close S;