#!/usr/bin/perl -w
use strict;              # Be prudent, turn on warnings and strict behavior

# remoteMM - A REMOTE Mail Manager.  Loosely based on the popread utility
#            program which comes with the Mail::Audit module of CPAN.
#            Edited to allow administration of the remote INBOX of mail
#            via POP, the remote INBOX and SENT mail boxes via IMAP,
#            and to download remote mailboxes (INBOX, SENT, ...) via
#            FTP.

# An area of user configurable variables exists within this file.  It
# allows the user to specify the configuration file, the folder (directory)
# to put mail boxes into.  
# Mind you, the interface for configuring within this program is clunky
# too.  The only other area where I think a user might want to make
# changes is the filter() subroutine, and the trailing functions spam()
# and trash() to deal with spam and trash email.

# 2003/05/19: After running this a few times, in preparation for letting
# it go automagically, I've noticed that it makes directories under
# ~/rmmail/folders of new, cur and tmp.  In addition, when I've noticed
# this, the "new" directory seems to contain messages not filed elsewhere
# and cur/tmp seem to be empty.  Why is this happening?  
#  This seems to be related to MailList detection and saving.  Not behaving
#  as advertised in man page.

# Also, in FTP mode it is still screwing up where/how to write sent-mail
# folders.

# Modules used:
use  Getopt::Std;

use  Mail::POP3Client;
use  Mail::IMAPClient;
use  Net::FTP;

use  Mail::Audit qw(List);
use  Mail::SpamAssassin;
use  Mail::Send;
use  Clone qw(clone);

use  LockFile::Simple qw(lock trylock unlock);
use  Date::Manip;                # Swiss army chainsaw of date arithmetic

use  XML::Simple;   # To read config file (Could read and write with this)
use  XML::Writer;   # To write config file.
use  IO::File;      # For writing file.

use  Mail::Folder::Mbox;
use  Mail::Folder::Maildir;
use  Mail::Internet;
#use  MIME::Head;      # We don't care if it is MIME or not.


#use  Data::Dumper;  # To see what a struct looks like in debugging.

# Getopt is there to parse the command line, as you would expect.  

# Mail::Audit, SpamAssassin and Send are there to deal with
# incoming messages (file them, detect them as spam, bounce them,
# forward them, ...).  In this regard, Clone is there to assist 
# in this.  A Mail::Audit item can only have a single ending:
# accept it into a file, forward it, bounce it.  So, if you want
# do do more than 1 of these; I'll try cloning the object.  Note:
# If I want to do something with spam, I should clone the objects.
# Mail::Audit is supposed to lose the contents of an object once
# it has been accepted (for some reason, it doesn't seem to).

# POP3Client, IMAPClient and FTP are there to download/manage the
# remote mail.  If you wanted to add support for things like downloading
# email from Yahoo, Hotmail, ...; you would probably need to find
# or make a module similar to these.

# Lockfile is there to allow the locking of files, something which
# should be done if there is a possibility of 2 or more programs
# interacting with a file.  Here, it is sort of overkill, unless
# the user adjust things such that normal email on the machine
# tries to write to one of the files this program does
# (like ~/mail/inbox).

# Date::Manip may be overkill, it is the most capable of the perl
# date parsing utilities (read slow).  I have run across dates
# in email that are not easily analysed for dates.  Since you are
# working with more or less fixed sets of remote sites, the fastest
# solution would be to write custom date parsing/re-arranging
# expressions for each site, and call one of the faster perl/C
# modules for working with that date.  However, I believe the
# slowest part of this program is running through SpamAssassin,
# so it's not really worth speeding up a seldom used routine.

# XML::Simple and XML::Writer are there to allow me to use a XML
# based init file.  I probably could get by with just XML::Simple,
# as it has input and output support.  Although simple, I do need
# to massage the structure produced by XMLin().

# Mail::Folder and Mail::Internet (possibly MIME::Head) are there
# to allow this program to process the contents of mail downloaded
# by the FTP functionality.  A person may want to use this for
# arbitrary mail processing with no defined FTP accounts, as the
# first thing the FTP support does is look in its directory for
# old mail files to process.  Once those are processed (and deleted),
# it will move on to downloading other email using FTP.

# Data::Dumper is there for debugging support, so I can see what
# a structure looks like.  Not needed in running program.

# In places, this program assumes things about files.  Such that
# mail sent by us is in a file =~ /(SENT-MAIL|OUTBOX)/i, or that remote
# files under mail/ is only mail.  There is only so much functionality
# available, I can't call file to tell me what the contents are
# remotely.


my( %midcache );
my( @Account_Keys, @POP_Keys, @IMAP_Keys, @FTP_Keys, @mail, @log );
my( $Account_RE, $POP_RE, $IMAP_RE, $FTP_RE,
    $RMMAIL, $maildir, $virusdir, $config_file, $NOW, $log_connected );

# Try to track down this directory creation thing.
my( $made_new, $made_cur, $made_tmp ) = (0, 0, 0);

# Okay, start of program.  We have a few variables defined only via
# getopts, shield these variables with a use vars() statement.  Next,
# call getopts() to parse the command line.  If the user asked for
# help, call usage (and die).

use vars qw($opt_c $opt_h $opt_b $opt_f $opt_t $opt_l $opt_P $opt_I $opt_F $opt_z);

getopts('chbftlPIFz');
&usage() if( $opt_h );




# Get the local time, and from that "calculate" a name for the spam file.
my @ltime       = localtime( time );
my $day         = $ltime[3];
my $month       = $ltime[4] + 1;
if( $opt_t ) {
    if( -e "rmmail.session.$month.$day" ) {
	die "Sorry, please delete rmmail.session.$month.$day before testing\n";
    }
    open( SESSION, "> rmmail.session.$month.$day" ) ||
	die "Can't open rmmail.session.$month.$day for some reason. $!\n";
}


# remoteMM_init will create an empty config file of proper permissions
# if it doesn't already exist.  However, we need data in that file.  So
# flag for configuring the file if it doesn't exist yet.  It also checks
# for things like the owner of the config file being the person running
# it, and effective and real UID being the same.  $config_file is defined
# in a BEGIN block, so that isn't a problem.

my $configure_me = -e $config_file ? 0 : 1;
remoteMM_init();

if( $opt_c || $configure_me ) {
    &write_xmlconfig();
    exit;
}
my $rmmail = &read_xmlconfig();
$rmmail    = &flushout_rmmail( $rmmail );



# I don't have the logic here to loop over multiple protocols.  So,
# make sure the user only calls a single protocol.
my $protocols = 0;
$protocols++    if $opt_P;
$protocols++    if $opt_I;
$protocols++    if $opt_F;
&usage( "Only one protocol (PIF)" )    if( $protocols >  1 );
&usage( "Specify one protocol (PIF)" ) if( $protocols == 0 );



# "Calculate" a name for the spam file.
my $spam = "$maildir/spam.$month.$day";

# Presence of lockfile (and age less than 1 hour by default), stops
# another program from access same files.
my $lock = "$RMMAIL/lock";


# The following structs are used in filter() and mbox_it().  These
# structures are slightly different than what is in that part of
# the $rmmail struct.
my $prespam_whereto  = &extract_prespam(    $rmmail );
my $postspam_whereto = &extract_postspam(   $rmmail );
my $my_remote        = &extract_remote_uid( $rmmail );
my $trashme          = &extract_trash(      $rmmail );
my $remote_monitor   = &extract_remote(     $rmmail );


# We cache messages downloaded, or at least a simple version of
# this.  It may help in avoiding downloading of email that we
# already have.  There are better ways to do this, I haven't
# coded anything.
if( -e "$RMMAIL/$rmmail->{message_cache}" ) {
    %midcache = map {chomp; $_ => 1}
                `tail -50 "$RMMAIL/$rmmail->{message_cache}"`;
}


# Do we forward or bounce spam?  Forwarding is used in case we want
# to send copies of spam mail to a service that helps others in
# verifying the email is spam.  There isn't much sense in sending
# email verified as spam by SpamAssassin, since this remote service
# either has SpamAssassin, or something similar.  This would be better
# used for email you see, that has escaped the automagic spam detection
# method.  Bouncing the spammed email to the sender, in the hopes that
# they will take you off their mailing list is usually fruitless.  Either
# the email header is forged and we can't trust the apparent sender, or
# they just don't care.  It might be worthwhile bouncing a message the
# first time you receive email from them, or once every "long period
# of time" (year ?), just in the hopes of getting the other end to quit
# spamming you.  I don't have logic here to do this.
my( $forward_spam, $bounce_spam );
if( exists( $rmmail->{forward} ) && $opt_f ) {
    $forward_spam = 1;
}
if( $rmmail->{bounce} && $opt_b ) {
    $bounce_spam = 1;
}



# Program is about ready to start.  Straighten out LOG and try to
# "lock" things from other programs.
die "Process already locked by $lock\n" unless trylock( $lock );


open( LOG, ">> $RMMAIL/$rmmail->{logfile}" ) || die "Can't open log file: $!\n";
print LOG @log;
$log_connected = 1;
&log_it("============================================================");
$NOW = scalar( localtime( time ) );
&log_it("Finished initializing at $NOW\n");





# Okay.  We could use POP to work with a remote INBOX.  We can use
# FTP (or other copy programs) to get copies of complete remote
# mbox's of any kind (including sent-mail boxes).  Or we can use
# IMAP to work with remote mbox's of any kind.  Pass into the
# subroutines for accessing remote mail, a list of accounts to
# work with, and a list cache for names of files being transferred 
# or to be transferred.

if( $opt_P ) {
    my $pop_accounts  = &extract_pop_accounts( $rmmail );
    &use_pop(  $pop_accounts, \%midcache );

} elsif( $opt_I ) {
    my $imap_accounts = &extract_imap_accounts( $rmmail );
    &use_imap( $imap_accounts, \%midcache );

} elsif( $opt_F ) {
    my $ftp_accounts  = &extract_ftp_accounts( $rmmail );
    &use_ftp( $ftp_accounts );

} else {
    die "Strange, protocol evaporated?!?\n";
}

# Cache what we downloaded.
open( OUT, "> $RMMAIL/$rmmail->{message_cache}") or die $!;
print OUT "$_\n" for keys(%midcache);
close( OUT );

&log_it("Finished mail run");
unlock( $lock );

close( SESSION ) if( $opt_t );
close( LOG );

# ========================================================================
# Done
# ========================================================================




# A couple of things need to be done very early, so they are in a
# BEGIN block.  If a user doesn't like rmmail, rmmail/folders,
# rmmail/.config as files/directories, this is where they would
# change them.  Some information needs to get logged, before we
# have opened a log file.  The log_it routine takes care of this.
BEGIN {
    $RMMAIL        = "$ENV{HOME}/rmmail";   # Must not have trailing slash!
    $maildir       = "$RMMAIL/folders";     # Place to write mbox's
    $virusdir      = "$RMMAIL/virii";       # Place to write msg's to scan
    $config_file   = "$RMMAIL/.config";     # Don't use ~/
    $log_connected = 0;
    &log_it("==startup===================================================");
    $NOW = scalar( localtime( time ) );



# This needs to be defined early.
sub log_it {
    my $string = shift;
    my( $second, $minute, $hour, @junk ) = localtime( time );

    my $msg = sprintf( "%02d:%02d:%02d %s\n", $hour, $minute, $second, $string );
    if( $log_connected == 1 ) {
	print LOG "$msg";
    } else {
	push( @log, $msg );
    }
}
}





# ================================================================
# Here is the part where we filter the @mail message.  We want to
# analyse the mail for being spam, and we want to distribute it to
# various folders/places. One being, the SQL dbase which we get
# "views" from.

sub filter {
    my @mail = &fix_EOL( @_ );
#    my @mail      = @_;
    my( $me, $msg_string );

    # Get a copy of the message, as a mbox_string, before Mail::Audit
    # alters the @Mail array.
    $msg_string = "";
    foreach (@mail) {
	$msg_string .= $_;
    }

    # Set up Mail::Audit.  Note, our emergency mbox will not clash
    # with any real mbox, if we put it in the RMMAIL directory
    # instead of somewhere under $maildir.  Also, it is easier
    # to find.
    my $item = Mail::Audit->new(
				data      => \@mail,
				noexit    => 1,
#				nomime    => 1,   # We want to parse MIME
				emergency => "$RMMAIL/$rmmail->{emergency}",
				);
    $item->escape_from(); # unless( $item->is_mime );
    # We may need to get at arbitrary parts of the header.  Get a
    # reference to a hash, where each key of the hash corresponds
    # to a field of the header that is present.  item->header() returns
    # entire header, as a string.
    my $hdr = &MA_hdr( $item->header() );

    # This filter() routine is intended for processing mostly inbound
    # mail, as it is assumed that outbound mail is more uniform and
    # rational.  For instance, every email we send will have From:
    # To: and Subject: fields defined.  However, we may receive mail
    # doesn't have all of these fields defined.
    my $log_msg = 'filter: ';
    $log_msg .= (exists($hdr->{from}) && defined($hdr->{from})) ?
                $hdr->{from} : 'unknown';
    $log_msg .= ' -> ';
    $log_msg .= (exists($hdr->{to}) && defined($hdr->{to})) ?
                $hdr->{to} : 'unknown';
    $log_msg .= ': ';
    $log_msg .= (exists($hdr->{subject}) && defined($hdr->{subject})) ?
                $hdr->{subject} : 'unknown';
    $log_msg .= ':';
    &log_it("$log_msg");

# Some logging statements are left_shifted below.  I am undecided
# as to whether these statements should even be here, or if they need
# to be conditional (such as debugging statements).

    # Some people search for spam first, to get it out of the way.
    # Some people search for spam last.  I've found that some things
    # probably should get looked at first.  If you are in the habit
    # of sending email to yourself as a note, it should go first.
    # Also, I get some commercial email which is unsolicited (hence
    # by definition spam), but it comes from organisations I want
    # to read (a bank I belong to, a small business organisation, ...).

    # Oops.  Scan for virii first.
    {
	open( VIRUS, "> $virusdir/test" ) || die "Can't open $virusdir/test. $!\n";
	print VIRUS "$msg_string";
	close( VIRUS );
	my @cmd = ("/usr/bin/clamscan","--quiet","-i","$virusdir/test");
	my $ret = 0xffff & system( @cmd );
&test_dirs("filter","[virus!$hdr->{from}!$hdr->{subject}]");
	if( $ret == 0 ) {
	    # Do nothing, virus free message
	} else {
	    $ret >>= 8;  # Divide by 256 to get return value
	    if( $ret == 1 ) {
		# Virus found
		$item->accept("$maildir/virus_contam");
		return( 0 );
	    } else {
		die "clamscan returned $ret.  Why?\n";
	    }
	}
        unlink( "$virusdir/test" );
    }

    # I have some computers mail me log files and stuff.
    for (@{$remote_monitor}) {
	my $remote_from = $_->{domain};
	if( exists( $hdr->{from} ) &&
	    $hdr->{from} =~ /$remote_from/i ) {  # Partial match,
	    my $field = $_->{header};
	    $field =~ tr/[A-Z]/[a-z]/;
	    if( exists( $hdr->{$field} ) &&
		($hdr->{$field} =~ /$_->{value}/) ) {
		if( exists( $_->{folder} ) ) {
		    $item->accept("$maildir/remote.$_->{folder}");
		} else {
		    $item->accept("$maildir/remote");
		}
&log_it(" remote");
&test_dirs("filter","[remote!$hdr->{from}!$hdr->{subject}]");
		return( 0 );
	    }
	}
    }


    # Special processing for mailing lists and special people.  This goes
    # after the remote_monitoring selection, since we may get other
    # email from the same sites/UserIDs that we are looking for here.
    # Mailing lists might have the To: field or the Return-Path: field
    # set to special values, they should only end up in my inbox.
    my $list = $item->list_accept( "$maildir/maillist" );
    if( $list ) {
	&log_it("ListDetected to $list $list->listname() $list->listsoftware()");
&test_dirs("filter","[mail_list!$hdr->{from}!$hdr->{subject}]");
	return( 0 );
    }
    for my $pattern (keys %{$prespam_whereto}) {
	if( (exists( $hdr->{from} ) && ($hdr->{from} =~ /$pattern/i)   ) ||
	    (exists( $hdr->{to} )   && ($hdr->{to}   =~ /$pattern/i)   ) ||
	    (exists( $hdr->{'return-path'} )
	         && ($hdr->{'return-path'}           =~ /$pattern/i)   ) ||
	    (exists( $hdr->{cc} )   && ($hdr->{cc}   =~ /$pattern/i)   )    ) {
	    $item->accept( "$maildir/$prespam_whereto->{$pattern}" );
&test_dirs("filter","[prespam!$hdr->{from}!$hdr->{subject}]");
	    if( exists( $hdr->{cc} ) && $hdr->{cc} =~ /$pattern/i ) {
		&log_it(" prespam:$prespam_whereto->{$pattern}=>{$pattern} and CC");
	    } else {
		&log_it(" prespam:$prespam_whereto->{$pattern}=>{$pattern}");
		return( 0 ) ;
	    }
	}
    }
    # I send some mail
    if( exists( $hdr->{from} ) ) {
	foreach $me (@{$my_remote}) {
	    if( $hdr->{from} =~ /$me/i ) {
		$item->accept("$maildir/sent-mail");
&log_it(" sent-mail");
&test_dirs("filter","[FromMe!$hdr->{from}!$hdr->{subject}]");
		return( 0 );
	    }
	}
    }

    # We sometimes get mail from people we don't want, and that
    # hasn't been flagged as spam.  A likely source of "trash"
    # addresses, are addresses you've labelled as only being
    # spammers.  Throw in trash folder.
    for my $pattern (@{$trashme}) {
	# Note, the site part of name should be case insensitive
	if( exists( $hdr->{from} ) && $hdr->{from} =~ /$pattern/ ) {
	    trash( $item, $hdr );
&test_dirs("filter","[trashme!$hdr->{from}!$hdr->{subject}]");
	    return( 1 );   # Same as spam, might as well delete it remotely.
	}
    }




    # Setup our handle to SpamAssassin and test for spam.  We should be
    # able to tune the SpamAssassin process so that certain emails are
    # treated more leniently.  We might do this if prespam email sources
    # start becoming sources of spam.
    my $spamtest = Mail::SpamAssassin->new();
    my $status   = $spamtest->check( $item );
    if( $status->is_spam() ) {

	if( $forward_spam ) {
	    # Forward spam to collector before spam-assassin rewrites message.
	    my $fwd = clone( $item );
	    $fwd->resend( $rmmail->{forward} );
	    $fwd->accept( "$maildir/spam_check" );  # For testing
	}

	# Bouncing is not believed to be a useful thing to do.  But this
	# would be how one did it.
	if( $bounce_spam ) {
	    # Bounce spam to sender before spam-assassin rewrites message.
	    my $bounce = clone( $item );
	    $bounce->reject();
	}

	$status->rewrite_mail();
	spam( $item, "SpamAssassin" );
&test_dirs("filter","[SPAM!$hdr->{from}!$hdr->{subject}]");
	return( 1 );
    }

    # Beyond this point, mail is real not spam.
    

    # Special processing for mailing lists and special people
    for my $pattern (keys %{$postspam_whereto}) {
	if( (exists( $hdr->{from} ) && ($hdr->{from} =~ /$pattern/i)  ) ||
	    (exists( $hdr->{to} )   && ($hdr->{to}   =~ /$pattern/i)  ) ||
	    (exists( $hdr->{'return-path'} )
	         && ($hdr->{'return-path'}           =~ /$pattern/i)  ) ||
	    (exists( $hdr->{cc} )   && ($hdr->{cc}   =~ /$pattern}/i) )    ) {
	    $item->accept( "$maildir/$postspam_whereto->{$pattern}" );
&log_it(" postspam");
&test_dirs("filter","[postSPAM!$hdr->{from}!$hdr->{subject}]");
#	    return( 0 ) unless( exists( $hdr->{cc} ) &&
#				$pattern =~ /$hdr->{cc}/i );
            # At this point, if I caught the message with postspam filters,
            # I have dealt with the filing problem.  All that remains after
            # here is strange addressing, or the remainder file.  So return(0).
            return( 0 );
	}
    }

    # Some mail gets to me, but I am not in the To/CC fields.  Some mailers
    # (web mailers?) use Apparently-To: (or emptied BCC field).
    my $address_in_to = 0;
    my $address_in_cc = 0;
    foreach $me (@{$my_remote}) {
	$address_in_to = 1 if( exists( $hdr->{to} ) &&
			       $hdr->{to} =~ /$me/i );
	$address_in_to = 1 if( exists( $hdr->{'apparently-to'} ) &&
			       $hdr->{'apparently-to'} =~ /$me/i );
	$address_in_cc = 1 if( exists( $hdr->{cc} ) &&
			       $hdr->{cc} =~ /$me/i );
    }
    if( ($address_in_to == 0) && ($address_in_cc == 0) ) {
	$item->accept("$maildir/huh");
&log_it(" huh");
&test_dirs("filter","[huh!$hdr->{from}!$hdr->{subject}]");
	return( 0 );
    }

    # If we get this far, just accept it and deal with it manually
    $item->accept("$maildir/remainder");
&log_it(" remainder");
&test_dirs("filter","[remainder!$hdr->{from}!$hdr->{subject}]");
    return( 0 );
}
sub test_dirs {
    my $subroutine = shift;
    my $summary    = shift;
    if( ! $made_new && -e "$maildir/new" ) {
	&log_it("  test_dirs($subroutine): Just made new/$summary");
	$made_new = 1;
    }
    if( ! $made_cur && -e "$maildir/cur" ) {
	&log_it("test_dirs($subroutine): Just made cur/$summary");
	$made_cur = 1;
    }
    if( ! $made_tmp && -e "$maildir/tmp" ) {
	&log_it("test_dirs($subroutine): Just made tmp/$summary");
	$made_tmp = 1;
    }
}
sub MA_hdr {
    my $hdr = shift;
    my $ret = {};

    my @lines = split( /\n\r?/, $hdr );
    my $token;
    my $value = '';
    foreach (@lines) {
	if( /^([A-Za-z]\S*)\s(.*)$/ ) {
	    if( $token ) {
		$ret->{$token} = exists( $ret->{$token} ) ?
                                 "$ret->{$token} $value"  : $value;
	    }
	    $token =  $1;
	    $value =  $2;
	    $token =~ tr/[A-Z]/[a-z]/;
	    $token =~ s/:$//;
	} else {
	    $value .= $_;
	}
    }
    if( exists( $ret->{$token} ) ) {
	if( defined( $value ) ) {
	    $ret->{$token} .= " $value";
	}

    } else {
	if( defined( $value ) ) {
	    $ret->{$token} = $value;
	} else {
	    $ret->{$token} = '';
	}
    }

    return( $ret );
}
sub spam {
    my( $tag, $item, $reason ) = ( "spam", @_ );

    # Log and accept $item as spam
    my $line = (caller(1))[2];   # A bit of perl magic
    &log_it("  $tag [$line]: $reason");
    $item->accept("$spam");      # Name calculated in main
}
sub trash {
    my( $tag, $item, $hdr ) = ( "trash", @_ );
    my $line = (caller(1))[2];   # A bit of perl magic
    my $hdr_string = '';
    my $key;
    foreach (keys(%{$hdr})) {
	$key = ucfirst $_;
	$hdr_string .= "$hdr->{$_}\\n";
    }
    &log_it("  $tag [$line]: $hdr_string\n");
    $item->accept("$maildir/trash");
}


#============================
# Protocol specific modules


# POP only deals with an INBOX, therefore filter() is always
# called as this is "incoming" mail by definition.
sub use_pop {
    my $accounts = shift;
    my $midcache = shift;
    my $deletes  = 0;
    my $err;

    $|=1;
    for( @{$accounts} ) {
	print "\nConnecting to $$_{HOST}...";

	# Note, currently the only members of this hash are elements
	# needed by Mail::POP3Client.  However, in the future, ....
	my $pop = new Mail::POP3Client (%{$_});
	unless( $pop ) {
	    warn "Couldn't connect\n";
	    next;
	}

	my $count = $pop->Count;
	if( $count < 0 ) {
	    warn "Authorization failed";
	    &log_it("POP Authorization failed $$_{HOST}");
	    next;
	}
	print "\n";
	print "New messages: $count\n";


	# Loop through the (remote) headers, printing who the
	# messages are from and the Subject field.  We may
	# want to delete messages on the remote POP server,
	# if we already have them here.  Note: I would want
	# to only delete older messages (say a month or more).
	my %down = map {$_ => 1} (2..$count); 
	my @mails;
	for my $num (2..$count) {
	    print "\n";
	    my @head = $pop->Head($num);

	    # MA_hdr() wants entire header, as a string
	    my $hdr  = &MA_hdr( join( "\n", @head ) );
	    $mails[$num]->{From}    = exists( $hdr->{from}    ) ?
                                      $hdr->{from}    : 'unknown';
	    $mails[$num]->{To}      = exists( $hdr->{to}      ) ?
                                      $hdr->{to}      : 'unknown';
	    $mails[$num]->{Subject} = exists( $hdr->{subject} ) ?
                                      $hdr->{subject} : 'unknown';
	    $mails[$num]->{Date}    = exists( $hdr->{date}    ) ?
                                      $hdr->{date}    : 'unknown';

	    if( exists( $hdr->{'message-id'} ) ) {
		if( exists( $midcache{$hdr->{'message-id'}} ) ) {
		    print " (already downloaded, duplicate)\n";
		    &log_it("duplicate");
		    delete( $down{$num} );
		    $mails[$num]->{mid} = $hdr->{'message-id'};
#                    $pop->Delete($num);
		}
		$midcache{$hdr->{'message-id'}}++;        # Set existance

	    } else {
		&log_it("POP: $num missing Message-Id");
	    }

	    if( exists( $down{$num} ) ) {
		print "Download $num $mails[$num]->{From} -> $mails[$num]->{To}\n\tSubject: $mails[$num]->{Subject}\n";
	    }
	}  # Loop over messages at this account

	next unless keys %down;
	my @tocome = sort {$a <=> $b} keys %down;
#	print "Downloading: @tocome\n";
	for my $num (@tocome) {
	    my @mail;

	    print "Downloading $num\r";
	    @mail    = $pop->Retrieve($num);
	    @mail    = &fix_EOL( @mail );
	    
	    if( $#mail < 4 ) {
		&log_it("===Strange/small message follows===");
		foreach my $tmpl (@mail) {
		    chomp( $tmpl );
		    &log_it( $tmpl );
		}
		&log_it("===Strange/small message above===");
		next;
	    }

#	    $_      .=  "\n" for @mail;
	    print SESSION @mail if( $opt_t );

	    # RFC email must start with a "From " line, and several
	    # systems don't.  So, we need to mangle some headers.
	    # In some cases, we will find we need a time to apply,
	    # so use the time "now".
	    my $now  =  scalar localtime( time );

	    # If the leading header element is a POP3-RCPT, shift off
	    if( $mail[0] =~ m/^X\-Pop3\-RCPT/i ) {
		&log_it(" X-POP3-RCPT email");
		shift( @mail );

	    } elsif( $mail[0] =~ m/^Subject/i ) {
		&log_it(" Lotus Notes email");
		my @new;
		my $from =  $mail[4];
		$from    =~ s/^From:\s+//;
		$new[0] = "From $from $now";
		push( @new, @mail );
		@mail = @new;
	    }

	    # The first line of a mail message starts with From
	    # Many (most) have the originator in angle brackets,
	    # my site just uses spaces.
	    if( $mail[0] =~ /Return-Path:\s+<([^>]+)>/ ) {
		$mail[0] = "From $1 $now";

	    } elsif( $mail[0] =~ /Return-Path:\s+(\S+)/ ) {
		$mail[0] = "From $1 $now";

	    } elsif( $mail[0] =~ /Return-Path:\s+/ ) {
		&log_it("Strange mail[0]=$mail[0]");
	    }


	    if( !@mail ) { 
		&log_it(" Ugh, something went wrong!"); 
		delete $midcache{$mails[$num]->{mid}};
		next;
	    }

	    if( filter( @mail ) == 1 ) {
		# detected as spam, delete now
		$pop->Delete($num);
		$deletes++;

	    } else {
		# Look to see if old enough to delete
		# Get the date of the message, and add our Archive
		# allowance to it.  If that Date/Time is in the past,
		# the message is too old, and we can delete it.
		my $delta = &DateCalc( "$mails[$num]->{Date}",
				       $rmmail->{archive_delete},
				       \$err );
		my $mail_date = &ParseDate( $delta );
		my $today     = &ParseDate( $NOW );
		my $past      = &Date_Cmp( $mail_date, $today );
		if( $past < 0 ) {
		    $pop->Delete($num);
		    #deletes++;
		}

	    }
	}                # Loop over messages which need downloading
	&log_it("Closing connection to POP server");
	$pop->Close;
    }                    # Loop over accounts which may have mail
}
sub use_imap {
    my $accounts = shift;
    my $midcache = shift;
    my $deletes  = 0;
    my $me;
    my $err;

    $|=1;
    for( @{$accounts} ) {
	print "\nConnecting to $$_{Server}...";
	&log_it("Connecting to $$_{Server}...");

	# Some elements of this $account, are not parsed by Mail::IMAPClient.
	# Don't pass the hash, just the necessary elements.  (Server, User,
	# Password, Buffer, Clear, Debug, Debug_fh,
	# EnableServerResponseInLiteral,, Fast_io, Folder, Maxtemperrors,
	# Peek, Port, Socket, Timeout, Uid) are parameters that can be
	# set here.  Our structure contains the parameter "separator",
	# which is important in IMAP.  However, this is a read-only
	# variable.  I have it in the structure to avoid asking the
	# remote end what it is.  It doesn't change often.  The parameter
	# mixedUse can't be read or set, only inferred.  It is important
	# if you are sending messages to the IMAP server, which we aren't.
	my $imap = Mail::IMAPClient->new( Server   => $_->{Server},
					  User     => $_->{User},
					  Password => $_->{Password},
					  );
	unless( $imap ) {
	    warn "Couldn't connect\n";
	    next;
	}

	# IMAP can have multiple folders to work with.
	my @folders = $imap->folders;

	# If -l switch given, only list folders present
	if( $opt_l ) {
	    my $f;
	    print "IMAP folders at $_->{Server}\n";
	    foreach $f (@folders) {
		print "$f\n";
	    }
	    $imap->close;
	    next;
	}


        # IMAP is a strange beast.  When I connect to my ISP
	# and ask for a list of folders, I get what looks like
	# a 'ls -a' of a FTP connection, along with some other
	# files (like INBOX).  I know that mail/INBOX is there
	# since I download it by FTP on occassion.  However,
	# with IMAP you apparently cannot use what looks to be
	# the folder separator.  You have to ask the system for
	# what it uses.  Some IMAP's allow subfolders and mail
	# to reside in a folder, some don't.
	my $sep       = $imap->separator;
	if( $sep ne $_->{separator} ) {
	    &log_it(" Strange, folder separator changed");
	}

	# Don't test for mixedUse, can't delete the folders sometimes.
	my $mixed_use = $_->{mixedUse};     # 0 ?
#	my $mixed_use = &test_mixed( $imap );


	# Is INBOX in list of folders?  It better be.
	foreach my $f (@folders) {
	    my $test = &test_folder( $f, $_ );
	    next if( $test == -1 );
	    &log_it("IMAP: Folder: $f");

	    # We want to skip "folders" that have nothing to do with
	    # mail at this site.  As near as I can tell, the only
	    # way to do this is to ask for a message_count, and skip
	    # if there the count is undefined, 0 or 1.

	    # If I connect to the directory using ftp, and do 'ls -alR'
	    # I (effectively) get the same list of files as listing
	    # all the folders when I connecting using IMAP, except that
	    # IMAP has this "imaginary" INBOX in the parent directory,
	    # and the recursive list from FTP has  some "." and ".."
	    # entries.  As far as how things map between IMAP and the
	    # filesystem goes, any file is parsed by IMAP to see how
	    # many mail messages are in it.  A file of zero size has
	    # zero messages within it when you ask for a count of
	    # how many messages are in the folder.  A file of finite
	    # size has 1 message, whether or not IMAP can parse the 
	    # file.  A directory, returns UNDEF for the number of
	    # messages in the "folder".
	    my $count = $imap->message_count( $f );
	    if( ! $count ) {
		next;

	    } elsif( ($test == 0) && ($count < 2) ) {
		next;

	    } elsif( $count < 2 ) {
		&log_it("Folder $f skipped, count=$count");
		next;
	    }



	    $imap->select( $f );
	    print "\nNew messages: $count in $f\n";

	    my %down = map {$_ => 1} (2..$count); 
	    my @mails;

	    # Within this folder,
	    # Mail::IMAPClient and children, don't (appear to)
	    # have enough functionality to be worth using.  So,
	    # just call fetch() with our own functions.
	    for my $num (2..$count) {
		# We can fetch all kinds of things.
		#  ALL      FLAGS INTERNALDATE RFC822.SIZE ENVELOPE
		#  BODY
		#  BODY[<section>]
		#  BODYSTRUCTURE
		#  BODYSTRUCTURE[<section>]<<partial>>
		#  BODY.PEEK[<section>]<<partial>>  Similar to
		#           BODY[<section>, but doesn't set \Seen flag
		#  ENVELOPE
		#  FAST     FLAGS INTERNALDATE RFC822.SIZE
		#  FLAGS
		#  FULL     FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODY
		#  INTERNALDATE
		#  RFC822
		#  RFC822.HEADER  Similar to BODY.PEEK[HEADER]
		#  RFC822.SIZE
		#  RFC822.TEXT  Similar BODY to [TEXT]
		#  UID
		# We want RFC822.HDR and RFC822 (for header plus
		# body), but we need to process the reference to array
		# that we receive.
		my $head = &imap_get_header( $imap, $num ) ||
		    &log_it("Couldn't fetch header $num from $f");
		next unless( $head );

		# $head must be entire header, as a string.
		my $hdr  = &MA_hdr( $head );
		$mails[$num]->{From}    = exists( $hdr->{from}    ) ?
                                          $hdr->{from}    : 'unknown';
		$mails[$num]->{To}      = exists( $hdr->{to}      ) ?
                                          $hdr->{to}      : 'unknown';
		$mails[$num]->{Subject} = exists( $hdr->{subject} ) ?
                                          $hdr->{subject} : 'unknown';
		$mails[$num]->{Date}    = exists( $hdr->{date}    ) ?
                                          $hdr->{date}    : 'unknown';

		if( exists( $hdr->{'message-id'} ) ) {
		    if( exists( $midcache{$hdr->{'message-id'}} ) ) {
			print " (already downloaded, duplicate)\n";
			&log_it("duplicate");
			delete( $down{$num} );
			$mails[$num]->{mid} = $hdr->{'message-id'};
#                        $imap->delete_message($num);
		    }
		    $midcache{$hdr->{'message-id'}}++;        # Set existance

		} else {
		    &log_it("IMAP: $num missing Message-Id");
		}

		if( exists( $down{$num} ) ) {
		    print "Download $num: $mails[$num]->{From} -> $mails[$num]->{To} Subject: $mails[$num]->{Subject}\n";
		}
	    }  # Loop over messages in folder $f

	    next unless keys %down;
	    my @tocome = sort {$a <=> $b} keys %down;
	    print "Downloading: @tocome\n";
	    for my $num (@tocome) {
		my @mail;
		print "Downloading $num\r";

		my $msg  = &get_imap_message( $imap, $num ) ||
		    &log_it("Trouble downloading $num from $f");
		next unless( $msg );

		push( @mail, &fix_EOL( @{$msg} ) );
		if( $opt_t ) {
		    my $tt;
		    foreach $tt (@{$msg}) { print SESSION "$tt"; }
		}

		# RFC email must start with a "From " line, and several
		# systems don't.  So, we need to mangle some headers.
		# In some cases, we will find we need a time to apply,
		# so use the time "now".
		my $now  =  scalar localtime( time );

		# If the leading header element is a POP3-RCPT, shift off
		if( $mail[0] =~ m/^X\-Pop3\-RCPT/i ) {
		    &log_it(" X-POP3-RCPT email");
		    shift( @mail );

		} elsif( $mail[0] =~ m/^Subject/i ) {
		    &log_it(" Lotus Notes email");
		    my @new;
		    my $from =  $mail[4];
		    $from    =~ s/^From:\s+//;
		    $new[0] = "From $from $now";
		    push( @new, @mail );
		    @mail = @new;
		}

		# The first line of a mail message starts with From
		# Many (most) have the originator in angle brackets,
		# my site just uses spaces.
		if( $mail[0] =~ /Return-Path:\s+<([^>]+)>/ ) {
		    $mail[0] = "From $1 $now";

		} elsif( $mail[0] =~ /Return-Path:\s+(\S+)/ ) {
		    $mail[0] = "From $1 $now";

		} elsif( $mail[0] =~ /Return-Path:\s+/ ) {
		    &log_it("Strange mail[0]=$mail[0]");
		}

		if( !@mail ) { 
		    &log_it(" Ugh, something went wrong!"); 
		    delete $midcache{$mails[$num]->{mid}};
		    next;
		}

		# We probably want to do more filtering to inbound mail
		# than outbound.  Also, we may be splitting our INBOX
		# into multiple folders as well.  So, if the folder
		# name starts with SENT-MAIL, do little processing.
		# Otherwise assume it is incoming, and filter() it.
		if( ($f =~ /^SENT.MAIL/i) || ($f =~ /^OUT/i ) ) {
		    &mbox_it( $f, @mail );

		    # Get the date of the message, and add our Archive
		    # allowance to it.  If that Date/Time is in the past,
		    # the message is too old, and we can delete it.
		    my $delta = &DateCalc( "$mails[$num]->{Date}",
					   $rmmail->{archive_delete},
					   \$err );
		    my $mail_date = &ParseDate( $delta );
		    my $today     = &ParseDate( $NOW );
		    my $past      = &Date_Cmp( $mail_date, $today );
		    if( $past < 0 ) {
#			$imap->delete_message($num);   # Actually just flag it.
#			$deletes++;
		    }

		} else {
		    if( &filter( @mail ) ) {
			# Filter detected this as spam, delete copy at
			# remote site now.
#			$imap->delete_message($num);   # Actually just flag it.
#			$deletes++;

		    } else {
			my $delta = &DateCalc( "$mails[$num]->{Date}",
					       $rmmail->{archive_delete},
					       \$err );
			my $mail_date = &ParseDate( $delta );
			my $today     = &ParseDate( $NOW );
			my $past      = &Date_Cmp( $mail_date, $today );
			if( $past < 0 ) {
#			    $imap->delete_message($num);
#			    $deletes++;
			}
		    }
		}
	    }
	    &log_it("Closing folder on IMAP server");
	    $imap->close;                           # Expunges at same time
	} # End loop over folders at this server.
    } # End loop over accounts which may have mail
}
sub test_folder {
    my $folder  = shift;
    my $account = shift;

    # For IMAP and FTP use, we have the arrays:
    #  $account->{ignore} and $account->{download}.
    # If the folder we are queried with is in the ignore list,
    # we return -1.  If it is in the accept list, we return +1.

    # Anything else, we query whether the default_action variable has
    # been set.  If the default action is to ignore, we return -1.  If
    # the default is download, we return +1.  If it isn't defined, we
    # return 0 and allow something else to decide.

    # If any term in the download or ignore lists ends in a slash, we
    # regard that as being a directory and the enquiry to be of a
    # recursive nature.  I should have added code to delete the 2 folders,
    # but no matter what I tried afterwards, nothing would delete them
    # using IMAP.  I could use a shell or FTP to delete them.

    foreach (@{$account->{download}}) {
	if( m#^(.*)/$# ) {
	    my $base = $1;
	    return( 1 ) if( $folder =~ /^$base/ );

	} else {                    # Note: mail/INBOX does =~ m#^mail/*#
	    return( 1 ) if( $folder =~ /^$_/ );
	}
    }
    foreach (@{$account->{ignore}}) {
	if( m#^(.*)/$# ) {
	    my $base = $1;
	    return( -1 ) if( $folder =~ /^$base/ );

	} else {
	    return( -1 ) if( $folder =~ /^$_/ );
	}
    }
    if( $account->{default_action} =~ /DOWNLOAD/i ) {
	return( 1 );

    } elsif( $account->{default_action} =~ /IGNORE/i ) {
	return( -1 );
    }
    return( 0 );
}
sub test_mixed {
    my$ imap = shift;

    my $sep         = $imap->separator;
    my $is_parent   = $imap->is_parent('INBOX');
    my $testFolder1 = "Folder_Test_$$";
    $testFolder1    = $is_parent ?
                      "INBOX" . $sep . $testFolder1 :
                      $testFolder1;
    my $testFolder2 = "Folder_Test_$$" . $sep . "Folder_Test__subfolder_$$";
    $testFolder2    = $is_parent ?
                      "INBOX" . $sep . $testFolder2 :
                      $testFolder2;

    # RFC2060 says that the parent folder WILL be made if required
    # by creation of a subfolder.
    $imap->create( $testFolder2 );
    my $mixedUse = grep(/NoSelect/i, $imap->list('',$testFolder1)) ? 0 : 1;

    $imap->delete( $testFolder2 );
    $imap->delete( $testFolder1 );

    my $l_msg = "IMAP host $$_{IMAP}{Server} uses '$sep' as a separator, ";
    $l_msg .= (defined($is_parent) ? "allows " : "does not allow ");
    $l_msg .= "children in the INBOX.  It supports ";
    $l_msg .= ($mixedUse ? "mixed use " : "single use ");
    $l_msg .= "folders.";
    &log_it( $l_msg );

    return( $mixedUse );
}
sub imap_get_header {
    my $imap   = shift;
    my $num    = shift;
    my $header = {};

    my $hdr =  $imap->fetch( $num, 'RFC822.HEADER' );

    &log_it("IMAP_HDR: $#{$hdr} for $num") if( $#{$hdr} != 4 );

    return( undef ) unless( $#{$hdr} == 4 );
    return( undef ) unless( $hdr->[-1] =~ / OK /i );

    # Returns something like:
    #  NN UID FETCH 1 RFC822.HEADER
    #  * 1 FETCH (UID 1 RFC822.HEADER Date....
    #  From:  <someone@someplace.domain>
    #  ....
    # 
    #  )
    #  NN OK UID FETCH completed
    # Or, it looks that way.  If we print this array, element by
    # element we get (before stripping the CR):
    # [0]: NN UID FETCH 1 RFC822.HEADER\r\n
    # [1]: * 1 FETCH (UID 1 RFC822.HEADER 
    # [2]: Date: ...
    #      From:
    #      ...
    #
    # [3]: )
    # [4]: NN OK UID FETCH completed
    # Which isn't exactly what I was expecting based on how printing
    # the array looked.  :-)


    # Shorten up routine.  Just deal with hdr->[2], our header.

    my @work = split(/\n/, $hdr->[2] );
    # This is IMAP, and we are on *NIX for an OS.  Get rid of \r
    $_      =~ s/\r$// for @work;

    my $now  =  scalar localtime( time );
    my $from;
    my $seen = 0;
    foreach (@work) {
	if( /^From / ) {
	    $from = $_;
	    $seen = 1;

	} elsif( /^From:\s+<([^>]+)>/ ) {
	    $from = "From $1 $now";

	} elsif( /^From:\s+(\S+)/ ) {
	    $from = "From $1 $now";
	}
    }
    push( @{$header}, $from ) if( ! $seen );
    foreach (@work) {
	push( @{$header}, $_ ) unless( /^\s*$/ );
    }

    return( $header );
}
sub get_imap_message {
    my $imap    = shift;
    my $num     = shift;
    my $message = {};

    # Very similar to get_header.
    my $msg = $imap->fetch( $num, 'RFC822' );

    &log_it("IMAP_MSG: $#{$msg} for $num") if( $#{$msg} != 4 );

    return( undef ) unless( $#{$msg} == 4 );
    return( undef ) unless( $msg->[-1] =~ / OK /i );

    my @work = split(/\n/, $msg->[2] );
    $_      =~ s/\r$// for @work;

    my $now  =  scalar localtime( time );
    my $from;
    my $seen = 0;
    foreach (@work) {
	if( /^From / ) {
	    $from = $_;
	    $seen = 1;

	} elsif( /^From:\s+<([^>]+)>/ ) {
	    $from = "From $1 $now";

	} elsif( /^From:\s+(\S+)/ ) {
	    $from = "From $1 $now";
	}
    }
    push( @{$message}, $from ) if( ! $seen );
    push( @{$message}, @work );

    return( $message );
}
sub use_ftp {
    my $accounts = shift;
    my( @expanded, $file );

    # Clean up our FTP_WORK directory, or create it if it doesn't
    # exist.  No permissions for world!  The directory should be empty,
    # unless the user moved some mail into the FTP_WORK directory for
    # us to process, or we crashed processing old email.
    if( -e "$RMMAIL/$rmmail->{ftp_work}" ) {
	if( -d "$RMMAIL/$rmmail->{ftp_work}" ) {
	    my @files = glob( "$RMMAIL/$rmmail->{ftp_work}/*" );

	    my $n = $#files + 1;
	    if( $#files > -1 ) {
		print "Processing mail left in $rmmail->{ftp_work} first\n $n files\n"; 
		&process_ftp_mail( @files );
		return if( $opt_z );  # We may not want to use FTP :-)
	    }


	} else {
	    print STDERR "$rmmail->{ftp_work} is not a directory\n";
	    return;
	}

    } else {
	# Best solution.  Save current umask and set to 000.  Mkdir
	# then restore umask.  (If other processes are running, and
	# "using" umask, this may not work optimally.)  Also, if the
	# "parent" directory ($RMMAIL) has SUID or SGID set, this will
	# also be inherited by the directory we are creating.  (SGID
	# is likely turned on, hence the final permissions would be 
	# 02700.)
	my $my_umask   = umask(000);
	mkdir( "$RMMAIL/$rmmail->{ftp_work}", 0700 );
	umask( $my_umask );
    }


    # Okay, for all our FTP accounts, transfer files.
    $|=1;
    for( @{$accounts} ) {
	print "\nConnecting to $$_{HOST}...";
	&log_it("Connecting to $$_{HOST}...");

	my $ftp = Net::FTP->new( $_->{HOST}, Passive => 1, );
	unless( $ftp ) {
	    warn "Couldn't connect\n";
	    next;
	}
	$ftp->login( $_->{USER}, $_->{PASSWORD} );
	unless( $ftp ) {
	    warn "Couldn't login\n";
	    next;
	}
	$ftp->binary();


	# If -l switch given, only list folders present
	if( $opt_l ) {
	    print "FTP files/directories at $_->{HOST}\n";
	    &list_dir( $ftp );
	    $ftp->quit();
	    next;
	}


	# For now, all files need to be explicitly listed for
	# download.
	foreach my $f (@{$_->{download}}) {
	    my %delete;
	    @expanded = $ftp->ls("$f");
	    if( (@expanded == 0)               ||
		($expanded[0] =~ /not found/i) ||
		($expanded[0] =~ /no such file/i) ) {
		&log_it("glob($f) returns nothing");
		next;
	    }
	    foreach $file (@expanded) {
		my $test = &test_folder( $file, $_ );
		next if( $test == -1 );
		&log_it("FTP: Folder: $file");
		my @path = split( m|/|, $file );
&log_it(" FTP($file)->($RMMAIL)/($rmmail->{ftp_work})/$path[-1]");
		if( !defined( $ftp->get( $file, "$RMMAIL/$rmmail->{ftp_work}/$path[-1]" ) ) ) {
		    &log_it("Strange, $file was here");

		} else {  # Download worked, we can delete file (maybe)
		  $delete{$file}++;
		}
	    }
	    foreach $file (keys(%delete)) {
	      $ftp->delete( $file );
	    }
	    @expanded = glob( "$RMMAIL/$rmmail->{ftp_work}/*" );

	    &process_ftp_mail( @expanded );
	}

	$ftp->quit();
    } # End loop over accounts which may have mail

}
sub process_ftp_mail {
    my @files = @_;
    my( $file, @delete_list );

    my $n_files = 0;
    foreach $file (@files) {
	# You do NOT want to print Dumper( $folder );  !!
	my $folder = new Mail::Folder('AUTODETECT',
				      $file,
				      MailFrom => "KEEP" ) ||
					  next;

	$n_files++;
	my @msg_list = sort {$a <=> $b} $folder->message_list;
	my $msg;
	foreach $msg (@msg_list) {
	    my( @mail, @field, $tag);

	    # Get access to an email object
	    my $email = $folder->get_message($msg);

	    # Okay, build the message in the order we want.  Header first.
	    # The "From " header line is probably the "Mail-From: " tag.
	    # Next we want Return-Path.  If we try to get a field which
	    # doesn't exist, we get an empty array back.
	    my $hdr  = $email->head();
	    my @tags = $hdr->tags();

	    @field   = &get_hdr_field( $hdr, 'Mail-From' );
	    if( $#field > -1 ) {
		$field[0] =~ s/^Mail-From: /From /;

	    } else {  # Build a fake "From " line
		@field   = &get_hdr_field( $hdr, 'Return-Path' );
		if( $#field == -1 ) {  # No Return-Path either, quit
		    &log_it("FTP_Process_mail: $file/$msg, strange");
		    next;
		}
		my $now  =  scalar localtime( time );
		if( $field[0] =~ /Return-Path:\s+<([^>]+)>/ ) {
		    $field[0] = "From $1 $now";

		} elsif( $field[0] =~ /Return-Path:\s+(\S+)/ ) {
		    $field[0] = "From $1 $now";

		} elsif( $field[0] =~ /Return-Path:\s+/ ) {
		    &log_it("Strange field[0]=$field[0]");
		}
	    }
	    push( @mail, @field );

	    @field   = &get_hdr_field( $hdr, 'Return-Path' );
	    push( @mail, @field );

	    @field   = &get_hdr_field( $hdr, 'From' );
	    push( @mail, @field );

	    @field   = &get_hdr_field( $hdr, 'To' );
	    push( @mail, @field );

	    @field   = &get_hdr_field( $hdr, 'CC' );
	    push( @mail, @field );

	    @field   = &get_hdr_field( $hdr, 'Subject' );
	    push( @mail, @field );

	    foreach $tag (@tags) {
		next if( $tag =~ /^Mail-From$/i );
		next if( $tag =~ /^Return-Path$/i );
		next if( $tag =~ /^From$/i );
		next if( $tag =~ /^To$/i );
		next if( $tag =~ /^CC$/i );
		next if( $tag =~ /^Subject$/i );

		@field   = &get_hdr_field( $hdr, $tag );
		push( @mail, @field );
	    }
	    push( @mail, '' );         # An empty line to separate hdr and body

	    # Fix up the body.  Call tidy_body() to get rid of excess
	    # space, extract the body, get rid of all EOL present, and
	    # then append to each line, a newline (UNIX EOL).  Then append
	    # body to header (in @mail).
	    $email->tidy_body();
	    @field = @{$email->body()};
	    push( @mail, &fix_EOL( @field ) );

	    if( $file =~ /SENT-MAIL/i ) {
		&mbox_it( $file, @mail );
	    } else {
		&filter( @mail );
	    }
	    push( @delete_list, $msg );
	}
	# Mark for deletion, any messages successfully processed (should
	# be all of them).
	$folder->delete_message(@delete_list);
	$folder->sync;

	@msg_list = $folder->message_list;
	$folder->close();
	if( $#msg_list == -1 ) {
&log_it(" FTP local processing done, unlink ($file)");
	    unlink( $file );
	}
    }
}
sub get_hdr_field {
    my $hdr = shift;
    my $tag = shift;

    my @field = $hdr->get( $tag );
    return( @field ) if( $#field == -1 );

    chomp( @field );
    foreach (@field) {
	s/^/$tag: /;
    }
    return( @field );
}
sub list_dir {
    my $ftp = shift;
    my $dir = @_ ? shift : undef;
    my $f;
    my @dirs;
    my @expanded;

    # Get long listing
    if( $dir ) {
	@expanded = $ftp->dir( $dir );
    } else {
	@expanded = $ftp->dir();
    }

    foreach $f (@expanded) {
	$f        =~ s/^\s+//;
	$f        =~ s/\s+$//;

	my @entry = split( /\s+/, $f );
	next unless( $#entry == 8 );

	# $entry[0]   permissions
	# $entry[1]   N_Links
	# $entry[2]   owner
	# $entry[3]   group
	# $entry[4]   size
	# $entry[5]   Month
	# $entry[6]   Day_of_Month
	# $entry[7]   Time/year
	# $entry[8]   name
	if( $entry[0] =~ /^d/ ) {
	    push( @dirs, $entry[8] );
	} else {
	    print "$entry[8]\n";
	}
    }
    foreach $f (@dirs) {
	$f = "$dir/$f" if( $dir );
	print "\nDir: $f\n";
	&list_dir( $ftp, $f );
    }
}

sub mbox_it {
    my $folder = shift;
    my @mail   = &fix_EOL( @_ );
#    my @mail   = @_;
    my $msg_string;

    # Write our processed data, to $maildir, not FTP_WORK.
&log_it(" mbox_it rewrite($folder)");
    $folder =~ s(^$RMMAIL/$rmmail->{ftp_work})(::);
&log_it(" mbox_it  rewrite($folder)");
    $folder =~ s(/)(_)g;  # Replace slashes with underscore.
&log_it(" mbox_it   rewrite($folder)");
    $folder =~ s/^\.//;   # Lose leading dot.
&log_it(" mbox_it    rewrite($folder)");
    $folder =~ s(^::)($maildir);
&log_it(" mbox_it     rewrite($folder)::$maildir");

    # Get a copy of the message, as a mbox_string, before Mail::Audit
    # alters the @Mail array.
    $msg_string = "";
    foreach (@mail) {
	chomp;
	$msg_string .= "$_\n";
    }

    # Ideally, this routine gets called with mail that is sent
    # by me.  I may want to direct it to mboxs based on the
    # the other party.  Another option, would be to accept it
    # into a mbox with the same name as the folder it came out
    # of.  Or, possibly a person wants to accept all of it into
    # a mbox called "sent-mail"?  In which case, this subroutine
    # becomes trivial.  We probably don't want to spam check mail
    # we send, and I am not going to.
    my $item = Mail::Audit->new(
				data      => \@mail,
				noexit    => 1,
#				nomime    => 1,   # We want to parse MIME
				emergency => $rmmail->{emergency},
				);
    # Get some msg parts.  $item->header() gets entire header as a
    # single string, which is what we want.
    my $hdr = &MA_hdr( $item->header() );
&log_it("mbox_it:$hdr->{from} -> $hdr->{to}: $hdr->{subject}:");


    # Oops.  Scan for virii first.
    {
	open( VIRUS, "> $virusdir/test" ) || die "Can't open $virusdir/test. $!\n";
	print VIRUS "$msg_string";
	close( VIRUS );
	my @cmd = ("/usr/bin/clamscan","--quiet","-i","$virusdir/test");
	my $ret = 0xffff & system( @cmd );
	if( $ret == 0 ) {
	    # Do nothing, virus free message
	} else {
	    $ret >>= 8;  # Divide by 256 to get return value
	    if( $ret == 1 ) {
		# Virus found
		$item->accept("$maildir/virus_contam");
		return( 0 );
	    } else {
		die "clamscan returned $ret.  Why?\n";
	    }
	}
        unlink( "$virusdir/test" );
    }

    # Special processing for mailing lists and special people
    for my $pattern (keys %{$prespam_whereto}) {
	if( (exists( $hdr->{from} ) && ($hdr->{from} =~ /$pattern/i) ) ||
	    (exists( $hdr->{to} )   && ($hdr->{to}   =~ /$pattern/i) ) ||
	    (exists( $hdr->{cc} )   && ($hdr->{cc}   =~ /$pattern/i) )    ) {
	    $item->accept( "$maildir/$prespam_whereto->{$pattern}" );
&log_it(" prespam");
	    return;
	}
    }

    # Special processing for mailing lists and special people
    for my $pattern (keys %{$postspam_whereto}) {
	if( (exists( $hdr->{from} ) && ($hdr->{from} =~ /$pattern/i) ) ||
	    (exists( $hdr->{to} )   && ($hdr->{to}   =~ /$pattern/i) ) ||
	    (exists( $hdr->{cc} )   && ($hdr->{cc}   =~ /$pattern/i) )    ) {
	    $item->accept( "$maildir/$postspam_whereto->{$pattern}" );
&log_it(" postspam");
	    return;
	}
    }

    # If we get this far, just accept it and deal with it manually.
    # $folder already has $maildir in it!
    $item->accept("$folder");
&log_it(" Accept to $folder anyway");
}


#===================================================================
# I am a big believer in only allowing the user in question to run
# this kind of software.  So, this program should not be installed
# SUID to any ID.  We also check to see if the effective and real
# user IDs are the same (this somewhat stops root from running it,
# but could be easily defeated; more an annoyance than anything).
#
# Our config file has remote passwords in it, make sure the permissions
# don't allow other people to easily read them.
sub remoteMM_init {
    # $<   = real UID of person running program
    # $>   = effective UID of person running program
    if( $< != $> ) {
	print STDERR "Error: Real and effective user ID's aren't the same.  Quitting!\n";
	exit( 0 );
    }

    &check_RMMAIL();


    # The following doesn't involve checking the user or file permissions,
    # but it is initialisation code of a kind.
    my $i;
    @Account_Keys = qw(POP IMAP FTP);
    $Account_RE   = "($Account_Keys[0]";
    for( $i = 1; $i <= $#Account_Keys; $i++ ) {
	$Account_RE .= "|$Account_Keys[$i]";
    }
    $Account_RE .= ")";

    @POP_Keys = qw(HOST USER PASSWORD);
    $POP_RE   = "($POP_Keys[0]";
    for( $i = 1; $i <= $#POP_Keys; $i++ ) {
	$POP_RE .= "|$POP_Keys[$i]";
    }
    $POP_RE .= ")";

    @IMAP_Keys = qw(Server User Password separator mixedUse download ignore default_action);
    $IMAP_RE   = "($IMAP_Keys[0]";
    for( $i = 1; $i <= $#IMAP_Keys; $i++ ) {
	$IMAP_RE .= "|$IMAP_Keys[$i]";
    }
    $IMAP_RE .= ")";

    @FTP_Keys = qw(HOST USER PASSWORD ignore download default_action);
    $FTP_RE   = "($FTP_Keys[0]";
    for( $i = 1; $i <= $#FTP_Keys; $i++ ) {
	$FTP_RE .= "|$FTP_Keys[$i]";
    }
    $FTP_RE .= ")";

}
sub check_RMMAIL {

    # Check for our config file (under $RMMAIL)
    my @stat = stat( $config_file );
    my $mode = $stat[2] & 07777;
    my $rw   = 0600;                       # 384 in base 10
    my $rwx  = 0700;                       # 448 in base 10
    if( -e _ ) {  # Config file exists
	# File better be owned by the User, with 600 permissions
	# UID  = stat[4]
	# mode = stat[2]
	# $<   = real UID of person running program
	if( $< != $stat[4] ) {
	    print STDERR "You aren't permitted to run this program,\n";
	    print STDERR "config_file $config_file owned by someone else\n";
	    exit;

	} elsif( $mode != $rw ) {
	    printf STDERR ("Incorrect file permissions (%05lo) on config file %s\n", $mode, $config_file);
	    print STDERR "Should be 0600\n";
	    print STDERR "(read/write for owner, nothing for group or world)\n";
	    exit;
	}
 
    } else {   # Config file doesn't exist yet.
	# New config_file
	open( CONFIG, "> $config_file" ) || die "Can't open $config_file\n";
	print CONFIG "<!-- $0 configuration file -->\n";
	close( CONFIG );
	my $my_umask   = umask(000);
	chmod 0600, $config_file;
	umask( $my_umask );
    }

    # And our folders directory for mboxen
    @stat = stat( $maildir );
    if( -d _ ) {
	$mode = $stat[2] & 07777;
	if( $mode != $rwx ) {
	    my $err = sprintf("Bad permissions (%05lo) on %s", $mode, $maildir );
	    &log_it($err);

	    my $my_umask   = umask(000);
	    if( chmod( 0700, $maildir ) != 1 ) {
		&log_it("Couldn't chmod(0700) on $maildir");
	    }
	    umask( $my_umask );
	}

    } else {
	# See similar section in FTP mode above for comments.  
	my $my_umask   = umask(000);
	mkdir( $maildir, 0700 );
	umask( $my_umask );
    }

    # There are virii in the (email) world, so look for them.  I've got
    # Clam Anti-Virus installed, which can read a file and scan for a
    # virus.
    @stat = stat( $virusdir );
    if( -d _ ) {
	$mode = $stat[2] & 07777;
	if( $mode != $rwx ) {
	    my $err = sprintf("Bad permissions (%05lo) on %s", $mode, $virusdir );
	    &log_it($err);

	    my $my_umask   = umask(000);
	    if( chmod( 0700, $virusdir ) != 1 ) {
		&log_it("Couldn't chmod(0700) on $virusdir");
	    }
	    umask( $my_umask );
	}

    } else {
	# See similar section in FTP mode above for comments.  
	my $my_umask   = umask(000);
	mkdir( $virusdir, 0700 );
	umask( $my_umask );
    }
}



# A zillion times we get input from STDIN, chomp off the end-of-line,
# suck up leading/trailing white space.  So, a little routine for that.
#
sub get_ans {
    my $ans = <STDIN>;
    chomp( $ans );
    $ans =~ s/^\s+//;
    $ans =~ s/\s+$//;
    return( $ans );
}




sub usage {
    my $msg = shift;
    print STDERR "$msg\n\n" if( $msg );
    print STDERR "Usage: $0 [-ch] (P|I|F)\n";
    print STDERR "          -c  Configure pop/imap/ftp server data\n";
    print STDERR "          -h  Print this message\n";
    print STDERR "          -b  Allow bouncing of incoming SPAM\n";
    print STDERR "          -f  Allow forwarding of SPAM to remote site\n";
    print STDERR "          -t  Test: copy messages to SESSION file\n";
    print STDERR "          -l  List remote IMAP/FTP site\n";
    print STDERR "          -P  Remote POP (INBOX only) server\n";
    print STDERR "          -I  Remote IMAP server\n";
    print STDERR "          -F  Use FTP to copy remote files from mail dir\n";
    print STDERR "          -z  Just process copies of files in FTP download dir\n";

    exit( 0 );
}




# New XML-ish config.  With XML::Simple, easy as 3.141592...  (Pi)
sub read_xmlconfig {
    my $simple = XML::Simple->new();
    my $tree   = $simple->XMLin( $config_file );

    return( $tree );
}

sub write_xmlconfig {
    # First off, attempt to read in current configuration
    my $rmmail = &read_xmlconfig();
    $rmmail    = &flushout_rmmail( $rmmail );

    # Now we open our file for writing.
    my $new_config = new IO::File("> $config_file.$$");
    my $writer = new XML::Writer(
				 OUTPUT => $new_config,
				 DATA_MODE => 1,
				 DATA_INDENT => 2
				 );

    # If you want nicely formatted comments as well, you need to
    # insert a newline before every comment.
    $writer->startTag('rmmail');
    &preamble(             $writer, $new_config );
    &conf_logfile(         $writer, $new_config, $rmmail->{logfile}        );
    &conf_message_cache(   $writer, $new_config, $rmmail->{message_cache}  );
    &conf_emergency(       $writer, $new_config, $rmmail->{emergency}      );
    &conf_archive_delete(  $writer, $new_config, $rmmail->{archive_delete} );
    &conf_ftp_work(        $writer, $new_config, $rmmail->{ftp_work}       );
    &conf_remote_uid(      $writer, $new_config, $rmmail->{remote_uid}     );
    &conf_trash(           $writer, $new_config, $rmmail->{trash}          );
    &conf_spam('prespam',  $writer, $new_config, $rmmail->{prespam}        );
    &conf_spam('postspam', $writer, $new_config, $rmmail->{postspam}       );
    &conf_remote(          $writer, $new_config, $rmmail->{remote}         );
    &conf_forward(         $writer, $new_config, $rmmail->{forward}        );
    &conf_bounce(          $writer, $new_config, $rmmail->{bounce}         );
    &conf_ac_question(     $writer, $new_config, $rmmail->{ac_question}    );
    &conf_account(         $writer, $new_config, $rmmail->{account},
			            $rmmail->{question} );
    $writer->endTag('rmmail');
    $writer->end;

    # Close file handle.
    undef $new_config;

    # Now unlink old file, copy temp to permanent name, unlink temp.
    if( -e "$config_file.bak" ) {
	unlink( "$config_file.bak" );
	print "A previous $config_file.bak existed, and was deleted\n";
	&log_it("A previous $config_file.bak existed, and was deleted");
    }
    rename( $config_file, "$config_file.bak" );
    rename( "$config_file.$$", $config_file );
}
sub flushout_rmmail {
    my $rmmail = shift;
    my $ret    = {};

    # Examine incoming struct.  If elements are missing, add them.
    # If extra elements are present, delete them.  Or rather, don't
    # copy them into returned structure.

    # Another thing to consider, is that the questions asked of the
    # user (ac_question) probably need to preserve whitespace, whereas
    # most of the other elements don't even want whitespace.  The
    # archive_delete element does want whitespace, but can allow
    # condensing multiple whitespace into a single space.  This excess
    # space occurs in the key, as well as in the value of a hash.  But,
    # it seems not to occur in the upper level we access in this
    # subroutine, rather it is in the copy_hash and copy_question.


    # We have a bunch of elements, which contain strings.
    foreach (qw(logfile message_cache emergency archive_delete ftp_work forward bounce)) {
	if( exists( $rmmail->{$_} ) ) {
	    $ret->{$_} = $rmmail->{$_};

	    # Suck up leading/trailing space.
	    $ret->{$_} =~ s/^\s+//;
	    $ret->{$_} =~ s/\s+$//;

	    # Convert multiple space into a single space.
	    $ret->{$_} =~ s/\s+/ /;
	} else {
	    $ret->{$_} = '';  # Empty string
	}
    }

    # And elements which contain an array of strings.  We can be passed
    # an array of strings, or a single string.  Treat whitespace same
    # as above.
    foreach (qw(remote_uid trash)) {
	$ret->{$_} = [];  # Empty array
	if( exists( $rmmail->{$_} ) ) {
	    my $type = ref( $rmmail->{$_} );
	    if( $type eq 'ARRAY' ) {
		my $row;
		foreach $row (@{$rmmail->{$_}}) {
		    if( ! ref( $row ) ) {     # Row is a string
			$row =~ s/^\s+//;
			$row =~ s/\s+$//;
			$row =~ s/\s+/ /;
			push( @{$ret->{$_}}, $row );
		    }
		}
	    } elsif( ! $type ) {  # String
		$rmmail->{$_} =~ s/^\s+//;
		$rmmail->{$_} =~ s/\s+$//;
		$rmmail->{$_} =~ s/\s+/ /;
		push( @{$ret->{$_}}, $rmmail->{$_} );

	    } else {
		&log_it("Strange ref($type) when looking for array");
		exit;
	    }
	}
    }

    # And elements which contain an array of hashes/structs.  Handle
    # leading/trailing whitespace the same as above, except that for
    # ac_question we want to append a single space to the end of
    # the value string after removing leading/trailing space.  We also
    # want to leave internal space alone for the value element of 
    # ac_question.
    foreach (qw(prespam postspam remote)) {
	$ret->{$_} = [];  # Empty array
	if( exists( $rmmail->{$_} ) ) {
	    my $type = ref( $rmmail->{$_} );
	    if( $type eq 'ARRAY' ) {
		my $row;
		foreach $row (@{$rmmail->{$_}}) {
		    push( @{$ret->{$_}}, &copy_hash($row) );
		}
	    } elsif( $type eq 'HASH' ) {  # single hash
		push( @{$ret->{$_}}, &copy_hash($rmmail->{$_}) );

	    } else {
		&log_it("Strange ref($type) when looking for array");
		exit;
	    }
	}
    }

    # We now need to specially process accounts.  If nothing else,
    # ->{account}{FTP}{download} and ->{account}{FTP}{ignore} need
    # to be arrays.  We want {account} to be an array of hashes.  The
    # hashes only have a single key, that being the account type.
    # The value of that account key, is a hash of characteristics
    # needed to login and work with that account.

#LOOP OVER ACCOUNT TYPES
    $ret->{account} = [];  # Empty array
    if( exists( $rmmail->{account} ) ) {
	my $type = ref( $rmmail->{account} );
	if( $type eq 'ARRAY' ) {
	    # Good, it's already an array
	    my $row;
	    foreach $row (@{$rmmail->{account}}) {
		my @protocol = keys( %{$row} );
		&log_it("Too many protocols for a single account")
		    if( $#protocol > 0 );
		push( @{$ret->{account}}, &copy_POP(  $row ) )
		    if( $protocol[0] eq 'POP' );
		push( @{$ret->{account}}, &copy_IMAP( $row ) )
		    if( $protocol[0] eq 'IMAP' );
		push( @{$ret->{account}}, &copy_FTP(  $row ) )
		    if( $protocol[0] eq 'FTP' );
#		push( @{$ret->{account}}, &copy_hash($row) );
	    }

	} elsif( $type eq 'HASH' ) {
            # Only a single account, so it's a hash
	    my @protocol = keys( %{$rmmail->{account}} );
	    &log_it("Too many protocols for a single account")
		if( $#protocol > 0 );
	    push( @{$ret->{account}}, &copy_POP(  $rmmail->{account} ) )
		if( $protocol[0] eq 'POP' );
	    push( @{$ret->{account}}, &copy_IMAP( $rmmail->{account} ) )
		if( $protocol[0] eq 'IMAP' );
	    push( @{$ret->{account}}, &copy_FTP(  $rmmail->{account} ) )
		if( $protocol[0] eq 'FTP' );
#	    push( @{$ret->{account}}, &copy_hash($rmmail->{account}) );

	} else {
	    &log_it("Strange ref($type) when looking for array");
	    exit;
	}
    }


    # Handling Account Questions (ac_question).
    $ret->{ac_question} = [];  # Empty array
    if( exists( $rmmail->{ac_question} ) ) {
	my $type = ref( $rmmail->{ac_question} );
	if( $type eq 'ARRAY' ) {
	    my $row;
	    foreach $row (@{$rmmail->{ac_question}}) {
		push( @{$ret->{ac_question}}, &copy_question($row) );
	    }
	} elsif( $type eq 'HASH' ) {  # single hash
	    push( @{$ret->{ac_question}},
		  &copy_question($rmmail->{ac_question}) );

	} else {
	    &log_it("Strange ref($type) when looking for array");
	    exit;
	}
    }

    return( $ret );
}
sub copy_hash {
    my $hash = shift;
    my $ret  = {};
    my $key;

    foreach (keys(%{$hash})) {
	$key = $_;
	$key =~ s/^\s+//;
	$key =~ s/\s+$//;
	my $type = ref( $hash->{$_} );
	if( ! $type ) {                # It's a string
	    $ret->{$key} = $hash->{$_};
	    $ret->{$key} =~ s/^\s+//;
	    $ret->{$key} =~ s/\s+$//;
	    $ret->{$key} =~ s/\s+/ /;
	} elsif( $type eq 'HASH' ) {
	    $ret->{$key} = &copy_hash( $hash->{$_} );
	} elsif( $type eq 'ARRAY' ) {
	    $ret->{$key} = [];
	    my $row;
	    foreach $row (@{$hash->{$_}}) {
		push( @{$ret->{$key}}, &copy_hash($row) );
	    }

	} else {
	    die "copy_hash: unexpected reference type in hash\n";
	}
    }
    return( $ret );
}
sub copy_question {
    my $hash = shift;
    my $ret  = {};
    my $key;

    foreach (keys(%{$hash})) {
	$key = $_;
	$key =~ s/^\s+//;
	$key =~ s/\s+$//;
	my $type = ref( $hash->{$_} );
	if( ! $type ) {                # It's a string
	    $ret->{$key} = $hash->{$_};
	    $ret->{$key} =~ s/^\s+//;
	    $ret->{$key} =~ s/\s+$//;
	    if( /^value$/ ) {
		$ret->{$key} .= ' ';
	    } else {
		$ret->{$key} =~ s/\s+/ /;
	    }
	} elsif( ($key eq 'question') && ($type eq 'HASH') ) {
	    # From how I read things, XML::Simple->XMLin() should
	    # set <question> up as an array, instead it gives me a
	    # hash.  I think this is because one of the elements
	    # of question is "name".  But, it may be just because
	    # things are unique and so a HASH makes as much sense
	    # as anything.  In any case, I would prefer question to
	    # be an array, so patch things a bit.
	    $ret->{$key} = [];
	    my $subkey;
	    foreach $subkey (keys(%{$hash->{$_}})) {
		my $tmphash = &copy_question($hash->{$_}{$subkey});

		my $tmpkey = $subkey;
		$tmpkey    =~ s/^\s+//;
		$tmpkey    =~ s/\s+$//;

		&log_it("Strange question") if( $tmpkey eq 'name' );
		$tmphash->{name} = $tmpkey;
		push( @{$ret->{$key}}, $tmphash );
	    }
	} elsif( $type eq 'HASH' ) {
	    $ret->{$key} = &copy_question( $hash->{$_} );
	} elsif( $type eq 'ARRAY' ) {
	    $ret->{$key} = [];
	    my $row;
	    foreach $row (@{$hash->{$_}}) {
		push( @{$ret->{$key}}, &copy_question($row) );
	    }

	} else {
	    die "copy_question: unexpected reference type in hash\n";
	}
    }
    return( $ret );
}
sub copy_POP {
    my $account = shift;

    # Dead easy, this POP account is just a hash.  ->{POP}{*}
    my $ret = &copy_hash( $account );
    return( $ret );
}
sub copy_IMAP {
    my $account = shift;
    my $proto   = 'IMAP';

    # IMAP account is a hash, with N scalar elements and also an array
    # of ignore and an array of download.
    my $ret = {};
    my @elements = keys( %{$account->{$proto}} );
    my $element;
    foreach $element (@elements) {
	my $tmp_element =  $element;
	$tmp_element =~ s/^\s+//;
	$tmp_element =~ s/\s+$//;
	if( $tmp_element =~ /^(ignore|download)$/ ) {
	    $ret->{$proto}{$tmp_element} = [];
	    my $type = ref( $account->{$proto}{$element} );
	    if( $type eq 'ARRAY' ) {                # Assume ARRAY of scalars
		foreach (@{$account->{$proto}{$element}}) {
		    my $tmp_val =  $_;
		    $tmp_val =~ s/^\s+//;
		    $tmp_val =~ s/\s+$//;
		    push( @{$ret->{$proto}{$tmp_element}}, $tmp_val );
		}

	    } elsif( $type eq 'HASH' ) {
		foreach (keys(%{$account->{$proto}{$element}})) {
		    my $tmp_key =  $_;
		    $tmp_key =~ s/^\s+//;
		    $tmp_key =~ s/\s+$//;
		    # If download/ignore paths is stored in a HASH,
		    # I think it will be keys.  I think the values
		    # will be undef.
		    my $tmp_val;
		    if( defined( $account->{$account}{$element}{$_} ) ) {
			$tmp_val =  $account->{$account}{$element}{$_};
			$tmp_val =~ s/^\s+//;
			$tmp_val =~ s/\s+$//;
		    }
		    push( @{$ret->{$proto}{$tmp_element}}, $tmp_key );
		}

	    } elsif( ! $type ) {
		my $tmp_val =  $account->{$proto}{$element};
		$tmp_val =~ s/^\s+//;
		$tmp_val =~ s/\s+$//;
		push( @{$ret->{$proto}{$tmp_element}}, $tmp_val );

	    } else {
		&log_it("Bad ignore/download $proto account $type");
	    }

	} else {
	    my $tmp_val =  $account->{$proto}{$element};
	    $tmp_val =~ s/^\s+//;
	    $tmp_val =~ s/\s+$//;
	    $ret->{$proto}{$tmp_element} = $tmp_val;
	}
    }

    return( $ret );
}
sub copy_FTP {
    my $account = shift;
    my $proto   = 'FTP';

    # FTP account is similar to IMAP.
    my $ret = {};
    my @elements = keys( %{$account->{$proto}} );
    my $element;
    foreach $element (@elements) {
	my $tmp_element =  $element;
	$tmp_element =~ s/^\s+//;
	$tmp_element =~ s/\s+$//;
	if( $tmp_element =~ /^(ignore|download)$/ ) {
	    $ret->{$proto}{$tmp_element} = [];
	    my $type = ref( $account->{$proto}{$element} );
	    if( $type eq 'ARRAY' ) {
		foreach (@{$account->{$proto}{$element}}) {
		    my $tmp_val =  $_;
		    $tmp_val =~ s/^\s+//;
		    $tmp_val =~ s/\s+$//;
		    push( @{$ret->{$proto}{$tmp_element}}, $tmp_val );
		}

	    } elsif( $type eq 'HASH' ) {
		foreach (keys(%{$account->{$proto}{$element}})) {
		    my $tmp_key =  $_;
		    $tmp_key =~ s/^\s+//;
		    $tmp_key =~ s/\s+$//;
		    # If download/ignore paths is stored in a HASH,
		    # I think it will be keys.  I think the values
		    # will be undef.
		    my $tmp_val;
		    if( defined( $account->{$account}{$element}{$_} ) ) {
			$tmp_val =  $account->{$account}{$element}{$_};
			$tmp_val =~ s/^\s+//;
			$tmp_val =~ s/\s+$//;
		    }
		    push( @{$ret->{$proto}{$tmp_element}}, $tmp_key );
		}

	    } elsif( ! $type ) {
		my $tmp_val =  $account->{$proto}{$element};
		$tmp_val =~ s/^\s+//;
		$tmp_val =~ s/\s+$//;
		push( @{$ret->{$proto}{$tmp_element}}, $tmp_val );

	    } else {
		&log_it("Bad ignore/download $proto account $type");
	    }

	} else {
	    my $tmp_val =  $account->{$proto}{$element};
	    $tmp_val =~ s/^\s+//;
	    $tmp_val =~ s/\s+$//;
	    $ret->{$proto}{$tmp_element} = $tmp_val;
	}
    }

    return( $ret );
}

sub preamble {
    my $writer = shift;
    my $fh     = shift;

    print $fh "\n";
    $writer->comment( 'Config file for rmmail: Remote Managed Mail' );
    print $fh "\n";
    $writer->comment( 'logfile:        file to log into (in $RMMAIL ? $RMMAIL : ~/rmmail)' );
    print $fh "\n";
    $writer->comment( 'message_cache:  file to cache message info into' );
    print $fh "\n";
    $writer->comment( 'emergency:      place for Mail::Audit to dump email on panic' );
    print $fh "\n";
    $writer->comment( 'archive_delete: how long to keep old email at remote site(s)' );
    print $fh "\n";
    $writer->comment( 'ftp_work:       subdir under $RMMAIL for FTP to work in/use' );
    print $fh "\n";
    $writer->comment( 'remote_uid:     email address of me, at a remote location' );
    print $fh "\n";
    $writer->comment( 'trash:          email address to log, but delete' );
    print $fh "\n";
    $writer->comment( 'prespam:        mailing list, etc. to divert before spam filter' );
    print $fh "\n";
    $writer->comment( 'postspam:       mailing list, etc. to divert after spam filter' );
    print $fh "\n";
    $writer->comment( 'remote:         capturing important mail from remote cron jobs' );
    print $fh "\n";
    $writer->comment( 'forward:        forward copies of spam to someone for analysis?' );
    print $fh "\n";
    $writer->comment( 'bounce:         do we try to return mail detected as spam to sender?' );
    print $fh "\n";
    $writer->comment( 'ac_question:    questions to ask user when configuring accounts' );
    print $fh "\n";
    $writer->comment( 'account:        remote account info (IP/uid/passwd)' );
    print $fh "\n";
    $writer->comment( ' ' );
    print $fh "\n";
    $writer->comment( ' ' );
}
# A bunch of single scalar question/answers.
sub conf_logfile {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;

    my $default = $current ? $current : 'logfile';

    print "\n\nEnter a filename to log into: [$default] ";
    my $ans = &get_ans();
    $ans = $default if( length( $ans ) < 1 );

    print $fh "\n";
    $writer->comment( 'logfile: file under RMMAIL to log info to' );
    $writer->dataElement( 'logfile', $ans );
}
sub conf_message_cache {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;

    my $default = $current ? $current : 'msgidcache';

    print "\n\nEnter a filename to cache message info into: [$default] ";
    my $ans = &get_ans();
    $ans = $default if( length( $ans ) < 1 );

    print $fh "\n";
    $writer->comment( 'message_cache: cache of select hdr info for download control' );
    $writer->dataElement( 'message_cache', $ans );
}
sub conf_emergency {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;

    my $default = $current ? $current : 'emergency_mbox';

    print "\n\nEnter a filename for Mail::Audit to use in emergency: [$default] ";
    my $ans = &get_ans();
    $ans = $default if( length( $ans ) < 1 );

    print $fh "\n";
    $writer->comment( 'emergency: mbox for Mail::Audit during panic' );
    $writer->dataElement( 'emergency', $ans );
}
sub conf_archive_delete {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;

    my $default = $current ? $current : '1 month';

    print "\n\nHow long do you want to leave email at remote?: [$default] ";
    my $ans = &get_ans();
    $ans = $default if( length( $ans ) < 1 );

    print $fh "\n";
    $writer->comment( 'archive_delete: time to leave mail at remote site' );
    $writer->dataElement( 'archive_delete', $ans );
}
sub conf_ftp_work {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;

    my $default = $current ? $current : 'FTP_WORK';

    print "\n\nWhat subdir of RMMAIL should FTP mode use?: [$default] ";
    my $ans = &get_ans();
    $ans = $default if( length( $ans ) < 1 );

    print $fh "\n";
    $writer->comment( 'ftp_work: subdir of RMMAIL for FTP mode to put files into' );
    $writer->dataElement( 'ftp_work', $ans );
}
# Questions seeking an array answer
sub conf_remote_uid {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;  # reference to array
    my $ans;

    if( $#{$current} > -1 ) {
	my $default = '';
	foreach (@{$current}) {
	    $default .= "$_\n";
	}
	print "\n\nThe following are your currently defined set of remote addresses\n";
	print $default;
    } else {
	print "\n\nYou currently have no defined remote addresses.\n";
    }


    do {
	print "Enter another of your remote addresses, nothing to quit: ";
	$ans = &get_ans();
	if( length( $ans ) > 2 ) {
	    push( @{$current}, $ans ) if( ! grep( m|^$ans$|, @{$current}) );
	}
    } while( length( $ans ) > 2 );

    print $fh "\n";
    $writer->comment( 'remote_uid: email addresses you have remotely' );
    foreach (@{$current}) {
	$writer->dataElement( 'remote_uid', $_ );
    }
}
sub conf_trash {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;  # reference to array
    my $ans;

    if( $#{$current} > -1 ) {
	my $default = '';
	foreach (@{$current}) {
	    $default .= "$_\n";
	}
	print "\n\nThe following are your currently defined set of trash addresses\n";
	print $default;
    } else {
	print "\n\nYou currently have no defined trash addresses.\n";
    }

    print "Trash: addresses you want to log, but not keep\n";
    do {
	print "Enter another of your trash addresses, nothing to quit: ";
	$ans = &get_ans();
	if( length( $ans ) > 2 ) {
	    push( @{$current}, $ans ) if( ! grep( m|^$ans$|, @{$current}) );
	}
    } while( length( $ans ) > 2 );

    print $fh "\n";
    $writer->comment( 'trash: email addresses to log and delete' );
    foreach (@{$current}) {
	$writer->dataElement( 'trash', $_ );
    }
}
sub conf_spam {
    my $kind    = shift;
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;  # reference to array of hash (address}=address
    my @addr    = [];     #                            (to_mbox}=mbox
    my $default = '';
    my $ans1;

    if( $#{$current} > -1 ) {
	foreach (@{$current}) {
	    my @keys = keys(%{$_});
	    if( ($#keys == 1) && exists( $_->{address} ) ) {
		push( @addr, $_->{address} );
		$default .= "$_->{address} => $_->{to_mbox}\n";

	    } else {
		print "Bad $kind hash, incorrect number of keys\n";
		&log_it("Bad $kind hash, incorrect number of keys: $#keys");
	    }
	}
	print "\n\nThe following are your currently defined set of $kind addresses\n";
	print $default;
    } else {
	print "\n\nYou currently have no defined $kind addresses.\n";
    }

    print "$kind: addresses of mailing lists, special people, etc. you\n";
    print "wish to divert to their own mail folders, before analysing the\n";
    print "header or contents for being SPAM\n";
    do {
	print "Enter another of your $kind addresses, a space, and the mbox\n";
	print "nothing to quit: ";
	$ans1 = &get_ans();
	my @token = split( /\s+/, $ans1 );
	if( ($#token == 1) && length( $token[0] ) > 2 ) {
	    my $hash = {};
	    $hash->{address} = $token[0];
	    $hash->{to_mbox} = $token[1];
	    if( ! grep( m|^$token[0]$|, @addr ) ) {
		push( @{$current}, $hash );
		push( @addr, $token[0] );
	    }
	}
    } while( length( $ans1 ) > 2 );

    print $fh "\n";
    $writer->comment( "$kind: email addresses to divert to mbox before spam analysis" );
    foreach( @{$current} ) {
	$writer->startTag($kind);
	$writer->dataElement( 'address', $_->{address} );
	$writer->dataElement( 'to_mbox', $_->{to_mbox} );
	$writer->endTag($kind);
    }
}
sub conf_remote {
    my $writer    = shift;
    my $fh        = shift;
    my $current   = shift;  # reference to array of hash {domain}=address
                            #                            {header}=value
    my @remote_id = [];
    my $default   = '';
    my( $domain, $header, $value, @addr, $ans );

    if( $#{$current} > -1 ) {
	foreach (@{$current}) {
	    my @keys = keys(%{$_});
	    if( ($#keys == 2) && exists $_->{domain} ) {
		# The uniqueness of any of these hashes, is distributed
		# amongst the domain we are scanning from, the header
		# field examined, and the value we are scanning for.
		# Be simple, just concatenate the 3 fields, in a fixed
		# order.
		my $key;
		foreach $key (@keys) {
		    if( $key eq 'domain' ) {
			$domain = $_->{domain};
		    } elsif( $key eq 'header' ) {
			$header = $_->{header};
		    } elsif( $key eq 'value' ) {
			$value = $_->{value};
		    } else {
			&log_it("Strange remote hash{$key}");
		    }
		}
		my $id = $domain . $header . $value;
		push( @addr, $id );
		$default .= "domain: $domain\n $header: $value\n";

	    } else {
		print "Bad remote hash, incorrect number of keys\n";
		&log_it("Bad remote hash, incorrect number of keys: $#keys");
	    }
	}
	print "\n\nThe following are your currently defined set of remote monitoring addresses\n";
	print $default;
    } else {
	print "\n\nYou currently have no defined remote monitoring addresses.\n";
    }

    print "Remote: some people are looking for specific messages from remote\n";
    print "sites.  One source may be cron jobs emailing log info.  We need\n";
    print "to analyse the from field and another field to spot the message.\n";
    do {
	print "Enter another of your remote addresses, a space, the header\n";
	print "field, a colon and some unique part of that field; all on\n";
	print "one line. nothing to quit:\n";
	print "?: ";
	$ans = &get_ans();
	if( $ans =~ /^(\S+)\s+([^:]+):\s*(.*)$/ ) {
	    $domain = $1;
	    $header = $2;
	    $value  = $3;
	    $header =~ s/\s+$//;
	    my $id = $domain . $header . $value;
	    if( (length( $domain ) > 2) && (grep ! m|^$id$|, @addr ) ) {
		my $hash = {};
		$hash->{domain}  = $domain;
		$hash->{header}  = $header;
		$hash->{value}   = $value;
		push( @{$current}, $hash );
		push( @addr, $id );
	    }
	}
    } while( length( $ans ) > 2 );

    print $fh "\n";
    $writer->comment( 'Remote: email from remote sites with specific headers' );
    foreach (@{$current}) {
	$writer->startTag('remote');
	my $key;
	foreach $key ( keys( %{$_} ) ) {
	    $writer->dataElement( $key, $_->{$key} );
	}
	$writer->endTag('remote');
    }
}
sub conf_forward {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;

    my $default = $current ? $current : 'no forwarding';

    print "\n\nForward SPAM to where for archiving/blacklisting?: [$default] ";
    my $ans = &get_ans();

    print $fh "\n";
    $writer->comment( 'forward: send spam copies to address for blacklisting' );
    return if( (length( $ans ) < 1) || ($ans eq 'no forwarding') );
    $writer->dataElement( 'forward', $ans );
}
sub conf_bounce {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;

    my $default = $current ? 'bounce' : 'no bouncing';

    print "\n\nBounce SPAM to \"sender\"? (Y/N): [$default] ";
    my $ans = &get_ans();
    $ans = ($ans =~ /Y/i) ? 1 : 0;

    print $fh "\n";
    $writer->comment( 'bounce: return spam to supposed originating address' );
    $writer->dataElement( 'bounce', $ans );
}
sub conf_ac_question {
    my $writer  = shift;
    my $fh      = shift;
    my $current = shift;  # reference to array of hashes
    my( $ans, $key, $HOST, $host, $Server, $server, $USER, $User, $user, $PASSWORD, $Password, $password );

    print "\n\nDo you want to edit the questions used to ask for\n";
    print "address/user/password on your various remote email\n";
    print "accounts?  This is changing the questions, not changing\n";
    print "the account information.  Y/n? ";
    $ans = <STDIN>;

    print $fh "\n";
    $writer->comment( "ac_question: questions to ask user about mail accounts" );
    if( $ans =~ /Y/i ) {
	# Grrr, someone wants to change the questions.  We have POP,
	# IMAP and FTP questions.  POP only has 1 or 2 other questions
	# which could be asked, FTP is about the same.  IMAP has tons
	# of additional questions which could be added.  If you want to
	# tune your logins with these additional questions, you'll need
	# to modify a bit of code here (and elsewhere).  The following
	# 3 sections are pretty repetitive, since they all just get a
	# domain name, a UserID and a password.  The only real difference
	# is the actual token describing each of those 3 things.  But, if
	# people customize things, then things would need to change quite
	# a bit more.  Hence, I'll leave it explicit and verbose.

	print "Okay, you want to edit the questions.  Just hit enter\n";
	print "to leave the question alone.\n\n";
	foreach (@{$current}) {
	    my @protocol = keys(%{$_});
	    if( $#protocol > 0 ) {
		print "Bad ac_questions\n";
		return;
	    }
	    if( $protocol[0] =~ /POP/ ) {
		&conf_pop_ac_question( $writer, $fh, $_->{POP} );

	    } elsif( $protocol[0] =~ /IMAP/ ) {
		&conf_imap_ac_question( $writer, $fh, $_->{IMAP} );


	    } else {     # FTP
		print "For the FTP protocol\n";
		foreach $key (keys(%{$_->{FTP}})) {
		    $Server   = $_->{FTP}{Server}   if( $key eq 'Server' );
		    $User     = $_->{FTP}{User}     if( $key eq 'User' );
		    $Password = $_->{FTP}{Password} if( $key eq 'Password' );
		}
		print "Net::FTP is looking for a Server, the question is\n";
		print "$Server\n";
		print "\nNew version? ";
		$server = &get_ans();

		print "Net::FTP is looking for a User, the question is\n";
		print "$User\n";
		print "\nNew version? ";
		$user = &get_ans();

		print "Net::FTP is looking for a Password, the question is\n";
		print "$Password\n";
		print "\nNew version? ";
		$password = &get_ans();

		foreach $key (keys(%{$_->{FTP}})) {
		    $_->{FTP}{Server}   = length( $server )   > 0 ? $server   : $Server
			if( $key eq 'Server' );
		    $_->{FTP}{User}     = length( $user )     > 0 ? $user     : $User
			if( $key eq 'User' );
		    $_->{FTP}{Password} = length( $password ) > 0 ? $password : $Password
			if( $key eq 'Password' );
		}
	    }
	}
    } # End of block to modify questions.


    print $fh "\n";
    $writer->comment( 'ac_question: questions to ask user about mail accounts' );
    foreach (@{$current}) {
	my @protocol = keys(%{$_});
	if( $protocol[0] =~ /(POP|IMAP|FTP)/ ) {
	    $writer->startTag('ac_question');
	    $writer->startTag($protocol[0]);
	    my $question;
	    foreach $question (@{$_->{$protocol[0]}{question}}) {
		$writer->startTag('question');
		$writer->dataElement( 'name',  $question->{name}  );
		$writer->dataElement( 'value', $question->{value} );
		$writer->endTag('question');
	    }
	    $writer->endTag($protocol[0]);
	    $writer->endTag('ac_question');

	}
    }
}
sub conf_pop_ac_question {
    my $writer    = shift;
    my $fh        = shift;
    my $questions = shift;
    my $element   = 'POP';
    my $new       = {};

    print "For the $element protocol\n";
    # Our only parameters, are ones needed for POP3Client.  So one
    # template does it.
    foreach (@POP_Keys) {
	print "Mail::POP3Client is looking for a $_, the question is\n";
	print "$questions->{$_}\n";
	print "\nNew version? ";
	$new->{$_} = &get_ans();
    }

    foreach (@POP_Keys) {
	$questions->{$_} = length( $new->{$_} ) > 0 ?
	                   $new->{$_} : $questions->{$_};
    }

    print $fh "\n";
    $writer->comment( "ac_question/$element: $element mail accounts" );

    $writer->startTag('ac_question');
    $writer->startTag($element);
    foreach (@POP_Keys) {
	$writer->startTag('question');
	$writer->dataElement( 'name',  $_ );
	$writer->dataElement( 'value', $questions->{$_} );
	$writer->endTag('question');
    }
    $writer->endTag($element);
    $writer->endTag('ac_question');
}
sub conf_imap_ac_question {
    my $writer    = shift;
    my $fh        = shift;
    my $questions = shift;
    my $element   = 'IMAP';
    my $new = {};

    print "For the $element protocol\n";

    print "Mail::IMAPClient is looking for a Server, the question is\n";
    print "$questions->{Server}\n";
    print "\nNew version? ";
    $new->{Server} = &get_ans();

    print "Mail::IMAPClient is looking for a User, the question is\n";
    print "$questions->{User}\n";
    print "\nNew version? ";
    $new->{User} = &get_ans();

    print "Mail::IMAPClient is looking for a Password, the question is\n";
    print "$questions->{Password}\n";
    print "\nNew version? ";
    $new->{Password} = &get_ans();

    print "Mail::IMAPClient is looking for a directory separator, the question is\n";
    print "$questions->{separator}\n";
    print "\nNew version? ";
    $new->{separator} = &get_ans();

    print "Mail::IMAPClient is looking for an indicator of mixedUse with folders, the question is\n";
    print "$questions->{mixedUse}\n";
    print "\nNew version? ";
    $new->{mixedUse} = &get_ans();

    print "Rmmail is looking for a default action (download or ignore), the question is\n";
    print "$questions->{default_action}\n";
    print "\nNew version? ";
    $new->{default_action} = &get_ans();

    print "Rmmail is looking for items to download, the question is\n";
    print "$questions->{download}\n";
    print "\nNew version? ";
    $new->{download} = &get_ans();

    print "Rmmail is looking for items to NOT download, the question is\n";
    print "$questions->{ignore}\n";
    print "\nNew version? ";
    $new->{ignore} = &get_ans();

    foreach (@IMAP_Keys) {
	$questions->{$_} = length( $new->{$_} ) > 0 ?
	                   $new->{$_} : $questions->{$_};
    }

    print $fh "\n";
    $writer->comment( "ac_question/$element: $element mail accounts" );

    $writer->startTag('ac_question');
    $writer->startTag($element);
    foreach (@IMAP_Keys) {
	$writer->startTag('question');
	$writer->dataElement( 'name',  $_ );
	$writer->dataElement( 'value', $questions->{$_} );
	$writer->endTag('question');
    }
    $writer->endTag($element);
    $writer->endTag('ac_question');

}
#FTP
sub conf_ftp_ac_question {
    my $writer    = shift;
    my $fh        = shift;
    my $questions = shift;
    my $element   = 'IMAP';
    my $new       = {};

    print "For the $element protocol\n";

    print "Net::FTP is looking for a Server, the question is\n";
    print "$questions->{Server}\n";
    print "\nNew version? ";
    $new->{Server} = &get_ans();

    print "Net::FTP is looking for a User, the question is\n";
    print "$questions->{User}\n";
    print "\nNew version? ";
    $new->{User} = &get_ans();

    print "Net::FTP is looking for a Password, the question is\n";
    print "$questions->{Password}\n";
    print "\nNew version? ";
    $new->{Password} = &get_ans();

    print "Rmmail is looking for a default action (download or ignore), the question is\n";
    print "$questions->{default_action}\n";
    print "\nNew version? ";
    $new->{default_action} = &get_ans();

    print "Rmmail is looking for items to download, the question is\n";
    print "$questions->{download}\n";
    print "\nNew version? ";
    $new->{download} = &get_ans();

    print "Rmmail is looking for items to NOT download, the question is\n";
    print "$questions->{ignore}\n";
    print "\nNew version? ";
    $new->{ignore} = &get_ans();

    foreach (@FTP_Keys) {
	$questions->{$_} = length( $new->{$_} ) > 0 ?
	                   $new->{$_} : $questions->{$_};
    }

    print $fh "\n";
    $writer->comment( "ac_question/$element: $element mail accounts" );

    $writer->startTag('ac_question');
    $writer->startTag($element);
    foreach (@FTP_Keys) {
	$writer->startTag('question');
	$writer->dataElement( 'name',  $_ );
	$writer->dataElement( 'value', $questions->{$_} );
	$writer->endTag('question');
    }
    $writer->endTag($element);
    $writer->endTag('ac_question');

}

sub conf_account {
    my $writer    = shift;
    my $fh        = shift;
    my $current   = shift;  # reference to array of hashes
    my $questions = shift;  # to ask the user questions about accounts
    my( $term, @account, $host, $user );
    my $string = '';
    my $ans;

    foreach (@{$current}) {
	my @protocol = keys(%{$_});
	if( $#protocol > 0 ) {
	    print "Bad accounts\n";
	    return;
	}
	my @terms = keys( %{$_->{$protocol[0]}} );
	my $host='';
	my $user='';
	foreach $term (@terms) {
	    $host   = $_->{$protocol[0]}{$term}
	    	if( $term =~ /(HOST|Host|Server)/ );
	    $user   = $_->{$protocol[0]}{$term}
	    	if( $term =~ /(USER|User)/ );
#	    $passwd = $_->{$protocol[0]}{$term}
#	    	if( $term =~ /(PASSWORD|Password)/ );
	}
	$string = sprintf( "%s:%s at %s", $protocol[0], $user, $host );
	push( @account, $string );
    }

    if( $#account ) {
	print "\n\nThe following are your currently defined accounts\n";
	foreach (@account) { print "$_\n"; }

    } else {
	print "\n\nYou have no currently defined accounts\n";
    }

    do {
	print "What kind of account? (POP/IMAP/FTP): ";
	my $protocol = &get_ans();
	if( $protocol =~ /POP/i ) {
	    $protocol = 'POP';

	} elsif( $protocol =~ /IMAP/i ) {
	    $protocol = 'IMAP';

	} elsif( $protocol =~ /FTP/i ) {
	    $protocol = 'FTP';

	} else {
	    print "Strange answer ($protocol).  Quit? (Y/N) ";
	    $ans = &get_ans();
	}

	if( $protocol =~ /^(POP|IMAP|FTP)$/ ) {
	    my( $question, @port, $q, %generic, %host, %user, %passwd );
	    foreach $question (@{$questions}) {
		@port = keys(%{$question});
		if( $port[0] eq $protocol ) {  # Found question set for proto
		    foreach $q (keys(%{$question->{$port[0]}})) {
			print "$question->{$port[0]}{$q} ";
			$ans = &get_ans();
			if( $q =~ /^(HOST|Host|Server)$/ )  {
			    $host{$q}   = $ans; next; }
			if( $q =~ /^(USER|User)$/ )         {
			    $user{$q}   = $ans; next; }
			if( $q =~ /^(PASSWORD|Password)$/ ) {
			    $passwd{$q} = $ans; next; }
			$generic{$q} = $ans;
		    }
		} # We have all our questions answered at this point.

		# Is this host/user in our set of previous ones?
		$string = sprintf( "%s at %s", $user, $host );
		if( (grep m|^$string$|, @account ) ) {
		    # Account update
print "Account update not done yet.  Edit the hard way please.\n";

		} else {  # New account
		    my $hash = {};
		    my $k;
		    my @k = keys(%host);
		    $hash->{$protocol}{$k[0]}=$host{$k[0]};
		    @k = keys(%user);
		    $hash->{$protocol}{$k[0]}=$user{$k[0]};
		    @k = keys(%passwd);
		    $hash->{$protocol}{$k[0]}=$passwd{$k[0]};
		    foreach $k (keys(%generic)) {
			$hash->{$protocol}{$k}=$generic{$k};
		    }
		    push( @{$current}, $hash );
		}
	    }
	}
    } while( (length($ans) < 1) && ($ans !~ /^N$/i) );


    print $fh "\n";
    $writer->comment( 'accounts: user mail accounts' );
    foreach (@{$current}) {
	my @protocol = keys(%{$_});
	if( $protocol[0] =~ /(POP|IMAP|FTP)/ ) {
	    $writer->startTag('account');
	    $writer->startTag($protocol[0]);
	    my $k;
	    foreach $k (keys( %{$_->{$protocol[0]}}) ) {

		# If this key ($k) points to a data element (string),
		# $kind_ref should be nothing as it isn't a
		# reference.  However, FTP and IMAP have download
		# and ignore which are arrays, possibly empty, possibly
		# a single element.  I only have arrays of scalars
		# at this point, but who knows about the future?
		my $kind_ref = ref( $_->{$protocol[0]}{$k} );
		if( $kind_ref eq 'REF' ) {
		    &log_it("Strange $kind_ref in account");
		} elsif( $kind_ref eq 'SCALAR' ) {
		    &log_it("Strange $kind_ref in account");
		} elsif( $kind_ref eq 'ARRAY' ) {
		    my $row;
		    foreach $row (@{$_->{$protocol[0]}{$k}}) {
			$writer->dataElement( $k,  $row );
		    }
		} elsif( $kind_ref eq 'HASH' ) {
		    &log_it("Strange $kind_ref in account");
		} elsif( $kind_ref eq 'CODE' ) {
		    &log_it("Strange $kind_ref in account");
		} elsif( $kind_ref eq 'GLOB' ) {
		    &log_it("Strange $kind_ref in account");
		} elsif( $kind_ref ) {  # Blessed object in package
		    &log_it("Strange $kind_ref in account");
		} else {
		    $writer->dataElement( $k,  $_->{$protocol[0]}{$k} );
		}
	    }
	    $writer->endTag($protocol[0]);
	    $writer->endTag('account');
	}
    }
}


#========================================================================
# Our config file has places where we can have an array of zero or
# more types of items.  Our XML parser, will not generate any content
# of an element type, if that element is missing in the config file.
# If only a single instance is present, we will get a SCALAR or a HASH
# (depending on the type of content).  Only if we have multiple instances,
# will we get the array.  Our code is written for arrays.  So, we need to
# interpret our configuration such that we return arrays of zero, one or
# many elements.

sub extract_prespam {
    my $config  = shift;
    my $element = 'prespam';

    # We are returning a hash.  Now, if our config file has no $element
    # addresses list, $rmmail->{$element} will not exist.  If our config
    # file has only a single address listed, $rmmail->{$element} will be
    # a hash with 2 elements.  If our config file has multiple addresses
    # listed, $rmmail->{$element} will be an array of 2 element hashes.
    # We want to return a reference to an hash, no matter what.  Addresses
    # are unique, folders/mbox to put the mail into aren't (no putting
    # a given mail into 2 different folders).

    my $ret = {};
    return( $ret ) unless exists( $config->{$element} );

    my $type = ref( $config->{$element} );
    if( $type eq 'HASH' ) {
	my $count = 0;
	my $nkeys = 0;
	foreach (keys(%{$config->{$element}})) {
	    $count++;
	    $nkeys++ if( $_ eq 'to_mbox' );
	    $nkeys++ if( $_ eq 'address' );
	}
	if( ($count == 2) && ($nkeys == 2) ) {  # Hooray, good hash
	    $ret->{$config->{$element}{address}} = $config->{$element}{to_mbox};
	    return( $ret );

	} else {
	    &log_it("Bad $element data in config file. Counts $count:$nkeys");
	}

    } elsif( ref( $config->{$element} ) eq 'ARRAY' ) {
	my $entry;
	foreach $entry (@{$config->{$element}}) {
	    my $count = 0;
	    my $nkeys = 0;
	    foreach (keys(%{$entry})) {
		$count++;
		$nkeys++ if( $_ eq 'to_mbox' );
		$nkeys++ if( $_ eq 'address' );
	    }
	    if( ($count == 2) && ($nkeys == 2) ) {
		$ret->{$entry->{address}} = $entry->{to_mbox};

	    } else {
		&log_it("Bad $element data in config file. Counts $count:$nkeys");
	    }
	}
	return( $ret );
	
    } else {
	&log_it("Bad $element data in config file. ref( $type )");
    }
    return( undef );
}
sub extract_postspam {
    my $config  = shift;
    my $element = 'postspam';

    # Same as prespam, different part of config hash

    my $ret = {};
    return( $ret ) unless exists( $config->{$element} );

    my $type = ref( $config->{$element} );
    if( $type eq 'HASH' ) {
	my $count = 0;
	my $nkeys = 0;
	foreach (keys(%{$config->{$element}})) {
	    $count++;
	    $nkeys++ if( $_ eq 'to_mbox' );
	    $nkeys++ if( $_ eq 'address' );
	}
	if( ($count == 2) && ($nkeys == 2) ) {
	    $ret->{$config->{$element}{address}} = $config->{$element}{to_mbox};
	    return( $ret );

	} else {
	    &log_it("Bad $element data in config file. Counts $count:$nkeys");
	}

    } elsif( ref( $config->{$element} ) eq 'ARRAY' ) {
	my $entry;
	foreach $entry (@{$config->{$element}}) {
	    my $count = 0;
	    my $nkeys = 0;
	    foreach (keys(%{$entry})) {
		$count++;
		$nkeys++ if( $_ eq 'to_mbox' );
		$nkeys++ if( $_ eq 'address' );
	    }
	    if( ($count == 2) && ($nkeys == 2) ) {
		$ret->{$entry->{address}} = $entry->{to_mbox};

	    } else {
		&log_it("Bad $element data in config file. Counts $count:$nkeys");
	    }
	}
	return( $ret );
	
    } else {
	&log_it("Bad $element data in config file. ref( $type )");
    }
    return( undef );
}
sub extract_remote_uid {
    my $config  = shift;
    my $element = 'remote_uid';

    # Extracting strings from an array, if the array references exists.

    my $ret = [];
    return( $ret ) unless exists( $config->{$element} );

    my $type = ref( $config->{$element} );
    if( $type eq 'ARRAY' ) {
	push( @{$ret}, @{$config->{$element}} );

    } elsif( ! $type ) {               # Single string
	push( @{$ret}, $config->{$element} );

    } else {
	&log_it("Strange $element in config");
	return( undef );
    }
    return( $ret );
}
sub extract_trash {
    my $config  = shift;
    my $element = 'trash';

    # Extracting strings from an array, if the array references exists.

    my $ret = [];
    return( $ret ) unless exists( $config->{$element} );

    my $type = ref( $config->{$element} );
    if( $type eq 'ARRAY' ) {
	push( @{$ret}, @{$config->{$element}} );

    } elsif( ! $type ) {            # Single string
	push( @{$ret}, $config->{$element} );

    } else {
	&log_it("Strange $element in config");
	return( undef );
    }
    return( $ret );
}
sub extract_remote {
    my $config  = shift;
    my $element = 'remote';

    # Similar to prespam, sort of.

    my $ret = [];
    return( $ret ) unless exists( $config->{$element} );

    my $type = ref( $config->{$element} );
    if( $type eq 'HASH' ) {
	my $count = 0;
	my $nkeys = 0;
	foreach (keys(%{$config->{$element}})) {
	    $count++;
	    $nkeys++ if( $_ eq 'domain' );
	    $nkeys++ if( $_ eq 'header' );
	    $nkeys++ if( $_ eq 'value' );
	}
	if( ($count == 3) && ($nkeys == 3) ) {
	    my $hash = {};
	    $hash->{domain} = $config->{$element}{domain};
	    $hash->{header} = $config->{$element}{header};
	    $hash->{value}  = $config->{$element}{value};
	    push( @{$ret}, $hash );
	    return( $ret );

	} else {
	    &log_it("Bad $element data in config file. Counts $count:$nkeys");
	}

    } elsif( ref( $config->{$element} ) eq 'ARRAY' ) {
	my $entry;
	foreach $entry (@{$config->{$element}}) {
	    my $count = 0;
	    my $nkeys = 0;
	    foreach (keys(%{$entry})) {
		$count++;
		$nkeys++ if( $_ eq 'domain' );
		$nkeys++ if( $_ eq 'header' );
		$nkeys++ if( $_ eq 'value' );
	    }
	    if( ($count == 3) && ($nkeys == 3) ) {
		push( @{$ret}, $entry );

	    } else {
		&log_it("Bad $element data in config file. Counts $count:$nkeys");
	    }
	}
	
    } else {
	&log_it("Bad $element data in config file. ref( $type )");
    }
    return( $ret );
}
sub extract_pop_accounts {
    my $config      = shift;
    my $element     = 'account';
    my $sub_element = 'POP';

    # Similar to prespam

    my $ret = [];
    return( $ret ) unless exists( $config->{$element} );


    my $type = ref( $config->{$element} );
    if( $type eq 'HASH' ) {  # Only a single account, is it $sub_element ?
	my $account = &extract_single_pop_account( $config->{$element} );
	push( @{$ret}, $account ) if( $account );
	return( $ret );


    } elsif( $type eq 'ARRAY' ) {  # We have more than 1 account
	my $account;
	foreach $account (@{$config->{$element}}) {
	    my $maybe = &extract_single_pop_account( $account );
	    push( @{$ret}, $maybe ) if( $maybe );
	}
	return( $ret );

    } else {
	&log_it("Bad $element data in config file. ref($type)\n");
    }
    return( undef );
}
sub extract_single_pop_account {
    my $account = shift;
    my $element = 'POP';

    my @accnt = keys(%{$account});
    if( $#accnt == 0 ) {
	if( $accnt[0] =~ /^$Account_RE$/ ) {
	    my $hash = {};
	    if( $accnt[0] eq $element ) {
		# Look for unknown elements in $element account
		foreach (keys(%{$account->{$element}})) {
		    if( ! grep( m|^$_$|, @POP_Keys ) ) {
			&log_it("Bad {$element($_)key}");
			return( undef );
		    }
		}
		foreach (@POP_Keys) {
		    $hash->{$_} = $account->{$element}{$_}
		        if( exists( $account->{$element}{$_} ) );
		}
		return( $hash );

	    } else {
		return( undef );  # No error, just no $element account
	    }
	} else {
	    &log_it("Bad {$element($accnt[0])}");
	    return( undef );
	}
    } else {
	&log_it("Bad {$element}");
	return( undef );
    }
}
sub extract_imap_accounts {
    my $config      = shift;
    my $element     = 'account';
    my $sub_element = 'IMAP';

    # Similar to prespam

    my $ret = [];
    return( $ret ) unless exists( $config->{$element} );


    my $type = ref( $config->{$element} );
    if( $type eq 'HASH' ) {  # Only a single account, is it $sub_element ?
	my $account = &extract_single_imap_account( $config->{$element} );
	push( @{$ret}, $account ) if( $account );
	return( $ret );


    } elsif( $type eq 'ARRAY' ) {  # We have more than 1 account
	my $account;
	foreach $account (@{$config->{$element}}) {
	    my $maybe = &extract_single_imap_account( $account );
	    push( @{$ret}, $maybe ) if( $maybe );
	}
	return( $ret );

    } else {
	&log_it("Bad $element data in config file. ref($type)");
    }
    return( undef );
}
sub extract_single_imap_account {
    my $account = shift;
    my $element = 'IMAP';

    my @accnt = keys(%{$account});
    if( $#accnt == 0 ) {
	if( $accnt[0] =~ /^$Account_RE$/ ) {
	    my $hash = {};
	    if( $accnt[0] eq $element ) {
		# Look for unknown elements in $element account
		foreach (keys(%{$account->{$element}})) {
		    if( ! grep( m|^$_$|, @IMAP_Keys ) ) {
			&log_it("Bad {$element($_)key}");
			return( undef );
		    }
		}
		foreach (@IMAP_Keys) {
		    $hash->{$_} = $account->{$element}{$_}
		        if( exists( $account->{$element}{$_} ) );
		}
		return( $hash );

	    } else {
		return( undef );  # No error, just no $element account
	    }
	} else {
	    &log_it("Bad {$element($accnt[0])}");
	    return( undef );
	}
    } else {
	&log_it("Bad {$element}");
	return( undef );
    }
}
sub extract_ftp_accounts {
    my $config      = shift;
    my $element     = 'account';
    my $sub_element = 'FTP';

    # Similar to prespam

    my $ret = [];
    return( $ret ) unless exists( $config->{$element} );


    my $type = ref( $config->{$element} );
    if( $type eq 'HASH' ) {  # Only a single account, is it $sub_element ?
	my $account = &extract_single_ftp_account( $config->{$element} );
	push( @{$ret}, $account ) if( $account );
	return( $ret );


    } elsif( $type eq 'ARRAY' ) {  # We have more than 1 account
	my $account;
	foreach $account (@{$config->{$element}}) {
	    my $maybe = &extract_single_ftp_account( $account );
	    push( @{$ret}, $maybe ) if( $maybe );
	}
	return( $ret );

    } else {
	&log_it("Bad $element data in config file. ref($type)");
    }
    return( undef );
}
sub extract_single_ftp_account {
    my $account = shift;
    my $element = 'FTP';

    my @accnt = keys(%{$account});
    if( $#accnt == 0 ) {
	if( $accnt[0] =~ /^$Account_RE$/ ) {
	    my $hash = {};
	    if( $accnt[0] eq $element ) {
		# Look for unknown elements in $element account
		foreach (keys(%{$account->{$element}})) {
		    if( ! grep( m|^$_$|, @FTP_Keys ) ) {
			&log_it("Bad {$element($_)key}");
			return( undef );
		    }
		}
		foreach (@FTP_Keys) {
		    $hash->{$_} = $account->{$element}{$_}
		        if( exists( $account->{$element}{$_} ) );
		}
		return( $hash );

	    } else {
		return( undef );  # No error, just no $element account
	    }
	} else {
	    &log_it("Bad {$element($accnt[0])}");
	    return( undef );
	}
    } else {
	&log_it("Bad {$element}");
	return( undef );
    }
}
sub fix_EOL {
    my @mail = @_;
    foreach (@mail) {
        s/\r\n$/\n/;
	s/\n\r$/\n/;
	s/^\r//g;
	s/\r$/\n/g;
	chomp( );
	$_ .= "\n";
    }
    return( @mail );
}