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:[^/]*$::;
} 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)
}
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) }
} 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' }
} elsif ($ENV{'QUERY_STRING'} eq '!') {
$type = 'text/plain';
}
-
-
+
+
if ($type eq 'text/html') {
$seek = $stop = 0;
local $^W = 0;
http_header('416 Requested Range Not Satisfiable');
exit;
}
-
+
alarm($timeout*10);
-
+
if ($seek or $stop) {
my $range;
if ($stop) {
$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
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 /~$/;
$htmldoc .= "<h3><a href=\"$uri/$d/\">$uri/$d/</a></h3>\n";
}
}
-
+
# # then the symlinks
# $htmldoc .= "\n<pre>\n";
# my $link;
# $htmldoc .= "$l -> <a href=\"$link\">$dir/$link</a>\n";
# }
# }
-
+
# then the files
$htmldoc .= "\n<pre>\n";
foreach my $f (sort @files) {
}
}
$htmldoc .= "</pre>\n</HTML>\n";
-
+
$size = length($htmldoc);
nvt_print(
'HTTP/1.1 200 OK',
sub http_date {
my $file = shift;
my @stat;
-
+
if (@stat = stat($file)) {
return strftime("%a, %d %b %Y %T GMT",gmtime($stat[9]));
} else {
# return real file name (from symlink)
sub realfilename {
my $file = shift;
-
+
return '' unless -e $file;
-
+
if (-l $file) {
return realfilename(readlink($file));
} else {
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");
@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);
}
local $_;
$dir .= '/x' if -d $dir;
-
+
while ($dir = dirname($dir) and $dir ne '/') {
$af = "$dir/.htaccessfrom";
if (open $af,$af) {
http_error(403);
}
}
-
+
}
# HTTP Basic authentication
my ($realm,$auth);
my @http_auth;
my $uri = $ENV{REQUEST_URI} || '/';
-
+
$uri =~ s/\/index\.html$//;
$uri =~ s/\/$//;
} else {
$realm = dirname($uri);
}
-
+
$auth = slurp($htauth);
unless ($auth and $realm) {
http_header("200 OK");
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(
# 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,@_);
}
projects / fex.git / blobdiff