use Fcntl qw':flock :seek';
use warnings;
-BEGIN {
+BEGIN {
# stunnel workaround
$SIG{CHLD} = "DEFAULT";
$ENV{PERLINIT} = q{
}
# 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
# import from fex.pp
our ($hostname,$debug,$timeout,$max_error,$max_error_handler);
-our ($spooldir,@logdir,$docdir,$xkeydir,$lockdir);
+our ($spooldir,@logdir,$docdir,$xkeydir,$akeydir,$lockdir);
our ($force_https,$default_locale,$bs,$MB,$adlm);
our (@locales);
our @log;
$0 = untaint($0);
-
+
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1f';
$ENV{SERVER_NAME} = $hostname;
$ENV{REQUEST_METHOD} = '';
}
$ra = $ENV{REMOTE_ADDR};
$rh = $ENV{REMOTE_HOST};
-}
+}
# new session
else {
my $iaddr;
-
+
# HTTPS connect
if ($ssl_ra) {
$ENV{PROTO} = 'https';
$rh ||= '-';
$port = 443;
# print {$log} "X-SSL-Remote-Host: $ssl_ra\n";
- }
+ }
# HTTP connect
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;
if (defined $ENV{REQUESTCOUNT}) { $ENV{REQUESTCOUNT}++ }
else { $ENV{REQUESTCOUNT} = 0 }
-
+
$connect = sprintf "%s:%s %s %s %s [%s_%s]",
$keep_alive ? 'CONTINUE' : 'CONNECT',
$port,
fexlog($connect,@log,"OVERRUN");
http_error(413);
}
-
- if (/^(GET \/|X-Forwarded-For|User-Agent)/i) {
+
+ 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
- /^X-Forwarded-For: ([\d.]+)/
+ /^\S*(Forwarded|Client-IP|Coming-From)\S*: ([\da-f:.]+)/i
) {
- $ENV{REMOTE_ADDR} = $ra = $1;
+ $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 }
exit unless @header;
exit if $header =~ /^\s*$/;
-
+
$ENV{HTTP_HEADER} = $header;
debuglog($header);
# http_die("<pre>$header</pre>");
-
+
$ENV{'HTTP_HEADER_LENGTH'} = $hl;
$ENV{REQUEST_URI} = $uri = '';
$cgi = '';
badlog("no HTTP request: $request");
exit;
}
-
+
if ($force_https and $port != 443
and $request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) {
$request = $2;
}
}
- if ($request =~ /^OPTIONS FEX HTTP\/[\d\.]+$/i) {
+ if ($request =~ /^OPTIONS \/?FEX HTTP\/[\d\.]+$/i) {
fexlog($connect,@log);
nvt_print(
"HTTP/1.1 201 OK",
}
while ($_ = shift @header) {
-
+
# header inquisition!
&$header_hook($connect,$_,$ra) if $header_hook;
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);
}
&$header_hook($connect,$header,$ra) if $header_hook;
exit unless $cgi;
-
+
# extra download request? (request http://fexserver//xkey)
if ($cgi =~ m{^//([^/]+)$}) {
my $xkey = $1;
# 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 {
$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'});
$locale = $default_locale;
}
}
-
+
# prepare document file name
if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) {
if (%redirect) {
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);
}
# neither document nor CGI ==> error
-
+
if ($status) {
fexlog($connect,@log,"FAILED to exec $cgi : $status");
http_error(666);
sub fexlog {
my @log = @_;
-
+
foreach my $logdir (@logdir) {
if (open $log,'>>',"$logdir/$log") {
flock $log,LOCK_EX;
sub badchar {
my $bc = shift;
-
+
fexlog($connect,@log,"DISCONNECT: bad characters in URL");
debuglog("DISCONNECT: bad characters in URL $uri");
badlog($request);
sub bintar {
my $tmpdir = "$FEXHOME/tmp";
my $fs = "$ENV{PROTO}://$ENV{HTTP_HOST}";
-
+
if (chdir "$FEXHOME/bin") {
fexlog($connect,@log);
chdir $fstb if $fstb;
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");
sub http_error_header {
my $error = shift;
my $uri = $ENV{REQUEST_URI};
-
+
errorlog("$uri ==> $error") if $uri;
nvt_print(
"HTTP/1.1 $error",
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(
'</body></html>'
));
}
+ fexlog($connect,@log,"REDIRECT $newurl");
if ($rr =~ /^http/) {
exit;
} else {
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;
projects / fex.git / blobdiff