Re: [perl #38268] checkpassword support

[Johan Almqvist via RT]

On Jan 18, 2006, at 13:18, Ask Bjoern Hansen (via RT) wrote:
> # New Ticket Created by  Ask Bjoern Hansen
> # Please include the string:  [perl #38268]
> # in the subject line of all future correspondence about this issue.
> # <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=38268 >

Here's a fixed-up version that actually works (for me)

#!/usr/bin/perl -w

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