John Peacock wrote:
John Peacock wrote:
I'm going to check in a patch which will cause this to work, instead:
my $auth_user = $self->auth_user();
as soon as I decide the best way to do that.
OK, I've done this now (to branches/0.31) so that the following does
what one might expect (note this is all that is required to implement
what Anil was asking for):
#!/usr/bin/perl -w
sub hook_mail {
my ($self, $transaction, $sender, $header) = @_;
my $auth_user = $self->auth_user();
my $auth_mechanism = $self->auth_mechanism();
if ( $auth_user && $sender ne $auth_user ) {
return (DENY,
"DENY : From: $sender :: Auth : $auth_user/$auth_mechanism");
}
else {
return DECLINED;
}
}
John
p.s. yes, that means that Qpsmtpd::Address objects now overload the
comparison operators
What if the sender is the auth login user, but verped?
sub auth {
my ( $self , $transaction , $sender ) = @_ ;
my ( $auth , $r , $dummy ) = ( 0 , 0 , 0 ) ;
$sender
= $self->strip_verp ( $sender || $self->from ( $transaction ) ) ;
my $connection = $self->qp->connection ;
my $mta = $self->qp->config( 'me' ) ;
my $from_esc_at = $sender ;
$from_esc_at =~ s/(\x40)/\x40/ ;
foreach $r ( $transaction->header->get( 'Received' ) ) {
( $dummy , $auth )
= ( $r =~ /.*(smtp-auth).*($from_esc_at).*($mta).*/ ) ;
return $auth if $auth ;
}
return $auth ;
}
sub strip_verp {
my ( $self , $address ) = @_ ;
my ( $verp , $localpart , $domain ) = () ;
if ( $address =~ /^srs[01]/i ) {
( $verp , $localpart , $domain )
= ( $address =~ /([EMAIL PROTECTED]@=-])(.*)\@(.*$)/i ) ;
}
else {
( $verp , $localpart , $domain )
= ( $address =~ /([EMAIL PROTECTED]@=-]|^)(.*)\@(.*$)/ ) ;
}
return lc $localpart . '@' . $domain ;
}
sub from {
my ( $self , $transaction ) = @_ ;
my $from = $transaction->header->get( 'From' ) ;
( $from ) = ( $from =~ /^[^<]*<([^>]+).*$/ ) ;
chomp $from ;
my $sender = $transaction->header->get( 'Sender' ) ;
if ( $sender ) {
( $sender ) = ( $sender =~ /^[^<]*<([^>]+).*$/ ) ;
chomp $sender ;
$from = $sender ? $sender : $from ;
}
return lc $from ;
}
-Bob
