#!/usr/bin/perl -w

# This is an example script that reads entries on an existing LDAP
# server, munges the schema a bit, pulls in some data from NIS, and then
# sends changes to a new LDAP server.  It generates output only when it
# performs updates on the new server, as it is intended to be run from
# cron, and we don't need e-mail from cron if nothing interesting is
# happening.

# In this scenario, we were deploying the new LDAP service, and needed
# to be able to synchronize data from an incumbent LDAP service, as well
# as an EU-based company that we had acquired.  This script synchronizes
# data from the incumbent LDAP service, does some crude schema
# enforcing, and rounds out the new entries with data from NIS.

use Net::LDAP;
use LWP::Simple;

# OLD LDAP
$oldap = Net::LDAP->new('INCUMBENT_LDAP_SERVER') or die "INCUMBENT_LDAP_SERVER: $!\n";
$oldap->bind or die "bind: $!\n";

# NEW LDAP
$nldap = Net::LDAP->new('NEW_LDAP_SERVER') or die "NEW_LDAP_SERVER: $!\n";
# Bind with a DN with sufficient credentials to add or update entries on
# he new LDAP server.
$nldap->bind(
    dn => '??????',
    password => '******'
) or die "bind: $!\n";

# GET OLD ENTRY
$omsg = $oldap->search(
    base => 'ou=People,o=tellme.com',
    filter => 'uid=*',
    attrs => [
	# person objectClass
	'sn', 'cn', 'telephoneNumber',
	# organizationalPerson objectClass
	'title', 'ou', 'postalAddress', 'postalCode', 'street', 'l',
	# inetOrgPerson objectClass
	'carLicense', 'displayName', 'employeeNumber', 'employeeType',
'givenName', 'homePhone', 'homePostalAddress', 'jpegPhoto', 'labeledURI',
'mail', 'manager', 'mobile', 'pager', 'secretary', 'preferredLanguage', 'uid',
	# tellmePerson objectClass
	'pagerEmail', 'tellmeAIMID',
	# ctCalUser objectClass
	'c', 'employeeNumber', 'generationQualifier', 'givenName', 'initials',
'mail', 'o', 'ou', 'ctCalAccess', 'ctCalAccessDomain', 'ctCalAdmd',
'ctCalDefaultNoteReminder', 'ctCalDefaultReminder', 'ctCalDefaultTaskReminder',
'ctCalDisplayPrefs', 'ctCalFlags', 'ctCalHost', 'ctCalLanguageId',
'ctCalNodeAlias', 'ctCalNotifMechanism', 'ctCalOperatingPrefs',
'ctCalOrgUnit2', 'ctCalOrgUnit3', 'ctCalOrgUnit4', 'ctCalPasswordRequired',
'ctCalPrmd', 'ctCalRefreshPrefs', 'ctCalServerVersion',
'ctCalSysopCanWritePassword', 'ctCalTimezone', 'ctCalXItemId', 'ctCalOrgUnit1',
'ctCalOrganization', 'ctCalCountry', 'ctCalMobileTelephoneType',
'ctCalPreferredSMSCTelephoneNumber', 'ctCalPublishedType',
	# legacy kludge
	'photoURL'

	]
);

$omsg->code && die $omsg->error;

# FOREACH OLD ENTRY ...
while( $oentry = $omsg->pop_entry ) {
	my $uid = ($oentry->get_value('uid'))[0];
	# Only bother with entries that have Unix accounts.  Leave the
	# random cruft behind.
	if( getpwnam($uid) ) { #&& (getpwnam($uid))[8] ne '/sbin/nologin' ) {

		# Fetch jpegPhoto attribute and store it according to schema
		my $jpegPhoto = $oentry->get_value('photoURL');
		if( $jpegPhoto && $jpegPhoto =~ /^(http|ftp):\/\/.*\.jpe?g?$/i ) {
			$jpegPhoto = get($jpegPhoto);
			# OpenLDAP was choking when sent jpegPhotos of great size.
			# :(
			if( $jpegPhoto && length($jpegPhoto) < 120000 ) {
				$oentry->replace('jpegPhoto'=>$jpegPhoto);
#				print "DONE!\n";
			} else {
				$oentry->delete('jpegPhoto');
#				print "WOAH!  Too big!\n";
			}
		}
		# Munge $oentry's DN
		# We were moving from o=tellme.com, to the more hip
		# dc=tellme,dc=com.
		$oentry->dn("uid=" . $oentry->get_value('uid') . ",ou=People,dc=tellme,dc=com");

		# Conform to new schema
		# pagerEmail -> tellmePagerEmail
		if( defined $oentry->get_value('pagerEmail') ) {
			$oentry->add('tellmePagerEmail'=>[$oentry->get_value('pagerEmail')]);
			$oentry->delete('pagerEmail');
		}
		# Nix photoURL
		$oentry->delete('photoURL');
		# When you enforce the schema on the new server, random stuff
		# like "call my secretary and ask her" is regarded as an invalid
		# phone number, and the updated entry is rejected.  This can get
		# really annoying, and there ought to some day be a module that
		# can check if an attribute conforms to rules and syntax,
		# according to the schema.  But, for now ... pager,
		# telephoneNumber, homePhone, and mobile must all be defined as
		# telephone numbers.
		foreach my $bogus ( $oentry->get_value('pager') ) {
			# RegExp: "Starts with an option '+', followed by one or
			# more digits, dashes, parentheses, white space, and dots."
			if( $bogus !~ /^\+?[\d\-\(\)\s\.]+$/ ) {
#				warn "Rejecting bogus pager attribute $bogus for " . $oentry->dn . "\n";
				$oentry->delete('pager');
			}
		}
		foreach my $bogus ( $oentry->get_value('telephoneNumber') ) {
			if( $bogus !~ /^\+?[\d\-\(\)\s\.]+$/ ) {
#				warn "Rejecting bogus telephoneNumber attribute $bogus for " . $oentry->dn . "\n";
				$oentry->delete('telephoneNumber');
			}
		}
		foreach my $bogus ( $oentry->get_value('homephone') ) {
			if( $bogus !~ /^\+?[\d\-\(\)\s\.]+$/ ) {
#				warn "Rejecting bogus homephone attribute $bogus for " . $oentry->dn . "\n";
				$oentry->delete('homephone');
			}
		}
		foreach my $bogus ( $oentry->get_value('mobile') ) {
			if( $bogus !~ /^\+?[\d\-\(\)\s\.]+$/ ) {
#				warn "Rejecting bogus mobile attribute $bogus for " . $oentry->dn . "\n";
				$oentry->delete('mobile');
			}
		}
		# Here, we change the manager and secretary attributes, which
		# are DNs, because we're changing to the trendy new DN.
		my @mandns; # Manager DNs
		foreach my $dn ( $oentry->get_value('manager') ) {
			$dn =~ s/o=tellme\.com/dc=tellme,dc=com/i;
			push @mandns, $dn;
		}
		$oentry->replace('manager'=>[@mandns]);
		my @secdns; # Secretary DNs
		foreach my $dn ( $oentry->get_value('secretary') ) {
			$dn =~ s/o=tellme\.com/dc=tellme,dc=com/i;
			push @secdns, $dn;
		}
		$oentry->replace('secretary'=>[@secdns]);

		# Populate posixAccount attributes
		my @pa = getpwnam($uid);
		$oentry->add(uidNumber => $pa[2]);
		$oentry->add(gidNumber => $pa[3]);
		$oentry->add(homeDirectory => $pa[7]);
		$oentry->add(loginShell => $pa[8]);

		# And userPassword
		# (This is actually horribly slick, because OpenLDAP will
		# authenticate against the DES password hashes we are reading
		# from NIS.  The cool way to do this is to have your Unix boxen
		# PAM against your LDAP, but first you have to implement a
		# reliable LDAP service, eh?  Chicken, egg ...)
		$oentry->add(userPassword => "{crypt}" . $pa[1]);

		# And reasonable default for co,
		# physicalDeliveryOfficeName
		$oentry->add(co=>"us");
		$oentry->add(physicalDeliveryOfficeName=>"Mountain View");

		# objectClass
		$oentry->add(objectclass => 'tellmePerson');
		if( $oentry->get_value('ctCalXItemId') ) {
			$oentry->add(objectclass => 'ctCalUser');
		}
		$oentry->add(objectClass => 'posixAccount');
	
		# Now, fetch $nentry ...

		my $nmsg = $nldap->search( filter=>"uid=$uid",
		    attrs=>[ $oentry->attributes ] );
		$nmsg->code && die $nmsg->error;
		$nmsg->count > 1 && die "More than one entry found where uid=$uid!\n";
		my $nentry = $nmsg->entry(0);

		if( ! $nentry ) {
			# Send new entry to new LDAP server
#			print "Adding " . $oentry->dn . " ... ";
#			When adds started failing, I throw in the UID of a failed
#			entry here, and examine it for suspicious data.
#			if( $uid eq 'eugene' ) { $oentry->dump(); }
			print "Adding $uid ... ";
			my $result = $nldap->add($oentry);
#			if( $result->code && $result->error eq 'Already exists' ) {
#				$result = $nldap->replace($oentry);
#			}
			if( $result->code ) { print "FAILED! (" . $result->error . ")\n"; }
			else { print "DONE!\n"; }
		} elsif( ($nentry->get_value('co')) eq 'us' ) {
			# UPDATE!
			my( $ostr, $nstr );
			# Compare this with the multi-attribute comparison kludge
			# code in the sync_EU script - this was based on that, and
			# is much cleaner.  It still assumes that the LDAP service
			# returns attributes in a consistent order, because I'm a
			# lazy bastard.
			foreach my $a (sort { lc($a) cmp lc($b) } $oentry->attributes) {
				$ostr .=
				    join(":",lc($a), $oentry->get_value($a));
			}
			foreach my $a (sort { lc($a) cmp lc($b) } $nentry->attributes) {
				$nstr .= 
				    join(":",lc($a), $nentry->get_value($a));
			}
			if( $ostr ne $nstr ) {
#				if(! $oentry->get_value('jpegPhoto') &!
#				    $nentry->get_value('jpegPhoto') ) {
#					$oentry->dump;
#					$nentry->dump;
#					print "\n*** OSTR: $ostr\n";
#					print "\n*** NSTR: $nstr\n";
#				}
				# Replace new / updated attributes
				foreach my $a ($oentry->attributes) {
					# See, now we sort the values ...
					my $oas = join('', sort $oentry->get_value($a));
					my $nas = join('', sort $nentry->get_value($a));
					if( $oas ne $nas ) {
						$nentry->replace($a=>[$oentry->get_value($a)]);
						print "UID $uid: replacing $a attribute.\n";
					}
				}
				# Remove removed attributes
				foreach my $a ($nentry->attributes) {
					if(! defined $oentry->get_value($a) ) {
						$nentry->delete($a);
						print "UID $uid: removing $a attribute.\n";
					}
				}
				print "Updating $uid ... ";
				$result = $nentry->update($nldap);
				if( $result->code ) {
					print "FAILED! (" . $result->error . ")\n";
				} else {
					print "DONE!\n";
				}
			}
		}
	} else {
		warn "UID $uid: Not found in NIS!\n";
	}
}