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

use HTTP::Daemon;
use HTTP::Status;
use URI::Escape qw(uri_unescape);
use Qmail::Deliverable ':all';

my ($listen, $pidfile) = @ARGV;

$listen ||= "127.0.0.1:8998";
($listen) = $listen =~ /^(stop|[0-9.]+:[0-9]+)$/
    or die "Listen argument must be ip:port!\n";
($pidfile) = $pidfile =~ m[^(/[\x20-\xff]+)$]
    or die "pidfile must be an absolute path, beginning with a /.\n";

chdir '/';

if ($listen eq 'stop') {
    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;

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

{
    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;
my %counter;
$counter{yes} = $counter{no} = 0;

for (;;) {
    while (my $c = $d->accept) {
        while (my $r = $c->get_request) {
            if ($r->method ne 'GET' or $r->uri->path !~ m[^/qd1/]) {
                $c->send_error(RC_FORBIDDEN);
                next;
            }
            my (undef, undef, $command) = split m[/], $r->uri->path;

            my $arg = uri_unescape($r->uri->query);

            my $rv;
            if ($command eq 'qmail_local') {
                $rv = qmail_local($arg);
            } elsif ($command eq 'deliverable') {
                $rv = deliverable($arg);
                $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 {
                $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 [PIDFILE]]
    qmail-deliverabled stop PIDFILE

LISTEN is the IP address and port to listen on. Defaults to "127.0.0.1:8998" if
no arguments are given.

PIDFILE is the absolute path where you want qmail-deliverabled to store (or
read) its process ID. If no PIDFILE is given, none is written.

=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.

=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>
