X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/e5c93609849bda051fff54b5d5265af5608c6c69..20160919:/lib/dop

diff --git a/lib/dop b/lib/dop
index 20df28e..4a6ece0 100755
--- a/lib/dop
+++ b/lib/dop
@@ -8,10 +8,11 @@
 #
 
 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);
@@ -98,9 +99,10 @@ sub http_output {
     @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] == $<)
+           @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,10 +126,16 @@ sub http_output {
     foreach (@files) {
       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 $_) {
         # file must be readable by user and group
+        errorlog("$streamfile: $_ is not readable by user and group");
         http_error(403);
       }
     }
@@ -221,15 +229,33 @@ sub http_output {
       }
       $dynamic = $htmldoc =~ s/$mark/$include/;
     }
-    # evaluate <<perl-code>>
-    while ($htmldoc =~ /<<(.+?)>>/s) {
-      local $pc = $1;
-      local $__ = '';
-      tie *STDOUT => "Buffer",\$__;
-      $__ .= eval $pc;
-      untie *STDOUT;
-      $dynamic = $htmldoc =~ s/<<(.+?)>>/$__/s;
-    };
+    # evaluate <<perl-code>> or <<<perl-code>>>
+    {
+      local $timeout = '';
+      local $SIG{ALRM} = sub { $timeout = '<h3>TIMEOUT!</h3>' };
+      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;
@@ -267,7 +293,6 @@ sub http_output {
       "Content-Length: $size",
       "Content-Range: $range",
       "Content-Type: $type",
-      '',
     );
   } else {
     # streaming?
@@ -277,7 +302,6 @@ sub http_output {
         'Server: fexsrv',
         "Expires: 0",
         "Content-Type: $type",
-        '',
       );
     } else {
       # Java (clients) needs Last-Modified header!
@@ -296,10 +320,11 @@ 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') {
@@ -586,7 +611,7 @@ sub out {
   return '';
 }
 
-# tie STDOUT to buffer variable (redefining print)
+# tie STDOUT to buffer variable (redefining print and printf)
 package Buffer;
 
 sub TIEHANDLE {