use Getopt::Long;
use Pod::Usage;
use Win32::TieRegistry( Delimiter=>"/", ArrayValues=>0 );

GetOptions('help|?' => \$opt_help, 'man' => \$opt_man, 'users' => \$opt_users, 'useraliases' => \$opt_useraliases, 'lists' => \$opt_lists, 'domains' => \$opt_domains, 'hostaliases' => \$opt_hostaliases, 'orphans' => \$opt_orphans)  ||  pod2usage(-verbose => 0);
pod2usage(-verbose => 1)  if ($opt_help);
pod2usage(-verbose => 2)  if ($opt_man);
#pod2usage("\nNo file specified\n")  if (!@ARGV);
pod2usage("\nToo many files specified\n")  if (@ARGV > 1);
pod2usage("\nNo options specified\n")  if (!($opt_users + $opt_useraliases + $opt_lists + $opt_domains + $opt_hostaliases + $opt_orphans));
    
#$inputFile = $ARGV[0];

#if (-e $inputFile) {
#  open MAILSERVERS, $inputFile or die "Cannot open $inputFile for reading\n";
#} else {
#  die "Cannot find file: $inputFile\n";
#}

#while (<MAILSERVERS>) {
#  chomp;
#  &dumpImail($_);
#}

  &dumpImail();

sub dumpImail {
  my $server = "localhost";

  my $noConnect = 0;
  my $usersFile = "users.txt";
  my $userAliasesFile = "useraliases.txt";
  my $listsFile = "lists.txt";
  my $domainsFile = "domains.txt";
  my $hostAliasesFile = "hostaliases.txt";
  my $orphansFile = "orphans.txt";
    
  open USERSFILE, ">>$usersFile" or die "Cannot open $usersFile for writing\n" if ($opt_users);
  open USERALIASESFILE, ">>$userAliasesFile" or die "Cannot open $userAliasesFile for writing\n" if ($opt_useraliases);
  open LISTSFILE, ">>$listsFile" or die "Cannot open $listsFile for writing\n" if ($opt_lists);
  open DOMAINSFILE, ">>$domainsFile" or die "Cannot open $domainsFile for writing\n" if ($opt_domains);
  open HOSTALIASESFILE, ">>$hostAliasesFile" or die "Cannot open $hostAliasesFile for writing\n" if ($opt_hostaliases);
  open ORPHANSFILE, ">>$orphansFile" or die "Cannot open $orphansFile for writing\n" if ($opt_orphans);
  
  my $domains = $Registry->{"LMachine/Software/Ipswitch/Imail/Domains"};
# 				   { Access=>KEY_READ, Delimiter=>"/" } )
#    or ($noConnect = 1);


  if ($noConnect) {
    print "Cannot open registry on server $server\t\t\t[Skipping]\n", "\n";
    return;
  }
  
  print "Dumping data on " . $server . "...\n";
  $domains->FixSzNulls(1);
  $domains->SplitMultis(1);
  
  foreach $thisDomain ($domains->SubKeyNames) {

    if (grep /\./, $thisDomain) {
            
			print "Querying server for $thisDomain\n";

      if ($opt_users || $opt_useraliases || $opt_orphans) {
      	$userCount = 0;
        $maxUsers = hex($domains->{$thisDomain}->GetValue("MaxUsers"));
        $users = $domains->{$thisDomain}->{"Users"} || next;
      
        foreach $thisUser ($users->SubKeyNames) {
      	
          if (($opt_users || $opt_orphans) && ($thisUser ne '_aliases')) {
            $userCount += dumpUsers($server, $users, $thisUser, $thisDomain);
          } elsif (($opt_useraliases) && ($thisUser eq '_aliases')) {
            dumpUserAliases($server, $users, $thisUser, $thisDomain);
          }
          
        }
        
      }
      
      if ($opt_orphans) {
        if ($userCount == 0) {
          print ORPHANSFILE "$server,$thisDomain\n";
        }
      }
      
      if ($opt_lists) {
        dumpLists($server, $domains, $thisDomain);
      }

      if ($opt_domains) {
        print DOMAINSFILE $server, ',', strip($thisDomain), "\n";
      }

    } elsif (grep /\$virtual/, $thisDomain) {
    	
      if ($opt_hostaliases) {
        dumpHostAliases($server, $domains, $thisDomain);
      }
      
    }
  }
  
  close USERILE if ($opt_users);
  close ALIASFILE if ($opt_aliases);
  close LISTFILE if ($opt_lists);
  close DOMAINFILE if ($opt_domains);
  close HOSTALIASESFILE if ($opt_hostaliases);
  close ORPHANSFILE if ($opt_orphans);
}


sub decrypt {
  my ($user, $password) = @_;
  my $counter = 0;
  
  my @holdUser = map { sprintf "%lx", ord lc($_) } split //, $user;
  my @decrypted = map { chr(hex($_) - hex($holdUser[$counter++ % scalar(@holdUser)])) } ($password =~ /(..)/g);
  return join '', @decrypted;
}


sub dumpUsers {
  my ($server, $users, $thisUser, $thisDomain) = @_;
   
  my $password = $users->{$thisUser}->GetValue( "Password" );
  my $flags = $users->{$thisUser}->GetValue( "Flags" );
          
  if (!(hex($flags) & 1)) {
  	
    if (hex($flags) & 256) {
      print USERSFILE join ",", ($server, $thisUser, &decrypt($thisUser, $password), strip($thisDomain), 1, $maxUsers), "\n";
    } else {
      print USERSFILE join ",", ($server, $thisUser, &decrypt($thisUser, $password), strip($thisDomain), 0), "\n";
    }
    
    return 1;
  } else {
    return 0;
  }
}


sub dumpHostAliases {
  my ($server, $domains, $thisDomain) = @_;
  	
  my $offical = $domains->{$thisDomain}->GetValue("Official");
  my $aliases = $domains->{$thisDomain}->GetValue("Aliases");
  my $domainName = shift @{$aliases};
  unshift @{$aliases}, $offical;
  pop @{$aliases};
  print HOSTALIASESFILE join ',', ($server, $domainName, (join ',', @{$aliases})), "\n";    	
}


sub dumpUserAliases {
  my ($server, $users, $thisUser, $thisDomain) = @_;
  
  my $aliases = $users->{$thisUser};
          
  foreach $thisAlias ($aliases->ValueNames) {
          	            
    if ($thisAlias ne 'postmaster') {
      $aliasValue = $aliases->GetValue( $thisAlias );
      $aliasValue =~ s/\s//g;
              
      if (grep !/\|/, $aliasValue) {
                
        if (grep /\\/, $aliasValue) {
          $aliasValue =~ s/:/\$/g;               
          $aliasListFile = '\\\\' . $server . '\\' . $aliasValue;
          open ALF, $aliasListFile;
          $aliasValue = join ',', map { substr $_, 0, -1 } <ALF>;
          close ALF;
        }
                
        if ($thisAlias eq 'nobody') {
          $sourceAlias = strip($thisDomain);
        } else {
          $sourceAlias = $thisAlias . "@" . strip($thisDomain);
        }

        foreach (split /,/, $aliasValue) {

          if (grep /@/, $_) {
            $destAlias = $_;
          } else {
            $destAlias = $_ . "@" . strip($thisDomain);
          }
                  
          print USERALIASESFILE join ',', ($server, $sourceAlias, $destAlias), "\n";
        }
        
      }
      
    }
    
  }
            
}


sub dumpLists {
  my ($server, $domains, $thisDomain) = @_;
  
  $topDir = $domains->{$thisDomain}->GetValue("TopDir");
  
  if ($domains->{$thisDomain}->SubKeyNames eq '_lists') {
    @lists = $domains->{$thisDomain}->{"_lists"}->SubKeyNames;

    foreach (@lists) {
      $listUserDir = join '\\', ($topDir, 'lists', $_);
      $listUserDir =~ s/:/\$/g;
      $listUserFile = '\\\\' . $server . '\\' . $listUserDir . '\\users';
      open LUF, $listUserFile;
      print LISTSFILE join ',', ($server, strip($thisDomain), $_, (join ',', map { substr $_, 0, -1} <LUF>)), "\n";
      close LUF;
    }
  }
}


sub strip {
 return (substr $thisDomain, 0);
}


__END__

=head1 NAME

migrate-imail.pl

=head1 SYNOPSIS

migrate-imail.pl [options] [file]

 Options:
   -help            brief help message
   -man             full documentation
   -users           dump users
   -useraliases     dump user aliases
   -lists           dump lists
   -domains         dump domains
   -hostaliases     dump host aliases
   -orphans         dump domains orphaned with no users
   
  File:
    filename containing a list of servers to dump, one per line

=head1 DESCRIPTION

B<This program> will dump all usernames, passwords, aliases, lists, host aliases domains and/or orphaned domains
from a remote IMail server via the registry.  You must have credentials to open the remote registry, and map an admin share to the server.
In a domain environment, this works very well from the domain controller.

=cut
