web-ftp.cgi

本文件为Web-FTP的实现源代码 是cgi编程 使用perl为主 本软件适用于linux下

  }
  elsif($Action eq 'delete') {
      while($_ = shift @Files) { $FTP->delete($CONTENT->unencode($_)); alarm($conf{timeout}); }
      while($_ = shift @Directories) { $FTP->rmdir($CONTENT->unencode($_)); alarm($conf{timeout}); }
  } elsif($Action eq $conf{lang}{upload}) {
  } elsif($Action eq 'crypto') {
      my $m;
      $FTP->quot("acct", $QueryHashRef->{response}[0]);
      $m = $FTP->message;
      if($m =~ /access denied/i) {
	  $HTTPD->sendResponse($CONTENT->errorPage("Server said: $m"));	  
      } else {
	  $HTTPD->sendResponse($CONTENT->frameset());
      }
      return;
  } elsif($Action) {
      my $str;
      s/\?(.*)$//;
      eval {
	  $str = eval "\$EDITOR->$Action(\$QueryHashRef,\$1)";
      };
      if($conf{state}) {
	  if($conf{state} eq 'save') {
	      doEditSave();
	      $conf{state} = '';
	  }
      }
      unless($@) {
	  $HTTPD->sendResponse(eval "\$EDITOR->$str()");
	  return 0;
      }
  }
  unshift @{$conf{messages}}, [time(), $FTP->message];
  # nothing much happens for the 'Upload' action
  $CONTENT->updateDir($FTP->pwd());
  $CONTENT->getDirectory($FTP->dir());
  $HTTPD->sendResponse($CONTENT->MAIN());
}

sub doEditSave {
    &FileMaster('NEW', $EDITOR->get_filename(),1);
    &FileMaster('PUT', $EDITOR->get_data(), 1);
    &FileMaster('CLOSE');
}

sub make_file_header_for_tar { #stolen from Archive::Tar
  my ($ref) = shift;
  my $tar_pack_header = 
    "a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12";
  my ($tmp,$file,$prefix,$pos);

  $file = $ref->{name};
  if (length ($file) > 99) {
    $pos = index $file, "/", (length ($file) - 100);
    next
      if $pos == -1;      # Filename longer than 100 chars!

    $prefix = substr $file,0,$pos;
    $file = substr $file,$pos+1;
    substr ($prefix, 0, -155) = ""
      if length($prefix)>154;
  }
  else {
    $prefix="";
  }

  $tmp = pack ($tar_pack_header,
	       $file,
	       sprintf("%06o ",$ref->{mode} || 0644),
	       sprintf("%06o ",$ref->{uid} || 1000),
	       sprintf("%06o ",$ref->{gid} || 1000),
	       sprintf("%11o ",$ref->{size}),
	       sprintf("%11o ",$ref->{mtime} || time()),
	       "",            #checksum field - space padded by pack("A8")
	       $ref->{type} || 0,
	       $ref->{linkname} || '',
	       $ref->{magic} || 'ustar',
	       $ref->{version} || '00',
	       $ref->{uname} || 1000,
	       $ref->{gname} || 1000,
	       sprintf("%6o ",$ref->{devmajor}||0),
	       sprintf("%6o ",$ref->{devminor}||0),
	       $prefix);
  substr($tmp,148,7) = sprintf("%6o\0", unpack("%16C*",$tmp));
  $tmp;
}

sub download {
    my $QueryHashRef = shift;
    my @Files = @{$QueryHashRef->{'Files'}}
      if(exists($QueryHashRef->{'Files'}));
    my($Action) = @{$QueryHashRef->{'action'}}
      if(exists($QueryHashRef->{'action'}));
    my($FTPbuffer,$download_size,$download_name);
    my @Directories = split "\r\n", $QueryHashRef->{'DirectoriesList'}[0]
      if(exists($QueryHashRef->{'DirectoriesList'}));

    # Sigh - we have to cheat and absorb some server functions here.
    my $CLIENT = $HTTPD->Client;
    alarm($conf{timeout});
    $FTP->binary;
    my $tar = 0;
    my @info;
    if(@Files > 1 || @Directories) {
      $tar = 1;
      my $iter = 0;
      my %list;
      @list{map { $CONTENT->unencode($_) } @Files,@Directories} = ();
      $download_name = ($QueryHashRef->{tarname}[0] || 'download.tar');
      my @Dirs = ('.');
      while(my $dir = shift @Dirs) {
	$iter++;
	my @dir = $iter == 1 ? $FTP->dir() : $FTP->dir($dir);
	for(@dir) {
	  my($pr,$fs,$us,$gr,$sz,$d1,$d2,$d3,$fn) = split / +/, $_, 9;
	  my $tp = 0;
#	  $fn =~ s|/$||;
	  next if $iter == 1 && !exists $list{$fn};
	  if($pr =~ /(?:([d-])[rwxtsTS-]{9})/) {
	    my $type = $1;
	    my $name = $dir eq '.' ? $fn : "$dir/$fn";
	    my $mode = 0;
	    my @pr = split('',$pr);
	    my $top = 0;
	    for(0..2) {
	      my $tmp = 0;
	      $tmp += 4 if $pr[3*$_+1] eq 'r';
	      $tmp += 2 if $pr[3*$_+2] eq 'w';
	      $tmp += 1 if $pr[3*$_+3] =~ /[xst]/;
	      $top += 2**(2-$_) if $pr[3*$_+3] =~ /[sStT]/;
	      $mode += ($tmp << ((2-$_)*3));
	    }
	    $mode += $top<<9;
	    if($type eq 'd') {
	      next if $fn eq '..' || $fn eq '.';
	      $download_size += 512;
	      $tp = 5;
	      $sz = 0;
	      push @Dirs, $name;
	    } else {
	      $download_size += 512+$sz+($sz%512?512-$sz%512:0);
	    }
	    push @info, { size => $sz, name => $name, mode => $mode, type => $tp };
	  }
	}
      }
      $download_size += 1024;
    } else {
      $download_name = $CONTENT->unencode($Files[0]);
      $download_size = $FTP->size($download_name);
      push @info, {size => $download_size, name => $download_name};
    }
#    for(@Files) {
#      my $size = $FTP->size($_);
#      my($ls) = $FTP->ls($_);
#      unshift @{$conf{messages}}, [time(), $FTP->message];
#      push @info, [$size];
#      if($tar) {
#	$download_size += 512+$size+($size%512?512-$size%512:0);
#      } else {
#	$download_size += $size;
#      }
#    }
    $download_name = $CONTENT->unencode($download_name);
    if($Action eq 'download') {
      print $CLIENT qq`Content-Type: application/force-download\n`.
	qq`Connection: close\n` .
	  qq`Content-Disposition: attachment;filename="$download_name"\n`.
	    qq`Content-Length: $download_size\n\n`;
    } else {
      print $CLIENT qq`Content-Type: text/html\n\n
<HTML><BODY><SCRIPT LANGUAGE=JAVASCRIPT>
alert("File $download_name is too big to edit/view. File may be no larger than $conf{maxeditsize} bytes");
self.close();
</SCRIPT></BODY></HTML>` if $download_size > $conf{maxeditsize};
      return if $download_size > $conf{maxeditsize};
      $conf{EDITDATA} = '';
      if($download_name =~ m|^/|) {
	$conf{CURRENTEDIT} = $download_name;
      } else {
	$conf{CURRENTEDIT} = $CONTENT->getDir."/$download_name";
      }
    }


    foreach my $info (@info) {
#      $file = $CONTENT->unencode($file);
#      my $info = shift @info;
      print $CLIENT make_file_header_for_tar($info) if $tar;
      next if $tar && $info->{type};
      my $file = $info->{name};
      my $FILE = $FTP->retr($file);
      unshift @{$conf{messages}}, [time(), $FTP->message];
      if(defined($FILE)) {
	my $bytes = 0;
	while(my $bytecount = $FILE->read($FTPbuffer, $BufferSize)) {
	  $bytes += $bytecount;
	  alarm($conf{timeout});
	  if($Action eq 'download') {
	    print $CLIENT $FTPbuffer;
	  } else {
	    $conf{EDITDATA} .= $FTPbuffer;
	  }
	}
	$FILE->close;
	if($tar) {
	  my $pad = $info->{size}%512?512-$info->{size}%512:0;
	  print $CLIENT ("\0" x $pad);
	}
      } else {
	$EDITOR->new_file();
      }
      alarm($conf{timeout});
      if($Action ne 'download') {
	$HTTPD->sendResponse($EDITOR->EDITMAIN());
	return;
      }
    }
    print $CLIENT ("\0"x1024) if $tar;
    return;
}

sub Timeout {
  $FTP->quit;
  warn "Remote user timed out";
  cleanup();
}

sub load_conf {
    my($key,$value);
    $_[0]->{base} = ''; 
    unless(open(DATA, 'web-ftp.conf')) {      
      if(open(DATA, 'webftp/web-ftp.conf')) {
	$_[0]->{base} = 'webftp/';
      } else {
	warn 'No web-ftp.conf file found';
      }
    }
    while(<DATA>) {
        next if ord($_) == 35;
        next unless /\s*(\w+)\s*=\s*(.*)/;
        $key = lc($1);
        if($value = $2) {
            $value =~ s/^\s*[yY][eE][sS]\s*$/1/;
            $value =~ s/^\s*[nN][oO]\s*$/0/;
        }
	if($key eq 'editors') {
	    my @v = split ',', $value;
	    for(@v) { s/^\s+//; s/\s+$//; }
	    push @{$_[0]->{$key}}, \@v;
	} else {
	    $_[0]->{$key} = $value;
	}
    }

    if($_[0]->{hidetag}) {
        $_[0]->{hidedownload} = 1;
        $_[0]->{hidedelete} = 1;
        $_[0]->{hidemove} = 1;
        $_[0]->{hidepermbutton} = 1;
    }
    $_[0]->{hidepermbutton} = 1 if $_[0]->{hidepermissions};

    $_[0]->{ftphost} = 'localhost' unless defined $_[0]->{ftphost};
    $_[0]->{ftphostname} = 'Localhost' unless defined $_[0]->{ftphostname};
    $_[0]->{timeout} ||= 300;
    if($_[0]->{basecgi} or $_[0]->{maincgi}) {
	$_[0]->{basecgi} ||= 'web-ftp.cgi';
	$_[0]->{maincgi} ||= 'web-ftp.cgi';
    } else {
	($_[0]->{basecgi} = $ENV{SCRIPT_NAME}) =~ s|.*/||;
	$_[0]->{maincgi} = $_[0]->{basecgi};
    }
    my $dir = $ENV{SCRIPT_NAME};
    $dir =~ s|[^/]*$||;
    $_[0]->{maincgi} =~ s|^/?|$dir|;
    $_[0]->{basecgi} =~ s|^/?|$dir|;
    
    $_[0]->{backgroundcolor} = '#FFFFFF' unless defined $_[0]->{backgroundcolor};
    $_[0]->{buttoncolor} = '#CCAAAA' unless defined $_[0]->{buttoncolor};
    $_[0]->{errorcolor} = '#FF0000' unless defined $_[0]->{errorcolor};   
    $_[0]->{linkcolor} = '#0000FF' unless defined $_[0]->{linkcolor};
    $_[0]->{logincolor} = '#77EECC' unless defined $_[0]->{logincolor};
    $_[0]->{textcolor} = '#000000' unless defined $_[0]->{textcolor};
    $_[0]->{visitedlinkcolor} = '#990099' unless defined $_[0]->{visitedlinkcolor};
    $_[0]->{oddcolcolor} = '#F0F0F0' unless defined $_[0]->{oddcolcolor};
    $_[0]->{evencolcolor} = '#FFFFFF' unless defined $_[0]->{evencolcolor};
    $_[0]->{hidedelete} = '0' unless defined $_[0]->{hidedelete};
    $_[0]->{hidedownload} = '0' unless defined $_[0]->{hidedownload};
    $_[0]->{hidelastmod} = '0' unless defined $_[0]->{hidelastmod};
    $_[0]->{hidemkdir} = '0' unless defined $_[0]->{hidemkdir};
    $_[0]->{hidemove} = '0' unless defined $_[0]->{hidemove};
    $_[0]->{hideowngrp} = '0' unless defined $_[0]->{hideowngrp};
    $_[0]->{hidepermbutton} = '0' unless defined $_[0]->{hidepermbutton};
    $_[0]->{hidepermissions} = '0' unless defined $_[0]->{hidepermissions};
    $_[0]->{hidetag} = '0' unless defined $_[0]->{hidetag};
    $_[0]->{hidesize} = '0' unless defined $_[0]->{hidesize};
    $_[0]->{hidemessages} = '0' unless defined $_[0]->{hidemessages};
    $_[0]->{hidesite} = '1' unless defined $_[0]->{hidesite};
    $_[0]->{hideupload} = '0' unless defined $_[0]->{hideupload};    
    $_[0]->{sockdir} = '/tmp/Web-FTP' unless defined $_[0]->{sockdir};    
    $_[0]->{mimefile} = '/etc/mime.types' unless defined $_[0]->{mimefile};
    $_[0]->{maxeditsize} = '100000' unless defined $_[0]->{maxeditsize};
    $_[0]->{fileframesize} = '*' unless defined $_[0]->{fileframesize};
    $_[0]->{dirsframesize} = '*' unless defined $_[0]->{dirsframesize};
    $_[0]->{infoframesize} = '40' unless defined $_[0]->{infoframesize};
    $_[0]->{editcrlf} =~ s/cr/\r/g;
    $_[0]->{editcrlf} =~ s/lf/\n/g;
#    $_[0]->{} = '' unless defined $_[0]->{};
    load_lang($_[0]);
}

sub load_lang {
    my $deflang = (split(/\s*,\s*/, ($_[1] || $_[0]->{language})))[0];
    for my $language ('english',$deflang) { # fill any empty holes with english
	next unless $language =~ /\S/;
	if(open(LANG, "$_[0]->{base}lang/$language.map")) {
	    local $/ = "\n.";
	    while(<LANG>) {
		s/^\s+//;
		s/\s*\n\.\s*$//;
		my @a = split /:\s*/, $_, 2;
		$_[0]->{lang}{$a[0]} = $a[1];
	    }
	} else {
	    print "Content-Type: text/plain\n\n$_[0]->{base}lang/$language.map not found! aborting!\n";
	    exit(1);
	}
    }
}

sub cleanup() {
    $HTTPD->closeServer();
}

sub HandleSession {
    my($dir,$s,$peer);
    $ENV{PATH_INFO} =~ m|^/*(\d{5})|;
    $peer = $1;
    $s = new IO::Socket::UNIX('Peer' => "$conf{socketdir}/$peer");
    unless($s) {
        print qq`Content-type: text/html

<HTML><HEAD>
<SCRIPT LANGUAGE=JAVASCRIPT>
function goToLogin() {
  setTimeout("open('$conf{basecgi}','_top')",5000);
}
</SCRIPT>
</HEAD>
<BODY BGCOLOR="$conf{backgroundcolor}" TEXT="$conf{textcolor}" VLINK="$conf{visitedlinkcolor}" LINK="$conf{linkcolor}" ONLOAD="goToLogin()">
Sorry, but your session has either timed out, or has aborted due to error, returning you to the <A TARGET="_top" HREF="$conf{basecgi}">Login page</A>
</BODY></HTML>
`;
        exit(0);
    }

    for my $a (keys %ENV) {
        $ENV{$a} =~ s/\n/ /g;
	print $s "$a=$ENV{$a}\n";
    }
    print $s "__END_ENV__\n";

    {
	my $buf;
	print $s "\n";
	while(read(STDIN,$buf,1024)) {
	    print $s $buf;
	}	
    }
    while(my $bytecount = $s->read($_, $BufferSize)) { print; }
    $s->close();
#    my @b = POSIX::times();
#    print STDERR ("Perl script took ",($b[0]-$main::a[0])/100,"\n");
    exit(0);
}