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

=head1 NAME

whitelist - add mail addresses to the whitelist

=head1 SYNOPSIS

~/system/bin/whitelist

~/system/bin/whitelist I<address>*

=head1 DESCRIPTION

If mail addresses are specified, adds them to the local copy of my TMDA whitelist
(if not already present there).
Synchronizes the remote whitelist on the mail server, in any case;
and on the backup server, if it is running.

Makes exceptions for my own zelea.com addresses,
because spam headers often masquerade as self-directed;
and one of my rogers.com addresses, which I use to test TMDA challenges.
These are never added to the list.

Prints any warnings (!!) to standard out, not standard error,
per DESCRIPTION of system/bin/mail-send (the usual caller).

=cut

use File::Copy ();
use File::stat qw( stat );
use IO::Handle qw( autoflush ); STDOUT->autoflush( 1 ); # for fast traces # otherwise flushes may be delayed till newline
use Net::Ping ();



    sub _save_white_address( $ ); # ( file ) [this can now go in line]

    our @_white_address;



   # Add new addresses, if any specified.
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    my $whitelist_file = '/home/mike/.tmda/white.address';
    if( scalar @ARGV )
    {
        open FILE, '<' . $whitelist_file or die $!;
        {
            @_white_address = <FILE>;
            close FILE;
        }
        chomp @_white_address;

        my $is_added = 0; # till proven otherwise
        for my $address( @ARGV )
        {
            $address = lc $address; # TMDA email address files (e.g. whitelist) are case insensitive

          # $address =~ m'^mike(?:-.*)?@zelea\.com$' and next;
          ## Leave out all zelea.com addresses. They are mostly public, and likely to be used by spammers as fake sender addresses. So, for the few that I actually want to receive mail from, I must manually add them to my incoming filter.
            $address =~ m'@zelea\.com$' and next;
            $address eq 'michael.c.allan' . # obfuscated, in case this script published to Web:
              '@rbs.rogers.com' and next; # this is my 'unknown-sender' test address, that is always to be challenged, and so never added to whitelist

            print "in whitelist...";
            if( grep( $_ eq $address, @_white_address ))
            {
                print 'found';
            }
            else
            {
                print 'not found, adding';
                push @_white_address, $address;
                $is_added = 1;
            }
            print ":  $address\n";
        }
        if( $is_added )
        {
          # print "  sorting $whitelist_file...";
            @_white_address = sort @_white_address;
          # print "  saving...";
            _save_white_address( $whitelist_file );
          # print "  done.\n";
        }
    }

   # Synch up the remote whitelist on mail server.
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    for my $server( 'mail' )
    {
        my $pinger = Net::Ping->new( 'udp' ); # default 'tcp' does not connect if server has booted up, only recently, and not yet handled (TCP?) traffic
        print "  whitelist to $server.zelea.com...";
        if( !$pinger->ping( $server, 2 )) # server, timeout s. # FIX to avoid assuming that 77 is the backup mail server. Take a specific option, to add other servers to this list, instead of assuming.
        {
            print "  no.\n";
            next;
        }

        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";
                  # print "  mounting $server...";
                    system $command and die 'unable to execute: ' . $command;
                    $was_mounted_here = 1;
                }
                close MTAB;
            }
        }
        my $whitelist_file_on_server = $mountpoint . $whitelist_file;
      # print "  comparing modtime $whitelist_file_on_server...";
        my $mtime = stat($whitelist_file)->mtime;
        if( !-e $whitelist_file_on_server
         || $mtime != stat($whitelist_file_on_server)->mtime )
        {
          # print "  updating...";
            File::Copy::copy( $whitelist_file, $whitelist_file_on_server ) or die $!;
            utime( time, $mtime, $whitelist_file_on_server ) or die;
        }
        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";
          # print "  unmounting $server...";
            system $command and die 'unable to execute: ' . $command;
        }
        print "  done.\n";
    }

    exit;



sub _save_white_address( $ )
{
    my $file = shift;
    open FILE, '>' . $file or die "$file: $!";
    {
        for( @_white_address )
        {
            print FILE;
            print FILE "\n";
        }
        close FILE;
    }
}



__END__
=pod

=head1 AUTHOR

Michael Allan <mike@zelea.com>

=cut