fts.cgi

http协议下的文件传输程序

use File::stat;
use Fcntl ':mode';
use strict;
use IPC::Shareable;

open(ERR,">/var/www/public/ftslog.txt");
print ERR "ftslog.txt   \n";


my $key = 'ftsd';

my %options = (
   create    => 0,
   exclusive => 0,
   mode      => 0644,
   destroy   => 0,
    );

my %ctrlinfo;

tie %ctrlinfo, 'IPC::Shareable', $key, { %options } or  die "server: tie failed\n";

my $size = $ENV{CONTENT_LENGTH};

my ($buf,$packattrib,$fileinfo,$filename,$packid,$file,$filepath,$filestat,@cmd,$recvpath,$path,$sb,$sfd);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,@dots,$tmp,$homepath,$bufsize);

$path = $ctrlinfo{'path'};
$homepath = $ctrlinfo{'homepath'};

print ERR $ctrlinfo{'path'},"kfdgjfgj   \n";

# $packattrib  (100: ctrlpack), (200: datapack)

sysread(STDIN,$buf,8);
$packattrib = $buf + 0;

if ($packattrib == 100)
{
	sysread(STDIN,$buf,$size-8);
	@cmd = split(/:/, $buf);
	if ($cmd[0] eq "cd")
	{
		$path = "$homepath/$cmd[1]";
		if ($cmd[1] eq "/")
		{
			$path = $homepath;
		}
		$ctrlinfo{'path'} = $path;

		opendir(DIR, $path) || die "can't opendir $path: $!";
		@dots = readdir(DIR);
		closedir DIR;  

		foreach(@dots)
		{
			$filename = $_;
			$filepath = "$path/$filename";
			$sb = stat($filepath);
			if (S_ISDIR($sb->mode))
			{
				$sfd = "/";
			}
			else
			{
				$sfd = " ";
			}
			($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($sb->mtime);  
			$year += 1900;
			$mon += 1;
			print ( $sfd,",",$filename,",", $sb->size,",",$year,"/",$mon,"/",$mday," ",$hour,":",$min,":",$sec,"\n");  
		}
 
	}
	if ($cmd[0] eq "ls")
	{
		$path = "$homepath/$cmd[1]";
		if ($cmd[1] eq "/")
		{
			$path = $homepath;
		}
		opendir(DIR, $path) || die "can't opendir $path: $!";
		@dots = readdir(DIR);
		closedir DIR;  

		foreach(@dots)
		{
			$filename = $_;
			$filepath = "$path/$filename";
			$sb = stat($filepath);
			if (S_ISDIR($sb->mode))
			{
				$sfd = "/";
			}
			else
			{
				$sfd = " ";
			}
			($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($sb->mtime);  
			$year += 1900;
			$mon += 1;
			print ( $sfd,",",$filename,",", $sb->size,",",$year,"/",$mon,"/",$mday," ",$hour,":",$min,":",$sec,"\n");  
		}
 
	}
	if ($cmd[0] eq "mkdir")
	{
		$recvpath = "$path/$cmd[1]";
		mkdir($recvpath);
		print "mkdir  $cmd[1] ok.";
	}
	if ($cmd[0] eq "start")
	{
		$file = $cmd[1];
		$ctrlinfo{'file'} = $file;
		$filepath = "$path/$ctrlinfo{'file'}";
		print ERR  $filepath,"  kfgjifgj ",$ctrlinfo{'file'},"   \n";
		unlink($filepath);
		print "$ctrlinfo{'file'} upload start.";
	}
	if ($cmd[0] eq "end")
	{
		$file = $cmd[1];
		$ctrlinfo{'file'} = $file;
		$filepath = "$path/$ctrlinfo{'file'}";
		$filestat = stat($filepath);
		print "$ctrlinfo{'file'}:    ", $filestat->size,"   upload end.";
	}
	if ($cmd[0] eq "get")
	{
		$file = $cmd[1];
		$filepath = "$path/$file";
		open(DLFH,"<$filepath");
		while ($bufsize = sysread(DLFH,$buf,4096))
		{
			 syswrite(STDOUT,$buf,$bufsize);
		}
		close(DLFH);
	}
}

if ($packattrib == 200)
{
	$filepath = "$path/$ctrlinfo{'file'}";
	open(FHUL,">>$filepath");
	sysread(STDIN,$buf,8);
	$packid = $buf + 0;
	sysread(STDIN,$buf,$size-16);
        syswrite(FHUL,$buf,$size-16);
	close(FHUL);
	$filestat = stat($filepath);
	print "$ctrlinfo{'file'}:    ",$filestat->size,"   uploading --> ";
}

select(undef, undef, undef, 0.001);  

close(ERR);