Re: [perl #38268] checkpassword support

[Johan Almqvist]

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