#! /usr/bin/perl ##################################################################### # # Program Name: archive_migrate # # Function: migrates Listproc 6.0c format archive files to # LISTSERV 1.8b minimal digest format notebooks # # Comment: In fact converts any UNIX mailbox format # file to notebook format which can be read by # virtually any LISTSERV version. # # Author: Peter 'Rattacresh' Backes, PLASMA ORGANIZATION # ([log in to unmask]) # Based on work originally done by Steve Howie # (CCS. University of Guelph) # Based on work originally done by Norm Aleks # ([log in to unmask]) # # Logic: # archive_mig will traverse each subdirectory in the # $HOME/archives/lists directory, converting each archive # file it finds into Listserv Minimal Digest format. It stores # each converted archive file under a subdirectory of $newarch_root. # This tree can then be moved en masse to it's new home, and the # permissions / ownerships adjusted accordingly. # # When processing each directory, you will be prompted for the # full list name for the "Sender:" field in the archive. # # If an error is encountered processing an archive, it will be # skipped, a flag set and the archive processing will stop after # the last archive in that directory # # You have the opportunity to skip directories if you wish # ##################################################################### require "pwd.pl"; # To get a half-assed accurate pwd function $SIG{'INT'} = 'handler'; # Set up a handler to catch ctrl-C print <<EOF; ************************************************************** * * Listproc -> Listserv Archive Migration Utility * ************************************************************** EOF $newarch_root = "/var/tmp"; # Root for converted archives $home_dir = `pwd`; chop($home_dir); opendir(THISDIR,"."); # Read all list directory names $num = @alldirs = sort grep(-d, grep(!/^\./, readdir(THISDIR))); closedir(THISDIR); printf("\nFound a total of %d list archive directories. Continuing ..\n", $num); &initpwd; $err_flag = 0; $list_tot = $skip_tot = $arch_tot = 0; # # Process each lists archive directory # foreach $i (@alldirs) { if ($err_flag == 1) { print "Errors encountered processing archives. Please check logs\n"; exit; } $location = "$home_dir\/$i"; next if ($location eq "/users/u/2/showie/archive"); #local mod printf("\n>>>> Processing directory %s, press \"y\" to continue..", $i); $yn = <STDIN>; chop($yn); if ($yn ne "y") { print "Skipping directory $i ... \n"; $skip_tot++; next; } $list_tot++; print "Please enter the title of the group: "; $oldlistaddr = <STDIN>; chop($oldlistaddr); print "Creating Directory ", $newarch_root."/".$i, " ...\n"; mkdir("$newarch_root/$i",0755); # Create new archive directory subtree &chdir($location); # Move into next directory to process # # get a list of all archive files in the directory # opendir(THISDIR,"."); @newfiles = sort grep(/^[0-9]/,grep(!/^\./, readdir(THISDIR))); closedir(THISDIR); # # Process each archive file inside the directory # foreach $archive (@newfiles) { printf("Processing archive %s..", $archive); $arch_tot++; # Bump total $newname = $archive; # # Only rename and uncompress .z archives # if (/\.z$/) { printf("."); $newname =~ tr/z/Z/; if (rename($archive,$newname) == 0) { printf("Error renaming %s to %s, skipping this archive\n", $archive, $newname); $err_flag = 1; next; } printf("."); $result = system("uncompress $newname"); if ($result != 0) { printf("Error uncompressing %s, skipping this archive\n", $newname); $err_flag = 1; next; } chop($newname); chop($newname); } printf("."); $result = 0; $result = &convert($newname); if ($result == 1) { printf("Error converting archive %s, skipping this archive\n", $newname); $err_flag = 1; next; } printf(" DONE\n"); } } printf("\n\nProcessed %d list(s) and %d archives. A total of %d lists were skipped. \n\n", $list_tot, $arch_tot, $skip_tot); exit 0; # # Signal Handler for ctrl-C # sub handler { print "User pressed CTRL-C, exiting..\n"; exit(0); } # # Do the actual archive conversion # sub convert { ($archive_name) = @_; open(NEWARCH, "> $newarch_root/$i/log$archive_name"); open(INFILE, $archive_name); #print "\n\t\tCreating new Listserv archive: $newarch_root/$i/log$archive_name\n"; $body = 0; $delm = 0; while (<INFILE>) { if ($body) { if (/^From .* \d\d\d\d$/ ) { $body = 0; $delm = 0; } else { if ($delm) { print NEWARCH "\n"; } if (/^$/) { $delm = 1; } else { $delm = 0; print NEWARCH; } } } else { if (/^$/) { $body = 1; print NEWARCH "=========================================================================\n"; print NEWARCH "Date: $headerline{'DATE'}\n"; if ($headerline{'REPLY-TO'} ne "") { print NEWARCH "Reply-To: $headerline{'REPLY-TO'}\n"; } else { print NEWARCH "Reply-To: $oldlistaddr\n"; } print NEWARCH "Sender: $oldlistaddr\n"; if ($headerline{'FROM'} ne "") { print NEWARCH "From: $headerline{'FROM'}\n"; } if ($headerline{'ORGANIZATION'} ne "") { print NEWARCH "Organization: $headerline{'ORGANIZATION'}\n"; } if ($headerline{'SUBJECT'} ne "") { print NEWARCH "Subject: $headerline{'SUBJECT'}\n"; } if ($headerline{'IN-REPLY-TO'} ne "") { print NEWARCH "In-Reply-To: $headerline{'IN-REPLY-TO'}\n"; } if ($headerline{'MIME-VERSION'} ne "") { print NEWARCH "MIME-Version: $headerline{'MIME-VERSION'}\n"; } if ($headerline{'CONTENT-TYPE'} ne "") { print NEWARCH "Content-type: $headerline{'CONTENT-TYPE'}\n"; } if ($headerline{'CONTENT-TRANSFER-ENCODING'} ne "") { print NEWARCH "Content-Transfer-Encoding: $headerline{'CONTENT-TRANSFER-ENCODING'}\n"; } print NEWARCH "\n"; $headerline{'DATE'} = ""; $headerline{'REPLY-TO'} = ""; $headerline{'FROM'} = ""; $headerline{'ORGANIZATION'} = ""; $headerline{'SUBJECT'} = ""; $headerline{'IN-REPLY-TO'} = ""; $headerline{'MIME-VERSION'} = ""; $headerline{'CONTENT-TYPE'} = ""; $headerline{'CONTENT-TRANSFER-ENCODING'} = ""; } else { chop; if (! /^\s+(.*)/) { $toprint = (($hdr,$info)=/^([a-zA-Z][a-zA-Z-]*)\:\s+(.*)/i); $hdr =~ tr/a-z/A-Z/; $headerline{$hdr} = $info if $toprint; } else { $headerline{$hdr} .= " $1" if $toprint; } } } } close(NEWARCH); close(INFILE); return 0; }