#!/usr/bin/perl
use strict; use warnings;
=pod

=head1 SYNOPSIS

get-mail [mail|offline]

=head1 DESCRIPTION

Transfers my mail messages from the specified server to the delivery agent.
Exit value is 0 (normal) if messages were transferred; 1 otherwise.

=cut

require Mail::Box::Maildir;


    my $server = shift; defined $server or $server = 'mail';

    {
        my $user_name = `whoami`; chomp $user_name; # guard against root running it
        my $expected_name = 'mike'; # so mail files deletable by him
        $user_name eq $expected_name or die "must run as user '$expected_name'";
    }
    my $message_count = 0; # thus far

    my $command;

    my $mountpoint = "/mnt/lan/$server";
    my $was_mounted_here = 0; # till proven otherwise
    {
        open MTAB, "</etc/mtab" or die $!;
        {
            if( ! grep / $mountpoint /, <MTAB> )
            {
                $command = "/bin/mount $mountpoint";
                system $command and die 'unable to execute: ' . $command;
                $was_mounted_here = 1;
            }
            close MTAB;
        }
    }

  # for my $folder_path ( '/home/mike/.mail', '/var/qmail/alias/.mail' )
  ### no permission for /var/qmail/alias/, and qmail is fussy about changing them. Use forwarding there, instead.
    for my $folder_path ( '/home/mike/.mail' )
    {
        my $folder = Mail::Box::Maildir->new
        (
            access => 'rw', folder => "/mnt/lan/" . $server . $folder_path,
            remove_when_empty => 0
        );
        my @message = $folder->messages;
        my $folder_message_count = scalar @message;
        print "messages on $server:$folder_path: $folder_message_count\n";
        my $m = 0; # to start
        for my $message( @message )
        {
            ++$m;
            print "$m/$folder_message_count: " . $message->messageId;

            my @lines = $message->lines;
            $command = '/home/mike/system/libexec/mail-deliver';

           # append spam tokens
           # ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` `
        #   my $html_escaped_letter = '%41|%42|%43|%44|%45|%46|%47|%48|%49|%4a|%4b|%4c|%4d|%4e|%4f|%50|%51|%52|%53|%54|%55|%56|%57|%58|%59|%5a|%61|%62|%63|%64|%65|%66|%67|%68|%69|%6a|%6b|%6c|%6d|%6e|%6f|%70|%71|%72|%73|%74|%75|%76|%77|%78|%79|%7a'; # they use escaped encodings to hide
        #   if
        #   (
        #       grep( m`href\s*(?:=|=3D)\s*['"][^'"]*(?:$html_escaped_letter)`, @lines )
        #                         # =3D, apparently per header Content-Transfer-Encoding: quoted-printable
        #  # || grep( m`^Subject: .*(?:\\\d\d.*){8,}`, @lines )
        #  #                          # at least 8 \codes, as in Subject: \250z\245\346\253\341\247\342\247\314\247\314\251
        #  ### but those \codes just mean the terminal can't display the characters, so:
        #    || grep( m'^Subject: .*(?:[\x80-\xFF].*){15,}', @lines )
        #                                  # at least 15 non-ASCII characters
        #    || grep( m'^Content-Transfer-Encoding: base64', @lines ) # they often load images and such crap

        #  # || grep( m'http://www\.(?:buy999\.net|dvd120\.com)', @lines )
        #    || grep( m'http://positiff\.net', @lines )
        #    || grep( m'(?:mortgageonelv\.net|realtyonelv\.net|verticalonelv\.com)', @lines )
        #    || grep( m'i-am-waiting4love\.com', @lines )
        #    || grep( m'\[Add to cart\]', @lines ) > 3
        #    || grep( m'http://.*sablesheaf\.com', @lines )
        #    || grep( m'http://.*demiluneba\.com', @lines )
        #   ){
        #       $command .= ' google-groups-spam';
        #   }

           # deliver
           # ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` ` `
            my $command_exit;
            open COMMAND, "| $command" or die "fork failure: $!";
            {
                local $SIG{PIPE} = sub { die "pipe broke on '$command'" };

                foreach( @lines )
                {
                    print COMMAND;
                }

                close COMMAND; # blocks till command process finishes
                $command_exit = $?;
            }

            my $command_exit_status = $command_exit >> 8;
            $command_exit_status and die "'$command' exit status: $command_exit_status";

            my $command_exit_signal = $command_exit & 0xFF;
            !$command_exit_signal or die "'$command' terminated by signal: $command_exit_signal";

            $message->delete;
            print "\n";
        }
        $folder->close;

        $message_count += $folder_message_count;
    }

    if( $was_mounted_here )
    {
      # $command = "/bin/umount $mountpoint";
      ### user umount returns exit status 1, even though it succeeds (as of build 2007-11-19)
        $command = "sudo /bin/umount $mountpoint";
        system $command and die "unable to execute: $command";
    }

    exit( $message_count == 0 );


__END__
=pod

=head1 AUTHOR

Michael Allan <mike@zelea.com>

=cut