File Coverage

blib/lib/Mail/EXPN.pm
Criterion Covered Total %
statement 15 64 23.4
branch 0 34 0.0
condition 0 5 0.0
subroutine 5 11 45.4
pod 0 6 0.0
total 20 120 16.6


line stmt bran cond sub pod time code
1             # $Id: EXPN.pm,v 1.3 2003/02/01 10:45:49 florian Exp $
2              
3             package Mail::EXPN;
4              
5 1     1   1634 use Net::DNS;
  1         235496  
  1         127  
6 1     1   1099 use Net::SMTP;
  1         16505  
  1         114  
7 1     1   12 use IO::Socket;
  1         15  
  1         10  
8             require Exporter;
9 1     1   793 use strict;
  1         2  
  1         51  
10 1     1   6 use vars qw(@ISA @EXPORT_OK $BAD $VERSION $first);
  1         2  
  1         917  
11             @ISA = qw(Exporter);
12             @EXPORT_OK = qw(isfake $BAD);
13              
14             $VERSION = '0.04';
15              
16             $BAD = "SMTP response not understood";
17              
18              
19             sub isfake ($;$) {
20 0     0 0   my @tokens = split(/\@/, shift);
21 0           my $mx = shift;
22 0 0         unless ($mx) {
23 0 0         return 'not in user@host format' unless @tokens == 2;
24 0           foreach (@tokens) {
25 0 0         return 'contains illegal characters' if /[;()<>]/;
26             }
27 0 0         return 'malformed mail domain' unless ($tokens[1] =~ /\./);
28 0           my @mx = mx($tokens[1]);
29 0 0         return 'bogus mail domain' unless @mx;
30             ##@mx = sort { $b->preference <=> $a->preference} @mx;
31 0           $mx = $mx[0]->exchange;
32             }
33 0   0       my $sock = new IO::Socket::INET("$mx:25") || return undef;
34 0           my $result = step1($sock, join('@', @tokens));
35 0           $sock->close;
36 0           $result;
37             }
38              
39             sub step1 {
40 0     0 0   my ($sock, $email) = @_;
41 0 0         return $BAD unless code($sock) == 220;
42 0           $first = 1;
43 0           out($sock, "HELO Mail-Check");
44 0 0         return $BAD unless code($sock) == 250;
45 0           out($sock, "EXPN $email");
46 0           my $code = code($sock);
47 0 0         return step2($sock, $email) if ($code == 502);
48 0 0         return "" if ($code == 250);
49 0 0         return "bogus username" if ($code == 550);
50 0           return $BAD;
51             }
52              
53             sub step2 {
54 0     0 0   my ($sock, $email) = @_;
55 0           out($sock, "VRFY $email");
56 0           my $code = code($sock);
57 0 0         return step3($sock, $email) if ($code == 252);
58 0 0         return "bogus username" if ($code == 550);
59 0 0         return "" if ($code == 250);
60 0           return $BAD;
61             }
62              
63             sub step3 {
64 0     0 0   my ($sock, $email) = @_;
65 0           out($sock, "MAIL FROM:<>");
66 0 0         return $BAD unless code($sock) == 250;
67 0           out($sock, "RCPT TO:<$email>");
68 0           my $code = code($sock);
69 0 0         return "bogus username" if ($code == 550);
70 0 0         return "" if ($code == 250);
71 0           return $BAD;
72             }
73              
74             sub out ($$) {
75 0     0 0   my ($sock, $text) = @_;
76 0           $sock->send("$text\n");
77             }
78              
79             sub code ($) {
80 0     0 0   my ($sock) = @_;
81 0           my $line = <$sock>;
82 0           my @tokens = split(/[- ]+/, $line);
83 0           my $ret = $tokens[0];
84 0 0 0       return code($sock) if $first && $ret == 220;
85 0           $first = undef;
86 0           return $ret;
87             }
88              
89             1;
90             __END__