Original release 20150826

[fex.git] / bin / fexsrv

diff --git a/bin/fexsrv b/bin/fexsrv
index 11911ffcb893fabbe2f293daa3de26601e272735..6a3e80e73641aa0c91eaf2e2d66bd127177fb6f6 100755 (executable)
--- a/bin/fexsrv
+++ b/bin/fexsrv
@@ -11,7 +11,7 @@ use IO::Handle;
 use Fcntl qw':flock :seek';
 use warnings;
 
 use Fcntl qw':flock :seek';
 use warnings;
 

-BEGIN { 
+BEGIN {

   # stunnel workaround
   $SIG{CHLD} = "DEFAULT";
   $ENV{PERLINIT} = q{
   # 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
 }
 
 # 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
   $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);
 our @log;
 
 $0 = untaint($0);

-  
+

 $ENV{GATEWAY_INTERFACE} = 'CGI/1.1f';
 $ENV{SERVER_NAME} = $hostname;
 $ENV{REQUEST_METHOD} = '';
 $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};
   }
   $ra = $ENV{REMOTE_ADDR};
   $rh = $ENV{REMOTE_HOST};

-} 
+}

 
 # new session
 else {
   my $iaddr;
 
 # new session
 else {
   my $iaddr;

-  
+

   # HTTPS connect
   if ($ssl_ra) {
     $ENV{PROTO} = 'https';
   # 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";
     $rh ||= '-';
     $port = 443;
     # print {$log} "X-SSL-Remote-Host: $ssl_ra\n";

-  } 
+  }

 
   # HTTP connect
   else {
 
   # HTTP connect
   else {


@@ -182,7 +182,7 @@ else {
 
   $ENV{REMOTE_HOST} = $rh || '';
 
 
   $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;
                   ? $hostname : "$hostname:$port";
 
   $ENV{PORT} = $port;


@@ -213,7 +213,7 @@ REQUEST: while (*STDIN) {
 
   if (defined $ENV{REQUESTCOUNT}) { $ENV{REQUESTCOUNT}++ }
   else                            { $ENV{REQUESTCOUNT} = 0 }
 
   if (defined $ENV{REQUESTCOUNT}) { $ENV{REQUESTCOUNT}++ }
   else                            { $ENV{REQUESTCOUNT} = 0 }

-  
+

   $connect = sprintf "%s:%s %s %s %s [%s_%s]",
                      $keep_alive ? 'CONTINUE' : 'CONNECT',
                      $port,
   $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);
     }
       fexlog($connect,@log,"OVERRUN");
       http_error(413);
     }

-    
+

     if (/^(GET \/|X-Forwarded-For|User-Agent)/i) {
       $hid .= $_."\n";
     }
     if (/^(GET \/|X-Forwarded-For|User-Agent)/i) {
       $hid .= $_."\n";
     }


@@ -265,11 +265,11 @@ REQUEST: while (*STDIN) {
 
   exit unless @header;
   exit if $header =~ /^\s*$/;
 
   exit unless @header;
   exit if $header =~ /^\s*$/;

-  
+

   $ENV{HTTP_HEADER} = $header;
   debuglog($header);
   # http_die("<pre>$header</pre>");
   $ENV{HTTP_HEADER} = $header;
   debuglog($header);
   # http_die("<pre>$header</pre>");

-  
+

   $ENV{'HTTP_HEADER_LENGTH'} = $hl;
   $ENV{REQUEST_URI} = $uri = '';
   $cgi = '';
   $ENV{'HTTP_HEADER_LENGTH'} = $hl;
   $ENV{REQUEST_URI} = $uri = '';
   $cgi = '';


@@ -281,7 +281,7 @@ REQUEST: while (*STDIN) {
     badlog("no HTTP request: $request");
     exit;
   }
     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 ($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) {
   }
 
   while ($_ = shift @header) {

-    
+

     # header inquisition!
     &$header_hook($connect,$_,$ra) if $header_hook;
 
     # 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 ($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 (/^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);
     }
     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;
   &$header_hook($connect,$header,$ra) if $header_hook;
 
   exit unless $cgi;

-  
+

   # extra download request? (request http://fexserver//xkey)
   if ($cgi =~ m{^//([^/]+)$}) {
     my $xkey = $1;
   # 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
 
   # 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 {
       and -d "$FEXHOME/locale/$1") {
     $ENV{LOCALE} = $locale = $1;
   } else {


@@ -520,7 +520,7 @@ REQUEST: while (*STDIN) {
       $locale = $default_locale;
     }
   }
       $locale = $default_locale;
     }
   }

-              
+

   # prepare document file name
   if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) {
     if (%redirect) {
   # 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?!"
         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 = '' }
 
       { $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";
           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);
         $ENV{DOCUMENT_FILENAME} = $doc;
         require "$FEXLIB/dop";
         fexlog($connect,@log);


@@ -670,7 +670,7 @@ REQUEST: while (*STDIN) {
   }
 
   # neither document nor CGI ==> error
   }
 
   # neither document nor CGI ==> error

-  
+

   if ($status) {
     fexlog($connect,@log,"FAILED to exec $cgi : $status");
     http_error(666);
   if ($status) {
     fexlog($connect,@log,"FAILED to exec $cgi : $status");
     http_error(666);


@@ -711,7 +711,7 @@ sub getaline {
 
 sub fexlog {
   my @log = @_;
 
 sub fexlog {
   my @log = @_;

-  
+

   foreach my $logdir (@logdir) {
     if (open $log,'>>',"$logdir/$log") {
       flock $log,LOCK_EX;
   foreach my $logdir (@logdir) {
     if (open $log,'>>',"$logdir/$log") {
       flock $log,LOCK_EX;


@@ -727,7 +727,7 @@ sub fexlog {
 
 sub badchar {
   my $bc = shift;
 
 sub badchar {
   my $bc = shift;

-  
+

   fexlog($connect,@log,"DISCONNECT: bad characters in URL");
   debuglog("DISCONNECT: bad characters in URL $uri");
   badlog($request);
   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}";
 sub bintar {
   my $tmpdir = "$FEXHOME/tmp";
   my $fs = "$ENV{PROTO}://$ENV{HTTP_HOST}";

-  
+

   if (chdir "$FEXHOME/bin") {
     fexlog($connect,@log);
     chdir $fstb if $fstb;
   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;
   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");
   # &$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};
 sub http_error_header {
   my $error = shift;
   my $uri = $ENV{REQUEST_URI};

-  
+

   errorlog("$uri ==> $error") if $uri;
   nvt_print(
     "HTTP/1.1 $error",
   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;
   my $r = shift;
   my $rr = $redirect{$r};
   my $newurl;

-  
+

   $uri =~ s/\Q$r//;
 
   if ($rr =~ s/^!//) {
     $newurl = $rr.$uri;
   $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";
     }
   } 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(
     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 $_;
   my @n;
   my $ed = "$spooldir/.error";
   local $_;

-  
+

   if (@ignore_error) {
     foreach (@ignore_error) {
       return if $request =~ /$_/;
     }
   }
   if (@ignore_error) {
     foreach (@ignore_error) {
       return if $request =~ /$_/;
     }
   }

-  
+

   if ($ra and $max_error and $max_error_handler) {
     mkdir($ed) unless -d $ed;
 
   if ($ra and $max_error and $max_error_handler) {
     mkdir($ed) unless -d $ed;