1: #!/usr/bin/perl -wT
2: use strict;
3: use IO::File;
4: use Cwd;
5: use HTTP::Daemon;
6: use HTTP::Status;
7:
8: $| = 1;
9:
10: # We are quite explicit about where we listen
11: my $d = new HTTP::Daemon
12: Reuse => 1,
13: LocalAddr => '192.168.1.100',
14: LocalPort => 8889;
15:
16: my $nofork = $^O =~ /Win32/i; # For easy testing under Win32
17:
18: $SIG{__WARN__} = sub { warn __stamp(shift) };
19: $SIG{__DIE__} = sub { die __stamp(shift) };
20: $SIG{CHLD} = 'IGNORE';
21:
22: warn "Please contact me at: <URL:" . $d->url . ">\n";
23:
24: $ENV{PATH} = '/bin:/usr/bin'; # Set our path to something secure
25: my $root = $ARGV[0] || cwd;
26: $root = $1 if $root =~ /^(.*)$/; # untaint document root
27: $root .= "/" unless $root =~ m!/$!;
28:
29: # This sub Copyright (c) 1996,97,98,99,2000,01 by Randal L. Schwartz
30: sub __stamp {
31: my ($message) = @_;
32: my $stamp = sprintf "[$$] [%02d@%02d:%02d:%02d] ", (localtime)[3,2,1,0];
33: $message =~ s/^/$stamp/gm;
34: $message;
35: }
36:
37: sub handleConnection {
38: local $SIG{PIPE} = 'IGNORE';
39: my ($connection) = @_;
40: while (my $r = $connection->get_request()) {
41: warn $r->as_string; # Yes, that's verbose.
42:
43: my $url = $r->url->path;
44: $url = "/$url" unless $url =~ m!^/!; # Remove all suspicious paths
45: $url =~ s!/.?.(?=/|$)!/!g;
46: $url =~ tr!\x00-\x1F!!d;
47:
48: my $response = new HTTP::Response( 404,undef,undef,"404 - Not found." );
49: if (-d "$root$url") {
50: $url = "$url/" unless $url =~ m!/$!;
51: opendir DIR, "$root$url";
52: $response->code(200);
53: $response->content(
54: "<html><head><title>$url</title></head><body><h1>$url</h1><tt>"
55: . join( "<br>",
56: map { my ($cmt,$link) = ((-s "$root$url$_")." bytes",$_);
57: -d _ and $cmt = "directory";
58: $link =~ s/([ '"?%&:])/{'%'.unpack("H2",$1)}/eg;
59: "<A href='$url$link'>$_</A> $cmt"
60: } sort grep { /^[^.]/ } readdir DIR )
61: . "</tt></body></html>" );
62: closedir DIR;
63: } else {
64: my $file = new IO::File "< $root$url";
65: if (defined $file) {
66: $response->code( 200 );
67: binmode $file;
68: my $size = -s $file;
69:
70: my ($startrange, $endrange) = (0,$size-1);
71: if (defined $r->header("Range")
72: and $r->header("Range") =~ /bytes\s*=\s*(\d+)-(\d+)?/) {
73: $response->code( 206 );
74: ($startrange,$endrange) = ($1,$2 || $endrange);
75: };
76: $file->seek($startrange,0);
77:
78: $response->header(Content_Length => $endrange-$startrange);
79: $response->header(Content_Range => "bytes $startrange-$endrange/$size");
80: $response->content( sub {
81: sysread($file, my ($buf), 16*1024); # No error checking ???
82: return $buf;
83: });
84: };
85: };
86: warn "Response :",$response->code;
87: $connection->send_response($response);
88: };
89: warn "Handled connection (closed, " . $connection->reason . ")";
90: $connection->close;
91: };
92:
93: while (my $connection = $d->accept) {
94: # Really condensed fork/nofork handler code
95: next unless $nofork || ! fork();
96: warn "Forked child" unless $nofork;
97: handleConnection( $connection );
98: die "Child quit." unless $nofork;
99: }
Back to
Craft