Skip to content

Instantly share code, notes, and snippets.

@msoap
Created March 17, 2012 16:10
Show Gist options
  • Save msoap/2061555 to your computer and use it in GitHub Desktop.
Save msoap/2061555 to your computer and use it in GitHub Desktop.
test http server via Net::Server::HTTP for static files
#!/usr/bin/perl
=head1 NAME
http-server-test.pl
=head1 DESCRIPTION
test http server via Net::Server::HTTP for static files
=head1 SYNOPSIS
http-server-test.pl [--host=localhost] [--port=8000] [--document-root=./]
Options:
--host, -s server host (default - localhost)
--port, -p server port (default - 8000)
--document-root, -d document root (default - current dir)
--access-log, -a log to this file
--help, -h help
--version, -v print version
=cut
package Net::Server::HTTP::LightForStaticFiles;
use strict;
use warnings;
use base qw(Net::Server::HTTP);
use URI::Escape;
use Data::Dumper;
our $VERSION = 0.01;
# perl -MMojolicious::Types -MData::Dumper -E 'say Dumper(Mojolicious::Types->new()->types())'
our %MIME_TYPES = (
'tar' => 'application/x-tar',
'css' => 'text/css',
'ico' => 'image/x-icon',
'bin' => 'application/octet-stream',
'xsl' => 'text/xml',
'woff' => 'application/x-font-woff',
'txt' => 'text/plain',
'json' => 'application/json',
'html' => 'text/html;charset=UTF-8',
'xml' => 'text/xml',
'jpg' => 'image/jpeg',
'atom' => 'application/atom+xml',
'gz' => 'application/gzip',
'mp3' => 'audio/mpeg',
'png' => 'image/png',
'pdf' => 'application/pdf',
'htm' => 'text/html;charset=UTF-8',
'zip' => 'application/zip',
'js' => 'application/x-javascript',
'jpeg' => 'image/jpeg',
'rss' => 'application/rss+xml',
'gif' => 'image/gif',
'svg' => 'image/svg+xml'
);
our %CONFIG;
our $CRLF = "\r\n";
# ------------------------------------------------------------------------------
sub run {
my $self = shift;
my %params = @_;
for my $config_name (qw/document_root access_log/) {
$CONFIG{$config_name} = $params{$config_name} if defined $params{$config_name}
}
$self->SUPER::run(@_);
}
# ------------------------------------------------------------------------------
sub process_http_request {
my $self = shift;
my $document_root = $CONFIG{document_root} || ".";
my $method = $ENV{REQUEST_METHOD};
my $path = $ENV{PATH_INFO};
my $file_name = $document_root . uri_unescape($path);
$file_name =~ s/\.\././g;
my $user_agent = $ENV{HTTP_USER_AGENT} || '-';
my $status_code = 200;
my $content_type = $MIME_TYPES{html};
my $content;
# Response
if (-e $file_name) {
if (! -r $file_name) {
$status_code = 403;
$content = '<h1 style="font-size: 500%;">403 Forbidden.</h1>';
} elsif (-f $file_name) {
my ($ext) = $file_name =~ /\.([a-z]+)$/i;
if ($ext && $MIME_TYPES{lc $ext}) {
$content_type = $MIME_TYPES{lc $ext};
} else {
open my $F, '-|', 'file', '--brief', '--mime-type', $file_name or die "error on exec 'file $file_name': $!\n";
$content_type = join('', <$F>);
$content_type =~ s/\s+//g;
close $F;
$content_type //= $MIME_TYPES{bin};
}
} elsif (-d $file_name && ! -e "$file_name/index.html") {
$content = "<h1>Directory listing:</h1>\n";
$content .= join("<br>\n",
map {my $size = -s $_;
s/^\.//;
s|//|/|g;
qq|<a href="$_">$_</a> - $size|
}
sort
glob("$file_name/*")
);
} elsif (-d $file_name && -e "$file_name/index.html" && -r "$file_name/index.html") {
$file_name = "$file_name/index.html";
} else {
$status_code = 500;
$content = '<h1 style="font-size: 500%;">500 Error.</h1>';
}
} else {
$status_code = 404;
if (-f "$document_root/404.html" && -r "$document_root/404.html") {
$file_name = "$document_root/404.html";
} else {
$content = '<h1 style="font-size: 500%;">404 Not found.</h1>';
}
}
if (! defined $content && defined $file_name) {
open my $F, '<', $file_name or die "error open $file_name: $!\n";
binmode $F, ':raw';
local $/;
$content = <$F>;
close $F;
}
# out header and content
$self->{http_status} = $status_code;
print "Content-type: $content_type$CRLF$CRLF";
print $content;
# logging
my $time = localtime() . "";
my $log_line = "[$time] $method $path ($content_type) - $status_code\n";
if (defined $CONFIG{access_log}) {
open my $FH, '>>', $CONFIG{access_log} or die "Error open file: $!\n";
print $FH $log_line;
close $FH;
} else {
print STDERR $log_line;
}
}
# ------------------------------------------------------------------------------
sub send_status {
my ($self) = @_;
my $status = $self->{http_status};
my $msg = $status == 200 ? 'OK' : '-';
print "HTTP/1.0 $status $msg$CRLF";
print "Date: " . gmtime() . " GMT$CRLF";
print "Server: " . $self->server_revision() . $CRLF;
print "Connection: close$CRLF";
}
1;
# ------------------------------------------------------------------------------
package main;
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
our $VERSION = 0.01;
# ------------------------------------------------------------------------------
sub main {
my $host = 'localhost';
my $port = 8000;
my $document_root = '.';
my $access_log;
GetOptions(
"host|s=s" => \$host
, "port|p=i" => \$port
, "document-root|d=s" => \$document_root
, "access-log|a=s" => \$access_log
, "help|h" => sub {
pod2usage(-exitval => 0, -verbose => 99, -sections => [qw/NAME DESCRIPTION SYNOPSIS/]);
}
, "version|v" => sub {
print "$VERSION\n";
exit 0;
}
);
print STDERR qq|Start HTTP server at http://$host:$port/ for documents in "$document_root"...\n|;
Net::Server::HTTP::LightForStaticFiles->run(
port => $port
, host => $host
, server_type => 'Fork'
, log_level => 0
, document_root => $document_root
, access_log => $access_log
);
}
# ------------------------------------------------------------------------------
main();
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment