This is forward.pl in view mode; [Download] [Up]
#!/usr/local/bin/perl
# $Id: forward.pl,v 1.1 92/05/31 14:39:09 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: cap', 'test',
# Bounce Tom's mail. Tom is a friend and this is just a joke.
'^From: .*Thomas.Price',
"| /usr/$user/bin/mailtravesty | /bin/mail Thomas_Price@cmu.edu cap",
);
# some things you probably don't have to change
$uudecode = "/usr/bin/uudecode";
$uncompress = "/usr/ucb/uncompress";
$tar = "/bin/tar";
############# 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) || 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) || die "can't mkdir $attach_dir";
chdir($attach_dir) || die "can't cd $attach_dir";
open(UUDECODE, "| $uudecode") || 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("N8", $buf);
}
#
# write_header(handle, magic, num_msgs, mbox_time) -
# 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
# The other five longword fields in the header are written as 0.
#
sub write_header {
local($handle, $magic, $num_msgs, $mbox_time) = @_;
local($buf) = pack("N8", $magic, $num_msgs, $mbox_time,
0, 0, 0, 0, 0);
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);
open(MBOX, ">> $mailbox/mbox") || return 1;
open(CONTENTS, "+<$mailbox/table_of_contents") || return 1;
if ($nextmail) {
($message, $attachment) = &unpack_nextmail($mailbox, $message);
} else {
$attachment = '';
}
$start_pos = tell(MBOX);
print MBOX "$message\n";
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) = &read_header(CONTENTS);
seek(CONTENTS, 0, 0); # go to beginning of the file
&write_header(CONTENTS, $magic, $num_msgs + 1, $mbox_time);
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
open(MBOX, ">> $defaultmbox");
print MBOX "$thefile\n";
close(MBOX);
} else {
# We get here if we found a mailbox to put the mail in and there
# is no lock on the mailbox. This is a race condition, where
# Mail.app could lock the mailbox once we get here. We'll just
# cross our fingers.
&add_message($mbox, $thefile, $from, $subject, $next_mail);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.