An SMTP AUTH plug-in to interface with djb's checkpassword interface.

#!/usr/bin/perl -w
 
# by Michael Holzt
# adapted by Johan Almqvist 2006-01-18
 
sub register {
     my ( $self, $qp ) = @_;
 
     $self->register_hook( "auth-plain", "authcpw" );
     $self->register_hook( "auth-login", "authcpw");
 
}
 
sub authcpw {
     my ( $self, $transaction, $method, $user, $passClear, $passHash,  
$ticket ) =
       @_;
 
     my $binary = $self->qp->config("smtpauth-checkpassword")
       or return (DECLINED);
     return(DECLINED) if ( ! -x $binary );
 
     my ($untainted) = $binary =~ /^(.*)$/;
 
     open(CPW,"|$untainted /usr/bin/true 3<&0");
     # checkpassword will fail if it's not give something to execute.
     # Probably a bad idea to hard-code the path. -Johan
     printf(CPW "%s\0%s\0Y123456\0",$user,$passClear);
     close(CPW);
 
     my $status = $?;
 
     return(DECLINED) if ( $status != 0 );
    $self->connection->notes('authuser',$user);
    # This should probably be in lib/Qpsmtpd/Auth.pm instead... -Johan
$self->connection->relay_client(1);
return ( OK, "authcheckpassword" );
}