# 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 >



It'd be nice to support checkpassword for SMTP AUTH.

Something like Michael Holzt's plugin at:

http://qpsmtpd.kju.de/qpsmtpd/created_by_me/authcheckpassword/
authcheckpassword


#!/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 3<&0");
      printf(CPW "%s\0%s\0Y123456\0",$user,$passClear);
      close(CPW);

      my $status = $?;

      return(DECLINED) if ( $status != 0 );
      return ( OK, "authcheckpassword" );
}


-- 
http://askask.com/  - http://develooper.com/

Reply via email to