Re: auth_ldap using tinyldap on localhost

[Bob]

From - Sun Apr 10 15:34:50 2005
X-Spam-Check-By: la.mx.develooper.com
Received-SPF: pass (x1.develooper.com: domain
of [EMAIL PROTECTED] designates 67.99.13.172 as permitted sender)
Message-ID: <[EMAIL PROTECTED]>
Date: Sun, 10 Apr 2005 12:04:40 -0400
From: Bob <[EMAIL PROTECTED]>
To: qpsmtpd@perl.org
Subject: auth_ldap using tinyldap on localhost
http://perlq.org/tinyldap/auth_ldap.html
http://perlq.org/tinyldap/
./plugins/extra/auth_ldap works
....April 10, 2005, plugin named "auth_ldap", "works".
April 13, 2005, "auth_ldap" still works. I use Net::LDAP::Entry
to skip some iteration and the superfluous anonymous bind.
Any thoughts yet?
-Bob Dodds
use Net::LDAP ;
use Net::LDAP::Entry ;
use Digest::HMAC_MD5 qw( hmac_md5_hex ) ;
my $VERSION = '0.01' ;
my %LDAPSEARCH = map { $_ => 1 } qw ( ip port base_dn timeout 
filter_attr target ) ;
my %DEFAULTS = (
ip => "127.0.0.1" ,
port => 389 ,
base_dn => "o=q" ,
timeout => 5 ,
filter_attr => "mail" ,
target => "userPassword" ) ;

sub register {
my ( $self , $qp , %arg ) = @_ ;
my $config = { %DEFAULTS ,
 map { split /\s+/ , $_ , 2 } $self->qp->config( 'authldap' ) , %arg } ;
  if ( my @bad = grep { ! exists $LDAPSEARCH{$_} } sort keys %$config ) {
   $self->log( LOGERROR , "invalid parameter(s): " . join( ',' , @bad ) ) ;
}
my $ip = "" ;
map {
 $ip = (
             ( $_ || 0 ) > ( length ( $ip ) ? -1 : 0 )
             and
             ( ( $_ || 0 ) >= 0 ? $_ : 256 ) < 256
           )
           ? $ip . $_ . "."
           : $ip
        } split ( /[^0-9]+/ ,  $config->{ip} ) ;
$config->{ip} = (
          index ( $ip , '.' , index ( $ip , '.' ,  index ( $ip , '.' ) 
+ 1 ) + 1 ) >= 0
          and
          substr ( $ip , rindex ( $ip , '.' , length ( $ip ) - 2 ) + 1 
) > 0
        )
        ? substr ( ( join "." , split ( /\./ , ( $ip || "bad" ) , 4 ) ) 
, 0 , -1 )
        : "" ; # <---empty because 0=IP=0.0.0.0, not for plaintext 
passwords

if ( int $config->{port} and $config->{port} >= 389 and $config->{ip} ) {
 $self->register_hook( "auth-cram-md5" , "authldap" ) ;
 $self->{_authldap_config} = $config ;
}
else {
 $self->log( LOGWARN, "authldap - config error ip $config->{ip} or port 
$config->{port}" ) ;
}
}

sub authldap {
   my ( $self , $transaction , $method , $user , $passClear , $passHash 
, $ticket ) =
     @_ ;
   my $config = $self->{_authldap_config} ;
   my ( $auth_pass , $pw_name , $pw_domain ) = ( 0 , split "@" , lc ( 
$user ) ) ;

   unless ( defined $pw_domain ) {
       return DECLINED;
   }
  my ( $ldip , $ldport , $ldbase , $ldwait , $ldmattr , $ldpwd ) =
    ( $config->{ip} ,
      $config->{port} ,
      $config->{base_dn} ,
      $config->{timeout} ,
      $config->{filter_attr} ,
      $config->{target} ) ;
  my $ldh = Net::LDAP->new( $ldip , port => $ldport , timeout => 
$ldwait ) or
   $self->log( LOGWARN , "authldap - new\(\) error: " , $@ ) &&
   return DECLINED ;

  my $mesg = $ldh->search(
   base => $ldbase ,
   filter => "\([EMAIL PROTECTED])" ,
   attrs => [ $ldpwd ] ,
   sizelimit => 2 ) or
     $self->log( LOGWARN, "authldap - search error" ) &&
     return DECLINED ;
  $ldh->unbind if $ldh ;
  $auth_pass = $mesg->entry->get_value( $ldpwd )
   if $mesg->count == 1 ;
  $ldh->disconnect if $ldh ;
   return DECLINED unless $auth_pass ;
   my $hmac = "" ;
   if (
       ( defined $passClear
           and $auth_pass eq $passClear ) or
       ( defined $passHash and ( $hmac = hmac_md5_hex ( $ticket , 
$auth_pass ) )
           eq $passHash )
     )
   {
     # $self->log( LOGDEBUG , "authldap/$method OK passHash "
     #  . $passHash . " hmac " . $hmac ) ;
       return OK ;
   }
   else {
     # $self->log( LOGDEBUG , "authldap/$method DENY auth_pass "
     # . substr ( $auth_pass , 1 , 3 ) ) ;
       return DENY ;
   }
}