#auth.pl version 1.3
#global variables:
#$uid= userid of logged in user
#param('pass1')= new password 
#param('pass2')= verification of new password
#param('authuser') = id of user to change password for (if $uid is manager)
#$ismanager=set to true if logged in user is Cyrus imap manager uid

#required functions for a generic auth.pl
# &auth_changepass - returns 0 for success
# &auth_getuserserver - returns a server name or 0;

use Net::LDAP;
use Net::LDAP::Util qw(ldap_error_text);

my $dn;
sub auth_disconnect {
	$ld->unbind if $ld;
	undef ($ld);
}

sub auth_getdn {
	my ($ld,$uid)=@_;
#  Since we've entered our UID, not our CN, we must first find the DN of a
#  person who matches the UID in $ldap_bind_uid
	return -1 if ($ld < 0);
        @attrs = ();
        $filter = "(uid=$uid)";
        $result=$ld->search(base=>$LDAP_BASEDN,scope=>"sub",filter=>$filter,attrs=>\@attrs);
	if ($result->code)
 	
        {
	   $ld->unbind;
	   return -1;
        }

#  Obtain a pointer to the first entry matching our query.  We are making the
#  assumption that since UID means Unique ID that this is the only time we
#  need to do this.
 
        @entries=$result->entries;
	$ent=$entries[0];
        if ($ent )
        {
#  We only need the DN from the entry we matched.
	    $dn = $ent->dn;
       	    my $user=$ent->get_value('uid');
	    if ($uid ne $user) { 
		$ld->unbind;
		return -1; #Failure
	    }
	    return $dn;
	}
	return 0;
}	

sub auth_connect {
	my ($uid,$pass)=@_;
#  First initialize our connection to the LDAP Server and bind anonymously.

	$ld = Net::LDAP->new($LDAP_SERVER) or die "$@";

	$mesg=$ld->bind;
	if ($mesg->code)
	{
	  print "Error:  Unable to Bind Anonymously to the Directory.",p;
	  print "bind_s: " .  ldap_error_text($mesg->code) . "\n";
	  $ld->unbind;
	   return -1;
	}

	$dn=&auth_getdn($ld,$uid); 
	return -1 if !$dn; #Failure

#  Attempt to bind with the DN and Password supplied previously.
	  $mesg=$ld->bind($dn,password=>$pass);
	  if ($mesg->code)
          {
	      $ld->unbind;
	      print "Error binding to $dn!!!";
	      return -1;  # Return Failure
	  }

          return $ld;  # Return Success
}

sub auth_getuserserver {
	  $mailhostatt='mailroutingaddress' if !$mailhostatt;
# Get the mail server address for imap
	  my $err=&auth_connect($uid,$pass);
	  if ($err<0) {
	  	$err='';
	  	&auth_disconnect;
		return -1 ;
	  }
	  $err='';
	  my (@mra)=$ent->get_value($mailhostatt);
	  if ($mra[0]) {
	  	$imapserver=$mra[0];
	  }
	  if ($imapserver) {
		&auth_disconnect;
	  	return $imapserver;
	  }
	  else {
	  	&auth_disconnect;
	  	return '';
	  }
}

sub encrypt {
	my ($pass1)=@_;
	      $chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";

#  Seeding with time and proccess id is not normally recommended, but we're
# only generating the salt, not the password.

	      srand( time() ^ ($$ + ($$ << 15)) );
	      $salt = "";
	      for ($i = 0; $i <2; $i++)
	      {
	         $saltno = int rand length($chars);
	         $mychar = substr($chars,$saltno,1);
	         $salt = $salt . $mychar;
	      }
	      $pass1 = "{CRYPT}".crypt $pass1, $salt;
	      return $pass1;
}

sub auth_changepass {
	
#  Lets Check the Password... If non-empty, encrypt and add to %ldapmod
	my $err;
	my $pass1 = param("pass1");
	my $pass2 = param("pass2");
	my $authuser = param('authuser');
	param('pass1','');
	param('pass2','');
	param('authuser','');

	if (!$pass1 && !$pass2) {return 0;}
	if ($pass1 eq "" || $pass2 eq "")
	{
		return 0;
	} else {
	   if ($pass1 eq $pass2)
	   {
# Encrypt as necessary...
	     if ($ENCRYPT_PASS == 1)
	     {
	     $pass1=&encrypt($pass1);
	     }
	     $ldapmod{'userPassword'} = $pass1;
	     print "<p><b>Warning:</b> You must login with your new password by clicking <a href=" . $program_url . "?op=login>HERE</a>\n</p>" if !$authuser;

	   } else {
	      print "<p><b>Warning:</b> Passwords Did Not Match...Not Changed...\n</p>";
	      return 1;
	   }
	 }
#  Perform a synchronous MODIFY operation on our $dn

	@change_keys = keys %ldapmod;
	  if ($#change_keys >= 0)
	  {
	    if (($ld=&auth_connect($uid,$pass))<0) {
	      print "<b>Password change:</b> Unable to bind to Ldap server...\n",p;
	      print "Ldap error: ".ldap_error_text($mesg->code)  . "\n";
	      exit;
	    }
	    if ($authuser) {
	    	$dn=&auth_getdn($ld,$authuser);	
		if (!$dn) {
			 $err= "<b>Password change:</b>  $authuser does not exist in directory<br>";
		}
	    }
	    $result=$ld->modify($dn,replace=>{%ldapmod}) if !$err; 
	    if ($result->code)
	    {
	      $err= "Password change for $dn: Unable to Modify Entry...\n",br;
	      print "Ldap Error: ".ldap_error_text($result->code) . "\n";
	    }
	  }
	 &auth_disconnect; 
         if (!$err) {
	   print "<b>Password Modified...</b>\n";
	   exit if (!$authuser);
	   return 0;
	}
	else {
		print "<p>$err</p>";
		return 1 ;
	}
}
sub auth_saveattrib {
	my ($att,$val)=@_;
	$ldapmod{$att}=$val;
	my $ld=&auth_connect($uid,$pass);
	return -1 if ($ld < 0);
	my $dn=&auth_getdn($ld,$uid);	
	my $res=&auth_changeatt($ld,$dn,$att,$val);
	return $res;
}

sub auth_getattrib {
	my ($att)=@_;
	my $ld=&auth_connect($uid,$pass);
        my $dn=&auth_getdn($ld,$uid);
        my $val=&auth_getatt($ld,$dn,$att);
	return $val;
}

sub auth_changeatt {
	my ($ld,$dn,$att,$val)=@_;
	return -1 if ($ld < 0);
	$ldapmod{$att}=$val;
	$result=$ld->modify($dn,replace=>{%ldapmod});
	 if ($result->code)
	    {
	      print "Ldap Error: ".ldap_error_text($result->code) . "\n";
	    }
	return $result->code;
}
sub auth_getatt {
	my ($ld,$dn,$att)=@_;
	return -1 if ($ld < 0);
	my $result=$ld->search(base=>$dn,filter=>"(objectclass=*)");
	if ($result->code) {
		return;
	}
	my @ent=$result->entries;
	my @val=$ent[0]->get_value($att);
	return $val[0];

}

1;


syntax highlighted by Code2HTML, v. 0.9.1