#!/usr/bin/perl -w # # this script modifies UNIX mailbox files exported from Forté Agent: # it extracts the time from sent messages and creates a "Date:" header line # set to this time # - You will need Perl itself and the modules 'libnet' and 'MailTools' # (www.perl.com) and perhaps a basic understanding of Perl # - The script assumes you are living in Western Europe (wrt Daylight # Savings Time/summer time). And it's not fully automated; for dates # in the last week of March and October, the script just puts # '+0&00' in the Date Header, you will have to decide yourself if it # has to be '+0100' or '+0200' (I was too lazy to program this out, # I was way faster to handle these cases myself). # - It's kind of quick and dirty, it was written for a job that is done # only once ;-) # # Copyright (c) 1999 Peter Steiner use Carp; use Mail::Address; use Mail::Internet; use Net::SMTP; #------------------------------------------------------------------------------- sub processMail (\@) { my @mail = @{shift()}; my $mail = Mail::Internet->new(\@mail, Modify => 0, MailFrom => COERCE); # wenn das Mail keine Received:-Zeilen enthält, ist es ein gesendetes, # nicht ein empfangenes; wenn das Mail schon eine Zeit enthält, tun wir nichts if ( $mail->get('Received') || $mail->get('Date') ) { # das Mail unverändert ausgeben (dh die From-Zeile wieder herstellen) my $from = $mail->get('Mail-From'); $mail->delete('Mail-From'); print join("", "From $from",@{$mail->header},"\n",@{$mail->body}); } else { # wir nehmen für das Datum das aus der From-Zeile (als Mail-From gespeichert) # (From ???@??? DOW Month dd hh:mm:ss yyyy) my $from = $mail->get('Mail-From'); $mail->delete('Mail-From'); if ($from =~ /.*\@.* (Mon|Tue|Wed|Thu|Fri|Sat|Sun) (\w+) (\d+) (\d+:\d+:\d+) (\d+)/) { my ($dow,$month,$day,$time,$year) = ($1,$2,$3,$4,$5); # Ob jetzt zu einem bestimmten Datum Winter- oder Sommerzeit war, # bestimmen wir nur grob; Zweifelsfälle müssen manuell erledigt werden my $tz = "+0&00"; # default in Zweifelsfällen $tz = "+0100" if $month =~ /(Nov|Dec|Jan|Feb)/ || ($day < 24 && $month eq "Mar"); $tz = "+0200" if $month =~ /(Apr|May|Jun|Jul|Aug|Sep)/ || ($day < 24 && $month eq "Oct"); print join("", "From $from", # From-Zeile wieder herstellen @{$mail->header}, "Date: $dow, $day $month $year $time $tz\n", "\n", @{$mail->body}); } } } #------------------------------------------------------------------------------- # ein Mailfile (RFC822/From-delimited) einlesen (STDIN oder erstes Argument) # und es in einzelne Mails aufspalten my @oneMail = (); while (<>) { if (/^From /) { processMail(@oneMail) if @oneMail; @oneMail = (); push @oneMail, $_; } else { push @oneMail, $_; } } # evtl. letztes Mail auch noch behandeln processMail(@oneMail) if @oneMail; exit 0; # eof