#!/usr/bin/perl -w
# ad.pl - get some info from Active Directory LDAP database
use strict;
$|=1;
use CGI qw/:standard -no_xhtml/;
use Net::LDAP;
use Data::Dumper;
$Data::Dumper::Terse = 0;

my $adhost_default = 'dc.my.domain.com';
my $adbase_default = 'DC=my,DC=domain,DC=com';
my $aduser         = 'ro@my.domain.com';
my $adpassword     = 'secret';

# libraries
my %samaccounttype = (
	268435456 => 'Security Group - Global',
	536870912 => 'Security Group - Domain Local',
	805306368 => 'User',
	805306369 => 'Computer',
);	

my $filter_default = '|(mail=*@*)(homedirectory=*)(msnpAllowDialin=TRUE)'; # most real users 
my %filter = (
	'Most real users'          => '|(mail=*@*)(homedirectory=*)(msnpAllowDialin=TRUE)',
	'Accounts with emails'     => 'mail=*@*',
	'Boss'                     => '|(mail=*boss*)(description=*Boss*)',
	'Szef'                     => '|(mail=*szef*)(description=*szef*)(description=*prezes*)',
	'Any Common Name'          => 'cn=*',
	'Users with special flags' => '&(samaccounttype=805306368)(!(|(useraccountcontrol=66048)(useraccountcontrol=512)))',
);

my @adattrs;
push @adattrs, qw/samaccountname displayname description/;
push @adattrs, qw/mail telephonenumber msnpAllowDialin scriptpath homedirectory/;
push @adattrs, qw/useraccountcontrol/;

# see http://support.microsoft.com/default.aspx?scid=kb;en-us;Q305144
# "How to use the UserAccountControl flags to manipulate user account properties"

my %accountflag = (
	0x0000001 => 'SCRIPT',
	0x0000002 => 'ACCOUNTDISABLE',
	0x0000008 => 'HOMEDIR_REQUIRED',
	0x0000010 => 'LOCKOUT',
	0x0000020 => 'PASSWD_NOTREQD',
	0x0000040 => 'PASSWD_CANT_CHANGE',
	0x0000080 => 'ENCRYPTED_TEXT_PWD_ALLOWED',
	0x0000100 => 'TEMP_DUPLICATE_ACCOUNT',
	0x0000200 => 'NORMAL_ACCOUNT',
	0x0000800 => 'INTERDOMAIN_TRUST_ACCOUNT',
	0x0001000 => 'WORKSTATION_TRUST_ACCOUNT',
	0x0002000 => 'SERVER_TRUST_ACCOUNT',
	0x0010000 => 'DONT_EXPIRE_PASSWORD',
	0x0020000 => 'MNS_LOGON_ACCOUNT',
	0x0040000 => 'SMARTCARD_REQUIRED',
	0x0080000 => 'TRUSTED_FOR_DELEGATION',
	0x0100000 => 'NOT_DELEGATED',
	0x0200000 => 'USE_DES_KEY_ONLY',
	0x0400000 => 'DONT_REQ_PREAUTH',
	0x0800000 => 'PASSWORD_EXPIRED',
	0x1000000 => 'TRUSTED_TO_AUTH_FOR_DELEGATION',
);
sub UserAccountControlFlags($) {
	my $in = int ( shift );
	my @setflagnames = ();
	foreach my $flag (keys %accountflag) {
		push @setflagnames, $accountflag{$flag} 
			if $flag == ($in & $flag); 
	}
	return join(' ',@setflagnames);
}

my $CSS=<<END;
body { background-color: ivory; font-family: verdana, arial, sans-serif; }
.error { color: red; background-color: black; border: 1px solid red; padding: 0.25em; }
.red { color: red; }
table { width: 95% }
table td { border: 1px solid silver; padding: 0.25em; vertical-align: middle;}
form submit { margin: 5px; }
p { margin-top: 1 em; }
td.hr { border: none; }
END

sub ldap_attr_format {
	my ($entry,$name) = @_;
	
	my $attr = join(' ', $entry->get_value($name) );
	
	
	if($name eq 'useraccountcontrol') {
		
		my $uacf = UserAccountControlFlags($attr);
		$uacf =~ s/(ACCOUNTDISABLE|LOCKOUT|TRUSTED_FOR_DELEGATION)/<a class="red">$1<\/a>/g;
		return $uacf;
	}
	elsif($name =~ /msnpAllowDialin/i and $attr =~ /(true|1|yes)/i) {
		return '<a class="red">' . $attr . '</a>' 
	}
	elsif ( $name =~ /homedirectory/i) {
		return qq[<a href="file://$attr">$attr</a>];
	}
	else {
		return $attr;
	}
}

print header(-type => 'text/html; charset=UTF-8'),
	start_html(-title => `/bin/hostname` . ' :: Active Directory info',
		-style => { -code => $CSS }
		), 
	
	start_form(), 
	table(
		{-border=>0},
		caption(h3("Search Active Directory")),
		Tr(
			td('at host'),
			td({colspan=>2},textfield('adhost', $adhost_default, 35, 255)),
		),
		Tr(
			td("starting from <A href=\"http://www.ietf.org/rfc/rfc2255.txt\">base CN</A>"),
			td({colspan=>2},textfield('adbase', $adbase_default, 50, 255)),
		),
		Tr(td({colspan=>3, class=>'hr'}, '<hr>')),
		Tr(
			td('Select object type '),
			td(
				popup_menu(
				-name=> 'samaccounttype',
				-values => [  keys %samaccounttype ],
				-labels => \%samaccounttype,
				-default=> 805306368,
				)
			),
			td(submit(-name=>'op', -value=>'list objects'))
		),
		Tr(td({colspan=>3, class=>'hr'}, '<hr>')),
		Tr(
			td('Select cooked filter'),
			td(
				popup_menu(
				-name=> 'filterselect',
				-values => [  keys %filter ],
				)
			),
			td(submit(-name=>'op', -value=>'search'))
		),
		Tr(
			td('or enter <A href="http://www.ietf.org/rfc/rfc2254.txt">filter expression</A>'),
			td(textfield('filter', $filter_default, 80, 255)),
			td(submit(-name=>'op', -value=>'free search'))
		),
		Tr(td({colspan=>3, class=>'hr'}, '<hr>')),
		Tr(
			td("Enable debug settings " ),
			td({colspan=>2},
 				checkbox('dumper', 0, 1, 'Dump raw search results'),
			    checkbox('dumpclasses', 0, 1, 'Dump all classes in schema'), 
			)
		),
	),
	
	end_form();


if (param()) {
	my($op, $sat, $adhost,$adbase, $filter,$filterselect, $d1,$d2) = 
	(
		param('op'), param('samaccounttype'),
		param('adhost'), param('adbase'), param('filter'), param('filterselect'),
		param('dumper'), param('dumpclasses')
	);
	#print "op = $op = ";
	if($op eq 'list objects') {
		#print "account type = $samaccounttype{$sat} = ";
		$filter = "samaccounttype=$sat";
	}
	elsif($op eq 'search') {
		#print "filter selected = $filterselect = ";
		$filter = $filter{ $filterselect };
	}
	elsif($op eq 'free search') {
		$filter = $filter;
	}
	else {
		print "WRONG OP";
		die " wrong op ";
	}

	print hr;
	my $ad = Net::LDAP->new( $adhost );
	$ad or die;
	# bind and check
	print "Binding to AD...";
	my $bind = $ad->bind( $aduser, password => $adpassword );
	do {
		print $bind->error_name();
		die "Bind error ".$bind->error_name()."\n";
	} if $bind->is_error();
	# search and check
	print "Searching...";
	my $search = $ad->search(
		base   => $adbase,
		filter => $filter,
		attrs  => join(', ',@adattrs)
	);
	do {
		print $search->error_name();
		die "Search error ".$search->error_name()."\n";
	} if $search->is_error();
	 
	my $count = $search->count;
	print "Results found: $count", p;
	
	print table(
		{-border=>1},
		caption(h5($filter)),
		Tr( [ th({-width=>'100'}, [ 'Object', @adattrs ] ),
			map {
				my $entry = $_;
				td( [ $entry->dn(), map { ldap_attr_format($entry,$_) } @adattrs ] );
			} $search->entries()
		] ) );
	print hr();

	if ($d1) {
		print h5("Dump results");
		print pre(Dumper($search));
	}
	if ($d2) { 
		my $schema = $ad->schema;
		# dump objectClasses
		print h5('All object classes');
		print pre(Dumper($schema->all_objectclasses));
	}
	
	$ad->unbind;  # take down session
}

print end_html();