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