Initial release.
--- /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
--- /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 =~ /^<!DOCTYPE HTML/ ? "text/html" : "text/plain";
+
+ return <<EOF;
+HTTP/1.1 $code
+Date: $date
+Connection: close
+Content-Type: $type
+
+$msg
+EOF
+}
+
+sub date1123(;$) {
+ my @now = gmtime(@_ ? shift : time);
+ sprintf "%s, %2d %s %4d %02d:%02d:%02d GMT",
+ qw(Sun Mon Tue Wed Thu Fri Sat Sun) [ $now[6] ],
+ $now[3],
+ qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) [ $now[4] ],
+ $now[5] + 1900, @now[ 2, 1, 0 ];
+}
+
+sub bad_request() {
+ return <<'EOF';
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
+<html><head>
+<title>400 Bad Request</title>
+</head><body>
+<h1>Bad Request</h1>
+<p>Your browser sent a request that this server could not understand.<br
+/>
+</p>
+</body></html>
+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