Overview#

An Example code we put together to help out with the semantics of a How To for adding a user to LDAP (Microsoft Active Directory specifically) using Perl in the sample.

Often the hard part of connecting to AD using LDAP is determining the FDN of the user to login with.

NOTE: We specifically do NOT set a password as Microsoft Active Directory requires at least 128 bit SSL do set passwords.

#!/usr/bin/perl

use warnings;
use strict;

use Net::LDAP;
use IO::Socket;
use IO::Socket::INET;

my $base  = "CN=Users,DC=mad,DC=yourdomain,DC=com";
my @Attrs = (
    "accountexpires",     "badpasswordtime",
    "badpwdcount",        "cn",
    "displayname",        "distinguishedname",
    "givenname",          "instancetype",
    "lastlogoff",         "lastlogon",
    "lastlogontimestamp", "logoncount",
    "memberof",           "name",
    " objectcategory",    "objectclass"
);

my $ldapconnect =
  Net::LDAP->new( "mad.yourdomain.com", version => 3, port => 389 );

print "\n";

my $bind =
  $ldapconnect->bind( "CN=Administrator,CN=Users,DC=mad,DC=yourdomain,DC=com",
    password => "secret" );
if ( $bind->code ) {
    LDAPerror( "Bind: ", $bind );
}
print "\n";

my $currentCN = "testFour";
my $currentDN = "CN=".$currentCN.",".$base;

my $addrs =
  addAdUser( $ldapconnect, $currentDN,
    $currentCN, "User", "User.$currentCN", $currentCN );
if ( $addrs->code ) {
    LDAPerror( "Bind: ", $addrs );
}

# We need to wait a little bit for AD to add the user...
print "waiting ..";
my $num = 10;
while($num--)
{
    sleep(1);
    print ".";
}
print "\n";

my $results = LDAPsearch( $ldapconnect, "cn=".$currentCN, \@Attrs, $base );
DisplayResults($results);

sub LDAPsearch {
    my ( $ldap, $searchString, $attrs, $base ) = @_;

    # if they don't pass a base... set it for them

    if ( !$base ) { $base = "o=mycompany, c=mycountry"; }

    # if they don't pass an array of attributes...
    # set up something for them

    if ( !$attrs ) { $attrs = [ 'cn', 'mail' ]; }

    my $sr = $ldap->search(
        base   => "$base",
        scope  => "sub",
        filter => "$searchString",
        attrs  => $attrs
    );
}

sub DisplayResults {
    my ($results) = @_;

    #------------
    #
    # Accessing the data as if in a structure
    #  i.e. Using the "as_struct"  method
    #

    my $href = $results->as_struct;

    # get an array of the DN names

    my @arrayOfDNs = keys %$href;    # use DN hashes

    # process each DN using it as a key

    foreach (@arrayOfDNs) {
        print $_, "\n";
        my $valref = $$href{$_};

        # get an array of the attribute names
        # passed for this one DN.
        my @arrayOfAttrs = sort keys %$valref;    #use Attr hashes

        my $attrName;
        foreach $attrName (@arrayOfAttrs) {

            # skip any binary data: yuck!
            next if ( $attrName =~ /;binary$/ );

            # get the attribute value (pointer) using the
            # attribute name as the hash
            my $attrVal = @$valref{$attrName};
            print "\t $attrName: @$attrVal \n";
        }
        print "#-------------------------------\n";

        # End of that DN
    }

    #
    #  end of as_struct method
    #
    #--------

    #------------
    #
    # handle each of the results independently
    # ... i.e. using the walk through method
    #

    my @entries = $results->entries;

    my $entr;
    foreach $entr (@entries) {
        print "DN: ", $entr->dn, "\n";

        my $attr;
        foreach $attr ( sort $entr->attributes ) {

            # skip binary we can't handle
            next if ( $attr =~ /;binary$/ );
            print "  $attr : ", $entr->get_value($attr), "\n";
        }

        print "#-------------------------------\n";
    }

    #
    # end of walk through method
    #------------

    sub LDAPerror {
        my $unknown = "not known";

        my ( $from, $mesg ) = @_;
        print "Return code: ", $mesg->code;
        print "\tMessage: ",   $mesg->error_name;
        print " :",            $mesg->error_text;
        print "MessageID: ",   $mesg->mesg_id;
        my $dn = $mesg->dn;
        if ( !$dn ) { $dn = $unknown; }
        print "\tDN: ", $dn;

        #---
        # Programmer note:
        #
        #  "$mesg->error" DOESN'T work!!!
        #
        #print "\tMessage: ", $mesg->error;
        #-----
    }

    sub addAdUser {
        my ( $ldap, $dn, $cn, $sn, $displayName, $givenName ) = @_;
        $ldap->add(
            $dn,
            attr => [
                'cn'          => $cn,
                'sn'          => $sn,
                'displayName' => $displayName,
                'givenName'   => $givenName,
                'objectclass' =>
                  [ "top", "person", "organizationalPerson", "user" ]
            ]
        );
    }
}

More Information#

There might be more information for this subject on one of the following:

• Perl LDAP Samples