#!/usr/bin/perl -Tw
use strict;

use HTTP::Daemon;
use HTTP::Status;
use URI::Escape qw(uri_unescape);
use Qmail::Deliverable ':all';
use Getopt::Long;
Getopt::Long::Configure("bundling");

my ($listen, $pidfile, $verbose, $stop, $foreground);
$listen = "127.0.0.1:8998";

if (@ARGV and $ARGV[0] !~ /^-/) {
    warn "WARNING: Using deprecated old style command line argument parsing. Update your startup scripts!\n";

    ($listen, $pidfile) = @ARGV;
} else {
    GetOptions(
        "help|h"       => sub { die "Use 'man qmail-deliverabled' for full documentation.\n" },
        "verbose|v"    => \$verbose,
        "listen|l=s"   => \$listen,
        "pidfile|p:s"  => \$pidfile,
        "stop"         => \$stop,
        "foreground|f" => \$foreground,
    ) or exit 255;
}

($listen) = $listen =~ /^(stop|[0-9.]+:[0-9]+)$/
    or die "Listen argument must be ip:port!\n";

if ($pidfile) {
    ($pidfile) = $pidfile =~ m[^(/[\x20-\xff]+)$]
        or die "pidfile must be an absolute path, beginning with a /.\n";
}

chdir '/';

if ($stop or $listen eq 'stop') {
    die "Cannot --stop without --pidfile.\n" if not $pidfile;
    open my $fh, '<', $pidfile or die "Could not open pidfile $pidfile: $!\n";
    my $pid = readline $fh;
    ($pid) = $pid =~ /^([2-9]|[0-9]{2,})$/
        or die "Could not read PID from $pidfile\n";
    close $fh;
    kill 15, $pid;
    sleep 1;
    kill 9, $pid;
    unlink $pidfile;
    exit;
}


fork && exit unless $foreground;

$verbose && print "My PID is $$.\n";

my $d = HTTP::Daemon->new(
    LocalAddr => $listen,
    ReuseAddr => 1,
) or die "Could not start daemon ($!)";

if ($pidfile) {
    open my $fh, '>', $pidfile or die "Could not open pidfile $pidfile: $!\n";
    print { $fh } $$;
    close $fh or die "Could not write to pidfile $pidfile: $!\n";
}

$SIG{HUP} = sub {
    warn "SIGHUP received.\n";
    reread_config;
    warn "Qmail configuration reloaded.\n";
};

my ($base0) = $0 =~ /([\x20-\x7f]+)/;
my %counter;
$counter{yes} = $counter{no} = 0;

$| = 1;

for (;;) {
    $verbose && printf "Listening on %s.\n", $listen;
    while (my $c = $d->accept) {
        $verbose && printf "Accepted request from %vd.\n", $c->peeraddr;
        while (my $r = $c->get_request) {
            if ($r->method ne 'GET' or $r->uri->path !~ m[^/qd1/]) {
                $verbose && printf "Not a qd request: %s %s\n", $r->method, $r->uri->path;
                $c->send_error(RC_FORBIDDEN);
                next;
            }
            my (undef, undef, $command) = split m[/], $r->uri->path;

            my $arg = uri_unescape($r->uri->query) || "\0";

            ($arg) = $arg =~ /^([\x20-\x7e]*)\z/ or do {
                $verbose && print "Invalid data received.\n";
                $c->send_error(RC_BAD_REQUEST);
                next;
            };

            my $rv;
            if ($command eq 'qmail_local') {
                $verbose && printf "qmail_local('%s') => ", $arg;
                $rv = eval { qmail_local($arg) };
                $verbose && printf "%s\n", $rv;
            } elsif ($command eq 'deliverable') {
                $verbose && printf "deliverable('%s') => ", $arg;
                $rv = eval { deliverable($arg) };
                $verbose && printf "0x%02x\n", $rv;
                $counter{yes}++ if $rv;
                $counter{no}++ if not $rv;
                my $total = $counter{yes} + $counter{no};
                $0 = sprintf "$base0 yes=%d(%.1f%%), no=%d(%.1f%%), total=%d",
                    $counter{yes}, $counter{yes}/$total*100,
                    $counter{no},  $counter{no} /$total*100,
                    $total;

            } else {
                $verbose && print "Unknown command: %s\n", $command;
                $c->send_error(RC_FORBIDDEN);
                next;
            }
            if (defined $rv) {
                $c->send_response( HTTP::Response->new(200, "OK", undef, $rv) );
            } else {
                $c->send_response( HTTP::Response->new(204, "UNDEF", undef, "undef") );
            }

        }
        $c->close;
        undef($c);
    }
    sleep 5;
}

__END__

=head1 NAME

qmail-deliverabled - Deliverabitily check daemon

=head1 USAGE

    qmail-deliverabled [--listen 127.0.0.1:8998] [--pidfile /foo/bar.pid]
    qmail-deliverabled --stop --pidfile /foo/bar.pid

    --stop          Kill the process in the given --pidfile
    --listen        IP and port to listen on, defaults to 127.0.0.1:8998
    --foreground    Don't daemonize, but stay in the foreground
    --verbose       Print debug information while running
    --help          Print usage information and exit.
    --pidfile       Write a pidfile (unless --stop is also given)

=head1 DESCRIPTION

Exposes the Qmail::Deliverable functions C<qmail_local> and C<deliverable>
over HTTP. Typically requires root access for file permissions.

Requires the HTTP::Daemon module, available from CPAN.

Use only with a ::Client of the same version. Returns 403 FORBIDDEN on error,
any error.

A simple init.d-style script is provided in the .tar.gz, in the init.d
directory.

=head1 CAVEATS

The PIDFILE is not used to avoid concurrent processes: it's perfectly fine to
have multiple qmail-deliverableds running on different addresses or ports, but
make sure each combination has its own PIDFILE.

Verbose mode may get messy.

=head1 LEGAL

This software is released into the public domain, and does not come with
warranty or guarantee of any kind. Use it at your own risk.

=head1 AUTHOR

Juerd Waalboer <#####@juerd.nl>

=head1 SEE ALSO

L<Qmail::Deliverable::Client>