#!/usr/bin/perl
# Copyright 1999-2012. Parallels IP Holdings GmbH. All Rights Reserved.

package Imapd2Md;

use IO::File;
use Digest::MD5 qw/md5_hex/;
use Time::Local;

my $_DEBUG = 0;
my $_SKIP_CONVERT = 0;

use constant MAX_FILE_CREATE_TRIES => 1000;

my %months = (
  "Jan" => 0,
  "Feb" => 1,
  "Mar" => 2,
  "Apr" => 3,
  "May" => 4,
  "Jun" => 5,
  "Jul" => 6,
  "Aug" => 7,
  "Sep" => 8,
  "Oct" => 9,
  "Nov" => 10,
  "Dec" => 11,
);

sub maildirmake
{
  foreach(@_) {
     -d $_ or mkdir $_,0700 or die("Fatal: Directory $_ doesn't exist and can't be created.\n");
     -d "$_/tmp" or mkdir("$_/tmp",0700) or die("Fatal: Unable to make $_/tmp/ subdirectory.\n");
     -d "$_/new" or mkdir("$_/new",0700) or die("Fatal: Unable to make $_/new/ subdirectory.\n");
     -d "$_/cur" or mkdir("$_/cur",0700) or die("Fatal: Unable to make $_/cur/ subdirectory.\n");
 }
}


#this is result of code analyze from sources ftp://ftp.cac.washington.edu/imap/imap.tar.Z  [file imap-2007a\src\osdep\unix\mbx.c: mbx_parse function]

sub convertit{
  my( $srcfilename, $maildir ) = @_;

  return "Message convertaion skipped by configuration value!" if $_SKIP_CONVERT;
  return "File not found '$srcfilename'." if ! -e $srcfilename;

  my $buffer;
  my ($uidvalidity, $uidlast);
  my $uidcurr = 0;

  #open mbox file
  sysopen(MBX, $srcfilename, O_RDONLY | O_BINARY) or return "Cannot open '$srcfilename'!";
  #binmode( MBX ) or die "Cannot set binary reading mode for file '$srcfilename'!";

  #read common header
  if( read( MBX, $buffer, 2048 )!=2048 ){
      close(MBX);
      return "Cannot read header from '$srcfilename'!";
  }
  #check for mbox format
  my $format = substr( $buffer, 0, 5 );
  if( substr( $buffer, 0, 5 ) eq '*mbx*' ){
     $uidvalidity = hex(substr($buffer, 7, 8));
     $uidlast = hex(substr($buffer, 15, 8));

     #create target maildirs
     maildirmake( $maildir );
     my $msgCount = 1;
     my $curpos = 2048;

     my $uidlistFh = undef;
     sysopen($uidlistFh, "$maildir/courierimapuiddb.tmp", O_WRONLY|O_CREAT|O_TRUNC) or die "Can't open courierimapuiddb.tmp file: $!";

     #read mail messages
     M1:
     while( not eof(MBX) ){
         #seek to begin of next mail message
         seek( MBX, $curpos, SEEK_SET );
         #read message header
         my $readed = read( MBX, $buffer, 64 );
         last M1 if  $readed<=0;

         $buffer = substr( $buffer, 0, $readed );
         print "Read buffer: $buffer\n" if $_DEBUG;
         #parse header
         my $headerEolPos = index( $buffer, "\x0D\x0A" );
         my $headerText = ($headerEolPos >= 0) ? substr($buffer, 0, $headerEolPos) : undef;
         $uidcurr += 1;
         my ($msgtime, $msglen, $msgflags, $msguid);
         if (defined($headerText) and $headerText =~ /^([^,]+),(\d+);(.{12})-(.{8})$/) {
           ($msgtime, $msglen, $msgflags, $msguid) = ($1, $2, $3, $4);
         } else { 
           my $errorString = "Cannot parse internal message header of message number '$msgCount', filepos '$curpos'.";
           if ($msgCount > 1) {
             $errorString .= ' Only previous ' . scalar($msgCount - 1) . ' messages will be transferred.';
           }
           return $errorString;
         }
         if ($msguid >= $uidcurr) {
           $uidcurr = $msguid;
         }

         print "Message number $msgCount info: $msgflags, $msguid, $msglen\n" if $_DEBUG;
         # create message file name. msguid, despite its name, may be non-unique
         # across the messages in a mailbox, so we need to deal with it
         my $msgfilename = '';
         my $filenamePart = '';
         my $filename_tries = 0;
         my $is_file_opened = 0;
         my $filename_special = md5_hex($msglen . $msgtime);
         my $filename_flags = '';
         $filename_flags .= "S" if hex($msgflags) & 0x01; #Seen
         $filename_flags .= "T" if hex($msgflags) & 0x02; #Deleted
         $filename_flags .= "F" if hex($msgflags) & 0x04; #Flagged
         $filename_flags .= "R" if hex($msgflags) & 0x08; #Answered

         while( $filename_tries < MAX_FILE_CREATE_TRIES and not $is_file_opened ) {
           $filenamePart = sprintf ('%s.%s.%s.mbx', $msguid, $filename_special, $filename_tries);
           $msgfilename = sprintf ('cur/%s:2,%s', $filenamePart, $filename_flags);

           if( sysopen(OUT, "$maildir/$msgfilename", O_WRONLY | O_CREAT | O_BINARY | O_EXCL ) ) {
             $is_file_opened = 1;
           } else {
             $filename_tries += 1;
           }
         }
         if (not $is_file_opened) {
           my $last_error = $!;
           my $additional_message = ($last_error eq 'File exists') ? ' Please contact support.' : '';
           die("Can't generate unique file name after '" . MAX_FILE_CREATE_TRIES . "' tries "
             . "for message number '" . ($msgCount) . "' at offset '" . $curpos . "' "
             . "in file '$maildir/$messagefn' with last error being '$last_error'. Mbx file conversion is incomplete."
             . $additional_message
           );
         }

         print $uidlistFh "$uidcurr $filenamePart\n";

         #read message body
         seek( MBX, $curpos+$headerEolPos+2, SEEK_SET );
         my $len = $msglen;

         while( $len>0 and $readed>0 ){
           $readed = read( MBX, $buffer, $len<4096 ? $len : 4096 );
           if( $readed>0 ){
              $len -= $readed;
              syswrite( OUT, $buffer, $readed ) or die "Cannot write message '$msgCount' body to file '$maildir/$messagefn'!";
           }
         }
         close( OUT );

         # arrange file timestamps
         {  # see RFC3501, "date-time" definition (except for quotes)
           if ($msgtime =~ /^(\d\d)-(\w\w\w)-(\d\d\d\d) (\d\d):(\d\d):(\d\d) ([+-])(\d\d\d\d)$/) {
             my ($day, $monText, $year, $hour, $minute, $second, $tzsign, $tzoffset) = ($1, $2, $3, $4, $5, $6, $7, $8);
             my $time = undef;
             eval {
               $time = timegm($second, $minute, $hour, $day, $months{ucfirst(lc($monText))}, $year);
               my ($tzhours, $tzminutes) = $tzoffset =~ /^(\d\d)(\d\d)$/;
               $tzsec = ($tzhours * 60 + $tzminutes) * 60;
               $tzsec = -$tzsec if $tzsign eq '-';
               $time += $tzsec;

               utime $time, $time, "$maildir/$msgfilename";
             }
           }
         }

         #calc next message offset
         $curpos += $headerEolPos + 2 + $msglen;
         $msgCount += 1;
     } # end of M1 loop
     close($uidlistFh);

     # reprocess courierimapuiddb
     {
       my $done = 0;
       my ($in, $out);
       if ($msgCount > 0) {
         if (sysopen($in, "$maildir/courierimapuiddb.tmp", O_RDONLY)) {
           if (sysopen($out, "$maildir/courierimapuiddb", O_WRONLY | O_CREAT | O_TRUNC)) {
             $uidlast = $uidcurr if ($uidcurr > $uidlast);
             # mbx stores last assigned UID, not the next to-be-assigned one
             $uidlast += 1;
             print $out "1 $uidvalidity $uidlast\n";
             while (my $line = <$in>) {
               print $out $line;
             }
             close($in);
             close($out);
             unlink("$maildir/courierimapuiddb.tmp");
             $done = 1;
           }
         }
         if (!$done) {
           warn "Unable to generate courierimapuiddb: $!";
         }
       }
     }
  } else {
    close(MBX);
    return "Cannot convert mail messages from file '$srcfilename'. Only '*mbx*' format is supported, but found '$format'!";
  }
  close(MBX);
  return 0;

}


#convertit( 'C:/cygwin/Drafts', 'C:/!mtest' );

1;
