-#!/usr/bin/perl -wT
+#!/usr/bin/perl -T
# fexsrv : web server for F*EX service
#
use Socket;
use IO::Handle;
use Fcntl qw':flock :seek';
-
-# stunnel workaround
-BEGIN { $SIG{CHLD} = "DEFAULT" }
+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 = "<h3>send this error to <a href=\"$mailto\">$admin</a></h3>";
+ }
+ $_ = join("\n",@_);
+ chomp;
+ s/&/&/g;
+ s/</</g;
+ $_ = join("\n",
+ "<html><body>",
+ "<h1>INTERNAL ERROR in $0</h1>",
+ "<pre>\n$_\n</pre>\n<p>",
+ "$url\n<p>",
+ "$time\n<p>",
+ "$info\n<p>",
+ "</body></html>"
+ );
+ $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";
if ($ENV{KEEP_ALIVE}) {
$keep_alive = $ENV{KEEP_ALIVE};
} else {
- %ENV = (); # clean environment
+ %ENV = ( PERLINIT => $ENV{PERLINIT} ); # clean environment
}
-$ENV{HOME} = (getpwuid($<))[7] or die "$0: no HOME\n";
+$ENV{HOME} = (getpwuid($<))[7] or die "no HOME";
# fexsrv MUST be run with full path!
if ($0 =~ m:^(/.+)/bin/fexsrv:) {
# import from fex.pp
our ($hostname,$debug,$timeout,$max_error,$max_error_handler);
-our ($spooldir,$logdir,$docdir,$xkeydir,$lockdir);
-our ($force_https,$default_locale,$bs,$adlm);
+our ($spooldir,@logdir,$docdir,$xkeydir,$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 "$0: cannot load $FEXLIB/fex.pp - $!\n";
+require "$FEXLIB/fex.pp" or die "cannot load $FEXLIB/fex.pp - $!\n";
chdir $spooldir or http_die("$0: $spooldir - $!\n");
-our $log = "$logdir/fexsrv.log";
+our $log = 'fexsrv.log';
our $error = 'F*EX ERROR';
our $htmlsource;
our $hid = ''; # header ID
$0 = untaint($0);
-$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
+$ENV{GATEWAY_INTERFACE} = 'CGI/1.1f';
$ENV{SERVER_NAME} = $hostname;
+$ENV{REQUEST_METHOD} = '';
$ENV{QUERY_STRING} = '';
$ENV{HTTP_COOKIE} = '';
$ENV{PATH_INFO} = '';
# HTTP connect
else {
$ENV{PROTO} = 'http';
- my $sa = getpeername(STDIN) or die "$0: no network stream on STDIN\n";
+ 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);
$^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);
+ $ENV{REMOTE_ADDR} = $ra = inet_ntop(AF_INET6,$iaddr);
$rh = gethostbyaddr($iaddr,AF_INET6);
($port) = unpack_sockaddr_in6(getsockname(STDIN));
} else {
- die "$0: unknown IP version\n";
+ die "unknown IP version\n";
}
$port = 80 unless $port;
}
$ENV{HTTP_HOST} = ($port == 80 or $port == 443)
? $hostname : "$hostname:$port";
+ $ENV{PORT} = $port;
}
if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) {
$header{$1} = $2 if /(.+)\s*:\s*(.+)/;
push @log,$_;
}
+ if ($hl > $MB) {
+ fexlog($connect,@log,"OVERRUN");
+ http_error(413);
+ }
if (/^(GET \/|X-Forwarded-For|User-Agent)/i) {
$hid .= $_."\n";
}
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;
if ($debug) {
debuglog("ENV:\n");
foreach $var (sort keys %ENV) {
- debuglog(sprintf " %s = >%s<\n",$var,$ENV{$var});
+ if (defined($ENV{$var})) {
+ debuglog(sprintf " %s = >%s<\n",$var,$ENV{$var});
+ }
}
debuglog("\n");
}
# 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 -e "$docdir/locale/$locale/$doc") {
+ if ($locale and $locale ne 'english' and -e "$docdir/locale/$locale/$doc") {
$doc = "$docdir/locale/$locale/$doc";
} else {
$doc = "$docdir/$doc";
fexlog($connect,@log,"FORBIDDEN");
http_error(403);
}
- unlink "$logdir/.error/$ra";
+ unlink "$spooldir/.error/$ra";
# push @log,"DEBUG: locale=$locale locales=(@locales)";
fexlog($connect,@log,"EXEC $cgi");
eval { local $^W = 0; exec $cgi };
or $doc =~ /(.+)\.tgz$/ and -f "$1.tar"
or $doc =~ /(.+)\.gz$/ and -f $1)
{
- unlink "$logdir/.error/$ra";
+ unlink "$spooldir/.error/$ra";
delete $ENV{SCRIPT_FILENAME};
$ENV{DOCUMENT_FILENAME} = $doc;
require "$FEXLIB/dop";
# read one text line unbuffered from STDIN
sub getaline {
my $line = '';
+ my $n = 0;
my $c;
alarm($timeout);
# (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);
sub fexlog {
my @log = @_;
- if (open $log,">>$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 $log - $!\n");
+
+ 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;
} 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) {
}
+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(
+ '<h3>Please use new URL: <a href="$newurl">$newurl</a></h3>'
+ '</body></html>'
+ ));
+ }
+ if ($rr =~ /^http/) {
+ exit;
+ } else {
+ &reexec;
+ }
+}
+
+
sub badlog {
my $request = shift;
my @n;
projects / fex.git / blobdiff