package Win32::ADUtils;

use 5.006;
use strict;
use warnings;
use Win32::OLE;
use Net::DNS;

require Exporter;

our @ISA = qw(Exporter);
(our $VERSION = q$Revision: 1.13 $) =~ s/Revision: //;

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Alea::ADUtils ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	&ADSearch
	&ADSearchHash
	&ADSearchArray
	&GetDomainDNSName
	&GetDefaultNamingContext
	&GetConfigurationNamingContext
	&GetSchemaNamingContext
	&GetComputerSite
	&ForwardDNSLookup
	&ReverseDNSLookup
	&GetDNSNameFromDN
	&GetDomainControllersInSite
);


# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.
# ADSearchArray - return records as an array of hashes
sub ADSearchArray {
	my $LDAPSearchString = shift;
	my @results;
	my $debug = shift;
	
	print "Search string $LDAPSearchString\n" if $debug;
	
	# Create ADO Connection first
	print "Creating ADO Connection\n" if $debug;
	my $con = Win32::OLE->CreateObject("ADODB.Connection") or die;
	
	# Set provider to ADSI
	print "Setting provider to ADdDSOObject\n" if $debug;
	$con->{Provider} = "ADsDSOObject";
	
	# Open connection
	print "Opening connection\n" if $debug;
	$con->Open;
	
	# Execute query, hopefully we've been given one with valid syntax!
	print "Executing query\n" if $debug;
	my $rs = $con->Execute($LDAPSearchString) or return undef;
	
	# <LDAP://$ou>;(objectClass=computer);Name,distinguishedName;SubTree";
	my @fields = split(/,/,(split(/;/,$LDAPSearchString))[2]);
	print "Searching for fields @fields\n" if $debug;
	
	until ($rs->{EOF}) {
		my %record;
		print "Processing record\n" if $debug;
		foreach my $field (@fields) { $record{$field} = $rs->{Fields}->Item($field)->{Value} };
		push @results, \%record;
		$rs->MoveNext;
	}
	return \@results;
}

# ADSearch - Alias to ADSearchArray for backwards compatibility
sub ADSearch {
	return ADSearchArray(@_);
}

# ADSearchHash - Return record as a hash of hashes keyed on user specified field
sub ADSearchHash {
	my $LDAPSearchString = shift or return undef;
	my $KeyField = shift or return undef;
	my %results;
	my $debug = shift;
	
	print "Search string $LDAPSearchString\n" if $debug;
	
	# Create ADO Connection first
	print "Creating ADO Connection\n" if $debug;
	my $con = Win32::OLE->CreateObject("ADODB.Connection") or die;
	
	# Set provider to ADSI
	print "Setting provider to ADdDSOObject\n" if $debug;
	$con->{Provider} = "ADsDSOObject";
	
	# Open connection
	print "Opening connection\n" if $debug;
	$con->Open;
	
	# Execute query, hopefully we've been given one with valid syntax!
	print "Executing query\n" if $debug;
	my $rs = $con->Execute($LDAPSearchString) or return undef;
	
	# <LDAP://$ou>;(objectClass=computer);Name,distinguishedName;SubTree";
	my @fields = split(/,/,(split(/;/,$LDAPSearchString))[2]);
	print "Searching for fields @fields\n" if $debug;
	
	until ($rs->{EOF}) {
		my %record;
		print "Processing record\n" if $debug;
		foreach my $field (@fields) {
			$record{$field} = $rs->{Fields}->Item($field)->{Value} || "";
		};
		if ($record{$KeyField}) { $results{$record{$KeyField}} = \%record }
		$rs->MoveNext;
	}
	return \%results;
}

sub GetDomainDNSName {
	my $ADSystemInfo;
	unless ($ADSystemInfo = Win32::OLE->CreateObject("ADSystemInfo")) {
		warn "Can't instantiate ADSystemInfo";
		return undef;
	}
	my $DomainDNSName = $ADSystemInfo->{DomainDNSName};
	return $DomainDNSName;
}

sub GetDefaultNamingContext {
	my $rootDSE;
	unless ($rootDSE = Win32::OLE->GetObject("LDAP://rootDSE")) {
		warn "Can't instantiate rootDSE";
		return undef;
	}
	my $DomainDistinguishedName = $rootDSE->Get("defaultNamingContext");
	return $DomainDistinguishedName;
}

sub GetConfigurationNamingContext {
	my $rootDSE;
	unless ($rootDSE = Win32::OLE->GetObject("LDAP://rootDSE")) {
		warn "Can't instantiate rootDSE";
		return undef;
	}
	my $DomainDistinguishedName = $rootDSE->Get("configurationNamingContext");
	return $DomainDistinguishedName;
}

sub GetSchemaNamingContext {
	my $rootDSE;
	unless ($rootDSE = Win32::OLE->GetObject("LDAP://rootDSE")) {
		warn "Can't instantiate rootDSE";
		return undef;
	}
	my $DomainDistinguishedName = $rootDSE->Get("schemaNamingContext");
	return $DomainDistinguishedName;
}

sub GetComputerSite {
	# This takes either a DNS name, a DN, or an IP address and returns a hashref containing the cn and dn of the site
	my $computer = shift;
	my $ip;
	if ($computer =~ /\d+\.\d+\.\d+\.\d+/) { $ip = $computer }
	elsif ($computer =~ /\S+\.\S+/) {
		# We assume this is a DNS hostname
		$ip = ForwardDNSLookup($computer) || "Arse";
	}
	elsif ($computer =~ /,\S\S=/) {
		# Assume this is a DN.
		$ip = ForwardDNSLookup(GetDNSNameFromDN($computer)) || "Arse";
	}
	else  { $ip = "arse" };
	
	unless ($ip =~ /\d+\.\d+\.\d+\.\d+/) { return undef };
	my $configurationNamingContext = GetConfigurationNamingContext;
	my $SitesPath = "CN=Sites,$configurationNamingContext";
	my $SubnetsPath = "CN=Subnets,CN=Sites,$configurationNamingContext";
	
	# LDAP search string for site data - return distinishedName and cn for each site
	my $SiteSearchString = "<LDAP://$SitesPath>;(objectClass=site);distinguishedName,cn;SubTree";
	
	# LDAP search string for subnet data - return name (as network/mask) and DN of site to which subnet belongs
	my $SubnetSearchString = "<LDAP://$SubnetsPath>;(objectClass=subnet);siteObject,cn;SubTree";
	
	# Do ADO search for Sites using ADsDSOObject provider
	my $Sites = ADSearchHash($SiteSearchString, "distinguishedName");
	
	# Do ADO search for subnets using ADsDSOObject provider
	my $Subnets = ADSearchHash($SubnetSearchString, "cn");
	
	# Now iterate through each subnet
	foreach my $subnet (keys %{$Subnets}) {
		# Split out network from mask using regular expression
		my ($network,$mask) = ($subnet =~ m|(.*)/(.*)|);
		# Compare ip to network address via mask given
		if (IsIpInNetwork($ip,$network,$mask)) {
			# Now we have the right subnet, need to match to a site
			my $SiteDN   = $Subnets->{$subnet}->{siteObject};
			my $SiteName = $Sites->{$SiteDN}->{cn};
			return { distinguishedName => $SiteDN, cn => $SiteName };
		}	
	}
	# We get to here if nothing has matched.
	return undef;
}

sub IsIpInNetwork {
	# Note we expect ip and network in dotted quad notation, mask can be either CIDR (24) or dotted quad
	my ($ip,$network,$mask) = @_;
	
	# Get ip and network into binary form
	# Note ip format is byte.byte.byte.byte with most significant bytes first
	my $binarynetwork = pack( 'C4', split (/\./, $network ));
	my $binaryip =      pack( 'C4', split (/\./, $ip ));
	my $binarymask;
	
	# Need to get mask into binary form
	# If it's a ditted quad we'll convert like the ip addresses above
	if ($mask =~ m|\d+\.\d+\.\d+\.\d+|) { $binarymask = pack( 'C4C4C4C4', split (/\./, $mask )) }
	# Or if not it's a CIDR and we convert mask to a bitstring, then to binary
	elsif ($mask =~ /^\d+$/) { $binarymask = pack("B32",("1" x $mask) . ("0" x (32-$mask))) }
	
	# Now we compare the IP and'ed against the mask to see if it equals the network
	return (($binaryip & $binarymask) eq $binarynetwork) ? 1 : undef;
}

sub ForwardDNSLookup {
	# Turn a hostname into an ip address via default DNS servers
        my $hostname = shift or return undef;
	my $dns = Net::DNS::Resolver->new;
	my $query = $dns->search($hostname);
	my $ip;
        
	if ($query) {
	      foreach my $rr ($query->answer) {
	          next unless $rr->type eq "A";
	          $ip = $rr->address;
	      }
	  }

        return $ip || "unresolvable";
}

sub ReverseDNSLookup {
	# turn an ip into a hostname via default DNS servers
        my $ip = shift;
 	my $dns = Net::DNS::Resolver->new;
	my $query = $dns->search($ip);
	my $name;
        
	if ($query) {
	      foreach my $rr ($query->answer) {
	          next unless $rr->type eq "PTR";
	          $name = $rr->ptrdname;
	      }
	}

        return $name || "unresolvable";
}

sub GetDNSNameFromDN {
	# Turn a distinguishedName into a DNS Name
	my $dn = shift;
	my $computer;
	unless ($computer = Win32::OLE->GetObject("LDAP://$dn")) {
		warn "Error - cannot bind to $dn\n";
		return undef;
	}
	my $dNSHostName = $computer->Get("dNSHostName");
	return $dNSHostName;
}

sub GetHostName {
	my $info     = Win32::OLE->CreateObject("ADSystemInfo");
	my $domain   = $info->{DomainDNSName};
	my $hostname = lc($ENV{COMPUTERNAME} . "." . $domain);
	return $hostname;
}

sub GetDomainControllersInSite {
	# _ldap._tcp.whuk-dpfm._sites.dc._msdcs.dpfm.net. 600 IN SRV 0 100 389 grdc5.dpfm.net.
	my $site = shift or return undef;
	my $domain = GetDomainDNSName();
	my $string = "_ldap._tcp.$site._sites.dc._msdcs.$domain.";
	
	my $dns = Net::DNS::Resolver->new;
	my $query = $dns->search($string, "SRV");
	my @list;
	if ($query) {
	      foreach my $rr ($query->answer) {
	          next unless $rr->type eq "SRV";
	          my $name = $rr->{target};
	          push @list, $name;
	      }
	      return \@list;
	} else {
		return undef;
	}

}

1;