package UMR::SysProg::ADSObject;
require 5.000;
require Exporter;
use Net::LDAPS;
use Net::LDAP;
use Net::LDAP::Search;
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED );
use Net::LDAP::LDIF;
use UMR::AuthSrv;
use Math::BigInt; # should do with eval instead perhaps

# Begin-Doc
# Name: UMR::SysProg::ADSObject
# Type: module
# Description:  Allows for create/modify/delete/reset passwords in AD
# Syntax:  use UMR::SysProg::ADSObject;
# RCSId: $Header: /umr/.s/umrperl/cvsroot/libs/UMR/SysProg/ADSObject.pm,v 1.34 2002/04/05 14:55:41 nneul Exp $
# End-Doc

@ISA = qw(Exporter);
@EXPORT = qw();

my $retries=4;  # Set this to one higher than the number of DCs.

# Last Error Message
$ErrorMsg = "no error";

# Account Flag Constants
my $FLAG_ENABLED =  512;
my $FLAG_NEVER_EXPIRE =  65536;
 
my $FLAG_NORMAL_ACCOUNT = $FLAG_ENABLED + $FLAG_NEVER_EXPIRE;


# Begin-Doc
# Name: new
# Type: function
# Description:  Binds to AD
# Syntax: $ex = new UMR::SysProg::ADSObject(
#		user => $user,
#		password => $pw) || die $UMR::SysProg::ADSObject::ErrorMsg;
# End-Doc
sub new
{
	my $self = shift;
	my $class= ref($self) || $self;
	my %info = @_;
	my $mode = $info{mode} || "R";
	my $pref_server = $info{server};
	my $pref_pagesize = $info{pagesize} || 50;
	if ($mode eq "R")
	{
		$server = "umr-dc.umr.edu";
	}
	if ($mode eq "W")
	{
		$server = "umr-dc01.umr.edu";
	}
	if ($mode eq "EX") 
	{
		$server = "umr-dc02.umr.edu";
	}

	# override for now till ssl fixed
	$server = "umr-dc03.umr.edu";
	if ($pref_server)
	{
		$server = $pref_server;
	}
	#print "using server ($server)\n";

	my $port = $info{port} || 636;
	my $ssl;
	if ( defined($info{ssl}) )
	{
		$ssl = $info{ssl};
	}
	else
	{
		$ssl = 1;
	}

	if ( defined($info{port}) )
	{
		$port = $info{port};
	}
	else
	{
		if ( $ssl )
		{
			$port = 636;
		}
		else
		{
			$port = 389;
		}
	}
	my $user = $info{user} || (getpwuid($>))[0];
	my $pw = $info{password} || &AuthSrv_Fetch( user=>$user,
		 instance => 'ads');
	my $domain = $info{domain} || "umr.edu";
	
	# set any object params
	my $tmp = {};
	$tmp->{"debug"} = undef;

	if ( $ssl )
	{
		$tmp->{ldap} = new Net::LDAPS($server, port=> $port, 
			version => 3) || return undef;
	}
	else
	{
		$tmp->{ldap} = new Net::LDAP($server, port=> $port,
			version => 3) || return undef;
	}
	$tmp->{pagesize} = $pref_pagesize;

	my $ldap = $tmp->{ldap};
	my $count = 0;
	my $res = undef;
	my $bound = 0;
	while ($count < $retries && ! $bound)
	{	
		$res = $ldap->bind("$user\@$domain", password =>$pw);
		if (! $res->code)
		{
			$bound = 1;
			last;
		}
		$count++;
	}
	if ( ! $bound )
	{
		$ErrorMsg = "ldap bind failed: " . $res->error;
		return undef;
	}
	else
	{
		return bless $tmp, $class;
	}
}

sub debug
{
	my $self = shift;
	if (@_)
	{
		$self->{debug} = shift;
	}
	else
	{
		return $self->{debug};
	}
}

# Begin-Doc
# Name: _GetDN
# Type: function
# Access: private
# Description: Does a search on the sAMAccountName attribute and returns the 
# distinguishedName attribute
# Returns: distinguishedName
# End-Doc

sub _GetDN
{
	my $self = shift;
	my $ldap = $self->{ldap};

	my ($SAM) = @_;
	my $baseDN="DC=umr,DC=edu";
	my $Dname = undef;
	$self->debug && print "SAM is $SAM\n";	
	my $srch = $ldap->search(
	      base => $baseDN,
	      scope => 'sub',
	      filter => "(|(sAMAccountName=$SAM))",
	      attrs=>['distinguishedName']	
	);
		
        my @entries=$srch->entries;
	my $max = $srch->count;
		
	foreach my $entry ($srch->all_entries) 
	{
		$Dname=$entry->get_value('distinguishedName');
	}
	$self->debug && print "Dname1 is $Dname\n";
	
	if ($Dname==undef)
	{
		my $srch = $ldap->search(
			base => $baseDN,
             	 	scope => 'sub',
			filter => "(|(userPrincipalName=$SAM\@umr.edu))",
			attrs=>['distinguishedName']
		);

		my @entries=$srch->entries;
		my $max = $srch->count;

		foreach my $entry ($srch->all_entries)
	        {
			$Dname=$entry->get_value('distinguishedName');
		}
		$self->debug && print "Dname2 is $Dname\n";
	}
		
	if ($srch->code)
	{
		$ErrorMsg = "Search failed: " . $srch->error . "\n";
		return undef;
	}
	return $Dname;
}

# Begin-Doc
# Name: SetPassword
# Type: function
# Description:  Resets the ADS Password for a userid
# Syntax:  $setpw = $ex->SetPassword(
#			userid => "miner",
#			password => "engineer");
# Returns: undef is successful otherwise the error
# End-Doc
sub SetPassword
{
	my $self = shift;
	my (%info) = @_;
	my ($userid,$password,$upn,$dn,$res);
	$userid = $info{userid} || return "need a userid\n";
	$password = $info{password} || return "need new password\n";
	$dn = $self->_GetDN($userid);
	if ( ! $dn )
	{
		$self->debug && print "userid not found\n";
		$ErrorMsg = "Userid '$userid' not found. Password not set.\n";
		return $ErrorMsg;
	}

	$self->debug && print "dn is $dn\n";
	$self->debug && print "userid is $userid\n";
	$self->debug && print "password is $password\n";
	#---
	# simple string=>unicode conversion
	#---
	$pw = $self->_MakeUnicode($password);	
	$res = $self->{ldap}->modify
	(	
		dn => $dn,
		changes => [
			replace => [ 
				"unicodePwd" => $pw,
				"userAccountControl" => $FLAG_NORMAL_ACCOUNT
			]
		]
	);
	if ($res->code)
	{
		$ErrorMsg = "password set failed: " . $res->error;
		return $ErrorMsg;
	}
	return undef;
}

# Begin-Doc
# Name: CreateUser
# Type: function
# Description: Creates a user in AD...note that the userid is disabled until
# Syntax: $crtusr = $ex->ADS_CreateUser(
#			DistinguishedName => $dn,
#			SamAccountName => $samaccount,
#			DisplayName => $display,
#			UserPrincipalName => $upn)
# Returns: undef if success, else error
# End-Doc

sub CreateUser
{
	my $self = shift;
	my (%info) = @_;
	my ($dn, $samName, $dispName, $userPN);
	my $ldap = $self->{ldap};
	$dn = $info{DistinguishedName};
	$samName = $info{SamAccountName};
	$dispName = $info{DisplayName};
	$userPN = $info{UserPrincipalName};
	$spn = $info{ServicePrincipalName};
	$self->debug && print "dispName = $dispName\n";
	$self->debug && print "userPN = $userPN\n";
	$self->debug && print "samName = $samName\n";
	$self->debug && print "dn = $dn\n";	
	
	$self->debug && print "inside create\n";
	$crtusr = $self->{ldap}->add(
	       	dn => "$dn",
	       	attr => [ SamAccountName => "$samName",
	               	DisplayName => "$dispName",
	               	UserPrincipalName => "$userPN\@umr.edu",
	               	objectclass => ['top', 'person', 'organizationalPerson', 'user']
	               	]
	);
	if ($crtusr->code)
	{	
		$self->debug && print "Create failed: ".$crtusr->error."\n";
		$ErrorMsg = "create failed: " . $crtusr->error;
		return "Create failed: ".$crtusr->error."\n";
	}
	
	return undef; 
}


# Begin-Doc
# Name: CreateSecurityGroup
# Type: function
# Description: Creates a security group netgroup
# Syntax: $crtusr = $ex->CreateSecurityGroup(
#			group => $group)
# Returns: undef if success, else error
# End-Doc

sub CreateSecurityGroup
{
	my $self = shift;
	my (%info) = @_;
	my ($group);
	my $ldap = $self->{ldap};
	$group = $info{group};
	my $ou = $info{ou};
	if ( !defined($ou) )
	{
		if ( $group =~ /^ng-/ )
		{
			$ou = "OU=NetGroups,DC=umr,DC=edu";
		}
		else
		{
			return "need to specify OU";
		}
	}
	my $dn = "CN=$group,$ou";

	$self->debug && print "dn = $dn\n";	
	
	$self->debug && print "inside create\n";
	$crtusr = $self->{ldap}->add(
	       	dn => "$dn",
	       	attr => [ 
						sAMAccountName => "$group",
						name => $group,
	               		objectclass => ['top', 'group'],
				groupType => -2147483640
	               	]
	);
	if ($crtusr->code)
	{	
		$self->debug && print "Create failed: ".$crtusr->error."\n";
		$ErrorMsg = "create failed: " . $crtusr->error;
		return "Create failed: ".$crtusr->error."\n";
	}
	
	return undef; 
}

sub Create_Svc_Princ
{
	my $self = shift;
	my (%info) = @_;
	my ($princ, $pw, $samName, $dispName, $count,$name);
	$count=1;
	$princ = $info{principal};
	$pw = $info{pw};
	$dn="CN=$princ,CN=Users,DC=umr,DC=edu";
	$dispName=$princ;
	$samName=$princ;
	$samName =~ s|/|-|go;
	$samName =~ s|\..*||go;

	#------
	#  Look for the sAMAccountName in AD.
	#  If it's already present start adding digits to the end.
	#------
	$self->debug && print "princ- $princ\n";
	$self->debug && print "samName - $samName\n";
	if (length($samName) > 15)
	{
		#just in case too long
		$samName=substr($samName,0,15);
	}
	$origsamName=$samName;
	my $found=1;
	while ($self->_GetDN($samName))
	{
		$samName=$origsamName.$count;
		if (length($samName) >15)
		{
			$samName=substr($origsamName,0,15-length($count)).$count
		}
		$count++;
	}
	$self->debug && print "\nadd principal\n";
	
#	$crtprinc=$self->CreateUser
#	(
#		DistinguishedName => $dn,
#		SamAccountName => $samName,
#		DisplayName => $dispName,
#		UserPrincipalName => $princ,
#		ServicePrincipalName => $princ
#	);
	
	$crtprinc= $self->{ldap}->add(			
		dn => "$dn",
		attr => [ SamAccountName => "$samName",
			  DisplayName => "$dispName",
			  UserPrincipalName => "$princ\@umr.edu",
			  servicePrincipalName => "$princ",
			  objectclass => ['top','person','organizationalPerson','user']
			]
	);
	if ($crtprinc->code)
	{
		$ErrorMsg = "create principal failed: ".$crtprinc->error."\n";
		$self->debug && print "Create princ failed: ".$crtprinc->error."\n";
		return "create principal failed: ".$crtprinc->error."\n";
	}
	#------
	# Set the password for this principal
	#------
	$svcpw= $self->SetPassword(
		userid => $princ,
		password => $pw
	);		

	return $svcpw;
}

# Begin-Doc
# Name: DeleteUser
# Type: function
# Description: Deletes a userid from AD
# Syntax: $deluser = $ads->DeleteUser( userid => $name);
# End-Doc

sub DeleteUser
{
	my $self = shift;
	my (%info) = @_;
	my ($upn);
	my $userid = $info{userid} || return "Need the userid\n";
	my $dn = $self->_GetDN($userid);
	$delusr = $self->{ldap}->delete($dn);
	if ($delusr->code)
	{	
		return "delete failed: ".$delusr->error."\n";
	}
	return undef;
}

# Begin-Doc
# Name: _MakeUnicode
# Type: function
# Description: simple ascii to unicode/2bytechar conversion
# Syntax: $unicode = $ads->_MakeUnicode($string);
# Access: internal
# End-Doc
sub _MakeUnicode
{
	my $self = shift;
	my ($string, $plainstring, $chr);
	$string = shift;
#	print "string $string\n";
	$plainstring = "\"$string\"";	
	#---
	# simple string=>unicode conversion
	#
	my @tmp = ();
	foreach $chr ( split('', $plainstring) )
	{
		push(@tmp, $chr);
        	push(@tmp, chr(0));
	}
	$unistring = join("",@tmp);
	#
	#---
	return $unistring;
	print "$unistring\n";
}

# Begin-Doc
# Name: FindProxyHost
# Type: function
# Description: Finds mailbox host for a given proxy address
# Syntax: $host = $ad->FindProxyHost($email)
# Returns: hostname if success, else error
# Comments: If address does not have a type in front of it, assumes smtp
# End-Doc

sub FindProxyHost
{
	my $self = shift;
	my ($email) = @_;
	my ($res, $homeServer);
	my $ldap = $self->{ldap};

	if ( $email !~ /^[a-z0-9\.]+:/o )
	{
		$email = "smtp:$email";
	}

	$res = $self->{ldap}->search(
        base => 'DC=umr,DC=edu',
        scope => 'sub',
        filter => "(|(proxyAddresses=$email))",
        attrs=>['msExchHomeServerName']
	);
	if ($res->code)
	{	
		$self->debug && print "Search failed: ".$res->error."\n";
		$ErrorMsg = "create failed: " . $res->error;
		return undef;
	}

	my @entries=$res->entries;
	foreach my $entry ( $res->entries )
	{
		$homeServer = $entry->get_value('msExchHomeServerName');
	}

	$homeServer =~ s/.*cn=//gio;
	if ( $homeServer !~ /UMR-MAIL\d+/ )
	{
		$ErrorMsg = "unknown server pattern";
		return undef;
	}

	return lc($homeServer);
}


# Begin-Doc
# Name: GetUserList
# Type: function
# Description: Returns list of all ADS userids
# Syntax: @users = $ad->GetUserList()
# Returns: Returns list of all ADS userids
# End-Doc

sub GetUserList
{
	my $self = shift;
	my $ldap = $self->{ldap};
	my $page = new Net::LDAP::Control::Paged( 
		size => $self->{pagesize} ) || return undef;
	my @users = ();
	my $res;

	while (1)
	{
		$res = $self->{ldap}->search(
        	base => 'DC=umr,DC=edu',
        	scope => 'sub',
        	filter => "(&(sAMAccountName=*))",
        	attrs=>['sAMAccountName'],
			control  => [$page],
		);
		if ($res->code)
		{	
			$self->debug && print "Search failed: ".$res->error."\n";
			$ErrorMsg = "create failed: " . $res->error;
			return undef;
		}

		foreach $entry ( $res->entries )
		{
			my $sa = lc $entry->get_value('sAMAccountName');
			push(@users, $sa);
		}

		my ($resp) = $res->control(LDAP_CONTROL_PAGED) or last;

        $cookie = $resp->cookie or last;
        $page->cookie($cookie);
	}
	
	return @users;
}


# Begin-Doc
# Name: GetMailboxUserList
# Type: function
# Description: Returns list of all ADS userids w/ exchange mailboxes
# Syntax: @users = $ad->GetMailboxUserList()
# Returns: Returns list of all ADS userids
# End-Doc

sub GetMailboxUserList
{
	my $self = shift;
	my $ldap = $self->{ldap};
	my $page = new Net::LDAP::Control::Paged( 
		size => $self->{pagesize} ) || return undef;
	my @users = ();
	my $res;

	while (1)
	{
		$res = $self->{ldap}->search(
        	base => 'DC=umr,DC=edu',
        	scope => 'sub',
        	filter => "(&(msExchHomeServerName=*UMR-MAIL*))",
        	attrs=>['sAMAccountName'],
			control  => [$page],
		);
		if ($res->code)
		{	
			$self->debug && print "Search failed: ".$res->error."\n";
			$ErrorMsg = "create failed: " . $res->error;
			return undef;
		}

		foreach $entry ( $res->entries )
		{
			my $sa = lc $entry->get_value('sAMAccountName');
			push(@users, $sa);
		}

		my ($resp) = $res->control(LDAP_CONTROL_PAGED) or last;

        $cookie = $resp->cookie or last;
        $page->cookie($cookie);
	}
	
	return @users;
}

# Begin-Doc
# Name: GetAttributes
# Type: function
# Description: Returns all attributes associated with a userid
# Syntax: $info = $ad->GetAttributes($userid, [attributes => [attriblist])
# Returns: hash reference, elements are the ldap keys for each attribute, values are array references
# Comments: In most cases, the array will only have a single element, in some there will be multiple elements.
# Comments: can optionally specify list of specific attributes to retrieve, 
#	otherwise it retrieves everything.
# End-Doc

sub GetAttributes
{
	my $self = shift;
	my $ldap = $self->{ldap};
	my $userid = shift;
	my ($info, $res, @entries, $entry, $attrib);
	my %opts = @_;
	my $whichattrib = $opts{attributes};

	$info = {};

	if ( ! defined($userid) )
	{
		$self->debug && print "Must specify userid.\n";
		$ErrorMsg = "must specify userid";
		return undef;
	}

	if ( !defined($whichattrib) )
	{
		$res = $self->{ldap}->search(
	        	base => 'DC=umr,DC=edu',
	        	scope => 'sub',
	        	filter => "(&(sAMAccountName=$userid))",
		);
	}
	else
	{
		$res = $self->{ldap}->search(
	        	base => 'DC=umr,DC=edu',
	        	scope => 'sub',
	        	filter => "(&(sAMAccountName=$userid))",
				attrs => $whichattrib,
		);
	}
	if ($res->code)
	{	
		$self->debug && print "Search failed: ".$res->error."\n";
		$ErrorMsg = "create failed: " . $res->error;
		return undef;
	}

	@entries = $res->all_entries;
	$entry = shift(@entries);

	if ( ! defined($entry) )
	{
		return undef;
	}

	foreach my $aref ( @{ $entry->{asn}->{attributes} } )
	{
		my $name = $aref->{type};
		my $values = $aref->{vals};

		$info->{ $name } = $values;
	}

	return $info;
}

# Begin-Doc
# Name: GetAttributesMatch
# Type: function
# Description: Returns all attributes for userids matching a filter
# Syntax: $info = $ad->GetAttributesMulti($filter, [attributes => [attriblist])
# Returns: ref to array of hash refs, elements are the ldap keys for each attribute, values are array references
# Comments: In most cases, the array will only have a single element, in some there will be multiple elements.
# Comments: can optionally specify list of specific attributes to retrieve, 
#	otherwise it retrieves everything.
# Comments: filter is an ldap search string
# End-Doc

sub GetAttributesMatch
{
	my $self = shift;
	my $ldap = $self->{ldap};
	my $filter = shift;
	my ($info, $res, @entries, $entry, $attrib);
	my %opts = @_;
	my $whichattrib = $opts{attributes};

	$info = {};

	if ( ! defined($filter) )
	{
		$self->debug && print "Must specify filter.\n";
		$ErrorMsg = "must specify filter";
		return undef;
	}

$self->debug && print "Using filter = $filter\n";

	if ( !defined($whichattrib) )
	{
		$res = $self->{ldap}->search(
	        	base => 'DC=umr,DC=edu',
	        	scope => 'sub',
	        	filter => $filter,
		);
	}
	else
	{
		$res = $self->{ldap}->search(
	        	base => 'DC=umr,DC=edu',
	        	scope => 'sub',
	        	filter => $filter,
				attrs => $whichattrib,
		);
	}
	if ($res->code)
	{	
		$self->debug && print "Search failed: ".$res->error."\n";
		$ErrorMsg = "create failed: " . $res->error;
		return undef;
	}

	my $matches = [];
	foreach $entry ( $res->all_entries )
	{
		my $info = {};
$self->debug && print "got entry\n";
		foreach my $aref ( @{ $entry->{asn}->{attributes} } )
		{
			my $name = $aref->{type};
			my $values = $aref->{vals};
	
			$info->{$name} = $values;
			
		}
		push(@$matches, $info);
	}	

	return $matches;
}

# Begin-Doc
# Name: SetAttributes
# Type: function
# Description:  Sets a list of attributes for a userid
# Syntax:  $res = $ex->SetAttributes(
#			userid => "miner",
#			attributes => $info);
# Returns: undef is successful otherwise the error
# Comments: $info should be array ref containing [ attrib => val, ... ]
# values should either be scalars, or should be references to arrays of scalars
# End-Doc
sub SetAttributes
{
	my $self = shift;
	my (%info) = @_;
	my ($userid,$changes,$upn,$dn);

	$userid = $info{userid} || return "need a userid\n";
	$attributes = $info{attributes} || return "need list of attributes to change\n";

	$dn = $self->_GetDN($userid);
	$self->debug && print "dn is $dn\n";
	$self->debug && print "userid is $userid\n";

	$res = $self->{ldap}->modify
	(	
		dn => $dn,
		changes => [
			replace => $attributes
		]
	);
	if ($res->code)
	{
		$ErrorMsg = "attribute set failed: " . $res->error;
		return "attribute set failed: ".$res->error."\n";
	}
	return undef;
}

# Begin-Doc
# Name: ConvertTime
# Description: Converts a ADS FileTime value to unix timestamp
# Syntax: $timestamp = $ads->ConvertTime($value);
# End-Doc
sub ConvertTime
{
	my $self = shift;
	my $time = shift;
	my ($secs, $nsecs);

	# convert from 100-nanosecond intervals to 1-sec intervals
	$nsecs = new Math::BigInt $time;
	$secs = new Math::BigInt $nsecs->bdiv(10_000_000);

	# subtract base (seconds from 1601 to 1970)
	$secs = $secs->bsub("11644473600");

	return int($secs);
}


# Begin-Doc
# Name: DumpLDIF
# Type: function
# Description: Dumps ldap info to an LDIF format file
# Syntax: $ad->DumpLDIF($fh, %options)
# Comments: Don't use this yet... Options will eventually allow specifying list of
# attributes, and a different filter string, etc. 
# End-Doc

sub DumpLDIF
{
	my $self = shift;
	my $ldap = $self->{ldap};
	my $page = new Net::LDAP::Control::Paged( 
		size => $self->{pagesize} ) || return undef;
	my $fh = shift;
	my %options = @_;
	my $res;
	my $count;

	my $ldif = Net::LDAP::LDIF->new($fh, "w", onerror => 'undef');

	$count = 0;
	while (1)
	{
		$res = $self->{ldap}->search(
        	base => 'DC=umr,DC=edu',
        	scope => 'sub',
        	filter => "(&(distinguishedName=*))",
			control  => [$page],
		);
		if ($res->code)
		{	
			$self->debug && print "Search failed: ".$res->error."\n";
			$ErrorMsg = "create failed: " . $res->error;
			return undef;
		}

		foreach $entry ( $res->entries )
		{
			my $dn = $entry->get_value(distinguishedName);
			$ldif->write_entry($entry);
			$count++;
			if ( $count % 50 == 0 )
			{
				print $count, "\n";
			}
		}

		my ($resp) = $res->control(LDAP_CONTROL_PAGED) or last;

        $cookie = $resp->cookie or last;
        $page->cookie($cookie);
	}

	$ldif->done;
}

# Begin-Doc
# Name: CheckPassword
# Type: function
# Description: Attempts to validate an ADS password
# Syntax: $res = $ad->CheckPassword($userid, $password)
# Comments: Actually attempts to bind to ADS with that user and password, and returns
# non-zero if it cannot.
# End-Doc
sub CheckPassword
{
	my $self = shift;
	my ($userid, $password) = @_;
	my $tmpad;

	if ( !$userid || !$password )
	{
		return 1;
	}

	$tmpad = new UMR::SysProg::ADSObject(
		user => $userid,
		password => $password);

	if ( $tmpad )
	{
		return 0;
	}
	else
	{
		return 1;
	}
}



1;



__END__

require UMR::SysProg::ADS;

my $ads = new UMR::SysProg::ADS || print $UMR::SysProg::ADS::ErrorMsg && die;
my $ads2 = new UMR::SysProg::ADS(domain => 'test.umr.edu');



my $msx = new UMR::SysProg::ADS::Exchange(ads => $ads) || print ...;




package ...ADS;


sub ADS_Init
{
	params...
	my $ads = new UMR::SysProg::ADS(....);
)

sub ADS_Create
{
	$ads->CreateUser(@_);
}