]> git.treefish.org Git - fex.git/blobdiff - bin/fexsrv
projects / fex.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Original release 20160328
[fex.git] / bin / fexsrv
diff --git a/bin/fexsrv b/bin/fexsrv
index 27e331864289d4d0674044a17fd996b54a2d5b8a..8bef7fc65fb91fa7dd7018f7f97a7fec586127f7 100755 (executable)
--- 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
 #
 
 # fexsrv : web server for F*EX service
 #
@@ -9,9 +9,50 @@ use 5.008;
 use Socket;
 use IO::Handle;
 use Fcntl qw':flock :seek';
 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 = "<h3>send this error to <a href=\"$mailto\">$admin</a></h3>";
+      }
+      $_ = join("\n",@_);
+      chomp;
+      s/&/&amp;/g;
+      s/</&lt;/g;
+      $_ = join("\n",
+        "<html><body>",
+        "<h1>INTERNAL ERROR in $0</h1>",
+        "<pre>\n$_\n</pre>\n<p>",
+        "$url\n<p>",
+        "$time\n<p>",
+        "$info\n<p>",
+        "</body></html>"
+      );
+      $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";
 
 # use BSD::Resource;
 # setrlimit(RLIMIT_CPU,999,999) or die "$0: $!\n";
@@ -22,13 +63,13 @@ 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 {
   $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:) {
 
 # fexsrv MUST be run with full path!
 if ($0 =~ m:^(/.+)/bin/fexsrv:) {
@@ -50,25 +91,26 @@ foreach my $lib (
 
 # import from fex.pp
 our ($hostname,$debug,$timeout,$max_error,$max_error_handler);
 
 # 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,$akeydir,$lockdir);
+our ($force_https,$default_locale,$bs,$MB,$adlm);
 our (@locales);
 
 # load common code (local config: $FEXHOME/lib/fex.ph)
 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");
 
 
 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
 our @log;
 
 $0 = untaint($0);
 our $error = 'F*EX ERROR';
 our $htmlsource;
 our $hid = ''; # header ID
 our @log;
 
 $0 = untaint($0);
-  
-$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
+
+$ENV{GATEWAY_INTERFACE} = 'CGI/1.1f';
 $ENV{SERVER_NAME} = $hostname;
 $ENV{SERVER_NAME} = $hostname;
+$ENV{REQUEST_METHOD} = '';
 $ENV{QUERY_STRING} = '';
 $ENV{HTTP_COOKIE} = '';
 $ENV{PATH_INFO} = '';
 $ENV{QUERY_STRING} = '';
 $ENV{HTTP_COOKIE} = '';
 $ENV{PATH_INFO} = '';
@@ -92,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';
@@ -114,12 +156,12 @@ 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 {
     $ENV{PROTO} = 'http';
 
   # 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);
     if (sockaddr_family($sa) == AF_INET) {
       ($ENV{REMOTE_PORT},$iaddr) = sockaddr_in($sa);
       $ENV{REMOTE_ADDR} = $ra = inet_ntoa($iaddr);
@@ -129,20 +171,21 @@ else {
       $^W = 0; eval 'use Socket6'; $^W = 1;
       http_error(503) if $@;
       ($ENV{REMOTE_PORT},$iaddr) = unpack_sockaddr_in6($sa);
       $^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 {
       $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;
   }
 
   $ENV{REMOTE_HOST} = $rh || '';
 
     }
     $port = 80 unless $port;
   }
 
   $ENV{REMOTE_HOST} = $rh || '';
 
-  $ENV{HTTP_HOST} = ($port == 80 or $port == 443) 
+  $ENV{HTTP_HOST} = ($port == 80 or $port == 443)
                   ? $hostname : "$hostname:$port";
 
                   ? $hostname : "$hostname:$port";
 
+  $ENV{PORT} = $port;
 }
 
 if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) {
 }
 
 if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) {
@@ -170,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,
@@ -199,16 +242,21 @@ REQUEST: while (*STDIN) {
       $header{$1} = $2 if /(.+)\s*:\s*(.+)/;
       push @log,$_;
     }
       $header{$1} = $2 if /(.+)\s*:\s*(.+)/;
       push @log,$_;
     }
-    
-    if (/^(GET \/|X-Forwarded-For|User-Agent)/i) {
+    if ($hl > $MB) {
+      fexlog($connect,@log,"OVERRUN");
+      http_error(413);
+    }
+
+    if (/^(GET \/|\S*Forwarded|\S*Client-IP|\S*Coming-From|User-Agent)/i) {
       $hid .= $_."\n";
     }
 
     # reverse-proxy?
       $hid .= $_."\n";
     }
 
     # reverse-proxy?
+    # (only IPv4 support!)
     if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra and
     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 }
       $ENV{REMOTE_HOST} = $rh = gethostbyaddr(inet_aton($ra),AF_INET) || '';
       $ENV{HTTP_HOST} = $hostname;
       if ($ENV{PROTO} eq 'https') { $port = 443 }
@@ -218,11 +266,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 = '';
@@ -234,7 +282,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;
@@ -265,7 +313,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",
     fexlog($connect,@log);
     nvt_print(
       "HTTP/1.1 201 OK",
@@ -306,6 +354,7 @@ REQUEST: while (*STDIN) {
   }
 
   if ($request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) {
   }
 
   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;
     $ENV{REQUEST_METHOD} = uc($1);
     $ENV{REQUEST_URI}    = $uri = $cgi = $2;
     $ENV{HTTP_VERSION}   = $protocol = $3;
@@ -320,7 +369,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;
 
@@ -335,11 +384,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);
     }
@@ -412,7 +461,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;
@@ -444,20 +493,38 @@ 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 {
     $ENV{LOCALE} = $locale = $default_locale;
   }
 
       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'});
 
   if ($debug) {
     debuglog("ENV:\n");
     foreach $var (sort keys %ENV) {
   # check for name based virtual host
   $vhost = vhost($ENV{'HTTP_HOST'});
 
   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");
   }
     }
     debuglog("\n");
   }
@@ -470,15 +537,23 @@ REQUEST: while (*STDIN) {
       $locale = $default_locale;
     }
   }
       $locale = $default_locale;
     }
   }
-              
+
   # prepare document file name
   if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) {
   # 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/\?.*//;
     $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";
       $doc = "$docdir/locale/$locale/$doc";
     } else {
       $doc = "$docdir/$doc";
@@ -514,7 +589,7 @@ REQUEST: while (*STDIN) {
         fexlog($connect,@log,"FORBIDDEN");
         http_error(403);
       }
         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 };
       # push @log,"DEBUG: locale=$locale locales=(@locales)";
       fexlog($connect,@log,"EXEC $cgi");
       eval { local $^W = 0; exec $cgi };
@@ -564,17 +639,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)
       {
           or $doc =~ /(.+)\.(tar|tgz|zip)$/ and lstat("$1.stream")
           or $doc =~ /(.+)\.tgz$/           and -f "$1.tar"
           or $doc =~ /(.+)\.gz$/            and -f $1)
       {
-        unlink "$logdir/.error/$ra";
-        delete $ENV{SCRIPT_FILENAME};        
+        unlink "$spooldir/.error/$ra";
+        delete $ENV{SCRIPT_FILENAME};
         $ENV{DOCUMENT_FILENAME} = $doc;
         require "$FEXLIB/dop";
         fexlog($connect,@log);
         $ENV{DOCUMENT_FILENAME} = $doc;
         require "$FEXLIB/dop";
         fexlog($connect,@log);
@@ -612,7 +687,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);
@@ -628,6 +703,7 @@ REQUEST: while (*STDIN) {
 # read one text line unbuffered from STDIN
 sub getaline {
   my $line = '';
 # read one text line unbuffered from STDIN
 sub getaline {
   my $line = '';
+  my $n = 0;
   my $c;
 
   alarm($timeout);
   my $c;
 
   alarm($timeout);
@@ -636,7 +712,12 @@ sub getaline {
   # (later exec would destroy line buffer)
   while (sysread STDIN,$c,1) {
     $line .= $c;
   # (later exec would destroy line buffer)
   while (sysread STDIN,$c,1) {
     $line .= $c;
+    $n++;
     last if $c eq "\n";
     last if $c eq "\n";
+    if ($n > $bs) {
+      fexlog($connect,@log,$line,"OVERRUN");
+      http_error(413);
+    }
   }
 
   alarm(0);
   }
 
   alarm(0);
@@ -647,21 +728,23 @@ sub getaline {
 
 sub fexlog {
   my @log = @_;
 
 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;
 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);
@@ -672,7 +755,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;
@@ -711,6 +794,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 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) {
   } elsif ($error eq 416) {
     http_error_header("416 Requested Range Not Satisfiable");
   } elsif ($error eq 503) {
@@ -733,7 +819,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");
@@ -749,7 +835,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",
@@ -765,18 +851,57 @@ 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(
+      '<h3>Please use new URL: <a href="$newurl">$newurl</a></h3>'
+      '</body></html>'
+    ));
+  }
+  fexlog($connect,@log,"REDIRECT $newurl");
+  if ($rr =~ /^http/) {
+    exit;
+  } else {
+    &reexec;
+  }
+}
+
+
 sub badlog {
   my $request = shift;
   my @n;
   my $ed = "$spooldir/.error";
   local $_;
 sub badlog {
   my $request = shift;
   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;
 
Unofficial F*EX git repository tracking official releases.