#!/usr/bin/perl -w use strict; my $URL_FILE = "URL"; my $DEF_SIZE = 8*1024; use HTTP::Daemon; use Time::HiRes qw(sleep time); my $d = new HTTP::Daemon; $SIG{PIPE} = 'IGNORE'; # if syswrite() on the socket fails open(URL, ">$URL_FILE") || die "Can't open $URL_FILE: $!"; print URL $d->url, "\n"; close(URL); print "url, ">\n"; my $req_no = 1; while (my $c = $d->accept) { if (my $r = $c->get_request) { print $req_no++, ": "; print $r->as_string; $c->autoflush; my $u = $r->url; my %q; eval { %q = $u->query_form; }; my $wait = ($q{w} || 0) / 1000; my $bsize = $q{cs} || $DEF_SIZE; my $line = $q{line}; my $cr = $q{cr}; $line++ if $cr; my $file = ($u->path_components)[1]; if ($file && !($file =~ m,/,)) { if (open(FILE, $file)) { my $before = time; print "["; if ($line) { # we should output the file a line at time my $count = 0; while () { if ($cr) { chomp; $cr = 0 unless length; # headers done $_ .= "\015\012"; } print $c $_; $count++; sleep($wait) if $wait; } print "$count lines response sent"; } else { my $bytes = 0; my $blocks = 0; my $buf; while (my $n = sysread(FILE, $buf, $bsize)) { $blocks++; $n = syswrite($c, $buf, length($buf)); if (!defined($n)) { print "syswrite error for block $blocks: $!\n"; last; } $bytes += $n; if ($n != length($buf)) { print "short write ($n)\n"; last; } sleep($wait) if $wait; } print "$blocks blocks, $bytes bytes response sent"; } printf " in %.2fs]\n\n", time - $before; } else { $c->send_error(404); } } else { $c->send_error(400); } } $c->close; $c = undef; }