View ¡m../ftp/web-ftp.cgi¡n
#!/usr/bin/perl $| = 1; #BEGIN { # use POSIX; # @main::a = POSIX::times(); #} use lib 'webftp'; use IO::Socket; use strict; use MiniServer; use WebFTPPages; # ooh, Net::Gnift compliance.. if I ever get the d**m thing written BEGIN { $^W = 0; eval "use Net::Gnift qw(Net::FTP);"; if($@) { eval "use Net::FTP;"; if($@) { print qq`Content-Type: text/html\n\nYou do not have Net::FTP installed. You need it to use Web-FTP. You can find it on
CPAN
`; die "Net::FTP not found in \@INC: @INC"; } } } ############# # Global vars # ############### my %conf; load_conf(\%conf); my($FTPhost,$FTPhostname); my $Version = '2.2.1'; @{$conf{h}} = split /\s*,\s*/, $conf{ftphost}; @{$conf{hn}} = split /\s*,\s*/, $conf{ftphostname}; for(my $i=0; $i<=$#{$conf{h}}; $i++) { $conf{hn}->[$i] ||= $conf{h}->[$i]; $conf{whathostname}{$conf{h}->[$i]} = $conf{hn}->[$i]; } unless($#{$conf{h}}) { $FTPhost = $conf{h}->[0]; $FTPhostname = $conf{hn}->[0]; } # Don't alter these # # unless you know # # what you're doing # $FTPhostname ||= $FTPhost; my $BufferSize = 5 * 1024; my $CRLF = "\015\012"; my $RemoteHost = $ENV{'REMOTE_ADDR'}; # These may have to change if my $Scriptname = $ENV{'SCRIPT_NAME'}; # you're not using Apache. my $Servername = $ENV{'HTTP_HOST'}; # my ($ServerPort,$FTP); $conf{SERVERNAME} = $Servername; $conf{SCRIPT_NAME} = $conf{maincgi}; $conf{ORIG_SCRIPT_NAME} = $Scriptname; $conf{HTTP} = (($ENV{HTTPS} =~ /on/i )? 'https://' : 'http://'); $conf{SCRIPT} = "$conf{HTTP}$conf{SERVERNAME}$Scriptname"; ############## # Main program # ################ my($CONTENT,$EDITOR,$HTTPD); if($ENV{PATH_INFO}) { &HandleSession; } else { &UserLogin; } ############### # Login handler # ################# sub UserLogin { my($language, $host, $username, $password); while (
) { if(/(?:language=([^&]*)&)?(?:host=([^&]*)&)?username=(\S*)&password=(\S*)/) { if($1) { load_lang(\%conf,$1); } $username = $3; $password = $4; $FTPhost = $FTPhostname = $2 if $2; $FTPhost ||= 'localhost'; $FTPhost =~ s/\%([A-Fa-f0-9]{2})/chr(hex($1))/eg if($FTPhost); $FTPhostname = ($conf{whathostname}{$FTPhost} || $FTPhost); } if($_ eq 'CRLF') { last; } } $username =~ s/\%([A-Fa-f0-9]{2})/chr(hex($1))/eg if($username); $password =~ s/\%([A-Fa-f0-9]{2})/chr(hex($1))/eg if($password); $conf{username} = $username; $conf{password} = $password; $CONTENT = WebFTPPages->new($Version, $FTPhost, $FTPhostname, $Servername, $conf{maincgi}, \%conf); $HTTPD = MiniServer->new($RemoteHost, $CONTENT, $Servername, \&FileMaster, \%conf); $conf{HTTPD} = $HTTPD; $conf{CONTENT} = $CONTENT; if($username && $password) { if(&TryFTPLogin([$username, $password, 1])) { #ANT: this is a major kludge... STDOUT not closing makes some # browsers hang and not redirect. However, closing STDOUT causes # apache to kill the cgi. SO! I must fork and close the parent, # then close STDOUT thus saving the day... till I find a better # solution # $HTTPD->WANT_COOKIE(1); # &TryFTPLogin([$username, $password]); close STDOUT; &Serve; } } else { $HTTPD->sendResponse($CONTENT->loginScreen()); exit(0); } } sub TryFTPLogin { my ($user, $pass, $test) = @{$_[0]}; #passed this way to hide password from logs, sigh unless($FTP = Net::FTP->new($FTPhost, Timeout => $conf{timeout}+50)) { $HTTPD->sendResponse($CONTENT->errorPage("Server said: $@")); die "Server said: $@"; } if($FTP->message() =~ /microsoft/i) { $conf{servertype} = 'MS'; $conf{hidepermissions} = 1; $conf{hidepermbutton} = 1; $conf{hideowngrp} = 1; } # print STDERR "---- ",$FTP->message(),"\n"; unless( $FTP->login($user, $pass) ) { if($FTP->message =~ /CRYPTOCard challenge (\d+)/i) { $conf{challenge} = $1; } else { my $mesg = $FTP->message; $FTP->quit; $HTTPD->sendResponse($CONTENT->failLogin($mesg)); exit(0); } } if(fork()) { $FTP->close(); exit(0); } $FTP->cwd($conf{initialdir}) if $conf{initialdir}; # All systems are go. Let's start the webserver. $conf{FTP} = $FTP; $HTTPD->startServer; $HTTPD->sendRedirect(sprintf("$conf{HTTP}$Servername$conf{maincgi}/%05d/START?$conf{challenge}",$$)); } ############# # Server core # ############### sub Serve { $SIG{ALRM} = \&Timeout; alarm($conf{timeout}); while(1) { unless($HTTPD->awaitConnection()) { next; } my $queryHashRef = $HTTPD->handleQueryHeaders(); next unless($queryHashRef); if($queryHashRef->{REQUEST_METHOD} eq 'GET') { &GetHandler($queryHashRef->{PATH}); } elsif($queryHashRef->{REQUEST_METHOD} eq 'POST') { &PostHandler($queryHashRef); } $HTTPD->closeConnection unless $conf{noclose}; $conf{noclose} = 0; } } sub GetHandler { $_ = shift; # s|^/(?:\Q$conf{SCRIPT_NAME}\E/)*||; # s|^/||g; if(($_ eq '') || ($_ eq 'LIST') || ($_ eq 'START')) { $CONTENT->updateDir($FTP->pwd()); $CONTENT->getDirectory($FTP->dir()); $HTTPD->genCookie(); $HTTPD->sendResponse($CONTENT->frameset()); } elsif($_ eq 'PUT') { $HTTPD->sendResponse($CONTENT->uploadScreen()); } elsif($_ eq 'MKDIR') { $HTTPD->sendResponse($CONTENT->mkdirScreen()); } elsif($_ eq 'CDUP') { $FTP->cdup; unshift @{$conf{messages}}, [time(), $FTP->message]; alarm($conf{timeout}); $HTTPD->sendRedirect("$conf{HTTP}$Servername$conf{SCRIPT_NAME}$conf{COOKIE}/"); } elsif($_ eq 'QUIT') { $FTP->quit; print STDERR "Exiting '$conf{HTTP}$Servername$conf{ORIG_SCRIPT_NAME}'\n"; $HTTPD->sendRedirect("$conf{HTTP}$Servername$conf{ORIG_SCRIPT_NAME}"); cleanup(); } elsif(/CDTO\?(.*)/) { $FTP->cwd($CONTENT->unencode($1)); unshift @{$conf{messages}}, [time(), $FTP->message]; alarm($conf{timeout}); $CONTENT->updateDir($FTP->pwd()); $CONTENT->getDirectory($FTP->dir()); $HTTPD->sendResponse($CONTENT->MAIN()); } elsif(/PERM\?(.*)/) { $HTTPD->sendResponse($CONTENT->permsScreen($1)); } elsif(/DNLD\?(.*)/) { my(%foo); $foo{Files} = [$1]; $foo{action} = ['download']; my $pwd = $FTP->pwd(); if($conf{challenge}) { download(\%foo); } elsif (!fork()) { close $FTP; # Much thanks to Graham Barr for this fix. unless($FTP = Net::FTP->new($FTPhost, Timeout => $conf{timeout}+50)) { $HTTPD->sendResponse($CONTENT->errorPage("Server said: ".$FTP->message)); die "Server said: ".$FTP->message; } $FTP->login($conf{username}, $conf{password}); unshift @{$conf{messages}}, [time(), $FTP->message]; $FTP->cwd($pwd); unshift @{$conf{messages}}, [time(), $FTP->message]; download(\%foo); $HTTPD->closeConnection(); exit(0); } } elsif(/EDIT\?(.*)/) { my(%foo); my $str = $1; $str =~ /file=([^&]+)/; $foo{Files} = [$1]; $foo{action} = ['edit']; $str =~ /editor=([^&]+)/; my $editor = $1; require "$editor.pm"; $EDITOR = eval "new $editor('conf' => \\\%conf)"; download(\%foo); } elsif(/MAIN/) { $CONTENT->updateDir($FTP->pwd()); $CONTENT->getDirectory($FTP->dir()); $HTTPD->sendResponse($CONTENT->MAIN()); } elsif($_) { my $str; s/\?(.*)$//; eval { $str = eval "\$CONTENT->$_(\$1)"; die if $@; }; if($@) { eval { $str = eval "\$EDITOR->$_(\$1)"; }; die if $@; } $HTTPD->sendResponse($str) if($str && !$@); } } BEGIN { # a horrendous kludge my $FILE; sub FileMaster { my $directive = shift; my $full_path = $_[1]; # Ewwwww ugly. # ant if($directive eq 'NEW') { my $filename = shift; $filename =~ s/^.*[\\\/\:]// unless $full_path; $_[2] ? $FTP->ascii : $FTP->binary; $FILE = $FTP->stor($filename); unshift @{$conf{messages}}, [time(), $FTP->message()]; } elsif($directive eq 'PUT') { my $buff = shift; if($FILE && length($buff)) { $FILE->write($buff, length($buff)); } } elsif($directive eq 'CLOSE') { if($FILE) { $FILE->close; $FILE = undef; alarm($conf{timeout}); } else { $conf{save_error} = 1; unshift @{$conf{messages}}, [time(), "Could not write file: ". $FTP->message()]; } } } } sub PostHandler { my $QueryHashRef = shift; my @keys = keys %$QueryHashRef; my @Files = @{$QueryHashRef->{'Files'}} if(exists($QueryHashRef->{'Files'})); my @Directories; @Directories = @{$QueryHashRef->{'Directories'}} if(exists($QueryHashRef->{'Directories'})); push @Directories, split "\n", $QueryHashRef->{'DirectoriesList'}->[0] if($QueryHashRef->{'DirectoriesList'}->[0]); my($Action) = @{$QueryHashRef->{'action'}} if(exists($QueryHashRef->{'action'})); print STDERR "Action is $Action\n"; if($Action eq 'download') { return &download($QueryHashRef); } elsif($Action eq 'site') { $FTP->quot('SITE',$Directories[0]); } elsif($Action eq 'edit') { $conf{EDITDATA} = $QueryHashRef->{data}[0]; doEditSave(); $HTTPD->sendResponse($EDITOR->SYS); return; } elsif($Action eq 'move') { $HTTPD->sendResponse($CONTENT->moveScreen(@Directories, @Files)); return; } elsif($Action eq $conf{lang}{move_button}) { print STDERR "Action is $Action MOVE\n"; while($_ = shift @Files) { $FTP->rename($_, shift @Directories); alarm($conf{timeout}); } } elsif($Action eq 'permissions') { $HTTPD->sendResponse($CONTENT->permsScreen(@Directories, @Files)); return 0; } elsif($Action eq $conf{lang}{change_permissions}) { my $i = 0; while($_ = shift @Files) { my $newperms = shift(@Directories); if($newperms) { if($newperms =~ /[0-7]{3,4}/) { $FTP->quot('SITE',"CHMOD $newperms $_"); } } else { $newperms = 0; if($QueryHashRef->{"perm_$i"}) { for(@{$QueryHashRef->{"perm_$i"}}) { $newperms |= $_; } $FTP->quot('SITE',sprintf("CHMOD %03o $_", $newperms)); } } $i++; alarm($conf{timeout}); } } elsif($Action eq 'chdir') { $FTP->cwd(shift @Directories); alarm($conf{timeout}); } elsif($Action eq $conf{lang}{make_directory}) { $FTP->mkdir(shift @Directories, 1); alarm($conf{timeout}); } 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 ` 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(
) { 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(
) { 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 Sorry, but your session has either timed out, or has aborted due to error, returning you to the
Login page
`; 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); }