#!/usr/bin/perl -wT use strict; use IO::File; use Cwd; use HTTP::Daemon; use HTTP::Status; $| = 1; # We are quite explicit about where we listen my $d = new HTTP::Daemon Reuse => 1, LocalAddr => '192.168.1.100', LocalPort => 8889; my $nofork = $^O =~ /Win32/i; # For easy testing under Win32 $SIG{__WARN__} = sub { warn __stamp(shift) }; $SIG{__DIE__} = sub { die __stamp(shift) }; $SIG{CHLD} = 'IGNORE'; warn "Please contact me at: url . ">\n"; $ENV{PATH} = '/bin:/usr/bin'; # Set our path to something secure my $root = $ARGV[0] || cwd; $root = $1 if $root =~ /^(.*)$/; # untaint document root $root .= "/" unless $root =~ m!/$!; # This sub Copyright (c) 1996,97,98,99,2000,01 by Randal L. Schwartz sub __stamp { my ($message) = @_; my $stamp = sprintf "[$$] [%02d@%02d:%02d:%02d] ", (localtime)[3,2,1,0]; $message =~ s/^/$stamp/gm; $message; } sub handleConnection { local $SIG{PIPE} = 'IGNORE'; my ($connection) = @_; while (my $r = $connection->get_request()) { warn $r->as_string; # Yes, that's verbose. my $url = $r->url->path; $url = "/$url" unless $url =~ m!^/!; # Remove all suspicious paths $url =~ s!/.?.(?=/|$)!/!g; $url =~ tr!\x00-\x1F!!d; my $response = new HTTP::Response( 404,undef,undef,"404 - Not found." ); if (-d "$root$url") { $url = "$url/" unless $url =~ m!/$!; opendir DIR, "$root$url"; $response->code(200); $response->content( "$url

$url

" . join( " ", map { my ($cmt,$link) = ((-s "$root$url$_")." bytes",$_); -d _ and $cmt = "directory"; $link =~ s/([ '"?%&:])/{'%'.unpack("H2",$1)}/eg; "$_ $cmt" } sort grep { /^[^.]/ } readdir DIR ) . "" ); closedir DIR; } else { my $file = new IO::File "< $root$url"; if (defined $file) { $response->code( 200 ); binmode $file; my $size = -s $file; my ($startrange, $endrange) = (0,$size-1); if (defined $r->header("Range") and $r->header("Range") =~ /bytes\s*=\s*(\d+)-(\d+)?/) { $response->code( 206 ); ($startrange,$endrange) = ($1,$2 || $endrange); }; $file->seek($startrange,0); $response->header(Content_Length => $endrange-$startrange); $response->header(Content_Range => "bytes $startrange-$endrange/$size"); $response->content( sub { sysread($file, my ($buf), 16*1024); # No error checking ??? return $buf; }); }; }; warn "Response :",$response->code; $connection->send_response($response); }; warn "Handled connection (closed, " . $connection->reason . ")"; $connection->close; }; while (my $connection = $d->accept) { # Really condensed fork/nofork handler code next unless $nofork || ! fork(); warn "Forked child" unless $nofork; handleConnection( $connection ); die "Child quit." unless $nofork; }