Qmail::Deliverable::Client - Client for qmail-deliverabled


Qmail-Deliverable documentation Contained in the Qmail-Deliverable distribution.

Index


Code Index:

NAME

Top

Qmail::Deliverable::Client - Client for qmail-deliverabled

SYNOPSIS

Top

    use Qmail::Deliverable::Client qw(deliverable);

    $Qmail::Deliverable::Client::SERVER = "127.0.0.1:8998";

    if (deliverable "foo@example.com") { ... }

DESCRIPTION

Top

Qmail::Deliverable comes with a daemon program called qmail-deliverabled. This module is a front end to it.

This module requires LWP (libwww-perl), available from CPAN.

Error reporting

The error message for communication failure is reported via a warning, but also available via $Qmail::Deliverable::Client::ERROR.

Configuration

$Qmail::Deliverable::Client::SERVER

IP adress and port of the qmail-deliverabled server, joined by a colon. Defaults to 127.0.0.1:8998, just like the daemon.

This variable can also be assigned a code reference, in which case it is called in scalar context for each remote call, using the returned value.

If the value is undef, then a connection failure is faked, but without the warning.

Functions

All documented functions are exportable, and a tag :all is available for convenience.

Unless documented differently, these functions follow the interfaces described in Qmail::Deliverable.

qmail_local $address

As Qmail::Deliverable::qmail_local. Warns and returns "" on communication failure.

deliverable $address
deliverable $local

As Qmail::Deliverable::deliverable. Warns and returns 0x2f on communication failure.

PERFORMANCE

Top

The server on which I benchmarked this, the client+daemon combination (on localhost) reached 300 deliverability checks per second for assigned/virtual users. Real users are slower: around 150 checks per second.

LEGAL

Top

AUTHOR

Top

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


Qmail-Deliverable documentation Contained in the Qmail-Deliverable distribution.

package Qmail::Deliverable::Client;

use strict;
use 5.006;
use Carp qw(carp);
use base 'Exporter';
use LWP::Simple qw($ua);
use URI::Escape qw(uri_escape);

our @EXPORT_OK = qw/qmail_local deliverable/;
our %EXPORT_TAGS = (all => \@EXPORT_OK);

our $SERVER = "127.0.0.1:8998";
our $ERROR;

# rfc2822's "atext"
my $atext = "[A-Za-z0-9!#\$%&\'*+\/=?^_\`{|}~-]";
my $valid = qr/^(?!.*\@.*\@)($atext+(?:[\@.]$atext+)*)\.?\z/;

sub _remote {
    my ($command, $arg) = @_;

    my $server = ref($SERVER) eq 'CODE'
        ? $SERVER->()
        : $SERVER;

    if (not defined $server) {
        $ERROR = "No SERVER defined; connection not attempted";
        return "\0";
    }

    my $response = $ua->get(
        "http://$server/qd1/$command?" . uri_escape($arg)
    );

    my $code = $response->code;
    return undef if $code == 204;  # rpc undef

    my $sl = $response->status_line;
    if ($code == 200) {
        return $response->content;
    }

    carp $ERROR = "Server $server unreachable or broken! ($sl)";
    return "\0";
}

sub qmail_local {
    my ($in) = @_;
    my ($address) = lc($in) =~ /$valid/ or
        do { carp "Invalid address: $in"; return; };

    # This we can do locally. Let's not waste HTTP requests :)
    return $address if $address !~ /\@/;

    my $rv = _remote 'qmail_local', $address;
    return "" if defined $rv and $rv eq "\0";
    return $rv;
}

sub deliverable {
    my ($in) = @_;
    my ($address) = lc($in) =~ /$valid/
        or do { carp "Invalid address: $in"; return; };

    my $rv = _remote 'deliverable', $address;
    return 0x2f if not defined $rv;  # shouldn't happen
    return 0x2f if not length $rv;   # shouldn't happen
    return 0x2f if $rv eq "\0";

    return $rv;
}

1;

__END__