Just to wrap up, and in case you are lazy like me, give you a whole file worth of subroutines. It's my toolbox and I'm giving it to you. I put this in a secure location and just call it from my other scripts. This makes the code much shorter in my other scripts, nearly auto-commenting, and avoids bugs because if it works in one, it will work in others.

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

To use:

#!/usr/bin/perl
require "/path/to/subs.pl";


The Code:

#!/usr/bin/perl

use strict;

use Net::LDAP;
use Authen::SASL;
use IO::Socket::SSL;
use Digest::SHA qw/sha1_base64/;
use Mail::Sendmail;
use Crypt::SmbHash;
use CGI;
use CGI qw/:standard/;

my $base;
my $ldap;
my $ssl;
my $mesg;
my $CGI;
my $secondaryLdap = "secondaryLdap.example.com";
my $primaryLdap = "primaryLdap.example.com";
my $caFile = '/location/of/certificate/authority/file.txt';
my $defaultBase = "dc=example,dc=com";
my $peopleBase = "ou=People,dc=example,dc=com";
my $groupBase = "ou=Groups,dc=example,dc=com";
my $mailServer = "mail.example.com";
my $adminEmail = "admin\@example.com";

#Simple Anonymous Bind, call as &bindLdapAnon;
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;
}

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;
}

sub unbindLdap{
$ldap->unbind;
}

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"
);
}

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;
}

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;
}

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;
}

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;
}

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;
}

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;
}

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;
}

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;
}

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";
}
}

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

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";
my $key;
sendmail %mail;
}

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;
}

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;
}
}

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;
}

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;
}

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;
}

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

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";
}

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

",;
}

sub printLogin{
print start_form,
"

","

",
"

","

",
"

",
submit,end_form;
}

1;