X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/97b87610331f53e756d032ad21db786037f921a1..e5c93609849bda051fff54b5d5265af5608c6c69:/lib/dop diff --git a/lib/dop b/lib/dop index 9c428a5..20df28e 100755 --- a/lib/dop +++ b/lib/dop @@ -27,19 +27,19 @@ 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:[^/]*$::; @@ -97,7 +97,7 @@ 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 + } elsif ($file =~ /(.+)\.(tar|tgz|zip)$/ and @s = lstat($streamfile = "$1.stream") and $s[4] == $<) { # streaming file (only if it is owned by user fex) @@ -122,18 +122,18 @@ sub http_output { } close $streamfile; foreach (@files) { - if (/^\// or /\.\.\//) { + if (/^\// or /\.\.\//) { # absolute path or relative path with parent directory is not allowed 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 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) } @@ -141,9 +141,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' } @@ -179,8 +179,8 @@ sub http_output { } elsif ($ENV{'QUERY_STRING'} eq '!') { $type = 'text/plain'; } - - + + if ($type eq 'text/html') { $seek = $stop = 0; local $^W = 0; @@ -251,9 +251,9 @@ sub http_output { http_header('416 Requested Range Not Satisfiable'); exit; } - + alarm($timeout*10); - + if ($seek or $stop) { my $range; if ($stop) { @@ -314,14 +314,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 @@ -340,22 +340,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 /~$/; @@ -381,7 +381,7 @@ sub showindex { $htmldoc .= "

$uri/$d/

\n"; } } - + # # then the symlinks # $htmldoc .= "\n
\n";
 #  my $link;
@@ -390,7 +390,7 @@ sub showindex {
 #      $htmldoc .= "$l -> $dir/$link\n";
 #    }
 #  }
-  
+
   # then the files
   $htmldoc .= "\n
\n";
   foreach my $f (sort @files) {
@@ -402,7 +402,7 @@ sub showindex {
     }
   }
   $htmldoc .= "
\n\n"; - + $size = length($htmldoc); nvt_print( 'HTTP/1.1 200 OK', @@ -426,7 +426,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 { @@ -450,9 +450,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 { @@ -481,13 +481,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"); @@ -499,14 +499,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); } @@ -519,7 +519,7 @@ sub access_check { local $_; $dir .= '/x' if -d $dir; - + while ($dir = dirname($dir) and $dir ne '/') { $af = "$dir/.htaccessfrom"; if (open $af,$af) { @@ -534,7 +534,7 @@ sub access_check { http_error(403); } } - + } # HTTP Basic authentication @@ -544,7 +544,7 @@ sub require_auth { my ($realm,$auth); my @http_auth; my $uri = $ENV{REQUEST_URI} || '/'; - + $uri =~ s/\/index\.html$//; $uri =~ s/\/$//; @@ -553,7 +553,7 @@ sub require_auth { } else { $realm = dirname($uri); } - + $auth = slurp($htauth); unless ($auth and $realm) { http_header("200 OK"); @@ -565,8 +565,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( @@ -589,18 +589,18 @@ sub out { # tie STDOUT to buffer variable (redefining print) 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,@_); }