#Implemented interface does not support concurrent connections.
use strict;
use HTTP::Daemon;
use HTTP::Status;
sub formatTime {
my $t = $_[0];
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
#Wed, 4 Jan 2004, 13:04:04
my @daySet = qw/Sun Mon Tue Wed Thu Fri Sat/;
my @monSet = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
return sprintf("%s, %d %s %d, %02d:%02d:%02d",$daySet[$wday],$mday,$monSet[$mon],1900+$year,$hour,$min,$sec);
}
sub getListing {
my $dir = $_[0];
my @contents = glob("$dir/*");
my $result = "Directory listing for $dir\nDirectory listing for $dir
\n\n";
if ($dir ne ".") {
$result .= "Ascend one directory\n";
}
$result .= "
| Name | Size | Date Modified |
|---|
\n";
foreach (@contents) {
$result .="";
my @st = stat;
my $date = $st[9];
if (-d) {
$result .= "| [DIR] | ";
$result .= "$_ | ";
$result .= " | ";
} else {
$result .= "[FILE] | ";
$result .= "$_ | ";
my $size = $st[7];
$result .= "$size | ";
}
$result .= "".formatTime($date)." |
\n";
}
$result .= "
\n";
return $result;
}
sub getContent {
my $path = $_[0];
if (-d $path) {
return &getListing($path);
} else {
open FP,$path;
my @content = ;
my $result = join("",@content);
close FP;
return $result;
}
}
my $d = HTTP::Daemon->new(LocalPort => 81) || die;
print &formatTime(time()).": Server up at '".$d->url."'.\n";
while (my $c = $d->accept) {
print &formatTime(time()).": ".$c->sockhost." connects.\n";
while (my $r = $c->get_request) {
if ($r->method eq 'GET') { # and $r->url->path eq "/xyzzy") {
my $path = ".".$r->url->path;
print &formatTime(time()).": ".$c->sockhost." wants '$path'.\n";
$path =~ s#/$##;
if (-d $path) {
my $rsp = HTTP::Response->new( 200 , "OK" );
$rsp->header("Content-Type" => "text/html");
$rsp->content(&getListing($path));
$c->send_response( $rsp );
} else {
$c->send_file_response($path);
}
}
else {
$c->send_error(RC_FORBIDDEN)
}
}
print &formatTime(time()).": ".$c->sockhost." disconnects.\n";
$c->close;
undef($c);
}