login.cgi

http协议下的文件传输程序

use File::stat;
use Fcntl ':mode';

my ($homepath,$path);

my ($buf,@tmp,%user,@cmd);

open(FH,"</var/www/ftcfg/ft.cfg");

open(ERR,">/var/www/public/log.txt");

while($buf = <FH>)
{
	chop($buf);
	@tmp = split(/:/,$buf);
	$user{"$tmp[0]"} = $tmp[2];
} 

close(FH);

$homepath = "/var/www/public";

my $key = 'ftsd';

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

my %ctrlinfo;

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

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

my $size = $ENV{CONTENT_LENGTH};

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

if ($packattrib == 100)
{
	sysread(STDIN,$buf,$size-8);
	@cmd = split(/:/, $buf);
	$homepath = $user{"$cmd[0]"};
}

$tmp = $cmd[0];


$path = $homepath;

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

print ERR $cmd[0],":  ",$homepath,"   ",$path,"   ",$ctrlinfo{'path'},"\n";

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");  
}

close(ERR);