X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..e60096926213ce02293a261254ff065cae44c1c8:/bin/fexsrv?ds=inline diff --git a/bin/fexsrv b/bin/fexsrv index 27e3318..11911ff 100755 --- a/bin/fexsrv +++ b/bin/fexsrv @@ -1,4 +1,4 @@ -#!/usr/bin/perl -wT +#!/usr/bin/perl -T # fexsrv : web server for F*EX service # @@ -9,9 +9,50 @@ use 5.008; 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 = "

send this error to $admin

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

INTERNAL ERROR in $0

", + "
\n$_\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"; @@ -25,10 +66,10 @@ if (@ARGV and $ARGV[0] eq 'stunnel' and $ENV{REMOTE_HOST} =~ /(.+)/) { 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:) { @@ -50,16 +91,16 @@ foreach my $lib ( # 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 @@ -67,8 +108,9 @@ our @log; $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} = ''; @@ -119,7 +161,7 @@ else { # 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); @@ -129,11 +171,11 @@ else { $^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; } @@ -143,6 +185,7 @@ else { $ENV{HTTP_HOST} = ($port == 80 or $port == 443) ? $hostname : "$hostname:$port"; + $ENV{PORT} = $port; } if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) { @@ -199,6 +242,10 @@ REQUEST: while (*STDIN) { $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"; @@ -306,6 +353,7 @@ REQUEST: while (*STDIN) { } 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; @@ -457,7 +505,9 @@ REQUEST: while (*STDIN) { 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"); } @@ -473,12 +523,20 @@ REQUEST: while (*STDIN) { # 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"; @@ -514,7 +572,7 @@ REQUEST: while (*STDIN) { 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 }; @@ -573,7 +631,7 @@ REQUEST: while (*STDIN) { 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"; @@ -628,6 +686,7 @@ REQUEST: while (*STDIN) { # read one text line unbuffered from STDIN sub getaline { my $line = ''; + my $n = 0; my $c; alarm($timeout); @@ -636,7 +695,12 @@ sub getaline { # (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); @@ -647,18 +711,20 @@ sub getaline { 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; @@ -711,6 +777,9 @@ sub http_error { } 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) { @@ -765,6 +834,44 @@ sub http_error_header { } +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

' + '' + )); + } + if ($rr =~ /^http/) { + exit; + } else { + &reexec; + } +} + + sub badlog { my $request = shift; my @n;