Now for the tools. There's a lot here, but in further articles you will see how this can be useful. I'll go through each tool with what it does, how to call it, and then the code itself.

NOTE: This uses the foundations in parts 1 and 2. You can find them here: Part 1 Part 2

Simple Anonymous Bind
Use this if you are only doing read operations. This will only work if your LDAP server allows anonymous reads.

&ldapBindAnon;

sub bindLdapAnon{
$base= "$defaultBase";
$ldap = Net::LDAP->new ( "$secondaryLdap" ) or die "$@";
$ssl = new IO::Socket::SSL("$secondaryLdap:636");
$mesg=$ldap->start_tls(verify => 'none',
cafile => $caFile,
ciphers=> 'AES256-SHA');
$ldap->bind;
}


Authenticated Bind
Use for write operations

my $bindResult = &bindLdapAuth($username,$password)

sub bindLdapAuth{
my ($user,$passwd) = @_;
my $dn;
if ( $user =~/^$/ ){
$dn = "cn=Manager,$defaultBase";
}elsif ($user =~/Manager/){
$dn = "cn=Manager,$defaultBase";
} else {
$dn = "uid=$user,$peopleBase";
}
$base= "$defaultBase";
$ldap = Net::LDAP->new ( "$primaryLdap" ) or die "$@";
$ssl = new IO::Socket::SSL("$primaryLdap:636");
$mesg=$ldap->start_tls(verify => 'none',
cafile => "$cafile",
ciphers=> 'AES256-SHA');
$mesg = $ldap->bind( "$dn",
password => $passwd,
version => 3);
my $code = $mesg->code;
return $code;
}

Unbind When you are done.

&unbindLdap;

sub unbindLdap{
$ldap->unbind;
}

Search LDAP
This is required by a lot of later operations. Typically I use this for searching for uids.

my $searchResult = &ldapSearch($searchString,$base,$attrs);

sub ldapSearch {
my ($searchString,$base,$attrs) = @_;
if (!$base ) { $base = "$peopleBase"; }
if (!$attrs ) { $attrs = [ 'uid','givenName' ]; }
my $result = $ldap->search ( base => "$base",
scope => "sub",
filter => "$searchString",
attrs => "$attrs"
);
}

Modifying an existing attribute for a user
my $modResult = &ldapModify($uid,$attribute,$value);

sub ldapModify {
my ($uid,$attribute,$value) = @_;
my $dn = "uid=$uid,$peopleBase";
my $resultmod = $ldap->modify( $dn,
changes => [
replace => [$attribute => $value]
]
);
my $code = $resultmod->code;
return $code;
}

Add an attribute for a user

my $addResult = &ldapAdd($uid,$attribute,$value);

sub ldapAdd {
my ($uid,$attribute,$value) = @_;
my $dn = "uid=$uid,$peopleBase";
my $resultmod = $ldap->modify( $dn,
changes => [
add => [$attribute => $value]
]
);
my $code = $resultmod->code;
return $code;
}

Delete an attribute for a user
Requires that you know the value, have not looked into why. Use &ldapGetUserAttribute to get the value first.

my $deleteResult = &ldapDelete($uid,$attribute,$value);

sub ldapDelete {
my ($uid,$attribute,$value) = @_;
my $dn = "uid=$uid,$peopleBase";
my $resultmod = $ldap->modify( $dn,
changes => [
delete => [$attribute => $value]
]
);
my $code = $resultmod->code;
return $code;
}

Retrieve one attribute

my $attributeValue = &getUserAttribute($uid,$attribute);

sub getUserAttribute{
my ($uid,$attribute) = @_;
my $resultsearch = ldapSearch ("uid=$uid",$base,$attribute);
my @entries = $resultsearch->entries;
my $entr;
my $value;
foreach $entr (@entries){
my $dn = $entr->dn;
my $attr;
foreach $attr (sort $entr->attributes){
if ($attr =~ /^$attribute$/) {
$value = $entr->get_value($attr);
}
}
}
return $value;
}

Get a full User List

my @users = &getUserList;

sub getUserList{
my $base = "$peopleBase";
my @Attrs=("uid","givenName","sambaPwdMustChange");
my $resultsearch = ldapSearch ("uid=*",$base,@Attrs);
my @entries = $resultsearch->entries;
my $entr;
my @users;
foreach $entr (@entries){
my $dn = $entr->dn;
my $uid = $entr->get_value('uid');
push (@users,$uid);
}
return @users;
}


Get Full Group List

my @groupList = &getGroupList;

sub getGroupList{
my $base = "$groupBase";
my @Attrs=("cn");
my $resultsearch = ldapSearch ("cn=*",$base,@Attrs);
my @entries = $resultsearch->entries;
my $entr;
my @groups;
foreach $entr (@entries){
my $dn = $entr->dn;
my $cn = $entr->get_value('cn');
push (@groups,$cn);
}
return @groups;
}

Get Members of a Group

my @groupMembers = &getGroupMembers($group);

sub getGroupMembers{
my ($group) = @_;
my @Attrs=("cn","memberUid");
my $resultsearchGroups = ldapSearch ("cn=$group",$base,@Attrs);
my @groupEntries = $resultsearchGroups->entries;
my $entr;
my @group;
foreach $entr ( @groupEntries ) {
my $dn = $entr->dn;
my $attr;
foreach $attr ( sort $entr->attributes ) {
if ($attr =~ /memberUid/){
my $member;
foreach $member ($entr->get_value ($attr)){
push (@group,$member);
}
}
}
}
return @group;
}

Get membership for a group

my @groupMembership = &getGroupMembership($uid);

sub getGroupMembership{
my ($uid) = @_;
my @Attrs=("cn","memberUid");
my $resultSearchGroups = &ldapSearch("cn=*",$groupBase,@Attrs);
my @entries = $resultSearchGroups->entries;
my $entr;
my @groups;
foreach $entr (@entries){
my $attr;
my $cn;
foreach $attr (sort $entr->attributes ) {
if ($attr =~ /cn/) {
$cn = $entr->get_value($attr);
}
if ($attr =~ /memberUid/) {
my @members = $entr->get_value ( $attr);
my $member;
foreach $member (@members){
if ($member eq $uid){
push (@groups,$cn);
}
}
}
}
}
return @groups;
}

Take a difference of UNIX time and make it human readable
I use this when calculating expiring accounts...

&diffTime($unixTimeToDiff)

sub diffTime{
(my ($timeToDiff)) = @_;
my $now = time;
my $diff = $timeToDiff - $now;
my $days = int($diff / 86400);
my $hours = int($diff / 3600);
my $minutes = int($diff /60);
if ($days == 0){
if ($hours == 0){
return "$minutes minutes";
}else{
return "$hours hours";
}
}else{
return "$days days";
}
}

Convert days to seconds
I use this when I am going to add days to unix time (for instance when I need to update an expiration time) This is just a shortcut for simple math. It adds a number of days, to the second, from right now.

my $newTime = &addDays($numberOfDaysToAdd);

sub addDays{
my ($daysToAdd) = @_;
return $daysToAdd * 86400 + time;
}

Send off an email
Shortcut to fire off an email.

&sendMailToUser($from,$to,$cc,$bcc,$subject,@message);

sub sendMailToUser{
my ($from,$to,$cc,$bcc,$subject,@message) = @_;
my $server = "$mailServer";
my %mail;
$mail{Smtp} = $server;
$mail{From} = $from;
$mail{To} = $to;
$mail{Cc} = "$cc";
$mail{Bcc} = $bcc;
$mail{Subject} = "$subject";
$mail{Message} = "@message";
sendmail %mail;
}

Generate a username from Frist Last
This will put a username into the format of firstInitalLastName (IE: Sean Hart turns into shart) Fairly standard username format. Will put up with apostrophes and spaces in lastname (IE: O'Hara and Von Drake)

my $username = &genUserName($firstName, $lastName

sub genUserName{
my ($firstName,$lastName) = @_;
my $holdFirstname = $firstName;
my $holdLastName = $lastName;
my $letters = length ($firstName);
while ($letters > 1) {
chop ($firstName);
$letters = length ($firstName);
}
my $firstInitialLc = lc $firstName;
my $lastNameLc = lc $lastName;
#remove all spaces from $lastName in case of prefixes etc
$lastNameLc =~ s/\s//g;
my $userName = "$firstInitialLc" . "$lastNameLc";
$userName =~ s/'//;
return $userName;
}

Check Password Complexity
Requires password have 3 of 4 character classes and be at least 8 characters long

my$complex = &checkPassComplexity($password);

sub checkPassComplexity{
my ($passToCheck) = @_;
my $complexPoints;
if ($passToCheck =~ /[A-Z]/){
$complexPoints += 1;
}
if ($passToCheck =~ /[a-z]/){
$complexPoints += 1; }
if ($passToCheck =~ /[0-9]/){
$complexPoints += 1;
}
if ($passToCheck =~ /\W/) {
$complexPoints += 1;
}
if (length($passToCheck) $complexPoints = 0;
}
if ($passToCheck =~ /\s/){
$complexPoints = 0;
}
if ($complexPoints return 1;
}else {
return 0;
}
}

Generate a random password of n characters
Defaults to 25 characters

my$randomPassword = &genRandomPassword($n);

sub genRandomPassword {
my $password;
my $_rand;

my $password_length = $_[0];
if (!$password_length) {
$password_length = 25;
}

my @chars = split(" ", "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m
n o p q r s t u v w x y z - _ % # | 0 1 2 3 4 5 6 7 8 9");

srand;

for (my $i=0; $i $_rand = int(rand 67);
$password .= $chars[$_rand];
}
return $password;
}

Generate password hashes
Will give you an SHA, and LanMan and NT hashes (for use with samba + LDAP)

my @hashes = &genPasswordHashes($password);
my $shaHash = $hashes[0];
my $lanManHash = $hashes[1];
my $ntHash = $hashes[2];

sub genPasswdHashes{
my ($passwd) = @_;
my @return;
my $hashedPasswd = '{SHA}' . sha1_base64($passwd) . '=';
my $lm;
my $nt;
ntlmgen($passwd, $lm, $nt);
@return =("$hashedPasswd","$lm","$nt");
return @return;
}

Generate date for better sorting
Puts date into YYYYMMDD format for sorting

my $date=&genDate;

sub genDate{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
my $day = $mday;
$year += 1900;
$mon += 1;
if ($mon $mon = "0" . "$mon";
}
if ($day $day ="0" . "$day";
}
return "$year"."$mon"."$day";
}

Round up
Round a number up. Useful when rounding up dollars/cents etc.


sub roundup {
my $n = shift;
return(($n == int($n)) ? $n : int($n + 1))
}

Reading and writing files
Shortcut for reading and writing files

my $data = &read_file($path_to_file);
&write_file($path_to_file,@data);

sub read_file {
my ( $f ) = @_;
open (F, " my @f = ;
close F;
return wantarray ? @f : \@f;
}
sub write_file {
my ( $f, @data ) = @_;
@data = () unless @data;
open F, "> $f" or die "Can't open $f : $!";
print F @data;
close F;
}

Print a webpage header
This simply does a lot of header information for cgi scripts, and sets a lot of things that really belong in css. As I was just whipping these out, and each script was on it's own subdomain css didn't make sense.

&printHeader;

sub printHeader{
my $title = $_[0];
my $cookie = $_[1];
if ($cookie =~ /^$/){
print header(-charset => "ISO10646") ,
}else{
print header(-charset => "ISO10646", -cookie => $cookie) ,
}
print start_html($title),
'

',
"

$title

",;
}

Print Login Form

&printLogin;

sub printLogin{
print start_form,
"


","

",
"


","

",
"