#!/usr/bin/perl -w # use Mail::Message to rip a message apart. # man entry: Mail::Message::Construct::Read use Mail::Message; use POSIX qw/strftime/; use File::Temp qw/tempdir tempfile/; use subs qw/domsg/; use strict; my $mtime; my $file; # Silence warnings. Mail::Reporter->defaultTrace('NONE'); # silence all reports foreach $file (@ARGV) { $mtime = (stat($file))[9]; domsg($file); utime($mtime, $mtime, $file); } exit(0); # ------------------------------------------------------------------------- # Read and process one or more mail messages, one per file. sub domsg { my $file = shift(@_) || die 'no file'; my $body; my $header; my $ifh; my $msg; my $recvd; my $stamp; my $template = "fixdateXXXXXXXX"; # Open input and output files. Grab the mail headers. my ($ofh, $tmpfile) = tempfile($template) or die "tempfile: $!\n"; open($ifh, "< $file") || die; $msg = Mail::Message->read($ifh); $header = $msg->head; $body = $msg->body; close($ifh); print "$file\n"; # Get a decent date from the "Received" headers, because too # many people screw up their dates or are scumbag spammers. # Skip "Received" headers if they're from me grabbing the # message from my ISP's POP-server. my $k = 0; my $date = undef; while (1) { last unless $recvd = $header->get('Received', $k); $k++; $_ = $recvd->body; tr/\t\n/ /; next if / by shell\.siscom\.net| by siscom\.net/; # Make sure the Received date isn't screwed up; spammers have # been known to do that... $stamp = Mail::Message::Field->dateToTimestamp($recvd->comment); $date = $recvd->comment if $stamp; last; } # Fix botched headers. "names" shows every header we've seen, # including crap like Berkeley From lines. Look for the ones # that start with ">from " or "from "; they're messed up because they # look for the first colon. my $badfrom = $header->{MMH_order}->[0]->[0]; # First header field. $_ = $header->{MMH_order}->[0]->[1]; # First contents. s/^ /:/; print {$ofh} $badfrom, $_; foreach ($header->names) { $header->delete($_) if /^from |^>from /; } # Replace the date if it's ok, and print the resulting message. $header->set("Date: $date") if $date; print {$ofh} "$header"; print {$ofh} "$body"; chmod(0644, $ofh); close($ofh); rename($tmpfile, $file) or die "rename($tmpfile, $file): $!\n"; return (1); }