#!/usr/bin/perl -w use CGI qw(:standard); use CGI::Carp qw(fatalsToBrowser); use Net::LDAP qw(:all); use Net::LDAP::Entry; use Net::LDAP::Util qw(ldap_error_text); use strict; use vars qw($attributes $returnedcount); $| = 1; { my $attributelist = qw(cn uid l departmentnumber title mail); $attributes = join('|', @attributelist); } $returnedcount = 0; my $cgi = new CGI; print $cgi->header(); print < HTML_HEADER my $flag = $cgi->param('looking'); if (!flag) { lookUp(); } else { print <LDAP Results
HEADER my $ldap_server = "your.ldap.server.here"; my $basedn = "your.base.dn.here"; my $binddn = "your.bind.dn.here"; my $password = "your.ldap.password.here"; my $ldap = Net::LDAP->new($ldap_server) or die ( $@ . "\n" ); my $result = $ldap->bind( $binddn, password => $password ) or die($result->error()); my $scope = "sub"; my $count = 0; my $searchstory = ''; { my %searchparams = ( 'first' => 'givenname', 'last' => 'sn', 'dept' => 'departmentnumber' ); foreach my $p (keys(%searchparams)) if (defined($cgi->param($p))) { $count++; $searchstory .= '(' . $p . '=*' . $cgi->param($searchparams{$p}) . '*)'; } } $searchstory = '(&' . $searchstory . ')' if ($count > 1); } # UNTESTED # - Supposed to send something to the browser periodically - $SIG{ALRM} = sub { print ' '; alarm(5); } # UNTESTED my $searchobj = $ldap->search( base => $basedn, filter => $searchstory, callback => \&process ); print( '', '', '', "\n" ) if ( $searchobj->code() ); print( '', '', "\n" ); } $ldap->unbind(); } print < HTML_FOOTER sub process { local $SIG{ALRM} = 'IGNORE'; my $mesg = shift; my $obj = shift; if ( !$obj ) { # Search complete } else { my $dn = $obj->dn(); { my @parts = (); my $resultstring = '|'; print( '\n" ); foreach my $attr ( sort( { lc($a) cmp lc($b) } $obj->attributes ) ) { next unless ($attr =~ m/^($attributes)$/); $resultstring .= join ( ': ', $attr, $obj->get_value($attr) ), "|" ); } print( "\n" ); $returnedcount++; } $mesg->pop_entry(); } }
Bad search', ldap_error_text( $searchobj->code() ), '
Returned entries: ', $returnedcount, '
dn: ', $dn, "$resultstring