#!/usr/bin/perl # calypso_import.pl # Author: Thorsten Maerz <info@netztorte.de> # License: GPL # Dependencies: MIME::Parser, LWP::MediaTypes from www.cpan.org # Converts mbox files as exported from Calypso to MH format. Regenerates # Calypso's folder structure and optionally includes the attachments. use strict ; our $mboxdir = '' || showhelp(); # enter path to exported mbox our $mboxfile = '' || showhelp(); # enter name of exported mbox our $outdir = '' || showhelp(); # enter destination path my $incl_attach = 1 ; # include attachments (needs CPAN modules) my $verbose = 1 ; # show some headers of processed mail my $testonly = 0 ; # dont create any files ################################################################################ # no user servicable parts below :) if ($incl_attach) { use MIME::Parser; use LWP::MediaTypes qw(guess_media_type); } my $mbox = "$mboxdir/$mboxfile"; my $calypso_hdr = 'From \?\?\?@\?\?\? '; #Mon Apr 17 00:37:38 2000 my $hdr_Folder = 'X-CalypsoFolder:'; my $hdr_HTML = 'X-CalypsoHtmlBody:'; my $hdr_Account = 'X-CalypsoAccount:'; my $hdr_Attach = 'X-Attachment:'; my %mail_nr; my $create_dirs = 1 ; # create dirs from "X-Calypso-Folder:" header ################################################################################ sub showhelp { die ( "You have not yet configured this script.\n" . "Please provide the correct path and file names, e.g\n" . "\tour \$mboxdir = 'Archive'\n" . "\tour \$mboxfile = 'mail.txt'\n" . "\tour \$outdir = 'Calypso'\n" . "at the top of $0\n" ); } ################################################################################ # # MAIN : scan $mbox linewise # Create a separate message for each $calypso_hdr found (MH format) # $attach_full = filename with path, $attach_short = original attachment name # $folder = Calypso folder # ################################################################################ my ($folder, $html, $html_full, $html_short, $account, $attach, $attach_short, $attach_full); my @lines ; open (INBOX, "<".$mbox); while (<INBOX>) { s/\x0d\x0a//; s/\x0d//; s/\x0a//; if (m/^$calypso_hdr/) { if (@lines) { $mail_nr{$folder}++ ; shift @lines ; # remove blank line savemail(); @lines = () ; $folder = $html = $html_full = $html_short = $account = $attach = $attach_short = $attach_full = ""; } } else { if (/^$hdr_Folder /) { $folder = $' ; $folder =~ s/"//eg ; $folder =~ tr#\\#\/# ; } if (/^$hdr_HTML /) { $html = $' ; $html =~ s/"//eg ; $html =~ tr#\\#\/# ; if ($html =~ /; /) { $html_full = $` ; $html_short = $' ; } } if (/^$hdr_Account /) { $account = $' ; $account =~ s/"//eg ; } if (/^$hdr_Attach /) { $attach = $' ; $attach =~ s/"//eg ; $attach =~ tr#\\#\/# ; if ($attach =~ /; /) { $attach_full = $` ; $attach_short = $' ; } } push (@lines, $_ ); } } close (INBOX); ################################################################################ # # sub:savemail # Saves mail in @lines to $outdir/$folder/$mail_nr # Folder is created unless $testonly or (not $create_dirs) is set # ################################################################################ sub savemail { my $mailname = $mail_nr{$folder}; my %headers; my $ishead=1; my $lineno=0; my $targetdir=""; # extract headers foreach (@lines) { my ($hdr,$cnt); $lineno++; m/^$/ and ($ishead=""); if ( $ishead ) { if (m/: /) { ($hdr,$cnt) = ($`,$'); $headers{$hdr}=$cnt; } } } if ($verbose) { print "MAIL : $mailname\n"; print "FOLDER : $folder\n" if ($folder); print "HTML : $html_short ($html_full)\n" if ($html); print "ACCOUNT : $account\n" if ($account); print "ATTACH : $attach_short ($attach_full)\n" if ($attach); print "\n"; } # write mail to folder if (! $testonly ) { if ($create_dirs) { $targetdir = $outdir.'/'.$folder ; my $curdir = ''; foreach (split('/',$targetdir)) { $curdir .= $_ . '/'; ( -d $curdir) || mkdir $curdir; } } open (OUTFILE, ">".$targetdir.'/'.$mailname); foreach (@lines) { print OUTFILE "$_\n" ; } close (OUTFILE); if ($incl_attach) { include_attachment($targetdir.'/'.$mailname); } } } ################################################################################ # make inline attachment from external file # uses MIME::Parser, LWP::MediaTypes from www.cpan.org # (Currently leaves a blank attachment in converted mails. Feel free to # improve this script) sub include_attachment() { my $mailname = shift ; my $parser = new MIME::Parser ; my $entity ; my %attachments ; my %CID ; $parser->output_to_core(1); # dont save to harddisk $entity = $parser->parse_open($mailname); # look for external attachments foreach ($entity->head->get('X-Attachment')) { if (m/["']? # 1. start with " or ' (or none) ([^"';]+) # word till quote or separator ["']? # delete quote \s?;\s? # separator ; (opt. spaces) ["']? # 2. start (s.a.) ([^"';]+) # ["']? /x ) { $attachments{$1} = $2 ; } } foreach ($entity->head->get('X-CalypsoHtmlBody')) { if (m/["']? # 1. start with " or ' (or none) ([^"';]+) # word till quote or separator ["']? # delete quote \s?;\s? # separator ; (opt. spaces) ["']? # 2. start (s.o.) ([^"';]+) # ["']? /x ) { $attachments{$1} = $2 ; } } foreach ($entity->head->get('X-CalypsoHtmlImg')) { if (m/["']? # 1. start with " or ' (or none) ([^"';]+) # word till quote or separator ["']? # delete quote \s?;\s? # separator ; (opt. spaces) ["']? # 2. start (s.a.) ([^"';]+) # ["']? \s?;\s? # separator ; (opt. spaces) ["']? # 3. start (s.a.) ([^"';]+) # ["']? /x ) { $attachments{$1} = $3 ; $CID{$1} = $2 ; } } if (%attachments) { # read attachment foreach my $key (keys (%attachments)) { our $attachdir; my $type ; my $enc ; my $fnam = $key; $fnam =~ tr#\\#/# if -d '/' ; # correct path names on unix like OS $fnam = $mboxdir .'/'. $fnam ; $type = guess_media_type($fnam); if ( $type =~ m/text/i ) { $enc = "8bit" } else { $enc = "base64" } $entity->attach(Path => $fnam, Type => $type, Encoding => $enc, Filename => $attachments{$key} ); } my $lines = $entity->as_string ; # correct images names in html messages foreach (keys (%CID)) { $lines =~ s/CID:$CID{$_}/$attachments{$_}/eg; } print $mailname."\n"; # qx(mv $mailname $mailname.bak); open ( MAIL, ">".$mailname ); print( MAIL $lines ); close( MAIL ); } }