#!/usr/local/bin/perl
# $Id: forward.pl,v 1.2 92/07/31 08:18:06 cap Exp $
# Here's a script to look for mail from certain senders
# and put it directly in the appropriate NeXTmail mailboxes.

# Change the following three variables for your local
# login name, spool mailbox, and NeXTMail mailboxes.
$user = cap;
$defaultmbox = "/usr/spool/mail/$user";
$maildir = "/usr/$user/Mailboxes";
# 
# mboxes is an association list that maps regular expressions to
# Mailboxes. Below, we apply each regular expression to each line in the
# header of the incoming mail message. If one matches, we take the value
# associated with the regular expression as the name of a NeXTMail
# mailbox. If the name of the mailbox is, say, haskell, we append the
# mail to ~user/Mailboxes/haskell.mbox/mbox.
# 
%mboxes = (
	   '^Sender: Haskell Distribution List',	'haskell',
	   '^From: .*DAT-Heads-Request',		'DAT-Heads',
	   '^From: NeXTmusic Mailing List',		'nextmusic',
);
# some things you probably don't have to change
$uudecode = "/usr/bin/uudecode";
$uncompress = "/usr/ucb/uncompress";
$tar = "/NextApps/Mail.app/safetar";

############# I hope you don't have to change anything below here. ############

require 'ctime.pl';
require 'stat.pl';

#
# unpack_nextmail(mailbox, buf) - unpack the NeXTmail message contained
#	in buf into the mailbox directory mailbox. Returns a modified
#	buffer and the name of the attachment directory. The modified
#	buffer has a Next-Reference: header instead of a Next-Attachment 
#	header, and the body of the original buffer is gone. This new
#	buffer is what should go in the mbox file. The name of the
#	attachment directory should become the of the dynamic strings
#	that make up the table_of_contents entry for this message.
#
sub unpack_nextmail {
    local($mailbox, $buf) = @_;
    local($pid, $subj, $set_id) = 
	$buf =~ /\nNext-Attachment: \.tar\.([0-9]*)\.([^.]*)\.attach, [0-9]*, ([^,]*)/;
    local($version);		# uniquifier for identical subject lines

    chdir($mailbox) || &append_and_die("can't cd to $mailbox");
    $tarfile = ".tar.${pid}.${subj}.attach";
    $attach_dir = "${subj}.attach";
    for ($version = 0; -d $attach_dir; $version++) {
	$attach_dir = "${subj}_$version.attach";
    }

#    print("the tarfile is $tarfile\n");
#    print("the attach_dir is $attach_dir\n");

    # Now we can create the attach_dir, extract the stuff in tarfile, and
    # clean up.
    mkdir($attach_dir, 0777) || &append_and_die("can't mkdir $attach_dir");
    chdir($attach_dir) || &append_and_die("can't cd $attach_dir");
    open(UUDECODE, "| $uudecode") || &append_and_die("can't start uudecode");
    print UUDECODE $buf;
    close(UUDECODE);
    system("$uncompress < $tarfile | $tar xf -");
    unlink($tarfile);

    # insert Next-Reference: header
    $buf =~ s/\n/\nNext-Reference: $attach_dir, $set_id\n/;
    # delete the Next-Attachment: header
    $buf =~ s/\nNext-Attachment: .*//;
    # delete the body of the message
    $buf =~ s/\n\n(.|\n)*/\n\n/;
#    print("the buffer is $buf\n");
    ($buf, $attach_dir);
}
    
#
# read_header(handle) - read a table_of_contents header from file handle
# 			handle and return a list of the eight fields
#
sub read_header {
    local($buf);

    read(@_[0], $buf, 8 * 4);
    unpack("N3f5", $buf);
}

#
# write_header(handle, magic, num_msgs, mbox_time,
#		listview_height, llx, lly, width, height) -
#     writes a table_of_contents header on file handle, where
#	magic		- is the magic number
#	num_msgs	- is the number of messages in the mailbox
#	mbox_time	- the m_time of the mbox file
#
sub write_header {
    local($handle, $magic, $num_msgs, $mbox_time,
	$listview_height, $llx, $lly, $width, $height) = @_;
    local($buf) = pack("N3f5", $magic, $num_msgs, $mbox_time,
			$listview_height, $llx, $lly, $width, $height);

    print $handle $buf;
}

#
# read_msg_header(handle) - read a record describing a message from the
#			    table_of_contents file handle.
#

sub read_msg_header {
    local($buf, $reclength, $start_position, $length, $date,
	  $status, $msgtype, $from, $subject, $attachment);

    read(@_[0], $buf, 4 * 5);			# all the static-length stuff
    ($reclength, $start_position, $length, $date, $status, $msgtype, 
	$pad1, $pad2) =	unpack("N4c4", $buf);

    read(@_[0], $buf, $reclength - 4 * 5); # the three variable-length strings
    # separate the strings
    ($from, $subject, $attachment) = split(/\000/, $buf);
    # return the whole mess
    ($start_position, $length, $date, $status, $msgtype, $pad1, $pad2,
     $from, $subject, $attachment);
}

#
# write_msg_header(handle, $reclength, $start_pos, $length, $date,
#		   $status, $msgtype, $from, $subject, $attachment) -
#    Writes a message header at the current position of table_of_contents
#    file handle.
#

sub write_msg_header {
    local($handle, $reclength, $start_pos, $length, $date,
	  $status, $msgtype, $from, $subject, $attachment) = @_;
    local($buf) = pack("N4", $reclength, $start_pos, $length, $date);

    print $handle $buf;		# write static-sized stuff
    printf($handle "%s%s  %s\0%s\0%s\0", 
	$status, $msgtype, $from, $subject, $attachment);
}

#
# builddate(datestring) - given a string like Sun Apr 19 07:32:33 1992,
#			  return a number that represents the input date
#			  in the form used by NeXTMail.
#    NeXTmail encodes dates into a single long int, as follows:
#    bits 9-31:	the year
#    bits 5-8:	the month of the year (1 = January)
#    bits 0-4:	the date of the month
#
sub builddate {
    # we really should have a more powerful way of parsing the date on
    # the From line. Something like GNU's getdate would be nice.
    local($month, $date, $year) = @_[0] =~ /... (...) (..) ..:..:.. (....)/;
    local(%datemap) = ('Jan', 1,
		       'Feb', 2,
		       'Mar', 3,
		       'Apr', 4,
		       'May', 5,
		       'Jun', 6,
		       'Jul', 7,
		       'Aug', 8,
		       'Sep', 9,
		       'Oct', 10,
		       'Nov', 11,
		       'Dec', 12);

    $year << 9 | $datemap{$month} << 5 | $date;
}

#
# add_message(mailbox, message, from, subject, nextmail) -
#     Adds the mail message in the string $message to the NeXT mailbox
#     $mailbox. The arguments $from and $subject are the contents of
#     the From: and Subject: header lines. $nextmail is 0 if this
#     is regular mail, or nonzero if this is NeXT mail.
#
#     Returns 0 on success or 1 on failure.
#
sub add_message {
    local($mailbox, $message, $from, $subject, $nextmail) = @_;
    local($start_pos, $length, $reclength, $date, $status);
    local($magic, $num_msgs, $mbox_time);
    local($listview_height, $llx, $lly, $width, $height);

    open(MBOX, ">> $mailbox/mbox") || &append_and_die("can't open mailbox");
    # LOCK_EX|LOCK_NB
    flock(MBOX, 2|4) || &append_and_die("can't get mbox lock");
    # and, in case someone appended
    # while we were waiting
    seek(MBOX, 0, 2);
    open(CONTENTS, "+<$mailbox/table_of_contents") || &append_and_die("can't open table_of_contents");

    if ($nextmail) {
	($message, $attachment) = &unpack_nextmail($mailbox, $message);
    } else {
	$attachment = '';
    }
    $start_pos = tell(MBOX);
    print MBOX "$message\n";
    flock(MBOX, 8);		# LOCK_UN
    close(MBOX);

    $length = length($message) + 1;
    $reclength = length($from) + length($subject) + length($attachment)
		+ 4 * 5 + 3;
    # get the date of this message from the "From <user> <date>" line
    # that is the first line of all mail messages.
    if ($message =~ /^From [^ ]* +([^\n]*)\n/) {
	$date = &builddate($1);
    }
    $status = '*';	# unread
    if ($nextmail) {
	$msgtype = 'r';
    } else {
	$msgtype = ' ';
    }

    @statbuf = stat("$mailbox/mbox");
    $mbox_time = @statbuf[$ST_MTIME];

    # take two items from the existing header
    ($magic, $num_msgs, $dummy, $listview_height, $llx, $lly, $width, $height)
	= &read_header(CONTENTS);
    seek(CONTENTS, 0, 0);	# go to beginning of the file
    &write_header(CONTENTS, $magic, $num_msgs + 1, $mbox_time,
	$listview_height, $llx, $lly, $width, $height);
    seek(CONTENTS, 0, 2);	# go to the end of the file

    &write_msg_header(CONTENTS, $reclength, $start_pos, $length, $date,
	$status, $msgtype, $from, $subject, $attachment);
    close(CONTENTS);
    0;		# return 0 on success
}

# With the above subroutines defined, we can read the incoming mail
# from stdin and process it.

# $thefile begins as the empty string, and eventually becomes a string
# containing the whole mail message. During each iteration of the
# while loop below, we're looking at a new line of the mail. 
$thefile = '';
# this gets set to a mailbox in ~/Mailboxes if we match something in %mboxes
$dest = '';
# this is nonzero while we are scanning the mail header
$inheader = 1;
# this becomes true if we detect that we are dealing with NeXTMail
$nextmail = 0;
while (<>) {
    if ($inheader) {
	foreach $key (keys(%mboxes)) {
	    $dest = $mboxes{$key} if (/$key/);
	}
	if (/^From: (.*)/) {
	    $from = $1;
	} elsif (/^Subject: (.*)/) {
	    $subject = $1;
	} elsif (/^Next-Attachment:/) {
	    $next_mail = 1;
	} elsif (/^[ \t]*$/) {
	    # we've hit the end of the mail header, so stop searching
	    $inheader = 0;
	}
    }
    $thefile .= $_;
}
$mbox = "$maildir/$dest.mbox";
if ($dest =~ /^\|/) {
	# we pipe this mail through a filter instead of saving it
#    print "filtering through $dest";
    open(FILTER, $dest);
    print FILTER "$thefile\n";
    close(FILTER);
} elsif (-f "$mbox/.lock"
	# There is a lock file for this mailbox, presumably because the
	# user is has the mailbox open in NeXTMail. In this case, we put
	# the mail in the default box, where it would go if this script
	# didn't exist. The user has to sort the mail herself then, but
	# this is at least safer.
    || length($dest) == 0) {
	# The search didn't match anything, so this is mail that we
	# want to keep in the default mailbox. We'll leave it in
	# the default mailbox and let Mail.app do the incorporate.

    # append the mail to the default mailbox.
    &append_to_mbox($thefile, $defaultmbox);
} else {
    # We get here if we found a mailbox to put the mail in and there
    # is no lock on the mailbox.
    &add_message($mbox, $thefile, $from, $subject, $next_mail);
}

# append $message to mbox file $mbox

sub append_to_mbox {
    local($message, $mbox, $lockmode) = @_;

    open(MBOX, ">> $defaultmbox");
    flock(MBOX, 2);		# LOCK_EX
    # and, in case someone appended while we were waiting
    seek(MBOX, 0, 2);
    print MBOX "$thefile\n";
    flock(MBOX, 8);		# LOCK_UN
    close(MBOX);
}

# append global $thefile to global $defaultmbox, and die with an error

sub append_and_die {
    &append_to_mbox($thefile, $defaultmbox);
    die "mailforward fatal error: @_[0]\n";
}
