http://qs321.pair.com?node_id=312730

bionicle32 has asked for the wisdom of the Perl Monks concerning the following question:

Perl Guru's who have wrote LDAP scripts to search the LDAP database, I am in need of your help. This is my first stab at writing a searchable script and have had success, but this runs very slow compared to a PHP script that another developer in my company wrote.

I was hoping that someone or many people could offer up some suggestions, modifications, etc...

Here is the code and I do have further comments that follow: 

#!/usr/local/bin/perl

use strict;
use warnings;
use CGI qw(:standard);
use CGI::Carp qw ( fatalsToBrowser);
use Net::LDAP;
use Net::LDAP::Constant qw(LDAP_SUCCESS);
use vars qw( $ldap @attributes @entries $search $msg $result );

my $cgi = new CGI;
my $flag = param('looking');
print $cgi->header();
if (!$flag) {

lookUp();    # Subroutine to display search form

} else {

my $fn = param('first');
my $ln = param('last');
my $dept = param('dept');

## Connect and bind to the server.
$ldap = Net::LDAP->new("server name",port => 389,version => 3 ) or die
+ $!;
my $result;

$result = $ldap->bind("ou=people,o=intra,dc=xxxxx,dc=com") or die $res
+ult->error();
if ($result->code != LDAP_SUCCESS) {
    die $result->error();
} else {
my @count;
my $sent;
my $searchstory;

     if ($fn ne "") {
    $searchstory .= "(givenname=*" . $fn . "*)";
    push(@count, $fn);
     }
     if ($ln ne "") {
    $searchstory .= "(sn=*" . $ln . "*)";
    push(@count, $ln);
     }
     if ($dept ne "") {
         $searchstory .= "(departmentnumber=*" . $dept . "*)";
    push(@count, $dept);
     }

$sent = @count;    # Number of unempty fields returned.
if ($sent > 1) {
    $search = "(&" . $searchstory . ")";
    } else {
    $search = $searchstory;
    }
@attributes = ("cn","uid","l","departmentnumber","title","mail");
  }
my $returned = ldapSearch($search, @attributes);    # Send HTML format
+ted results back to browser

print <<RESULTS
<html>
<head><title>LDAP Results</title>
<link href="/_vti_templates/templates/visual/visual.css" rel="styleshe
+et" type="text/css"></head>
<body topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" bg
+color="ffffff">
<p align="center"><center><table cellpadding="5" cellspacing="1" borde
+r="0" width="90%">
<tr>
<td valign="center" align="center"><p class="breadcrumb">Found Entries
+ of LDAP Search:</td>
</tr>
<tr>
<td valign="center" align="center">
$returned
</td>
</tr>
</table></center>
</body>
</html>
RESULTS
;
}

sub lookUp {

print <<LOOKUP
<html>
<head><title>LDAP Lookup</title>
<link href="/_vti_templates/templates/visual/visual.css" rel="styleshe
+et" type="text/css"></head>
<body topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" bg
+color="ffffff">
<form method="post" action="ldap.pl">
<input type="hidden" name="looking" value="yes">
<p align="center"><center><table cellpadding="5" cellspacing="1" borde
+r="0" width="60%">
<tr>
<td valign="center" colspan="2"><p class="text10pt">LDAP Lookup:</td>
</tr>
<tr> 
<td valign="center" colspan="2"><p class="text10pt">Use this form to f
+ind a employee. Enter as much information as you know.</td>
</tr>
<tr> 
<td valign="center" width="20%"><p class="text9pt">First Name</td>
<td valign="center" width="40%"><input type="text" name="first" size="
+20" class="text9pt"></td>
</tr>
<tr> 
<td valign="center" width="20%"><p class="text9pt">Last Name</td>
<td valign="center" width="40%"><input type="text" name="last" size="2
+0" class="text9pt"></td>
</tr>
<tr> 
<td valign="center" width="20%"><p class="text9pt">Department Number</
+td>
<td valign="center" width="40%"><input type="text" name="dept" size="1
+0" class="text9pt"></td>
</tr>
<tr> 
<td align="center" colspan="2"><input type="submit" value="Lookup"></a
+></td>
</tr>
</table></center>
</form>
</body>
</html>
LOOKUP
;
}

sub ldapSearch {
my ($filter, $attrs) = @_;
## Query for the cn and mail attributes.
$msg = $ldap->search(
           base => "ou=people,o=intra,dc=xxxxx,dc=com",
           scope => "sub",
           filter => $filter,
           attrs => "[" . $attrs . "]" );
if ( $msg->count == 0 ) {
       return "No matches found for $filter";
}
## Print resulting entries to standard output.
#if ( $msg->count() > 0 ) {
#     print $msg->count(), " entries returned.\n";
#}

@entries = $msg->entries;  
my $totalEntries = $msg->count();
## Unbind and exit.
$ldap->unbind();
parseResults($totalEntries);
}

sub parseResults {
my $total = $_[0];
my $info = qq(<table cellpadding="3" cellspacing="1" border="1" width=
+"75%"><tr><td valign="center" colspan="2"><p class="breadcrumb">Found
+: $total</tr>);
my $entry;
foreach $entry (@entries)
    {
     my $fln = $entry->get('cn')->[0];
     my $uid = $entry->get('uid')->[0];
     my $loc = $entry->get('l')->[0];
     my $department = $entry->get('departmentnumber')->[0];
     my $title;
     if ($entry->get('title')) {
         $title = $entry->get('title')->[0];
    } else {
    $title = "You don't have a job!";
    }
     my $email;
     if ($entry->get('mail')) {
    $email = $entry->get('mail')->[0];
    } else {
    $email = "sgrif12";
    }
            
     $info .= qq(<tr><td valign="center" width="15%"><a href="mailto:$
+email" class="link9pt">$fln</a></td>);
     $info .= qq(<td valign="center" width="10%"><p class="text9pt">$u
+id</td></tr>);
     $info .= qq(<tr><td valign="center" colspan="2"><p class="text9pt
+">$department, $title</td></tr>);
     $info .= qq(<tr><td valign="center" colspan="2"><p class="text9pt
+">$loc</td>);
    }
    $info .= qq(</table>);
}

[download]

I used if statements within the for loop for the individuals job title and e-mail information. I received a software error due to the fact that it returned an empty string and I did not do any error checking. Some employees do not have a job title or e-mail information for their perspective role.

I took snippets of code from a script that a perl programmer had sitting on this very sit. The script was very useful in guiding me with writing my own that could be customized to my needs.

Now I am in need of suggestions and help. Be as critical as you need to be because as a programmer I feel those who have the most experience and teach you the best methods of programming logic and theory. Looking forward to your advice.

Thank you all,
Bionicle32

20031206 Edit by Corion: Added READMORE tags plus some paragraph formatting

Replies are listed 'Best First'.
Re: LDAP Search Script runs slow
by mandog (Curate) on Dec 06, 2003 at 06:04 UTC

    One potential trouble is that your perl script is a CGI script. Everytime somebody uses your script, the file is opened, perl is launched, your script is compiled and then run.

    The chances are good that the php version is running through mod_php. Php is is always running and does not deal with the overhead of startup every time the Php script is run.

    You can do as well or better with mod_perl



    email: mandog
[reply]
      Mandog, I am not to familiar with mod_perl, but have heard of it. Are you very familiar? If so could you give me a few examples of what you are talking about? Thanks, Bionicle32
[reply]
Re: LDAP Search Script runs slow
by atcroft (Abbot) on Dec 06, 2003 at 17:59 UTC

    One thing you may wish to do is look at using a callback routine with your search. If I am reading your code correctly, you are not doing so yet. That being the case, the search waits for all the results to be returned (which can be quite some time, if there are a large number of records in the LDAP data store you are querying), whereas if a callback routine is used, each record is processed as found.

    The code below is part of a test routine I used a while back (edited appropriately, with appologies for any errors that may have been edited in), which might give you an idea on using a callback routine. (The LDAP modules' documentation were quite helpful for me when I had to do something with it.) 

    #!/usr/bin/perl -w

use Net::LDAP qw(:all);
use Net::LDAP::Entry;
use Net::LDAP::LDIF;
use Net::LDAP::Util qw(ldap_error_text);
use strict;

$| = 1;

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 $msg = $ldap->bind( $binddn, password => $password );
my $scope = "base";

my $filter = "(objectClass=*)";

my $searchobj = $ldap->search(
    base     => $basedn,
    filter   => $filter,
    callback => \&process
);
die ( "Bad search: " . ldap_error_text( $searchobj->code() ) )
  if ( $searchobj->code() );

sub process {
    my $mesg = shift;
    my $obj  = shift;
    if ( !$obj ) {
        # Search complete
    }
    else {
        my $dn = $obj->dn();
        {
            my @parts = ();
            print( 'dn: ', $dn, "\n" );
            foreach my $attr ( sort( { lc($a) cmp lc($b) } 
              $obj->attributes ) ) {
                print( join ( ': ', $attr, $obj->get_value($attr) ), 
                  "\n" );
            }
            print( "\n" );
        }
        $mesg->pop_entry();
    }
}

    [download]
[reply]
[d/l]
      Atcroft, I noticed that you are using LDIF which is for writting to a textfile. Can this be used to store the information in a variable like the way I did it in mine? I am trying to write a web application so I am not really sure if I would know how to modify your script to return the results back to the browser at one time. Can you advise? Thanks Bionicle32
[reply]

        Here was an attempt at blending some of the aspects of your script with the code I offered above. Untested, but at least it may give you the ideas you need. I did leave out some of the functions from your original code, so you would have to integrate them in.

        I wasn't actually using the LDIF format in my test script, so I appologize for any confusion that may have caused. 

        #!/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;
<html>
  <head>
HTML_HEADER

my $flag = $cgi->param('looking');

if (!flag) {
    lookUp();
} else {

    print <<HEADER;
    <title>LDAP Results</title>
  </head>
  <body>
    <div align="center">
      <table>
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( '<tr>',
               '<td colspan="2">Bad search</td>', 
               '<td>', 
               ldap_error_text( $searchobj->code() ), 
               '</td>',
               "</tr>\n" )
          if ( $searchobj->code() );
        print( '<tr>',
               '<td colspan="2">Returned entries: ', 
               $returnedcount, 
               '</td>', 
               "</tr>\n" );
    }
    $ldap->unbind();
}

print <<HTML_FOOTER;
      </table>
    </div>
  </body>
</html>
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( '<tr><td>dn: ', $dn, "</td>\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( "<td>$resultstring</td></tr>\n" );
            $returnedcount++;
        }
        $mesg->pop_entry();
    }
}

        [download]

        Updated: 06 Dec 2003 - Added *untested* SIGALRM to try to send something to the browser periodically.

[reply]
[d/l]

Back to Seekers of Perl Wisdom