# HG changeset patch # User Heiko Schlittermann # Date 1233085660 -3600 # Node ID 5eaf49bbf9c520f82e424e1a3327f95c9722fa1e Initial release. diff -r 000000000000 -r 5eaf49bbf9c5 .perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.perltidyrc Tue Jan 27 20:47:40 2009 +0100 @@ -0,0 +1,1 @@ +/home/heiko/.perltidyrc \ No newline at end of file diff -r 000000000000 -r 5eaf49bbf9c5 hlog --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hlog Tue Jan 27 20:47:40 2009 +0100 @@ -0,0 +1,135 @@ +#! /usr/bin/perl +use strict; +use warnings; +use Getopt::Long; +use IO::Socket::INET; +use Pod::Usage; + +my $opt_addr = "0.0.0.0"; +my $opt_port = 8080; +my $logfile = "hlog.log"; +my $FILE; + +sub handle_request($); +sub date1123(;$); +sub http($$); +sub bad_request(); + +MAIN: { + + GetOptions( + "addr" => \$opt_addr, + "port" => \$opt_port, + ) or pod2usage(); + + open(LOG, ">>$logfile"); + print LOG localtime() . " started\n"; + + $FILE = shift or pod2usage(); + + my $listener = new IO::Socket::INET( + LocalAddr => $opt_addr, + LocalPort => $opt_port, + Port => $opt_port, + Proto => "tcp", + Listen => 1, + ReuseAddr => 1, + ) or die "Can't create listener socket: $!\n"; + + while (my $client = $listener->accept) { + + print LOG localtime() + . " access from " + . $client->peerhost . ":" + . $client->peerport . "\n"; + + my $pid = fork(); + die "Can't fork: $!\n" if not defined $pid; + if ($pid == 0) { + $listener->close; + handle_request($client); + exit 0; + } + $client->close; + } + +} + +sub handle_request($) { + my $client = shift; + local $_ = <$client>; + + # should be HTTP/x.x + if (not s/HTTP\/\S+\s*$//) { + $client->print(bad_request); + return; + } + + # should be a GET request + if (not s/GET\s+//) { + $client->print(http "400 Bad Request" => bad_request); + } + + open(my $file, $FILE); + $client->print(http "200 OK" => join "", + "# Proof of concept ;-)\n", + "# see https://keller.schlittermann.de/hg/hlog\n", + <$file>); + +} + +sub http($$) { + my ($code, $msg) = @_; + my $date = date1123(); + + my $type = $msg =~ /^ + +400 Bad Request + +

Bad Request

Your browser sent a request that this server could not understand.
+

+ +EOF +} + +__END__ + +=head1 NAME + + hlog - simple http server providing access to some logfile + +=head1 SYNOPSIS + + hlog [-p|--port port] [-a|--address address] file + +=head1 DESCRIPTION + +This script should run as a server providing access to +the last lines of a logfile. It should understand basic HTTP/1.x. + +=cut