X-Git-Url: http://git.treefish.org/fex.git/blobdiff_plain/e60096926213ce02293a261254ff065cae44c1c8..20150826:/bin/fexsrv diff --git a/bin/fexsrv b/bin/fexsrv index 11911ff..6a3e80e 100755 --- a/bin/fexsrv +++ b/bin/fexsrv @@ -11,7 +11,7 @@ use IO::Handle; use Fcntl qw':flock :seek'; use warnings; -BEGIN { +BEGIN { # stunnel workaround $SIG{CHLD} = "DEFAULT"; $ENV{PERLINIT} = q{ @@ -63,7 +63,7 @@ if (@ARGV and $ARGV[0] eq 'stunnel' and $ENV{REMOTE_HOST} =~ /(.+)/) { } # KEEP_ALIVE <== callback from CGI -if ($ENV{KEEP_ALIVE}) { +if ($ENV{KEEP_ALIVE}) { $keep_alive = $ENV{KEEP_ALIVE}; } else { %ENV = ( PERLINIT => $ENV{PERLINIT} ); # clean environment @@ -107,7 +107,7 @@ our $hid = ''; # header ID our @log; $0 = untaint($0); - + $ENV{GATEWAY_INTERFACE} = 'CGI/1.1f'; $ENV{SERVER_NAME} = $hostname; $ENV{REQUEST_METHOD} = ''; @@ -134,12 +134,12 @@ if ($keep_alive) { } $ra = $ENV{REMOTE_ADDR}; $rh = $ENV{REMOTE_HOST}; -} +} # new session else { my $iaddr; - + # HTTPS connect if ($ssl_ra) { $ENV{PROTO} = 'https'; @@ -156,7 +156,7 @@ else { $rh ||= '-'; $port = 443; # print {$log} "X-SSL-Remote-Host: $ssl_ra\n"; - } + } # HTTP connect else { @@ -182,7 +182,7 @@ else { $ENV{REMOTE_HOST} = $rh || ''; - $ENV{HTTP_HOST} = ($port == 80 or $port == 443) + $ENV{HTTP_HOST} = ($port == 80 or $port == 443) ? $hostname : "$hostname:$port"; $ENV{PORT} = $port; @@ -213,7 +213,7 @@ 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, @@ -246,7 +246,7 @@ REQUEST: while (*STDIN) { fexlog($connect,@log,"OVERRUN"); http_error(413); } - + if (/^(GET \/|X-Forwarded-For|User-Agent)/i) { $hid .= $_."\n"; } @@ -265,11 +265,11 @@ REQUEST: while (*STDIN) { 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 = ''; @@ -281,7 +281,7 @@ REQUEST: while (*STDIN) { badlog("no HTTP request: $request"); exit; } - + if ($force_https and $port != 443 and $request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) { $request = $2; @@ -368,7 +368,7 @@ REQUEST: while (*STDIN) { } while ($_ = shift @header) { - + # header inquisition! &$header_hook($connect,$_,$ra) if $header_hook; @@ -383,11 +383,11 @@ REQUEST: while (*STDIN) { 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); } @@ -460,7 +460,7 @@ REQUEST: while (*STDIN) { &$header_hook($connect,$header,$ra) if $header_hook; exit unless $cgi; - + # extra download request? (request http://fexserver//xkey) if ($cgi =~ m{^//([^/]+)$}) { my $xkey = $1; @@ -492,7 +492,7 @@ REQUEST: while (*STDIN) { # get locale if (($ENV{QUERY_STRING} =~ /.*locale=([\w-]+)/ or - $ENV{HTTP_COOKIE} =~ /.*locale=([\w-]+)/) + $ENV{HTTP_COOKIE} =~ /.*locale=([\w-]+)/) and -d "$FEXHOME/locale/$1") { $ENV{LOCALE} = $locale = $1; } else { @@ -520,7 +520,7 @@ REQUEST: while (*STDIN) { $locale = $default_locale; } } - + # prepare document file name if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) { if (%redirect) { @@ -622,17 +622,17 @@ REQUEST: while (*STDIN) { 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 '!') + if ($doc =~ s/(\.html)!$/$1/ or + $doc =~ /\.html$/ and $ENV{'QUERY_STRING'} eq '!') { $htmlsource = $doc } else { $htmlsource = '' } - if (-f $doc + 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}; + delete $ENV{SCRIPT_FILENAME}; $ENV{DOCUMENT_FILENAME} = $doc; require "$FEXLIB/dop"; fexlog($connect,@log); @@ -670,7 +670,7 @@ REQUEST: while (*STDIN) { } # neither document nor CGI ==> error - + if ($status) { fexlog($connect,@log,"FAILED to exec $cgi : $status"); http_error(666); @@ -711,7 +711,7 @@ sub getaline { sub fexlog { my @log = @_; - + foreach my $logdir (@logdir) { if (open $log,'>>',"$logdir/$log") { flock $log,LOCK_EX; @@ -727,7 +727,7 @@ sub fexlog { sub badchar { my $bc = shift; - + fexlog($connect,@log,"DISCONNECT: bad characters in URL"); debuglog("DISCONNECT: bad characters in URL $uri"); badlog($request); @@ -738,7 +738,7 @@ sub badchar { sub bintar { my $tmpdir = "$FEXHOME/tmp"; my $fs = "$ENV{PROTO}://$ENV{HTTP_HOST}"; - + if (chdir "$FEXHOME/bin") { fexlog($connect,@log); chdir $fstb if $fstb; @@ -802,7 +802,7 @@ 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"); @@ -818,7 +818,7 @@ sub disconnect { sub http_error_header { my $error = shift; my $uri = $ENV{REQUEST_URI}; - + errorlog("$uri ==> $error") if $uri; nvt_print( "HTTP/1.1 $error", @@ -839,24 +839,24 @@ sub redirect { 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", - "" - ); + 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( @@ -877,13 +877,13 @@ sub badlog { 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;