From cdent@tepid.kiva.net Mon Jul 26 16:00:04 1999
X-VM-v5-Data: ([nil nil nil nil t nil nil nil nil]
	["8596" "Mon" "26" "July" "1999" "10:57:41" "-0500" "Chris Dent" "cdent@tepid.kiva.net" "<199907261557.KAA20560@tepid.kiva.net>" "348" "Re: Qmail::Queue" "^From:" nil nil "7" nil nil nil nil nil]
	nil)
Return-Path: <cdent@tepid.kiva.net>
Delivered-To: nelson@desk.crynwr.com
Received: (qmail 27843 invoked by uid 0); 26 Jul 1999 16:00:04 -0000
Received: from ns.crynwr.com (nelson@192.203.178.14)
  by desk.crynwr.com with SMTP; 26 Jul 1999 16:00:04 -0000
Received: (qmail 2526 invoked by uid 500); 26 Jul 1999 15:58:06 -0000
Delivered-To: nelson@crynwr.com
Received: (qmail 2523 invoked by uid 0); 26 Jul 1999 15:58:05 -0000
Received: from tepid.kiva.net (206.97.64.5)
  by pdam.crynwr.com with SMTP; 26 Jul 1999 15:58:05 -0000
Received: (from cdent@localhost)
	by tepid.kiva.net (8.8.7/8.8.7) id KAA20560;
	Mon, 26 Jul 1999 10:57:41 -0500
Message-Id: <199907261557.KAA20560@tepid.kiva.net>
In-Reply-To: <7ngg8k$8k$1@topsy.kiva.net>
Organization: Kiva Networking
From: Chris Dent <cdent@tepid.kiva.net>
To: nelson@crynwr.com
Cc: 
Subject: Re: Qmail::Queue
Date: Mon, 26 Jul 1999 10:57:41 -0500

In article <7ngg8k$8k$1@topsy.kiva.net> you write:
>Anybody written a Perl module for Qmail::Queue?

I'm not sure if the Module include in this message is what you
are after, but if it is, you are welcome to it. It needs some
cleaning, and it probably ought to cpan'ified...any comments or
suggestions you have would be welcome.

We use this to inject a newsletter to our ISP customers. If you
want to see some example code I can provide it. 

However, not know what you are after, I dunno if this has
anything to do with what you are trying to do...


------0XsnipX0------
# vi:sw=4:ts=4:sm:ai:wm=0:et

# $Id: Enqueue.pm,v 1.4 1999/03/31 02:58:58 cdent Exp $
# $Source: /usr2/sarc/cvsroot/qmail-enqueue/Enqueue.pm,v $

# Qmail::Enqueue.pm
# a module to enqueue a message to qmail
# via qmail-queue
# Chris Dent <cdent@kiva.net>
# Copyright 1999, Kiva Networking
# released under the same license as perl

# takes a sender, an open message filehandle, and a list of
# recipeints and uses that to cause qmail-queue to write the
# message into the queue. Purpose is to make things FAST

package Qmail::Enqueue;

use strict;
use IO::File;
use POSIX qw(strftime);
use Net::Domain qw(hostfqdn);

# some constants
my $QMAIL_QUEUE = '/var/qmail/bin/qmail-queue';

# some globals
my $Errstr = '';

# create the object
# see perltoot for more on the ref thing
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless ($self, $class);

    # set some values
    $self->{'errstr'} = '';

    return $self;
}

# get the error
sub geterr {
    my $self = shift;
    return $self->{'errstr'};
}

# internal error setting routing
sub _seterr {
    my $self = shift;
    my $message = join('', @_);
    $self->{'errstr'} = $message;
}

# figure out the timezone offset
sub _figuretz {
    my $sign;
    # 12 hours into the first day of the epoch
    my $diff = (localtime(12*60*60))[2] - (gmtime(12*60*60))[2];
    if ($diff <= 0) {
        $sign = '-';
    } else {
        $sign = '+';
    }

    $diff = abs($diff);

    if ($diff < 10) {
        return "${sign}0${diff}00";
    } else {
        return "${sign}${diff}00";
    }
}

sub _create_mid {
    # need to get hostname
    my $hostname = hostfqdn;
    return "<" . time . ".$$\@$hostname>";
}

# preprocess to make sure it has the proper date in it
# and other headers as well
sub process_message {
    my $self = shift;
    my %params = @_;

    # need the message file
    # the subject
    # the sender

    my $fail = 0;
    my $file = $params{'file'} || ($fail = 1);
    my $sender = $params{'sender'} || ($fail = 1);
    my $subject = $params{'subject'} || ($fail = 1);
    my $tostring = $params{'tostring'} || ($fail = 1);

    if ($fail) {
        $self->_seterr("missing required parameters");
        return undef;
    }

    if ($sender !~ /\@/) {
        $self->_seterr("sender address not fully defined");
        return undef;
    }

    # create the date header
    my $tz = _figuretz();
    my $date = strftime("%a, %d %b %Y %H:%M:%S", localtime(time));
    $date = "$date $tz";

    # create Message-Id
    my $mid = _create_mid();

    my $fh = new IO::File;
    $fh->open($file) || do {
        $self->_seterr("unable to open $file: $!");
        return undef;
    };

    $self->{'handle'} = new_tmpfile IO::File || do {
        $self->_seterr("unable to create and open tmpfile: $!");
        return undef;
    };
    $self->{'handle'}->autoflush(1);

    select($self->{'handle'});
    print "Date: $date\n";
    print "From: $sender\n";
    print "To: $tostring\n";
    print "Subject: $subject\n";
    print "Message-Id: $mid\n";
    print "\n";
    while (defined($_=<$fh>)) {
        print;
    }
    $fh->close;
    select(STDOUT);

    # seek back to the top of the file so when we read on it
    # later it won't be a huge deal
    seek($self->{'handle'}, 0, 0);

    $self->{'sender'} = $sender;
    
    return $self;
}

# actually send the message
sub send_message {
    my $self = shift;

    my $sender = $self->{'sender'};
    my %params = @_;
    my $listref = $params{'listref'} || do {
        $self->_seterr("no list reference for destinations supplied");
        return undef;
    };

    $self->{'handle'} ||= $params{'handle'};

    if(!defined($self->{'handle'})) {
        $self->_seterr("no filehandle to process in send_message");
        return undef;
    }

    # open the message

    pipe(EOUT, EIN) || do {
        $self->_seterr("unable to start pipe: $!");
        return undef;
    };

    # forking in a module, should be a blast

    my $pid = fork;
    if (!defined $pid) {
        $self->_seterr("unable to fork: $!");
        return undef;
    } elsif ($pid == 0) {
        # deep in the belly of the child
        my $num = fileno($self->{'handle'});
        open(STDIN, "<&=$num") || do {
            $self->_seterr("unable to dup message: $!");
            return undef;
        };
        open(STDOUT, '<&EOUT') || do {
            $self->_seterr("unable to dup pipe in child: $!");
            return undef;
        };
        close(EIN);
        exec "$QMAIL_QUEUE" || do {
            $self->_seterr("exec did not happen: $!");
            return undef;
        };
    } else {
        # non gender specific parent
        close(EOUT);
        print EIN "F$sender\0";
        print EIN map { "T$_\0" } @$listref;
        print EIN "\0";
        close EIN || do {
            $self->_seterr("unable to write envelope: $!");
            return undef;
        };
    }

    waitpid $pid, 0;
    if (($?>>8) != 0) {
        $self->_seterr("qmail-queue exixted nonzero: ", $?>>8);
        return undef;
    }

    return $self;
}

1;

=cut

=head1 NAME

Enqueue - a module for injecting a message into qmail's queue

=head1 SYNOPSIS

    # one way to do it
    use Qmail::Enqueue;
    $queue = new Qmail::Enqueue;
    $queue->send_message(\@recipients, \$msghandle);
    # TMTOWTDI

=head1 DESCRIPTION

Enqueue is a perl module that allows you quickly inject a message
with an arbitrary number of recipients into the qmail queue, for 
extra fast delivery. It injects only one copy of the message for all
the recipients, saving time and space.

In it's most basic form (above) it requires that the file associated
with msghandle be a fully formed RFC 822 compliant text file that
includes a 'To:', 'From:', 'Date:' and 'Message-ID:'. If you do not
include that information it will still send the message but it will be
bad form.

If you have a text file that does not have all these things you can
use the process_message method to process a text file to make it the
body of the message. This creates a temporary file which has it's
handle passed (automaticaly) to the send_message method. Example:

    use Qmail::Enqueue;
    my $queue = new Qmail::Enqueue;
    unless (defined($queue->process_message(
                              'file'     => $message,
                              'sender'   => $from,
                              'tostring' => $TO,
                              'subject'  => $subject,))) {
      die "process_message failed with ", $queue->geterr, "\n";
    }
    unless (defined($queue->send_message('listref' => \@recipients))) {
        die "send_message failed with ", $queue->geterr, "\n";
    }

=head1 METHODS

=over 4

=item B<new>

Initializes the class object.

=item B<geterr>

After the object has been created use this to access any error
messages that are left behind when a method returns undef.

=item B<process_message>

Turns a text body into a full message. Requires four arguments:

=over 4

=item B<file>

A pathname to the file.

=item B<sender>

The string that will show up in the 'From:' of the message. Expects
this address to have an @ in it.

=item B<subject>

The string that will be the subject of the the message.

=item B<tostring>

The string that will show up in the 'To:' of the message.

=back

If you use the process_message method you should not pass a filehandle
reference to send_message as this is handle automagically.

=item B<send_message>

Do the actual injection of the message. Takes B<listref> and B<handle>
as parameters. listref is required, handle is not if you used the
process_message method. listref is a reference to a list of recipient
addresses.

=back

=head1 BUGS

This version hard codes the location of the queue into the module. Easy
to fix, but not done yet.

=head1 COPYRIGHT

This program is copyright Kiva Networking, 1999 but is distributable
under the same license as perl.

=head1 AUTHOR

Chris Dent E<lt>cdent@kiva.netE<gt>


------0XsnipX0------