/usr/share/doc/libnetserver-generic-perl/examples/shttpd is in libnetserver-generic-perl 1.03-9.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | #!/usr/bin/perl
use NetServer::Generic;
# minimal http server (HTTP/0.9):
sub url_to_file($) {
# for a given URL, turn it into an absolute pathname
my ($u) = shift ; # incoming URL fragment from GET request
my ($f) = ""; # file pathname to return
my ($htbase) = "/usr/local/etc/httpd/docs/";
my ($htdefault) = "index.html";
chop $u;
if ($u eq "/") {
$f = $htbase . $htdefault;
return $f;
} else {
if ($u =~ m|^/.+|) {
$f = $htbase; chop $f;
$f .= $u;
} elsif ($u =~ m|[^/]+|) {
$f = $htbase . $u;
}
if ($u =~ m|.+/$|) {
$f .= $htdefault;
}
if ($f =~ /\.\./) {
my (@path) = split("/", $f);
my ($buff, $acc) = "";
shift @path;
while ($buff = shift @path) {
my ($tmp) = shift @path;
if ($tmp ne '..') {
unshift @path, $tmp;
$acc .= "/$buff";
}
}
$f = $acc;
}
}
return $f;
}
my ($http) = sub {
while (defined ($tmp = <STDIN>)) {
chomp $tmp;
if ($tmp =~ /^GET\s+(.*)$/i) {
my ($getfile) = url_to_file($1);
print STDERR "Sending $getfile\n";
my ($in) = new IO::File();
if ($in->open("<$getfile") ) {
$in->autoflush(1);
print STDOUT "Content-type: text/html\n\n";
while (defined ($line = <$in>)) {
print STDOUT $line;
}
} else {
print STDOUT "404: File not found\n\n";
}
}
return 0;
}
};
my (%config) = ("port" => 9000,
"callback" => $http,
"hostname" => "antipope.demon.co.uk"
);
my ($foo) = new NetServer::Generic(%config);
my ($allowed) = ['.*antipope\.org',
'.*easynet\.co\.uk' ];
my ($forbidden) = [ '194\.205\.10\.2'];
$foo->allowed($allowed);
$foo->forbidden($forbidden);
print "Server started\n";
$foo->run();
__END__
=pod
=head1 shttpd -- a trivial HTTP server
This is not a real web server, although it might turn into one
eventually!
You will need to modify %config (specifically the hostname) before
it will do anything useful. You may also need to modify the
B<allowed> and B<forbidden> anonymous arrays; these are given to
provide an example of simple access control to a server.
B<shttpd> understands a single HTTP command:
GET I<filename>
It looks for files in B<$htbase> (defined in B<url_to_file()>, the
subroutine that maps HTTP requests to absolute pathnames). If a
trailing slash is encountered, it appends B<$htdefault> (currently
set to I<index.html>).
If the file is not found, it returns a 404: File not found response --
otherwise it assumes the file is HTML and sends it(!). This may not
be what you want to do if the file is I<not> HTML, so take care.
B<shttpd> doesn't understand CGI scripts, relative URLs, or just about
anything. However, it serves as a skeleton which can easily be
extended to add these features.
|