#!/usr/bin/env perl

my $version_id = q$Id: cap2pab.pl,v 1.1 2003/08/08 04:23:57 dl111122 Exp $;
my $version = (qw$Revision: 1.1 $)[-1];

#use strict;
use Getopt::Long;

#--------------------------------------------------------------------
# Grab command line arguments
#--------------------------------------------------------------------
my $ARGC = $#ARGV + 1;
if ($ARGC < 1 ) {
    &Usage();
}

my @OPTIONS =  qw(f=s u=s o=s n h v);
GetOptions(@OPTIONS);

use vars qw($opt_f $opt_u $opt_o $opt_n $opt_h $opt_v);

if($opt_h) { Usage(); exit(0); };
if($opt_v) { print "$version\n"; exit(0); }

#--------------------------------------------------------------------
# Global Stuff
#--------------------------------------------------------------------

# Change these to your environment
my $rrdn = "ou=People,dc=gwu,dc=edu,o=internet,o=pab";
my $base_dir = "/mnt2";
my @addrbooks = qw ( ak );

#----------- Do not edit below this line ------------
my $debug = 0;
my $log = 0;
my $delim = '\000';
my $remove = "@|'|,|#|(|)|\"|\\\\|"; # wxa 07222003 PM 
      # "\"|.|,|;|:|\?|!|-|\'|/|(|)|=|\+|&|%|[|]|#|$|@|"
my $typedef = 'A51 A9 A256 A41 A512 A155';
my $sizeof = length pack($typedef, () );
my $log_file;
my $gguid; # Global Guid per user

my @uids = (); # array to hold all uids from input file

my %emailHash = (); # global hash for storing email addresses per user 
my %listNameHash = ();  # global hash of list names per user
my %listMap = (); # global hash for mapping list names to list guids
my %userListHoH = (); # global hash or hashes for pointer to lists

if($opt_o) {
	$log = 1;
	$log_file = $opt_o;
	if(-e $log_file) {
		unlink($log_file); # delete log file if it exists
	}
}

if($opt_u) {
	@uids = split(/,/,$opt_u); # multimple uids should be comma delimited
}

if($opt_f) {
	open (F, $opt_f) or die "Can't open $opt_f: $!\n";
	@uids = <F>;
	close(F);
}


#----------------------------- Start main() -------------------------------------

if(!$opt_n) { genMotherDN(); }  # o=pab setup
if($log) { logmsg(1, "\n"); } # start time 

foreach my $uid (@uids) {

    undef %emailHash;	
    undef %listNameHash;	
    undef %listMap;	
	undef %userListHoH;

    next if ($uid =~ m/^\./);
    chomp($uid);
    $uid = lc($uid);

	next if ($uid =~  m/@/ && $uid !~ m/\@gwu\.edu$/); # skip seas, research, etc.

	if($log) { logmsg(0, "\n"); }

	my $dohead = 1; # create addressbook entry in pab
	
	$gguid = genGuid(16); # 8 is not good

    foreach my $addrbk (@addrbooks) { # check all parent addrbook directories

		my $path = "$base_dir/$addrbk/$uid";
		my @paths = ( $path, "$path\@gwu.edu");

		foreach my $path (@paths) {

			# First process addressbook
			if ( !-e $path ) {
				if($log) { logmsg(0, "[$uid] No $path ... Skipping\n"); }
                next; 
            }
            else {	
				if($dohead) {  
					genPABuserTop($uid); 
					genPABuserHead($uid);
					$dohead = 0; # needs to be done once per uid
 				}
        		my $result = addWMaddr2Hash($path);
			}

        	# Then process all lists
   			my $listdir = "$path/LISTS";
    		opendir (DIR, $listdir) or 
				 warn "Can't open $listdir: $!\n" 
			&& next;
    		my @lists = readdir(DIR);
			if($log) { 
				my $n = $#lists - 1;
				logmsg(0,"[$uid] $n list(s) in $path/LISTS\n"); 
			}
    		closedir (DIR);

    		foreach my $list_file (@lists) {

        		next if ($list_file =~ m/^\./);
        		next if (-z "$listdir/$list_file");

        		open (F, "$listdir/$list_file") or
					warn "Can't open $listdir/$list_file: $!\n"
				&& next;
        		chomp(my $list = <F>);
        		close(F);
				addListAddr2Hashes($list); # both to emailHash and listNameHash
        	}
		
    	} # foreach my $path

	} # foreach my $addrbk 

    # Flush all hashes to ldif
    # <add code here to call these functions only if emailHash is populated>
    listNameHash2ldif($uid);
    emailHash2ldif($uid);

    if($debug) {
    	print "======================= $uid ==========================\n";
    	foreach my $k (keys %emailHash) {
			$cnt++;
        	my $v = $emailHash{$k}[0];
        	my $v2 = $emailHash{$k}[1];
        	print "$cnt\t\t\$k=$k\t\$v=$v\t\$v2=$v2\n";
    	}
    	print "=======================================================\n";
    }

} # End foreach my $uid

if($log) { logmsg(1, "\n"); } # end time 

#----------------------------------- End main() ---------------------------------------



#--------------------------------------------------------------------------------
# Subroutines
#--------------------------------------------------------------------------------

sub addWMaddr2Hash {

	my($path) = @_;
	my $cnt = 0;

	open(F, "$path/ADDRBOOK.WM") or 
            warn "Couldn't open $path/ADDRBOOK.WM ... skipping\n"
    && return 0;
    #&& next;

	seek(F, 0, 0);

	while (read(F, $buffer, $sizeof) == $sizeof) {
   		my ($fullName, $shortcutName,  $eMailAddress, $phoneNumber, $notes) 
        	= unpack($typedef, $buffer);
    	next unless $fullName && $eMailAddress;

    	$fullName =~ s/$remove//;
		$eMailAddress = normEmailAddr($eMailAddress);

        $emailHash{$eMailAddress} = $fullName;
		if($log) { $cnt++; } 
	} 

	close(F);

	if($log) { logmsg(0,"[$uid] Found $cnt address(es) in $path/ADDRBOOK.WM\n"); }

	return 1;

}

#--------------------------------------------------------------------------------
sub addListAddr2Hashes {

    my($list) = @_;
	my $cnt = 0;
		
    my ($list_name,$members,$rest) = split (/$delim/,$list,2);

	if($list_name =~ m/]\,/) { 
		$list_name = "LIST" . $gguid;
	} # wxa 07222003, workaround for really long list names 

	$members =~ s/$delim*//g; # remove the 3 null char at the end of list

    my @kvarray = split(/>,\s/,$members); # key = email address, val = name

    foreach my $entry (@kvarray) {

        my ($val,$key) = split (/ *</, $entry, 2);
		$val =~ s/$delim//g;
		$key = normEmailAddr($key);

        $emailHash{$key} = $val;
		$userListHoH{$key}{$list_name} = $list_name;
		if($log) { $cnt++;}

    }
	push @{ $listNameHash{$list_name} }, $list_name;

	if($log) { logmsg(0,"[$uid] \tList \"$list_name\" with $cnt addresses\n"); }	
}

#--------------------------------------------------------------------------------
sub normEmailAddr {
	my($str) = @_;

	#$str =~ s/$delim|\+//g;
	$str =~ s/$delim//g;
	$str =~ s/>$//g; 

	if ($str !~ m/@/) {
       	$str = $str . '@gwu.edu';
   	}

    return $str;

}

#-------------------------------------------------------------------------------
sub listNameHash2ldif {

	my($uid) = @_;

	foreach my $list (keys %listNameHash) {

		crListEntry( $list, $uid, genGuid(8) );

	}

}

#------------------------------------------------------------------------------
sub emailHash2ldif {

	my($uid) = @_;

    foreach my $mail (keys %emailHash) {

    	my $val = $emailHash{$mail};
   		genPABuserEntries( $mail,$val,genGuid(8) );

    }

	if($log) {
		my $n = keys %emailHash;
		my $m = keys %listNameHash;
		logmsg(0,"[$uid] Summary: Merged to $n unique address(es) and $m unique list(s)\n");
	}

}


#-------------------------------------------------------------------------------
sub genPabURI { # work in progress 

	my $uid = shift;

	my $paburi = "ldap://pabvip.gwu.edu:10389/ou=cn=$uid,$rrdn";

	print<<HERE;
dn: uid=$uid,ou=people,dc=gwu,dc=edu
changetype: modify
add: pabURI
pabURI: $paburi

HERE
}

#-------------------------------------------------------------------------------
sub crListEntry {
	
	my($list_name,$uid,$guid) = @_;

    $cn = $list_name;
    #$list_name =~ s/\s+|'|\#|\\//g; # wxa 07212003
    $list_name =~ s/$remove//g; # wxa 07222003
    $un = "$list_name$guid"; # wxa 07242003 - IE 6.x fix

	$listMap{$cn} = $un; # unmodified $listMap{$list_name}


	print <<HERE;
dn: un=$un,ou=cn=$uid,$rrdn
un: $un
objectClass: top
objectClass: pabgroup
memberOfPAB: AddressBook$gguid
cn: $cn

HERE
}


#-------------------------------------------------------------------------------
sub genPABuserTop {

    ($uid) = @_;

    print <<HERE;
dn: ou=cn=$uid,$rrdn
objectClass: top
objectClass: organizationalunit
ou: cn=$uid

HERE
}

#-------------------------------------------------------------------------------
sub genPABuserHead {

    my ($uid) = @_;

    print <<HERE;
dn: un=AddressBook$gguid,ou=cn=$uid,$rrdn
objectClass: top
objectClass: pab
un: AddressBook$gguid 
cn: Address Book

HERE
}


#-------------------------------------------------------------------------------
sub genPABuserEntries {

    my ($mail,$rawname,$guid) = @_;

	my $givenName; 
	my $sn;
 
    #print "\$rawname=$rawname\n";

	if($rawname !~ m/,/) {
		($givenName,$sn) = split(/ /,$rawname,2);
	}
	else {
		($sn,$givenName) = split(/,/,$rawname,2);
	}

	# this logic could be more intelligent
	if(!$sn) { $sn = $givenName; }
	if(!$givenName) { $givenName = $sn; }

	#$givenName =~ s/\"|,|\#|\\|\s+//g; # wxa 07212003 
	#$sn =~ s/\"|,|\#|\\|\s+//g; # wxa 07212003
	$givenName =~ s/$remove//g; # wxa 07222003 
	$sn =~ s/$remove//g; # wxa 07222003

	my $cn = $givenName . " " . $sn;

    my $name = $cn;
    $name =~ s/\s+|$remove//g; #wxa 07222003 
	my $un = $name . $guid;

    print <<HERE;

dn: un=$un,ou=cn=$uid,$rrdn
un: $un
objectClass: top
objectClass: person
objectClass: organizationalPerson
objectClass: inetOrgPerson
objectClass: pabperson
sn: $sn
givenName: $givenName
cn: $cn
mail: $mail
memberOfPAB: AddressBook$gguid
HERE

	foreach my $list_name (keys %{$userListHoH{$mail} } ) {
		print "memberOfPABGroup: $listMap{$list_name}\n";
	}
print "\n";

}

#--------------------------------------------------------------------------------
# Need to fix ACI part to be intelligent
# wxa 07222003
#--------------------------------------------------------------------------------
sub genMotherDN { 

my (@comp) = split(/,/,$rrdn); 
my $n = @comp;
my $i = 1;
my @dn = ();

@r_comp = reverse @comp; # reverse the array 

%ocMap =  (
				c  =>  country,
				o  =>  organization,
				dc =>  domain,
				ou =>  organizationalunit
		 );


foreach my $str (@r_comp) {

	push @dn,$str;
	my ($lhs,$rhs) = split(/=/,$str );

#    print "=> \$lhs=$lhs\t\$rhs=$rhs\t\$i=$i\n";

	if($lhs eq 'o' && lc($rhs) eq 'pab') {
	
		print<<HERE;
dn: o=pab
objectClass: top
objectClass: organization
o: pab
description: top level node in the Personal Address Book tree
aci: (target="ldap:///o=pab")(targetattr="*")(version 3.0; acl "PAB Administra
 tor access rights"; allow (all) groupdn="ldap:///cn=Messaging End User Admin
 istrators Group, ou=Groups,
HERE
		print  " ";
		for (my $x=1; $x < $n-1; $x++) {
			print $comp[$x];
			print "," unless $x==$n-2;
    	}
		print  "\"" . ";)" . "\n\n";
		next;
	}

	print "dn: " . join(',',reverse @dn) . "\n";
	print<<HERE;
objectClass: top
objectClass: $ocMap{$lhs}
$lhs: $rhs

HERE
	$i++;
}


HERE

}


#--------------------------------------------------------------------------------
# Helper Functions
#--------------------------------------------------------------------------------

sub genGuid {

	my ($length) = @_;

    if($debug) { print "Guid Length: $length \n"; }

	my $guid;
	my $_rand;


	my @chars = split(" ", "a b c d e f g h i j k l m n o p q r s t u v w x y z
                  0 1 2 3 4 5 6 7 8 9");

    srand();

	for (my $i=0; $i < $length ;$i++) {
		$_rand = int(rand 36);
        if($debug) { print "\$_rand=$_rand\n"; }
		$guid .= $chars[$_rand];
	}

    if($debug) { print length($guid) . "\n"; }

	return $guid;
}


sub logmsg {

	my $with_ts = shift;
    my $msg = shift;

    my $ts = getTimeStamp();

    open(LOG, ">>$log_file") or die "Can't open $log_file for writing: $!\n";
    if($with_ts) { print LOG $ts; }
    print LOG $msg;
    close(LOG);
}

sub getTimeStamp {
   local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time());
   $mon += 1;
   $yyyy=1900+$year;
   return "[$mon/$mday/$yyyy $hour:$min:$sec]: ";
}


sub Usage {
    print "usage: $0 -f <uid file> [-n] [-u {uid1,uid2,..}] [-o <log file>] [-h] [-v]\n";
    print "    -h    help\n";
    print "    -v    version\n";
    print "    -f    FILE (of uids)\n";
    print "    -u    uid\n";
    print "    -o    log to FILE\n";
    print "    -n    No headers\n";

    exit(0);
}


#typedef struct {
#char fullName[51];
#char shortcutName[9];
#char eMailAddress[256];
#char phoneNumber[41];
#char notes[512];
#char filler[155];
#} ADDRESSBOOK;

