Re: uploading mail batches

Hi Kragen,

* Kragen Javier Sitaker <[email protected]> [2006-09-09 09:37]:
> I picked Perl because I'm more familiar with CGI.pm than cgi.py, and I
> knew it could handle file uploads, but in retrospect this probably
> would have been simpler in Python, for the following reasons: 
> - cgi.py's interface for getting uploaded file contents was
>   what I went to 7 lines of trouble to duplicate here, which
>   doesn't sound bad except that one of them had a bug that took
>   me half an hour to track down due to Perl's gratuitous use of
>   a global variable
> - 8 different lines here have code to explicitly raise an
>   exception if an I/O operation fails, which is what I wanted
>   and happens to be the default behavior in Python

Except for raising exceptions from `print` (which cannot be
overridden), you can avoid that with

    use Fatal qw(:void open close rename);

But you could avoid most of the toil in your code anyway using
File::Slurp, which is very handy for trivial file work but
unfortunately not in core.

However, about half the code is just for managing the password
file. Since its purpose is to look up the password and remove it
if it’s there, I’d just use a tied DBM file and be done with it.

The code can be simplified further by not fighting CGI.pm’s
handle-based upload API.

Overall, something like this:

    #!/usr/bin/perl
    use strict;
    use warnings;
    use CGI qw( :standard );

    my $password_dbm = '/home/kragen/mail-passwords';
    my $mailmsgpy    = '/home/kragen/mailmsg.py';

    sub page_default {
        my ( $message ) = @_;
        print(
            header,
            start_html( 'upload file' ),
            ( $message ? p b escapeHTML $message : () ),
            h1( 'upload file' ),
            start_multipart_form, (
                filefield( 'file' ),
                submit,
            ), end_form,
            end_html,
       );
    }

    sub page_sending {
        my ( $body_callback ) = @_;
        print header, start_html( 'sending email' ), "<pre>\n";
        $body_callback->();
        print "</pre>", p( 'done' ), end_html;
    }

    sub check_password {
        my ( $dbm, $password ) = @_;
        return if not $password;
        my $db = tie my %pwd, DB_File => $dbm
            or die "Cannot open '$dbm': $!\n";
        0 == $db->del( $password );
    }

    sub assert { die "Can't $_[0]: $!\n" unless $_[1] }

    sub main {
        $|++;

        if ( request_method eq 'GET' ) {
            page_default;
        }
        elsif ( request_method eq 'POST' ) {
            my $upfh = upload 'file';

            if ( cgi_error or not $upfh ) {
                page_default 'No file uploaded or upload error';
                return;
            }

            my $password = <$upfh>;

            unless ( check_password $password_dbm, $password ) {
                page_default "Bad password: I don't see $password";
                return;
            }

            page_sending sub {
                my $data;
                local $/ = \65536; # read 64kb chunks
                assert 'open pipe', open my $pipe, '-|', $mailmsgpy, 'send';
                assert 'write to pipe', print $pipe $data
                    while defined( $data = <$upfh> );
                assert 'close pipe', close $pipe;
            };
        }
        else {
            die "Bad request method\n";
        }
    }

    main

Caveat: untested.

A script to add passwords to the DBM file is trivial and
therefore left as an excercise for the reader. :-)

This is longer than your code, actually, but also sparser, with
better distribution of responsibilities, and it has an extra
sanity check for broken uploads.

-- 
*AUTOLOAD=*_;sub _{s/(.*)::(.*)/print$2,(",$\/"," ")[defined wantarray]/e;$1}
&Just->another->Perl->hack;
#Aristotle