[svn:qpsmtpd] r694 - contrib/hjp/smtp_callback
[email protected] Sun, 17 Dec 2006 05:11:23 -0800 (PST)
| Newsgroups | perl.cvs.qpsmtpd |
|---|---|
| Message-ID | <[email protected]> |
Author: hjp Date: Sun Dec 17 05:11:23 2006 New Revision: 694 Added: contrib/hjp/smtp_callback/ contrib/hjp/smtp_callback/BUGS contrib/hjp/smtp_callback/Makefile contrib/hjp/smtp_callback/Makerules contrib/hjp/smtp_callback/smtp_callback contrib/hjp/smtp_callback/smtpcbd (contents, props changed) Log: Added smtp_callback. Added: contrib/hjp/smtp_callback/BUGS ============================================================================== --- (empty file) +++ contrib/hjp/smtp_callback/BUGS Sun Dec 17 05:11:23 2006 @@ -0,0 +1,12 @@ +Oct 13 10:13:20 faceoff postfix/smtp[6948]: CC5BA2D02B: +to=<[email protected]>, relay=samkar.wsr.ac.at[143.130.16.20], delay=2, +status=bounced (host samkar.wsr.ac.at[143.130.16.20] said: 550 +<[email protected]> doesn't exist according to 143.130.16.20: 550 no +such user <[email protected]>. Unchanged since +2006-10-13T09:55:07+0200, next check 2006-10-13T09:55:07+0200 (#5.1.8) +(in reply to RCPT TO command)) + + next check 2006-10-13T09:55:07+0200 is obviously wrong as it is in + the past (looks like it is the same as the last change date). + + should be fixed in r233 Added: contrib/hjp/smtp_callback/Makefile ============================================================================== --- (empty file) +++ contrib/hjp/smtp_callback/Makefile Sun Dec 17 05:11:23 2006 @@ -0,0 +1,16 @@ +NAME=smtp_callback +FILES = \ + Makefile \ + Makerules \ + $(NAME) \ + smtpcbd \ + BUGS \ + +# still missing: $(PKG).spec + +all: + +clean: + rm -f $(PKG).tar.gz *.tmp + +include Makerules Added: contrib/hjp/smtp_callback/Makerules ============================================================================== --- (empty file) +++ contrib/hjp/smtp_callback/Makerules Sun Dec 17 05:11:23 2006 @@ -0,0 +1,15 @@ +PKG = qpsmtpd-plugin-$(NAME) +CONTRIB_BASE=~/wrk/qpsmtpd/contrib/hjp +CONTRIB_FILES=$(patsubst %, $(CONTRIB_BASE)/$(NAME)/%, $(FILES)) + +contrib: $(CONTRIB_FILES) + +$(CONTRIB_BASE)/$(NAME)/%: % + cp -p $^ $@ + +rpm: $(PKG).tar.gz + rpm -ta --clean --sign --rmsource $^ + +$(PKG).tar.gz: $(FILES) + tar cfz $@ $^ + Added: contrib/hjp/smtp_callback/smtp_callback ============================================================================== --- (empty file) +++ contrib/hjp/smtp_callback/smtp_callback Sun Dec 17 05:11:23 2006 @@ -0,0 +1,134 @@ +#!/usr/bin/perl +=head1 NAME + +smtp_callback - verify sender via smtp callback + +=head1 DESCRIPTION + +Plugin that checks if the envelope sender exists by contacting the MX of +the sender's domain and checking the results of the VRFY and RCPT TO commands. + +This method was pioneered by Exim in 2000, and is also supported by postfix. +It is somewhat controversial as there is some potential for DOS attacks +and the callbacks may be mistaken for address harvesting (for example, +gmail seems to block IP addresses which test a large number of addresses). +Using VRFY seems to be mostly useless currently as almost all MTAs which +support the command at all return a 252 (basically "don't know") reply, it +might help an MTA distinguishing between address checks and mail delivery +attempts. + +This plugin doesn't do the callbacks itself. Instead it relies on a server +(smtpcbd) to perform them. This allows several MXs to share a common database +of verified addresses. + +=head1 CONFIG + +Configured in the plugins file without any parameters, the +smtp_callback plugin will connect to 127.0.0.1:4571 and do callbacks +for all recipients. + +The format goes like + + smtp_callback option value [option value] + +Options being those listed below and the values being parameters to +the options. Confused yet? :-) + +=over 4 + +=item smtpcbd address[:port] + +Set the adress and optionally port number of th smtpcbd to contact. + +=item per_recipient 0|1 + +If set to a non-zero value, the sender will only be checked for recipients +which have the smtp_callback note set. Note that for this to work you +also need the address_notes plugin and a plugin to set the note for the appropriate +recipients (e.g. address_notes_aliases). + + +=back + +=head1 TODO + +=cut +use Qpsmtpd::DSN; +use IO::Socket::INET; +use POSIX; + +sub register { + my ($self, $qp, @args) = @_; + + $self->log(LOGERROR, "Bad parameters for the smtp_callback plugin") + if @_ % 2; + + %{$self->{_args}} = @args; + +} + +sub hook_rcpt { + my ($self, $transaction, $rcpt) = @_; + + return DECLINED if ($transaction->sender->format eq '<>'); + if ($self->{_args}{per_recipient} && ! $rcpt->notes('smtp_callback')) { + $self->log(LOGINFO, 'smtp_callback skipped'); + return DECLINED; + } + my $res = $transaction->notes('smtp_callback'); + if ($res) { + my ($code, $msg, $addr, $server, $timestamp, $expire) = split(/:/, $res); + if ($code eq 'FAIL') { + return Qpsmtpd::DSN->addr_bad_from_system("$addr doesn't exist according to $server:\n" . + "$msg\n", + "Unchanged since " . strftime("%Y-%m-%dT%H:%M:%S%z", localtime($timestamp)) . + ", next check " . strftime("%Y-%m-%dT%H:%M:%S%z", localtime($expire)) + ); + } else { + return DECLINED; + } + } + my $paddr = '127.0.0.1'; + my $port = 4571; + if ($self->{_args}{smtpcbd}) { + if ($self->{_args}{smtpcbd} =~ m/(.*):(.*)/) { + $paddr = $1; + $port = $2; + } elsif ($self->{_args}{smtpcbd} =~ m/^([-.a-z0-9]+)$/i) { + $paddr = $1; + } else { + $self->log(LOGERROR, "Bad parameter smtpcbd $self->{_args}{smtpcbd} for the smtp_callback plugin") + } + } + $self->log(LOGINFO, "connecting to smtpcbd at $paddr:$port"); + my $s = IO::Socket::INET->new(PeerAddr => $paddr, PeerPort => $port, Timeout => 60); + $s->print($transaction->sender->format, "\n"); + $res = $s->getline; + $self->log(LOGINFO, "smtpcbd: $res"); + return Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT, $transaction->sender->format ." cannot be verified (server unreachable?)") + unless ($res); + $transaction->notes('smtp_callback', $res); + my ($code, $msg, $addr, $server, $timestamp, $expire) = split(/:/, $res); + if ($code eq 'FAIL') { + my @r = Qpsmtpd::DSN->addr_bad_from_system("$addr doesn't exist according to $server: " . + "$msg. " . + "Unchanged since " . strftime("%Y-%m-%dT%H:%M:%S%z", localtime($timestamp)) . + ", next check " . strftime("%Y-%m-%dT%H:%M:%S%z", localtime($expire)) + ); + $self->log(LOGINFO, "failure: returning @r"); + return @r; + } elsif ($code eq 'TEMPFAIL') { + my @r = Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT, + "$addr has a temporary problem according to $server: " . + "$msg. " . + "Unchanged since " . strftime("%Y-%m-%dT%H:%M:%S%z", localtime($timestamp)) . + ", next check " . strftime("%Y-%m-%dT%H:%M:%S%z", localtime($expire)) + ); + $self->log(LOGINFO, "temp failure: returning @r"); + return @r; + } else { + $self->log(LOGINFO, "ok"); + return DECLINED; + } +} +# vim: tw=0 Added: contrib/hjp/smtp_callback/smtpcbd ============================================================================== --- (empty file) +++ contrib/hjp/smtp_callback/smtpcbd Sun Dec 17 05:11:23 2006 @@ -0,0 +1,300 @@ +#!/usr/bin/perl +use warnings; +use strict; + +use POSIX ":sys_wait_h"; +use IO::Socket::INET; +use Net::DNS; +use Sys::Hostname; +use Sys::Syslog; +use DBI; + +my $hostname = hostname(); + +my $configfile = $ARGV[0] || "/etc/smtp_callback/smtpcbd.conf"; +open (my $cfh, '<', $configfile) or die "cannot open $configfile: $!"; +my %cfg = ( + listen_port => 4571, + facility => 'LOG_DAEMON', +); +while (<$cfh>) { + chomp; + my ($k, $v) = split(/\s*:\s*/, $_, 2); + $cfg{$k} = $v; +} +close($cfh); + +detach(); + +my $ident = $0; +$ident =~ s{.*/}{}; +openlog $ident, 'pid', $cfg{facility}; + +my $lsck = IO::Socket::INET->new(Proto => 'tcp', + Listen => 20, + ReuseAddr => 1, + $cfg{listen_addr} ? ( LocalAddr => $cfg{listen_addr} ) : (), + LocalPort => $cfg{listen_port}, + ); +unless ($lsck) { + syslog('err', "cannot bind to socket %s:%d: %m", $cfg{listen_addr} || 'ANY', $cfg{listen_port}); + exit(1); +} +syslog('info', "listening on %s:%d", $cfg{listen_addr} || 'ANY', $cfg{listen_port}); + +my $terminate; +$SIG{TERM} = sub { $terminate = 1}; + +for (;;) { + if ($terminate) { + syslog('notice', "going down"); + exit(0); + } + my $rsck = $lsck->accept(); + my $pid = fork(); + unless (defined($pid)) { + syslog('err', "fork failed: %m"); + sleep(1); + next; + } + if ($pid) { + while ((my $pid = waitpid(-1, WNOHANG)) > 0) { + syslog('debug', "kid $pid terminated"); + } + next; + } + my $request = $rsck->getline(); + syslog('info', "get request [$request]"); + my ($address, @args) = split(' ', $request); + syslog('info', "address = %s, args = " . join(", ", ("%s") x @args), $address, @args); + + $address = "<$address>" unless $address =~ /^<.*>$/; + + syslog('info', __LINE__); + my $dbh = DBI->connect($cfg{cache_datasource}, $cfg{cache_user}, $cfg{cache_password}, + { } ); + syslog('info', __LINE__); + unless ($dbh) { + syslog('err', "cannot connect to cache $cfg{cache_datasource}: %s", $dbh->errstr); + exit(1); + } + syslog('info', __LINE__); + my ($email, $cstatus, $first_seen, $expire, $count, $msg, $server) = + $dbh->selectrow_array("select email, status, first_seen, expire, count, msg, server from smtpcb where email=?", {}, $address); + syslog('info', __LINE__); + if ($email && $expire > time()) { + syslog('info', "found in cache: %s %s %s %s %s %s %s", $email, $cstatus, $first_seen, $expire, $count, $msg, $server); + $rsck->print("${cstatus}:${msg}:${address}:$server:$first_seen:$expire\n"); + exit(0); + } + syslog('info', __LINE__); + + my $domain; + if ($address =~ /\@([-.a-z0-9]+)>?$/) { + $domain = $1; + syslog('info', "domain is $domain"); + } else { + syslog('info', "FAIL: no domain: $address"); + $rsck->print("FAIL: no domain: $address\n"); + exit 0; + } + my @mx = get_mx($domain); + + my $status; + MX: for my $mx (@mx) { + for my $ip ((@$mx)[2..$#$mx]) { + syslog('info', "trying ip $ip"); + eval { + local $SIG{ALRM} = sub { die "timeout" }; + alarm(120); + my $s = IO::Socket::INET->new(PeerAddr => $ip, PeerPort => 25, Timeout => 60); + unless ($s) { + syslog('info', "cannot connect to %s: %m", $ip); + next; + } + + while (my $r = $s->getline) { + syslog('info', "connect: %s", $r); + last if ($r =~ /^\d\d\d /); + } + $s->print("EHLO $hostname\r\n"); + my $ln = 0; + my $size = 0; + my $vrfy_supported; + my $esmtp; + while (my $r = $s->getline) { + syslog('info', "ehlo: %s", $r); + if ($r =~ /^250[- ]([-\w]+)/ && ++$ln > 1 && uc($1) eq 'VRFY') { + $vrfy_supported = 1; + } + $esmtp = 1 if ($r =~ /^250 /); + last if ($r =~ /^\d\d\d /); + } + unless ($esmtp) { + $s->print("HELO $hostname\r\n"); + while (my $r = $s->getline) { + syslog('info', "helo: %s", $r); + last if ($r =~ /^\d\d\d /); + } + } + if ($vrfy_supported && $cfg{use_vrfy}) { + alarm(120); + $s->print("VRFY $address\r\n"); + $msg = ""; + while (my $r = $s->getline) { + syslog('info', "vrfy: %s", $r); + $msg .= $r; + if ($r =~ /^250 /) { + $status = 'OK'; + $server = $ip; + syslog('info', "status=$status"); + } + if ($r =~ /^251 /) { + $status = 'OK'; + $server = $ip; + syslog('info', "status=$status"); + } + if ($r =~ /^550 /) { + $status = 'FAIL'; + $server = $ip; + syslog('info', "status=$status"); + } + if ($r =~ /^551 /) { + $status = 'FAIL'; + $server = $ip; + syslog('info', "status=$status"); + } + last if ($r =~ /^\d\d\d /); + } + } + unless (defined $status && $status ne 'TEMPFAIL') { + alarm(120); + $s->print("MAIL FROM:<>\r\n"); + while (my $r = $s->getline) { + syslog('info', "mail from: %s", $r); + $msg .= $r; + if ($r =~ /^2/) { + $status = 'OK'; + $server = $ip; + syslog('info', "status=$status"); + } + if ($r =~ /^4/) { + $status = 'TEMPFAIL'; + $server = $ip; + syslog('info', "status=$status"); + } + if ($r =~ /^5/) { + $status = 'FAIL'; + $server = $ip; + syslog('info', "status=$status"); + } + last if ($r =~ /^\d\d\d /); + } + if ($status eq 'OK') { + $status = undef; + $s->print("RCPT TO:$address\r\n"); + $msg = ""; + while (my $r = $s->getline) { + syslog('info', "rcpt to: %s", $r); + $msg .= $r; + if ($r =~ /^2/) { + $status = 'OK'; + $server = $ip; + syslog('info', "status=$status"); + } + if ($r =~ /^4/) { + $status = 'TEMPFAIL'; + $server = $ip; + syslog('info', "status=$status"); + } + if ($r =~ /^5/) { + $status = 'FAIL'; + $server = $ip; + syslog('info', "status=$status"); + } + last if ($r =~ /^\d\d\d /); + } + } + } + + + $s->print("QUIT\r\n"); + while (my $r = $s->getline) { + syslog('info', "quit: %s", $r); + last if ($r =~ /^\d\d\d /); + } + alarm(0); + }; + last MX if (defined($status) && $status ne 'TEMPFAIL'); + } + } + exit(0) unless defined($status); + $msg =~ s/(\r?\n)+$//; + $msg =~ s/%/%25/g; + $msg =~ s/:/%3A/g; + $msg =~ s/\r?\n/%0A/g; + if ($first_seen && $cstatus eq $status) { + $expire = int(time() + (time() - $first_seen) * 0.2); + } else { + $first_seen = time(); + $expire = $first_seen + 3600; + } + $rsck->print("${status}:${msg}:$address:$server:$first_seen:$expire\n"); + if ($email) { + if ($cstatus eq $status) { + $dbh->do("update smtpcb set expire=?, count=count+1, msg=?, server=? where email=?", {}, + $expire, + $msg, + $server, + $address); + } else { + $dbh->do("delete from smtpcb where email=?", {}, + $address); + $dbh->do("insert into smtpcb(email, status, first_seen, expire, count, msg, server) values (?, ?, ?, ?, ?, ?, ?)", {}, + $address, $status, $first_seen, $expire, 1, $msg, $server); + } + } else { + $dbh->do("insert into smtpcb(email, status, first_seen, expire, count, msg, server) values (?, ?, ?, ?, ?, ?, ?)", {}, + $address, $status, $first_seen, $expire, 1, $msg, $server); + } + exit(0); +} + +sub get_mx { + my ($domain) = @_; + + my $res = Net::DNS::Resolver->new; + my $answer = $res->query($domain, 'MX'); + my @mx = (); + if ($answer) { + syslog('info', "DNS query $domain MX: ", $answer->header->rcode, ""); + for my $rr ($answer->answer) { + if ($rr->type eq 'MX') { + push @mx, [ $rr->preference, $rr->exchange ] + } + } + } + push @mx, [ 0, $domain ] unless @mx; + @mx = sort { $a->[0] <=> $b->[0] } @mx; + for my $mx (@mx) { + my $answer = $res->query($mx->[1], 'A'); + if ($answer) { + syslog('info', "DNS query $mx->[1] A: ", $answer->header->rcode, ""); + for my $rr ($answer->answer) { + if ($rr->type eq 'A') { + push @$mx, $rr->address; + } + } + } + } + return @mx; +} + +sub detach { + open STDIN, '/dev/null' or die "/dev/null: $!"; + open STDOUT, '>/dev/null' or die "/dev/null: $!"; + open STDERR, '>&STDOUT' or die "open(stderr): $!"; + defined (my $pid = fork) or die "fork: $!"; + exit 0 if $pid; + POSIX::setsid or die "setsid: $!"; +}