X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/e60096926213ce02293a261254ff065cae44c1c8..refs/heads/master:/bin/fexsrv?ds=sidebyside

diff --git a/bin/fexsrv b/bin/fexsrv
index 11911ff..2843167 100755
--- a/bin/fexsrv
+++ b/bin/fexsrv
@@ -11,10 +11,11 @@ use IO::Handle;
 use Fcntl qw':flock :seek';
 use warnings;
 
-BEGIN { 
+BEGIN {
   # stunnel workaround
   $SIG{CHLD} = "DEFAULT";
   $ENV{PERLINIT} = q{
+    $ENV{LC_ALL} = 'en_US.UTF-8';
     unshift @INC,(getpwuid($<))[7].'/perl';
     # web error handler
     $SIG{__DIE__} = $SIG{__WARN__} = sub {
@@ -63,7 +64,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
@@ -91,8 +92,8 @@ 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,$MB,$adlm);
+our ($spooldir,@logdir,$docdir,$xkeydir,$akeydir,$lockdir);
+our ($force_https,$default_locale,$bs,$MB,$adlm,@forbidden_user_agents);
 our (@locales);
 
 # load common code (local config: $FEXHOME/lib/fex.ph)
@@ -107,7 +108,7 @@ our $hid = ''; # header ID
 our @log;
 
 $0 = untaint($0);
-  
+
 $ENV{GATEWAY_INTERFACE} = 'CGI/1.1f';
 $ENV{SERVER_NAME} = $hostname;
 $ENV{REQUEST_METHOD} = '';
@@ -134,17 +135,17 @@ if ($keep_alive) {
   }
   $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/) {
+    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 $@;
@@ -156,7 +157,7 @@ else {
     $rh ||= '-';
     $port = 443;
     # print {$log} "X-SSL-Remote-Host: $ssl_ra\n";
-  } 
+  }
 
   # HTTP connect
   else {
@@ -182,7 +183,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 +214,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,16 +247,17 @@ REQUEST: while (*STDIN) {
       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 }
@@ -265,11 +267,11 @@ REQUEST: while (*STDIN) {
 
   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 = '';
@@ -281,7 +283,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;
@@ -312,7 +314,7 @@ REQUEST: while (*STDIN) {
     }
   }
 
-  if ($request =~ /^OPTIONS FEX HTTP\/[\d\.]+$/i) {
+  if ($request =~ /^OPTIONS \/?FEX HTTP\/[\d\.]+$/i) {
     fexlog($connect,@log);
     nvt_print(
       "HTTP/1.1 201 OK",
@@ -367,8 +369,10 @@ REQUEST: while (*STDIN) {
     if ($uri =~ /\\|%5c/i) { badchar("\\") }
   }
 
+  my $fua = join('|',@forbidden_user_agents);
+
   while ($_ = shift @header) {
-    
+
     # header inquisition!
     &$header_hook($connect,$_,$ra) if $header_hook;
 
@@ -380,14 +384,10 @@ REQUEST: while (*STDIN) {
       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 ($fua and /^User-Agent: ($fua)/) {
+      disconnect($1,"499 User Agent $1 Not Supported",30);
     }
-    
+
     if (/^Range:.*,/) {
       disconnect("Range a,b","416 Requested Range Not Satisfiable",30);
     }
@@ -435,7 +435,7 @@ REQUEST: while (*STDIN) {
     }
 
     # HTTP header ==> environment variables
-    if (/^([\w\-]+):\s*(.+)/s) {
+    if (/^([\w\-_]+):\s*(.+)/s) {
       $http_var = $1;
       $http_val = $2;
       $http_var =~ s/-/_/g;
@@ -447,7 +447,10 @@ REQUEST: while (*STDIN) {
       } else {
         $http_val =~ s/\s+/ /g;
         if ($http_var =~ /^HTTP_(HOST|VERSION)$/) {
-          $http_var = 'X-'.$http_var;
+          $http_var = 'HTTP_X_'.$1;
+        } elsif ($http_var =~ /^PROXY/) {
+          # http://cert.at/warnings/all/20160718.html
+          $http_var = 'HTTP_X_'.$http_var;
         } elsif ($http_var !~ /^CONTENT_/) {
           $http_var = 'HTTP_'.$http_var;
         }
@@ -460,7 +463,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,13 +495,29 @@ 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 {
     $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'});
 
@@ -520,7 +539,7 @@ REQUEST: while (*STDIN) {
       $locale = $default_locale;
     }
   }
-              
+
   # prepare document file name
   if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) {
     if (%redirect) {
@@ -622,17 +641,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 +689,7 @@ REQUEST: while (*STDIN) {
   }
 
   # neither document nor CGI ==> error
-  
+
   if ($status) {
     fexlog($connect,@log,"FAILED to exec $cgi : $status");
     http_error(666);
@@ -711,7 +730,7 @@ sub getaline {
 
 sub fexlog {
   my @log = @_;
-  
+
   foreach my $logdir (@logdir) {
     if (open $log,'>>',"$logdir/$log") {
       flock $log,LOCK_EX;
@@ -727,7 +746,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 +757,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 +821,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 +837,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 +858,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(
@@ -864,6 +883,7 @@ sub redirect {
       '</body></html>'
     ));
   }
+  fexlog($connect,@log,"REDIRECT $newurl");
   if ($rr =~ /^http/) {
     exit;
   } else {
@@ -877,13 +897,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;