X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..refs/heads/master:/lib/dop diff --git a/lib/dop b/lib/dop index df9511b..4a6ece0 100755 --- a/lib/dop +++ b/lib/dop @@ -8,15 +8,16 @@ # use File::Basename; -use CGI::Carp qw(fatalsToBrowser); use Fcntl qw(:flock :seek :mode); use POSIX qw(strftime locale_h); use Cwd qw(getcwd abs_path); +use utf8; +# use CGI::Carp qw(fatalsToBrowser); # import from fex.pp our ($bs,$tmpdir,@doc_dirs); -my $log = "$logdir/dop.log"; +my $log = 'dop.log'; # POSIX time format needed for HTTP header setlocale(LC_TIME,'POSIX'); @@ -27,31 +28,29 @@ sub dop { my $seek = 0; my $stop = 0; my ($link,$host,$path,$range); - + our $error = 'F*EX document output ERROR'; - + security_check($doc); - + # reget? if ($range = $ENV{HTTP_RANGE}) { $seek = $1 if $range =~ /^bytes=(\d+)-/i; $stop = $1 if $range =~ /^bytes=\d*-(\d+)/i; } - # redirect on relative symlinks without "../" - if ($link = readlink($doc) and + # redirect on relative symlinks without "../" + if ($link = readlink($doc) and $link !~ m:^/: and $link !~ m:\.\./: and $link !~ /^:.+:$/) { $path = $ENV{REQUEST_URI}; $path =~ s:[^/]*$::; $doc = "$path/$link"; $doc =~ s:/+:/:g; $doc =~ s:^/::; - $host = $ENV{HTTP_HOST} || $hostname; nvt_print( - "HTTP/1.1 301 Moved Permanently", - "Location: $ENV{PROTO}://$host/$doc", + "HTTP/1.1 302 Found", + "Location: /$doc", "Content-Length: 0", - "Connection: close", "" ); &reexec; @@ -99,10 +98,11 @@ sub http_output { } elsif ($file =~ /(.+)\.tgz$/ and -f "$1.tar") { @files = ("$1.tar"); open $file,'-|',qw'gzip -c',@files or http_error(503); - } elsif ($file =~ /(.+)\.(tar|tgz|zip)$/ and - @s = lstat($streamfile = "$1.stream") and $s[4] == $<) + } elsif ($file =~ /(.+)\.(tar|tgz|zip)$/ and + @s = lstat($streamfile = "$1.stream") and + ($s[4] == $< or $s[4] == 0)) { - # streaming file (only if it is owned by user fex) + # streaming file chdir dirname($file); security_check($file); if (-l $streamfile and readlink($streamfile) =~ /^:(.+):$/) { @@ -124,18 +124,24 @@ sub http_output { } close $streamfile; foreach (@files) { - if (/^\// or /\.\.\//) { + if (/^\// or /\.\.\//) { # absolute path or relative path with parent directory is not allowed + errorlog("$streamfile: $_ is not allowed for streaming"); + http_error(403); + } + unless (-e $_) { + errorlog("$streamfile: $_ does not exist"); http_error(403); } - if (@s = stat($_) and not($s[2] & S_IRGRP) or not -r $_) { + if (@s = stat($_) and not($s[2] & S_IRGRP) or not -r $_) { # file must be readable by user and group + errorlog("$streamfile: $_ is not readable by user and group"); http_error(403); } } http_error(416) if $ENV{HTTP_RANGE}; close STDERR; - if ($file =~ /\.tar$/) { @a = qw'tar --exclude *~ --exclude .* -cf -' } + if ($file =~ /\.tar$/) { @a = qw'tar --exclude *~ --exclude .* -cf -' } elsif ($file =~ /\.tgz$/) { @a = qw'tar --exclude *~ --exclude .* -czf -' } elsif ($file =~ /\.zip$/) { @a = qw'zip -x *~ */.*/* @ -rq -' } else { http_error(400) } @@ -143,9 +149,9 @@ sub http_output { } else { http_error(404); } - + $type = 'application/octet-stream'; - if ($file =~ /\.html$/) { $type = 'text/html' } + if ($file =~ /\.html$/) { $type = 'text/html' } # elsif ($file =~ /\.txt$/) { $type = 'text/plain' } elsif ($file =~ /\.css$/) { $type = 'text/css' } elsif ($file =~ /\.js$/) { $type = 'text/javascript' } @@ -181,8 +187,8 @@ sub http_output { } elsif ($ENV{'QUERY_STRING'} eq '!') { $type = 'text/plain'; } - - + + if ($type eq 'text/html') { $seek = $stop = 0; local $^W = 0; @@ -223,15 +229,33 @@ sub http_output { } $dynamic = $htmldoc =~ s/$mark/$include/; } - # evaluate <> - while ($htmldoc =~ /<<(.+?)>>/s) { - local $pc = $1; - local $__ = ''; - tie *STDOUT => "Buffer",\$__; - $__ .= eval $pc; - untie *STDOUT; - $dynamic = $htmldoc =~ s/<<(.+?)>>/$__/s; - }; + # evaluate <> or <<>> + { + local $timeout = ''; + local $SIG{ALRM} = sub { $timeout = '

TIMEOUT!

' }; + alarm(10); + while ($htmldoc =~ /<<(.+?>?)>>/s) { + local $pc = $1; + if ($pc =~ s/^<(.+)>$/$1/) { + # eval code without output substitution + eval('package DOP;' . $pc); + last if $timeout; + $dynamic = $htmldoc =~ s/<<<(.+?)>>>//s; + } else { + # eval code with output substitution + local $__ = ''; + local $^W = 0; + tie *STDOUT => "Buffer",\$__; + my $r .= eval('package DOP;' . $pc); + $__ .= $r if $pc !~ /;\s*$/; + untie *STDOUT; + last if $timeout; + $dynamic = $htmldoc =~ s/<<(.+?)>>/$__/s; + } + } + alarm(0); + $dynamic = $htmldoc =~ s/<<(.+?>?)>>/$timeout/sg if $timeout; + } # substitute $variable$ with value from environment (if present) while ($htmldoc =~ /\$([\w_]+)\$/g) { $var = $1; @@ -253,9 +277,9 @@ sub http_output { http_header('416 Requested Range Not Satisfiable'); exit; } - + alarm($timeout*10); - + if ($seek or $stop) { my $range; if ($stop) { @@ -269,7 +293,6 @@ sub http_output { "Content-Length: $size", "Content-Range: $range", "Content-Type: $type", - '', ); } else { # streaming? @@ -279,7 +302,6 @@ sub http_output { 'Server: fexsrv', "Expires: 0", "Content-Type: $type", - '', ); } else { # Java (clients) needs Last-Modified header! @@ -298,15 +320,17 @@ sub http_output { "Content-Length: $size", "Content-Type: $type", ); - nvt_print("Set-Cookie: locale=$locale") if $use_cookies and $locale; - nvt_print(''); + # nvt_print("Set-Cookie: locale=$locale") if $use_cookies and $locale; } } + nvt_print($_) foreach(@extra_header); + nvt_print(''); if ($ENV{REQUEST_METHOD} eq 'GET') { if ($type eq 'text/html') { alarm($timeout*10); print $htmldoc; + $s = $size; } else { # binary data # can be stream! seek $file,$seek,0 if $seek; @@ -315,14 +339,14 @@ sub http_output { $b = $size-$s; $data = substr($data,0,$b) } - $s += $b; + $s += $b; alarm($timeout*10); print $data or last; } } fdlog($log,$file,$s,$size) if $s; } - + alarm(0); close $file; exit if @files; # streaming end @@ -341,22 +365,22 @@ sub showindex { my $allowed; my ($htindex,$htauth); local $_; - + $uri =~ s:/+$::; $dir =~ s:/+$::; security_check($dir); - + $htindex = "$dir/.htindex"; $htauth = "$dir/.htauth"; - + open $htindex,$htindex or http_error(403); require_auth($htauth,$dir) if -f $htauth; - + # .htindex may contain listing regexp chomp ($allowed = <$htindex>||'.'); close $htindex; - + opendir $dir,$dir or http_error(503); while (defined($_ = readdir $dir)) { next if /^[.#]/ or /~$/; @@ -382,7 +406,7 @@ sub showindex { $htmldoc .= "

$uri/$d/

\n"; } } - + # # then the symlinks # $htmldoc .= "\n
\n";
 #  my $link;
@@ -391,7 +415,7 @@ sub showindex {
 #      $htmldoc .= "$l -> $dir/$link\n";
 #    }
 #  }
-  
+
   # then the files
   $htmldoc .= "\n
\n";
   foreach my $f (sort @files) {
@@ -403,7 +427,7 @@ sub showindex {
     }
   }
   $htmldoc .= "
\n\n";
-  
+
   $size = length($htmldoc);
   nvt_print(
     'HTTP/1.1 200 OK',
@@ -417,11 +441,6 @@ sub showindex {
 }
 
 
-sub mtime {
-  return (lstat shift)[9];
-}
-
-
 sub d3 {
   local $_ = shift;
   while (s/(\d)(\d\d\d\b)/$1,$2/) {};
@@ -432,7 +451,7 @@ sub d3 {
 sub http_date {
   my $file = shift;
   my @stat;
-  
+
   if (@stat = stat($file)) {
     return strftime("%a, %d %b %Y %T GMT",gmtime($stat[9]));
   } else {
@@ -456,9 +475,9 @@ sub path_match {
 # return real file name (from symlink)
 sub realfilename {
   my $file = shift;
-  
+
   return '' unless -e $file;
-  
+
   if (-l $file) {
     return realfilename(readlink($file));
   } else {
@@ -487,13 +506,13 @@ sub security_check {
       errorlog("$file contains @");
       http_error(403);
     }
-  
+
     # document filename must not end with ~
     if (realfilename($file) =~ /~$/) {
       errorlog("$file ends with ~");
       http_error(403);
     }
-  
+
     # file must be group or world readable
     if (@s = stat($file) and not($s[2] & (S_IRGRP|S_IROTH))) {
       errorlog("$file not group or world readable");
@@ -505,14 +524,14 @@ sub security_check {
       @s = lstat($file);
       return if $s[4] == 0 or $s[4] == $<;
     }
-    
+
   }
-  
+
   # file in allowed directory? ==> ok!
   foreach my $dir (@doc_dirs) {
     return if path_match($file,$dir);
   }
-  
+
   errorlog("$file not in \@doc_dirs");
   http_error(403);
 }
@@ -525,7 +544,7 @@ sub access_check {
   local $_;
 
   $dir .= '/x' if -d $dir;
-  
+
   while ($dir = dirname($dir) and $dir ne '/') {
     $af = "$dir/.htaccessfrom";
     if (open $af,$af) {
@@ -540,7 +559,7 @@ sub access_check {
       http_error(403);
     }
   }
-    
+
 }
 
 # HTTP Basic authentication
@@ -550,7 +569,7 @@ sub require_auth {
   my ($realm,$auth);
   my @http_auth;
   my $uri = $ENV{REQUEST_URI} || '/';
-  
+
   $uri =~ s/\/index\.html$//;
   $uri =~ s/\/$//;
 
@@ -559,7 +578,7 @@ sub require_auth {
   } else {
     $realm = dirname($uri);
   }
-  
+
   $auth = slurp($htauth);
   unless ($auth and $realm) {
     http_header("200 OK");
@@ -571,8 +590,8 @@ sub require_auth {
     exit;
   }
   chomp $auth;
-  
-  if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/) 
+
+  if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/)
   { @http_auth = split(':',decode_b64($1)) }
   if (@http_auth != 2 or $http_auth[1] ne $auth) {
     http_header(
@@ -592,21 +611,21 @@ sub out {
   return '';
 }
 
-# tie STDOUT to buffer variable (redefining print)
+# tie STDOUT to buffer variable (redefining print and printf)
 package Buffer;
 
-sub TIEHANDLE { 
-  my ($class,$buffer) = @_; 
-  bless $buffer,$class; 
+sub TIEHANDLE {
+  my ($class,$buffer) = @_;
+  bless $buffer,$class;
 }
 
-sub PRINT { 
-  my $buffer = shift; 
-  $$buffer .= $_ foreach @_; 
+sub PRINT {
+  my $buffer = shift;
+  $$buffer .= $_ foreach @_;
 }
 
-sub PRINTF { 
-  my $buffer = shift; 
+sub PRINTF {
+  my $buffer = shift;
   my $fmt = shift @_;
   $$buffer .= sprintf($fmt,@_);
 }