#!/usr/bin/perl
#
# VMS Mail to MH Format Tool : vms2mh.pl
#            Version 2.4 (98/10/05)
#            Version 2.3 (98/02/10)
#            Version 2.2 (98/02/04)
#            Version 2.1 (98/01/30)
#            Version 2.0 (98/01/30)
#            Version 1.3 (98/01/29)
#            Version 1.2 (98/01/28)
#            Version 1.1 (98/01/19)
#            Version 1.0 (98/01/10)
#            Written by Y.Tajima (tajima@cyric.tohoku.ac.jp)
#
#  Usage:
#     MAIL> sel <Folder>
#     MAIL> extract /all mail.txt
#           mail.txt: VAX -> Unix
#     $ cd ~/Mail
#     $ mkdir <Folder>
#     $ cd <Folder>
#     $ nkf -j ~/mail.txt | vms2mh.pl [<Number>]
#

$LOCAL_HOST  = "TITVS0";
$MESID_HOST  = "titvs0.nucl.phys.titech.ac.jp";
@SMTP_ENV    = ( 'MX%', 'SMTP%', 'WINS%' );
%DIRECT_ADRS = ( 'TITVS0', '@titvs0.nucl.phys.titech.ac.jp',
 	         'KEKVAX', '@kekvax.kek.jp',
	         'RIKEN' , '@rikaxp.riken.go.jp',
                 'RIK835', '@rikaxp.riken.go.jp'
               );
$FWD_ADRS    = '.dnet@titvs0.nucl.phys.titech.ac.jp';
#$FWD_ADRS    = '.decnet@kekmx.kek.jp';

$FWD_MODE    = 0;  # USER%VAX.***@host.domain
#$FWD_MODE   = 1;   # 'VAX::USER'@host.domain

$HEAD_SEP = "================== RFC 822 Headers ==================";

$PROT = 0400;

# For Week detection
@week_name   = ('Sun', 'Mon', 'Tue', 'Wed', 'Thr', 'Fri', 'Sat');
%month_num   = ('Jan',   0, 'Feb',  31, 'Mar',  59, 'Apr',  90,
                'May', 120, 'Jun', 151, 'Jul', 181, 'Aug', 212,
                'Sep', 243, 'Oct', 273, 'Nov', 304, 'Dec', 334);
%year_week   = ('1986', 3, '1987', 4, '1988', 5, '1989', 0, '1990', 1,
                '1991', 2, '1992', 3, '1993', 5, '1994', 6, '1995', 0,
                '1996', 1, '1997', 3, '1998', 4, '1999', 5, '2000', 6);

$new_page = 0; # New Page Mark Flag
$status = 0;

$start = $ARGV[0] - 1; if ($start < 0) { $start = 0; };
$counter = $start; # Mail Number Counter

while ($line = <STDIN>) {
  chop $line;
  $output = 1; # Output Line Flag
  if ($new_page == 1) { # New page mark detected in last line.
    if ($line =~ /^From:/) { # Next mail & VAX header start
      if ($counter != $start) {
	print FOUT "\n"; close(FOUT);
	if (($status == 2) || ($status == 3)) { # VMS or MX mail
	  rename ("$counter.tmp", "$counter.body");
	}
	# Add header and body.
        system("rm -f $counter");
	system("cat $counter.head $counter.body >$counter");
	system("rm $counter.*");
	chmod($PROT, "$counter");
      }
      # Next Mail Started.
      $counter++;
      open (FOUT, ">$counter.head"); # VAX Header 
      $status = 1;
    } else { print FOUT "\f"; } # New Page Mark in Body.
  }

  # New Page Mark Check
  $new_page = 0; if ($line =~ /^\f$/) { $new_page = 1; $output = 0; }
  
  if      ($status == 3) {     # In Body Block
    if ($line =~ /^$HEAD_SEP/) {       # If SMTP header by KEKVAX detected
      close (FOUT); rename ("$counter.tmp", "$counter.body");
      open (FOUT, ">$counter.head"); # Close Body & Open KEK Header
      $status = 4; $output = 0;
    }
  } elsif ($status == 2) {     # In 1st Body Block or MX Header
    if ((length($line) == 0) || ($line =~ /^\s$/)) { # If 1st Block End
      if ($smtphead >= 3) {          #   MX header detected
	print FOUT "\n"; close (FOUT); # MX Header End
	rename ("$counter.tmp", "$counter.head");
	open (FOUT, ">$counter.tmp");  # Body Block Start
      }
      $status = 3; $output = 0;
    } elsif ($line =~ /^(From|To|Subject|Message-ID):/) {
      $smtphead++;                       # SMTP Header Check 
    }
  } elsif ($status == 1) {     # In VAX Header
    if (length($line) == 0) {           # VAX header end
      # Write Date: & Message-ID Field
      print FOUT "Date: ",$week,", ",$date," ",$month," ",$year," ";
      print FOUT $time," +0900\n";
      print FOUT "Message-Id: <",$year,$month,$date,$week,".",$counter;
      print FOUT "@",$MESID_HOST,">\n\n";
      close(FOUT);   # VAX header end
      open (FOUT, ">$counter.tmp");   # Body Block or MX Header
      $status = 2; $output = 0; $smtphead = 0;
    } else {                 # Rewrite VAX Header to MX Format
      unless ($line =~ s/^Subj:\t/Subject: /) {
	$line =~ s/\t+/ /g;     # replace from tab to space
	while ($line =~ s/(\w+)::(\w+)::/$2::/) {} # Remove forwarding
	if ($line =~ /^From:/) {
	  $line =~ s/\t+/ /g;     # replace from tab to space
	  # Make Date: field
	  $line =~ s/\s+(\d?\d)-(\w\w\w)-(\d\d\d\d) (\d\d:\d\d:\d\d).\d\d//;
	  $date = $1; $month = $2; $year = $3; $time = $4;
	  $month =~ tr/A-Z/a-z/; $month =~ s/([a-z])/\u$1/;
	  $num = $month_num{$month} + $date - 1;     # Calculate week
	  if (($year % 4 == 0) && ($num > 58)) { $num++; }
	  $week = $week_name[($year_week{$year} + $num) % 7];
	  if ($line =~ /\s(\w+)::/) { $localhost = $1;          }
	  else                      { $localhost = $LOCAL_HOST; }
	}

	# For Irregular DECnet Address Format (USER@HOST->HOST::USER)
	while ($line =~ s/([, ])(\w+)\@(\w+)([, ])/$1$3::$2$4/) {}
	$line =~ s/([, ])(\w+)\@(\w+)$/$1$3::$2/;
	
	# For SMTP-VMS Mail Gateways (Remove SMTP Mail Envelope)
	foreach  (@SMTP_ENV) {
	  while ($line =~ s/([, ])\w+::$_\"/$1/) { $line =~ s/\"//; }
	  while ($line =~ s/([, ])$_\"/$1/)      { $line =~ s/\"//; }
	}
	while ($line =~ s/([, ])(\w+)::\"/$1/) { $line =~ s/\"//; }
	
	if ($line =~ /^From:/) {
	  $line =~ s/\"(.*)\"$/\($1\)/; # For GECOS Field
	}
	# Add VMS Hosts for To: and CC:
	while ($line =~ s/([\s,])([A-Z]+)([\s,])/$1$localhost\::$2$3/) {}
	$line =~ s/([\s,])([A-Z]+)$/$1$localhost\::$2/;
	
	# For Global VMS Mail Addresses
	foreach (keys %DIRECT_ADRS) {
	  $line =~ s/$_\::(\w+)/$1$DIRECT_ADRS{$_}/g;
	}
	if      ($FWD_MODE == 0) {
	    $line =~ s/(\w+)::(\w+)/$2\%$1$FWD_ADRS/g;
	} elsif ($FWD_MODE == 1) {
	    $line =~ s/(\w+::\w+)/\'$1\'$FWD_ADRS/g;
	}
      }
    }
  }
  if ($output == 1) { print FOUT $line,"\n"; } # Write Line
}

print FOUT "\n"; close (FOUT);
if (($status == 2) || ($status == 3)) { # VMS or MX mail
    rename ("$counter.tmp", "$counter.body");
}
system("rm -f $counter");
system("cat $counter.head $counter.body >$counter");
system("rm $counter.*");
chmod($PROT, "$counter");