#!/usr/bin/perl
#
# Written by Dominic Hargreaves <dom@earth.li>, based upon HTTP::Daemon
# example code and <http://perlmonks.thepen.com/326388.html>.
#
# This application is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# Description:  This runs a web server on port 80 (by default) whose sole
#               purpose in life is to return the HTTP status code 503
#               to connecting clients, along with a friendly HTML error
#               message. The purpose is to provide a more user-friendly 
#               error than "connection refused" when your main web server
#               is down whilst not returning a misleading 200 status.
#
# Instructions: Put a file panic.html in the same directory as this
#               program, and customise to your liking. It should probably
#               describe why it is there but probably not be overly
#               complex, or include any graphics. You must run it as root
#               in order to bind to privileged ports; by default the
#               program will drop privs to nobody.nogroup after binding.
#               
#               Run ./panichttpd.pl --help for a description of
#               the possible options.
#
#               You will of course need to alias the address of the
#               web server to the temporary machine and will also
#               want to make sure you aren't listening on any conflicting
#               services (eg an MTA which does not accept mail for the
#               correct places).
#               
# Requirements: All this needs to run are libwww-perl and getopt, both
#               of which have been a standard(ish) part of Perl for quite
#               some time. This means that this should run on pretty
#               much any old box you have lying around, or at least you
#               can probably install libwww-perl easily if not.

use strict;
use warnings;

use HTTP::Daemon;
use HTTP::Status;
use Getopt::Std;

my %opts;

getopt("pnaugf", \%opts);

if ($opts{h}) {
    print STDERR "$0: serves panic.html with a 503\n\n";
    print STDERR "-p: port to listen on [80]\n";
    print STDERR "-n: number of processes to fork [10]\n";
    print STDERR "-a: address to bind to [0.0.0.0]\n";
    print STDERR "-u: user to run as [nobody]\n";
    print STDERR "-g: group to run as [nogroup]\n";
    print STDERR "-f: file to serve [panic.html]\n";
    exit 1;
}

my ($port, $address, $num, $user, $group, $file);
$port = $opts{p} or $port = 80;
$address = $opts{a} or $address = "0.0.0.0";
$num = $opts{n} or $num = 10;
$user = $opts{u} or $user = "nobody";
$group = $opts{g} or $group = "nogroup";
$file = $opts{f} or $file = "panic.html";

$SIG{PIPE} = 'IGNORE';

$|++;
my $d = HTTP::Daemon->new (LocalAddr => $address, LocalPort => $port)
    or die "Cannot bind to $address:$port: $!";

if ($< == 0) {
    $< = getpwnam($user) or die "Cannot set user to $user: $!";
    $> = getpwnam($user) or die "Cannot set user to $user $!!";
    $( = getgrnam($group) or die "Cannot set group to $group: $!";
    $) = getgrnam($group) or die "Cannot set group to $group: $!";
}

for (1..$num) {
    my $pid = fork;
    next if $pid;
    next unless defined $pid;
    do {
	flock $d, 2;
        my $c = $d->accept;
	flock $d, 8;
	my $oldfh = select($c);
	$|++;
	select($oldfh);
	
	while (my $r = $c->get_request) {
	    print "Request for " . $r->url->path . "\n";
	    $c->send_basic_header(RC_SERVICE_UNAVAILABLE);
	    $c->send_crlf;
	    $c->send_file($file);
	    $c->send_crlf;
	    $c->force_last_request;
        }
        $c->close;
        undef($c);
    } while (1);
    exit 0;
}

while (1) { waitpid(-1, 0) }