#!/usr/bin/perl -T # fexsrv : web server for F*EX service # # Author: Ulli Horlacher # use 5.008; use Socket; use IO::Handle; use Fcntl qw':flock :seek'; use warnings; BEGIN { # stunnel workaround $SIG{CHLD} = "DEFAULT"; $ENV{PERLINIT} = q{ unshift @INC,(getpwuid($<))[7].'/perl'; # web error handler $SIG{__DIE__} = $SIG{__WARN__} = sub { my $info = ''; my $url = $ENV{REQUEST_URL}||''; my @d = localtime time; my $time = sprintf('%d-%02d-%02d %02d:%02d:%02d', $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]); if ($admin) { my $mailto = "mailto:$admin?subject=fex%20bug"; $info = "

send this error to $admin

"; } $_ = join("\n",@_); chomp; s/&/&/g; s/", "

INTERNAL ERROR in $0

", "

\n$_\n

", "$url\n

", "$time\n

", "$info\n

", "" ); $length = length; unless ($HTTP_HEADER) { print "HTTP/1.0 200 ERROR\r\n"; print "Content-Type: text/html\r\n"; print "Content-Length: $length\r\n"; print "\r\n"; } print; exit 99; } }; eval $ENV{PERLINIT}; } # use BSD::Resource; # setrlimit(RLIMIT_CPU,999,999) or die "$0: $!\n"; # SSL remote address provided by stunnel if (@ARGV and $ARGV[0] eq 'stunnel' and $ENV{REMOTE_HOST} =~ /(.+)/) { $ssl_ra = $1; } # KEEP_ALIVE <== callback from CGI if ($ENV{KEEP_ALIVE}) { $keep_alive = $ENV{KEEP_ALIVE}; } else { %ENV = ( PERLINIT => $ENV{PERLINIT} ); # clean environment } $ENV{HOME} = (getpwuid($<))[7] or die "no HOME"; # fexsrv MUST be run with full path! if ($0 =~ m:^(/.+)/bin/fexsrv:) { $FEXHOME = $1; $FEXHOME =~ s:/+:/:g; $FEXHOME =~ s:/$::; $ENV{FEXHOME} = $FEXHOME; } foreach my $lib ( $FEXHOME, '/usr/local/fex', '/usr/local/share/fex', '/usr/share/fex', ) { $ENV{FEXLIB} = $FEXLIB = $lib and last if -f "$lib/fex.pp"; $ENV{FEXLIB} = $FEXLIB = "$lib/lib" and last if -f "$lib/lib/fex.pp"; } # import from fex.pp our ($hostname,$debug,$timeout,$max_error,$max_error_handler); our ($spooldir,@logdir,$docdir,$xkeydir,$akeydir,$lockdir); our ($force_https,$default_locale,$bs,$MB,$adlm); our (@locales); # load common code (local config: $FEXHOME/lib/fex.ph) require "$FEXLIB/fex.pp" or die "cannot load $FEXLIB/fex.pp - $!\n"; chdir $spooldir or http_die("$0: $spooldir - $!\n"); our $log = 'fexsrv.log'; our $error = 'F*EX ERROR'; our $htmlsource; our $hid = ''; # header ID our @log; $0 = untaint($0); $ENV{GATEWAY_INTERFACE} = 'CGI/1.1f'; $ENV{SERVER_NAME} = $hostname; $ENV{REQUEST_METHOD} = ''; $ENV{QUERY_STRING} = ''; $ENV{HTTP_COOKIE} = ''; $ENV{PATH_INFO} = ''; $ENV{RANDOM} = randstring(8); $ENV{FEATURES} = join(',',qw( SID CHECKRECIPIENT GROUPS QUOTA FILEID MULTIPOST XKEY FILEQUERY FILESTREAM JUP NOSTORE AXEL FEXMAIL FILELINK )); $port = 0; # continue session? if ($keep_alive) { if ($ENV{HTTP_HOST} =~ /(.+):(.+)/) { $hostname = $1; $port = $2; } else { $hostname = $ENV{HTTP_HOST}; if ($ENV{PROTO} eq 'https') { $port = 443 } else { $port = 80 } } $ra = $ENV{REMOTE_ADDR}; $rh = $ENV{REMOTE_HOST}; } # new session else { my $iaddr; # HTTPS connect if ($ssl_ra) { $ENV{PROTO} = 'https'; $ENV{REMOTE_ADDR} = $ra = $ssl_ra; if ($ssl_ra =~ /\w:\w/) { # ($rh) = `host $ssl_ra 2>/dev/null` =~ /name pointer (.+)\.$/; $^W = 0; eval 'use Socket6'; $^W = 1; http_error(503) if $@; $iaddr = inet_pton(AF_INET6,$ssl_ra) and $rh = gethostbyaddr($iaddr,AF_INET6); } else { $rh = gethostbyaddr(inet_aton($ra),AF_INET); } $rh ||= '-'; $port = 443; # print {$log} "X-SSL-Remote-Host: $ssl_ra\n"; } # HTTP connect else { $ENV{PROTO} = 'http'; my $sa = getpeername(STDIN) or die "no network stream on STDIN\n"; if (sockaddr_family($sa) == AF_INET) { ($ENV{REMOTE_PORT},$iaddr) = sockaddr_in($sa); $ENV{REMOTE_ADDR} = $ra = inet_ntoa($iaddr); $rh = gethostbyaddr($iaddr,AF_INET); ($port) = sockaddr_in(getsockname(STDIN)); } elsif (sockaddr_family($sa) == AF_INET6) { $^W = 0; eval 'use Socket6'; $^W = 1; http_error(503) if $@; ($ENV{REMOTE_PORT},$iaddr) = unpack_sockaddr_in6($sa); $ENV{REMOTE_ADDR} = $ra = inet_ntop(AF_INET6,$iaddr); $rh = gethostbyaddr($iaddr,AF_INET6); ($port) = unpack_sockaddr_in6(getsockname(STDIN)); } else { die "unknown IP version\n"; } $port = 80 unless $port; } $ENV{REMOTE_HOST} = $rh || ''; $ENV{HTTP_HOST} = ($port == 80 or $port == 443) ? $hostname : "$hostname:$port"; $ENV{PORT} = $port; } if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) { $ENV{FEATURES} =~ s/SID,//; } if (@anonymous_upload and ipin($ra,@anonymous_upload)) { $ENV{FEATURES} .= ',ANONYMOUS'; } $| = 1; $SIG{CHLD} = "DEFAULT"; # stunnel workaround $SIG{ALRM} = sub { # printf {$log} "\nTIMEOUT %s %s\n",isodate(time),$connect; if (@log) { debuglog('TIMEOUT',isodate(time)); fexlog($connect,@log,"TIMEOUT"); } exit; }; REQUEST: while (*STDIN) { if (defined $ENV{REQUESTCOUNT}) { $ENV{REQUESTCOUNT}++ } else { $ENV{REQUESTCOUNT} = 0 } $connect = sprintf "%s:%s %s %s %s [%s_%s]", $keep_alive ? 'CONTINUE' : 'CONNECT', $port, isodate(time), $rh||'-', $ra, $$,$ENV{REQUESTCOUNT}; $hid = sprintf("%s %s\n",$rh||'-',$ra); @header = @log = (); $header = ''; # read complete HTTP header while (defined ($_ = &getaline)) { last if /^\s*$/; $hl += length; $header .= $_; s/[\r\n]+$//; # URL-encode non-printable chars s/([\x00-\x08\x0E-\x1F\x7F-\x9F])/sprintf "%%%02X",ord($1)/ge; s/%21/!/g; if (@header and s/^\s+/ /) { $header[-1] .= $_; } else { push @header,$_; $header{$1} = $2 if /(.+)\s*:\s*(.+)/; push @log,$_; } if ($hl > $MB) { fexlog($connect,@log,"OVERRUN"); http_error(413); } if (/^(GET \/|\S*Forwarded|\S*Client-IP|\S*Coming-From|User-Agent)/i) { $hid .= $_."\n"; } # reverse-proxy? # (only IPv4 support!) if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra and /^\S*(Forwarded|Client-IP|Coming-From)\S*: ([\da-f:.]+)/i ) { $ENV{REMOTE_ADDR} = $ra = $2; $ENV{REMOTE_HOST} = $rh = gethostbyaddr(inet_aton($ra),AF_INET) || ''; $ENV{HTTP_HOST} = $hostname; if ($ENV{PROTO} eq 'https') { $port = 443 } else { $port = 80 } } } exit unless @header; exit if $header =~ /^\s*$/; $ENV{HTTP_HEADER} = $header; debuglog($header); # http_die("

$header

"); $ENV{'HTTP_HEADER_LENGTH'} = $hl; $ENV{REQUEST_URI} = $uri = ''; $cgi = ''; # is it a HTTP-request at all? $request = shift @header; if ($request !~ /^(GET|HEAD|POST|OPTIONS).*HTTP\/\d\.\d$/i) { fexlog($connect,$request,"DISCONNECT: no HTTP request"); badlog("no HTTP request: $request"); exit; } if ($force_https and $port != 443 and $request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) { $request = $2; nvt_print( "HTTP/1.1 301 Moved Permanently", "Location: https://$hostname$request", "Content-Length: 0", "" ); fexlog($connect,@log); exit; } $request =~ s{^(GET|HEAD|POST) https?://$hostname(:\d+)?}{$1 }i; if ($request =~ m"^(GET|HEAD) /fop/\w+/") { # no header inquisition on regular fop request $header_hook = ''; } else { &$header_hook($connect,$request,$ra) if $header_hook; } unless ($keep_alive) { if ($request =~ m:(HTTP/1.(\d)): and $2) { $ENV{KEEP_ALIVE} = $keep_alive = $ra } else { $ENV{KEEP_ALIVE} = $keep_alive = ''; } } if ($request =~ /^OPTIONS \/?FEX HTTP\/[\d\.]+$/i) { fexlog($connect,@log); nvt_print( "HTTP/1.1 201 OK", "X-Features: $ENV{FEATURES}", "X-Timeout: $timeout", '' ); next REQUEST if $keep_alive; exit; } if ($request =~ m:^GET /?SID HTTP/[\d\.]+$:i) { if ($ENV{FEATURES} !~ /\bSID\b/) { fexlog($connect,@log); nvt_print( "HTTP/1.1 501 Not Available", "Server: fexsrv", "X-Features: ".$ENV{FEATURES}, "X-Timeout: ".$timeout, 'Content-Length: 0', '' ); } else { $ENV{SID} = randstring(8); fexlog($connect,@log); nvt_print( "HTTP/1.1 201 ".$ENV{SID}, "Server: fexsrv", "X-Features: ".$ENV{FEATURES}, "X-SID: ".$ENV{SID}, "X-Timeout: ".$timeout, 'Content-Length: 0', '' ); } next REQUEST if $keep_alive; exit; } if ($request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) { $ENV{REQUEST} = $_; $ENV{REQUEST_METHOD} = uc($1); $ENV{REQUEST_URI} = $uri = $cgi = $2; $ENV{HTTP_VERSION} = $protocol = $3; $ENV{QUERY_STRING} = $1 if $cgi =~ s/\?(.*)//; $ENV{PATH_INFO} = $1 if $cgi =~ m:/.+?(/.+?)(\?|$):; $ENV{KEEP_ALIVE} = $keep_alive = '' if $protocol =~ /1\.0/; $ENV{REQUEST_URL} = "$ENV{PROTO}://$ENV{HTTP_HOST}$ENV{REQUEST_URI}"; if ($uri =~ /<|%3c/i) { badchar("<") } if ($uri =~ />|%3e/i) { badchar(">") } if ($uri =~ /\||%7c/i) { badchar("|") } if ($uri =~ /\\|%5c/i) { badchar("\\") } } while ($_ = shift @header) { # header inquisition! &$header_hook($connect,$_,$ra) if $header_hook; # mega stupid "Download Manager" FlashGet if ($uri =~ m{^/fop/} and m{^Referer: https?://.*\Q$uri$}) { fexlog($connect,@log,"NULL: FlashGet"); debuglog("NULL: FlashGet"); exec qw'cat /dev/zero' or sleep 30; exit; } if ($header =~ /\nRange:/ and /^User-Agent: (FDM)/) { disconnect($1,"499 Download Manager $1 Not Supported",30); } if (/^User-Agent: (Java\/[\d\.]+)/) { disconnect($1,"499 User-Agent $1 Not Supported",30); } if (/^Range:.*,/) { disconnect("Range a,b","416 Requested Range Not Satisfiable",30); } if (/^Range:.*(\d+)-(\d+)/) { if ($1 > $2) { disconnect("Range a>b","416 Requested Range Not Satisfiable",0); } if (($header{'User-Agent'}||'') !~ /$adlm/ ) { disconnect("Range a-b","416 Requested Range Not Satisfiable",30); } } if (/^Range:.*\d+-$/ and $hid) { my $lock = untaint($lockdir.'/'.md5_hex($hid)); if (open $lock,'+>>',$lock) { if (flock($lock,LOCK_EX|LOCK_NB)) { seek $lock,0,0; truncate $lock,0; print {$lock} $hid; } else { disconnect( "multiple Range request", "400 Multiple Requests Not Allowed", 10, ); } } } # client signed int bug if (/^Range:.*-\d+-/) { disconnect("Range -a-","416 Requested Range Not Satisfiable",0); } # if (/^Range:/ and $protocol =~ /1\.0/) { # &$header_hook($connect,$_,$ra) while ($header_hook and $_ = shift @header); # fexlog($connect,@log,"DISCONNECT: Range + HTTP/1.0"); # debuglog("DISCONNECT: Range + HTTP/1.0"); # http_error(416); # exit; # } if (/^Connection:\s*close/i) { $ENV{KEEP_ALIVE} = $keep_alive = ''; } # HTTP header ==> environment variables if (/^([\w\-]+):\s*(.+)/s) { $http_var = $1; $http_val = $2; $http_var =~ s/-/_/g; $http_var = uc($http_var); $http_val =~ s/^\s+//; $http_val =~ s/\s+$//; if ($http_var =~ /^X_(FEX_\w+|CONTENT_LENGTH)$/) { $http_var = $1; } else { $http_val =~ s/\s+/ /g; if ($http_var =~ /^HTTP_(HOST|VERSION)$/) { $http_var = 'X-'.$http_var; } elsif ($http_var !~ /^CONTENT_/) { $http_var = 'HTTP_'.$http_var; } } $ENV{$http_var} = $http_val; } } # multiline header inquisition &$header_hook($connect,$header,$ra) if $header_hook; exit unless $cgi; # extra download request? (request http://fexserver//xkey) if ($cgi =~ m{^//([^/]+)$}) { my $xkey = $1; my $dkey; if ($xkey =~ /^afex_\d/) { $dkey = readlink "$xkeydir/$xkey" and $dkey =~ s/^\.\.\///; } else { $dkey = readlink "$xkeydir/$xkey/dkey" and $dkey .= "/$xkey"; } if ($dkey) { # xkey downloads are only one time possible - besides afex if ($xkey !~ /^afex_\d/) { unlink "$xkeydir/$xkey/xkey"; unlink "$xkeydir/$xkey"; } nvt_print( "HTTP/1.1 301 Moved Permanently", "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/fop/$dkey", "Content-Length: 0", "" ); fexlog($connect,@log); exit; } fexlog($connect,@log); http_error(404); exit; } # get locale if (($ENV{QUERY_STRING} =~ /.*locale=([\w-]+)/ or $ENV{HTTP_COOKIE} =~ /.*locale=([\w-]+)/) and -d "$FEXHOME/locale/$1") { $ENV{LOCALE} = $locale = $1; } else { $ENV{LOCALE} = $locale = $default_locale; } # for dynamic HTML documents if ($ENV{HTTP_COOKIE} =~ /akey=(\w+)/) { my $akey = $1; my ($user,$id); if ($user = readlink "$akeydir/$akey") { $user =~ s:.*/::; $user = untaint($user); if ($id = slurp("$spooldir/$user/@")) { chomp $id; $ENV{AKEY} = $akey; $ENV{USER} = $user; $ENV{ID} = $id; } } } # check for name based virtual host $vhost = vhost($ENV{'HTTP_HOST'}); if ($debug) { debuglog("ENV:\n"); foreach $var (sort keys %ENV) { if (defined($ENV{$var})) { debuglog(sprintf " %s = >%s<\n",$var,$ENV{$var}); } } debuglog("\n"); } # locale definitions in fex.ph? if (@locales) { if (@locales == 1) { $locale = $locales[0]; } elsif (not grep /^$locale$/,@locales) { $locale = $default_locale; } } # prepare document file name if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) { if (%redirect) { foreach my $r (keys %redirect) { if ($uri =~ /^\Q$r/) { redirect($uri,$r); exit; } } } $doc = untaint($uri); $doc =~ s/%([\dA-F]{2})/unpack("a",pack("H2",$1))/ge; $doc =~ m:/\.\./: and http_error(403); $doc =~ s:^/+::; $doc =~ s/\?.*//; if ($locale and $locale ne 'english' and -e "$docdir/locale/$locale/$doc") { $doc = "$docdir/locale/$locale/$doc"; } else { $doc = "$docdir/$doc"; } } # CGI or document request? if ($cgi =~ s:^/+::) { $cgi =~ s:/.*::; unless ($cgi) { my $login = "$FEXHOME/cgi-bin/login"; if (-x $login) { $cgi = untaint(readlink($login) || $login); $cgi =~ s:.*/::; } } $ENV{SCRIPT_NAME} = $cgi; # locale CGIs? (vhost comes already with own FEXLIB) if ($locale and $locale ne 'english' and -f "$FEXHOME/locale/$locale/cgi-bin/$cgi") { $ENV{SCRIPT_FILENAME} = $cgi = "$FEXHOME/locale/$locale/cgi-bin/$cgi"; $ENV{FEXLIB} = $FEXLIB = "$FEXHOME/locale/$locale/lib" unless $vhost; } else { $ENV{SCRIPT_FILENAME} = $cgi = "$FEXHOME/cgi-bin/$cgi"; $ENV{FEXLIB} = $FEXLIB = "$FEXHOME/lib" unless $vhost; } $status = ''; if (-x $cgi and -f $cgi) { if (@forbidden_hosts and ipin($ra,@forbidden_hosts)) { fexlog($connect,@log,"FORBIDDEN"); http_error(403); } unlink "$spooldir/.error/$ra"; # push @log,"DEBUG: locale=$locale locales=(@locales)"; fexlog($connect,@log,"EXEC $cgi"); eval { local $^W = 0; exec $cgi }; $status = "$! or bad interpreter"; fexlog($connect,@log,"FAILED to exec $cgi : $status"); http_error(555); } else { if (-f "$doc/.htindex") { require "$FEXLIB/dop"; fexlog($connect,@log); showindex($doc); STDOUT->flush; next REQUEST if $keep_alive; exit; } if (-f "$doc/index.html") { # force redirect if trailing / is missing # this is mandatory for processing further HTTP request! if ($doc !~ m{/$}) { nvt_print( "HTTP/1.1 301 Moved Permanently", "Location: $ENV{REQUEST_URL}/", "Content-Length: 0", "" ); fexlog($connect,@log); next REQUEST if $keep_alive; exit; } $doc .= '/index.html'; $doc =~ s:/+:/:g; } $doc =~ s/#.*//; # ignore HTML anchors (stupid msnbot) # special request for F*EX UNIX clients if ($ENV{SCRIPT_NAME} eq 'xx.tar') { bintar(qw'fexget fexsend xx zz ezz'); } if ($ENV{SCRIPT_NAME} eq 'sex.tar') { bintar(qw'sexsend sexget sexxx'); } if ($ENV{SCRIPT_NAME} eq 'afex.tar') { bintar(qw'afex asex fexget fexsend sexsend sexget'); } if ($ENV{SCRIPT_NAME} eq 'afs.tar') { bintar(qw'afex asex fexget fexsend xx sexsend sexget sexxx zz ezz'); } # URL ends with ".html!" or ".html?!" if ($doc =~ s/(\.html)!$/$1/ or $doc =~ /\.html$/ and $ENV{'QUERY_STRING'} eq '!') { $htmlsource = $doc } else { $htmlsource = '' } if (-f $doc or $doc =~ /(.+)\.(tar|tgz|zip)$/ and lstat("$1.stream") or $doc =~ /(.+)\.tgz$/ and -f "$1.tar" or $doc =~ /(.+)\.gz$/ and -f $1) { unlink "$spooldir/.error/$ra"; delete $ENV{SCRIPT_FILENAME}; $ENV{DOCUMENT_FILENAME} = $doc; require "$FEXLIB/dop"; fexlog($connect,@log); dop($doc); STDOUT->flush; next REQUEST if $keep_alive; exit; } elsif ($uri eq '/bunny') { fexlog($connect,@log); nvt_print( 'HTTP/1.1 200 OK', 'Server: fexsrv', "Content-Type: text/plain", '', '=:3', ); exit; } elsif ($uri eq '/camel') { fexlog($connect,@log); nvt_print( 'HTTP/1.1 200 OK', 'Server: fexsrv', "Content-Type: text/plain", '', ); local $/; print unpack('u',); exit; } elsif (-e $cgi) { $status = 'not executable'; } } } # neither document nor CGI ==> error if ($status) { fexlog($connect,@log,"FAILED to exec $cgi : $status"); http_error(666); } else { fexlog($connect,@log,"UNKNOWN URL"); badlog($request); http_error(404); } exit; } # read one text line unbuffered from STDIN sub getaline { my $line = ''; my $n = 0; my $c; alarm($timeout); # must use sysread to avoid perl line buffering # (later exec would destroy line buffer) while (sysread STDIN,$c,1) { $line .= $c; $n++; last if $c eq "\n"; if ($n > $bs) { fexlog($connect,@log,$line,"OVERRUN"); http_error(413); } } alarm(0); return $line; } sub fexlog { my @log = @_; foreach my $logdir (@logdir) { if (open $log,'>>',"$logdir/$log") { flock $log,LOCK_EX; seek $log,0,SEEK_END; print {$log} "\n",join("\n",@log),"\n"; close $log; } else { http_die("$0: cannot write to $logdir/$log - $!\n"); } } } sub badchar { my $bc = shift; fexlog($connect,@log,"DISCONNECT: bad characters in URL"); debuglog("DISCONNECT: bad characters in URL $uri"); badlog($request); http_die("\"$bc\" is not allowed in URL"); } sub bintar { my $tmpdir = "$FEXHOME/tmp"; my $fs = "$ENV{PROTO}://$ENV{HTTP_HOST}"; if (chdir "$FEXHOME/bin") { fexlog($connect,@log); chdir $fstb if $fstb; mkdir $tmpdir; foreach my $f (@_) { copy($f,"$tmpdir/$f","s#fexserver = ''#fexserver = '$fs'#"); chmod 0755,"$tmpdir/$f"; } chdir $tmpdir or http_die("internal error: $tmpdir - $!"); my $tar = `tar cf - @_ 2>/dev/null`; unlink @_; nvt_print( 'HTTP/1.1 200 OK', 'Server: fexsrv', "Content-Length: ".length($tar), "Content-Type: application/x-tar", '', ); print $tar; exit; } } sub http_error { my $error = shift; my $URL = $ENV{REQUEST_URL}||''; my $URI = $ENV{REQUEST_URI}||''; if ($error eq 400) { http_error_header("400 Bad Request"); nvt_print("Your request $URL is not acceptable."); } elsif ($error eq 403) { http_error_header("403 Forbidden"); nvt_print("You have no permission to request $URL"); } elsif ($error eq 404) { http_error_header("404 Not Found"); nvt_print("The requested URI $URI was not found on this server."); } elsif ($error eq 413) { http_error_header("413 Payload Too Large"); nvt_print("Your HTTP header is too large."); } elsif ($error eq 416) { http_error_header("416 Requested Range Not Satisfiable"); } elsif ($error eq 503) { http_error_header("503 Service Unavailable"); # nvt_print("No Perl ipv6 support on this server."); } else { http_error_header("555 Unknown Error"); nvt_print("The requested URL $URL produced an internal error."); } nvt_print( "

", "

fexsrv at $hostname:$port

", "", ); exit; } sub disconnect { my $info = shift; my $error = shift; my $wait = shift||0; # &$header_hook($connect,$_,$ra) while ($header_hook and $_ = shift @header); fexlog($connect,@log,"DISCONNECT: $info"); debuglog("DISCONNECT: $info"); errorlog("$ENV{REQUEST_URI} ==> $error"); badlog("$ENV{REQUEST_URI} ==> $error ($info)"); sleep $wait; nvt_print("HTTP/1.0 $error"); exit; } sub http_error_header { my $error = shift; my $uri = $ENV{REQUEST_URI}; errorlog("$uri ==> $error") if $uri; nvt_print( "HTTP/1.1 $error", "Connection: close", "Content-Type: text/html; charset=iso-8859-1", "", '', "", "$error", "", "

$error

", ); } sub redirect { my $uri = shift; my $r = shift; my $rr = $redirect{$r}; my $newurl; $uri =~ s/\Q$r//; if ($rr =~ s/^!//) { $newurl = $rr.$uri; nvt_print( "HTTP/1.1 301 Moved Permanently", "Location: $newurl", "Content-Length: 0", "" ); } else { if ($rr =~ /^http/) { $newurl = $rr.$uri; } else { $newurl = "$ENV{PROTO}://$ENV{HTTP_HOST}$rr$uri"; } http_header("200 OK"); print html_header("$hostname page has moved"); pq(qq( '

Please use new URL: $newurl

' '' )); } fexlog($connect,@log,"REDIRECT $newurl"); if ($rr =~ /^http/) { exit; } else { &reexec; } } sub badlog { my $request = shift; my @n; my $ed = "$spooldir/.error"; local $_; if (@ignore_error) { foreach (@ignore_error) { return if $request =~ /$_/; } } if ($ra and $max_error and $max_error_handler) { mkdir($ed) unless -d $ed; if (open $ra,"+>>$ed/$ra") { flock($ra,LOCK_EX); seek $ra,0,SEEK_SET; @n = <$ra>; printf {$ra} "%s %s\n",isodate(time),$request; close $ra; &$max_error_handler($ra,@n) if scalar(@n) > $max_error; } } } __END__ M("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("`@("PM)R(G+5P*("`@ M("`@("`@("`@("`@("`@("`@("`@("]@8&`M+B`@(&!<("`@("Q=+B`@("`@ M("`@("`@("`@("`@("`@("`L+BY?"B`@("`@("`@("`@("`@("`@("`@("`@ M+&`@("`@(&`B+B`@72X@("`@(&`N("`@("`@("`@("`@("`@7U]?+BY>(&!? M)V`B(B(*("`@("`@("`@("`@("`@("`@("`@("`I("`@("`@("`G+"TG+2T@ M+B`@("!@+B`@("`@(%]?7RPN+2<@("XN("T@("`G("TP("Y?"B`@("`@("`@ M("`@+"X@("`@("`@("`@?%]?+"Y?("!?("`N+5\@("!<("`\("Y@(B