#!/usr/bin/perl -w
require 5;
use File::stat;
use Fcntl;
$0=~s!.*/!!;

BEGIN {
	open(ERRORS, ">&STDERR");
	open(STDERR, ">/dev/null");
	unless (eval "import Fcntl ':mode'; 1")
	{
		*{"main::S_IFMT"} = sub { 0170000 };
		*{"main::S_IFSOCK"} = sub { 0140000 };
		*{"main::S_IFLNK"} = sub { 0120000 };
		*{"main::S_IFREG"} = sub { 0100000 };
		*{"main::S_IFBLK"} = sub { 0060000 };
		*{"main::S_IFDIR"} = sub { 0040000 };
		*{"main::S_IFCHR"} = sub { 0020000 };
		*{"main::S_IFIFO"} = sub { 0010000 };
	}
	open(STDERR, ">&ERRORS");
	close(ERRORS);
}

use strict;

$|=1;

my $packedintlen=length(pack("i", 0));
my $hostname=`hostname`;
chomp($hostname);
my ($instream, $outstream)=(*STDIN, *STDOUT);
senddataitem("ftserver on $hostname ready");
my $cwd=`pwd`;
chomp($cwd);
senddataitem($cwd);
my $cmd;

while($cmd=recvdataitem())
{
    if ($cmd eq "close") {
	exit(0);
    }
    if ($cmd eq "ls") {
	do_ls();
    } elsif ($cmd eq "dir") {
	do_dir();
    } elsif ($cmd eq "cd") {
	do_cd();
    } elsif ($cmd eq "fileexists") {
	do_fileexists();
    } elsif ($cmd eq "get") {
	do_get();
    } elsif ($cmd eq "put") {
	do_put();
    } else {
	senddataitem("ERROR");
	senddataitem("Command not understood");
    }
}

sub recvdataitem
{
    my $packedlen;
    my ($bytes, $error)=dosysread($instream, $packedlen, $packedintlen);
    die("$0: Read error in recvdataitem\n") if $error;
    die("$0: Unexpected EOF\n") if $bytes!=$packedintlen;
    my $len=unpack("i", $packedlen);
    my $data;
    ($bytes, $error)=dosysread($instream, $data, $len);
    die("$0: Read error in recvdataitem\n") if $error;
    die("$0: Unexpected EOF\n") if $bytes!=$len;
    return $data;
}

sub senddataitem
{
    my $data=shift;
    my $len=length($data);
    my $packedlen=pack("i", $len);
    my ($bytes, $error)=dosyswrite($outstream, $packedlen, $packedintlen);
    die("$0: Write error in senddataitem\n") if $error;
    ($bytes, $error)=dosyswrite($outstream, $data, $len);
    die("$0: Write error in senddataitem\n") if $error;
}

sub dosysread
{
    my ($fh, $data, $len)=@_;
    my $bytesread=0;

    $data="";
    while ($len)
    {
	my $thisdata;
	my $bytes=sysread($fh, $thisdata, $len);
	unless (defined($bytes))
	{
	    my $error="$!";
	    warn("$0: read: $error\n");
	    return ($bytesread, $error);
	}
	last if $bytes==0;
	$data.=$thisdata;
	$len-=$bytes;
	$bytesread+=$bytes;
    }
    $_[1]=$data;
    return ($bytesread, undef);
}

sub dosyswrite
{
    my ($fh, $data, $len)=@_;
    my $byteswritten=0;

    while ($len)
    {
	my $bytes=syswrite($fh, $data, $len);
	unless (defined($bytes))
	{
	    my $error="$!";
	    warn("$0: write: $error\n");
	    return ($byteswritten, $error);
	}
	substr($data, 0, $bytes, "");
	$len-=$bytes;
	$byteswritten+=$bytes;
    }
    return $byteswritten;
}

sub do_ls
{
    opendir(DIR, ".") || die("$0: opendir . : $!\n");
    my @files=readdir(DIR);
    closedir(DIR);
    my $files=join("\0", @files);
    senddataitem("OK");
    senddataitem($files);
}

sub do_dir
{
    opendir(DIR, ".") || die("$0: opendir . : $!\n");
    my @files=readdir(DIR);
    closedir(DIR);
    my $dirdata="";
    my $file;
    for $file (@files)
    {
	    my $stat=lstat($file);
	    $dirdata.="$file\0";
	    unless(defined($stat))
	    {
		    $dirdata.="ERROR\0$!\0";
		    next;
	    }	    
	    $dirdata.=join("\0", "OK",
	    ( $stat->dev, $stat->ino, $stat->mode, $stat->nlink,
	      lookup_uid($stat->uid), lookup_gid($stat->gid),
	      $stat->rdev, $stat->size,
	      $stat->atime, $stat->mtime, $stat->ctime,
	      $stat->blksize, $stat->blocks, ""));
    }
    senddataitem("OK");
    senddataitem($dirdata);
}

my %uid;
sub lookup_uid
{
	my $uid=shift;
	$uid{$uid}=getpwuid($uid) unless exists($uid{$uid});
	return $uid{$uid}? $uid{$uid}:"uid:".$uid;
}

my %gid;
sub lookup_gid
{
	my $gid=shift;
	$gid{$gid}=getgrgid($gid) unless exists($gid{$gid});
	return $gid{$gid}? $gid{$gid}:"gid:".$gid;
}

sub do_cd
{
    my $dir=recvdataitem();
    unless (chdir($dir))
    {
	my $error="$!";
	senddataitem("ERROR");
	senddataitem("cd: $error");
	return;
    }
    senddataitem("OK");
    $cwd=`pwd`;
    chomp($cwd);
    senddataitem($cwd);    
}

sub do_fileexists
{
    my $file=recvdataitem();
    unless (-e $file)
    {
	senddataitem("ERROR");
	senddataitem("Object does not exist");
	return;
    }
    unless (-f $file)
    {
	my $error="$!";
	senddataitem("ERROR");
	senddataitem("Object is not a file");
	return;
    }
    senddataitem("OK");
}

sub do_get
{
       my $file=recvdataitem();
       unless (open(FILE, "<$file"))
       {
	   my $error=$!;
	   senddataitem("ERROR");
	   senddataitem("$error");
	   return;
       }
       my $stat=lstat(*FILE);
       unless (defined($stat))
       {
	   my $error=$!;
	   senddataitem("ERROR");
	   senddataitem("$error");
	   return;
       }
       unless (($stat->mode & S_IFMT) == S_IFREG)
       {
	   senddataitem("ERROR");
	   senddataitem("Not a regular file");
	   return;
       }
       my $data;
       my ($bytes, $error)=dosysread(*FILE, $data, 4096);
       while ($bytes && !$error)
       {
	   senddataitem("DATA");
	   senddataitem($data);
	   ($bytes, $error)=dosysread(*FILE, $data, 4096);
       }
       close(FILE);
       senddataitem("OK");
}

sub do_put
{
       my $file=recvdataitem();
       unless (open(FILE, ">.$file.new"))
       {
	   my $error=$!;
	   senddataitem("ERROR");
	   senddataitem("$error");
	   return;
       }
       senddataitem("OK");
       my $status=recvdataitem();
       my ($bytes, $error);
       while ($status eq "DATA")
       {
	   my $data=recvdataitem();
	   ($bytes, $error)=dosyswrite(*FILE, $data, length($data))
	       if length($data) && !$error;
	   $status=recvdataitem();
       }
       close(FILE);
       if ($status ne "OK")
       {
	   unlink(".$file.new");
	   recvdataitem();
	   return;
       }
       unless (rename(".$file.new", "$file"))
       {
	   my $error=$!;
	   senddataitem("ERROR");
	   senddataitem("rename: $error");
	   return;
       }
       senddataitem("OK");
}