File Coverage

blib/lib/Metabrik/Audit/Smtp.pm
Criterion Covered Total %
statement 9 86 10.4
branch 0 36 0.0
condition 0 13 0.0
subroutine 3 11 27.2
pod 2 8 25.0
total 14 154 9.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # audit::smtp Brik
5             #
6             package Metabrik::Audit::Smtp;
7 1     1   659 use strict;
  1         3  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         26  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         1084  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             hostname => [ qw(hostname) ],
20             port => [ qw(integer) ],
21             domainname => [ qw(domainname) ],
22             _smtp => [ qw(INTERNAL) ],
23             },
24             attributes_default => {
25             port => 25,
26             },
27             commands => {
28             connect => [ qw(hostname|OPTIONAL port|OPTIONAL domainname|OPTIONAL) ],
29             banner => [ ],
30             quit => [ ],
31             open_auth_login => [ ],
32             open_relay => [ ],
33             all => [ ],
34             },
35             require_modules => {
36             'Net::SMTP' => [],
37             'Net::Cmd' => [ qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING) ],
38             },
39             };
40             }
41              
42             sub brik_use_properties {
43 0     0 1   my $self = shift;
44              
45             return {
46 0   0       attributes_default => {
47             hostname => defined($self->global) && $self->global->hostname || 'hostname',
48             },
49             };
50             }
51              
52             sub connect {
53 0     0 0   my $self = shift;
54 0           my ($hostname, $port, $domainname) = @_;
55              
56 0   0       $hostname ||= $self->hostname;
57 0   0       $port ||= $self->port;
58 0   0       $domainname ||= $self->domainname;
59 0 0         $self->brik_help_run_undef_arg('connect', $hostname) or return;
60 0 0         $self->brik_help_run_undef_arg('connect', $port) or return;
61 0 0         $self->brik_help_run_undef_arg('connect', $domainname) or return;
62              
63 0   0       my $timeout = defined($self->global) && $self->global->ctimeout || 3;
64              
65 0 0         my $smtp = Net::SMTP->new(
66             $hostname,
67             Port => $port,
68             Hello => $domainname,
69             Timeout => $timeout,
70             Debug => $self->log->level,
71             ) or return $self->log->error("connect: $!");
72              
73 0           $self->_smtp($smtp);
74              
75 0           return $smtp;
76             }
77              
78             sub quit {
79 0     0 0   my $self = shift;
80              
81 0           my $smtp = $self->_smtp;
82 0 0         $self->brik_help_run_undef_arg('connect', $smtp) or return;
83              
84 0           $self->_smtp(undef);
85              
86 0           return $smtp->quit;
87             }
88              
89             sub banner {
90 0     0 0   my $self = shift;
91              
92 0           my $smtp = $self->_smtp;
93 0 0         $self->brik_help_run_undef_arg('connect', $smtp) or return;
94              
95 0           chomp(my $banner = $smtp->banner);
96              
97             # XXX: move to identify::smtp
98             #if ($banner =~ /rblsmtpd/i) {
99             #$log->debug("smtpRbl=1");
100             #$result->rbl(1);
101             #}
102             #else {
103             #$log->debug("smtpRbl=0");
104             #$result->rbl(0);
105             #}
106              
107 0           return $banner;
108             }
109              
110             sub open_auth_login {
111 0     0 0   my $self = shift;
112              
113 0           my $smtp = $self->_smtp;
114 0 0         $self->brik_help_run_undef_arg('connect', $smtp) or return;
115              
116 0           my $smtp_feature_auth_login = 0;
117 0           my $smtp_open_auth_login = 0;
118              
119 0           my $msg = $smtp->message;
120 0 0         if ($msg =~ /AUTH LOGIN/i) {
121 0           $smtp_feature_auth_login = 1;
122              
123 0           my $ok = $smtp->command("AUTH LOGIN")->response;
124 0 0         if ($ok == Net::Cmd::CMD_MORE()) {
125 0           $ok = $smtp->command("YWRtaW4=")->response; # Send login 'admin'
126 0 0         if ($ok == Net::Cmd::CMD_MORE()) {
127 0           $ok = $smtp->command("YWRtaW4=")->response; # Send password 'admin'
128 0 0         if ($ok == Net::Cmd::CMD_OK()) {
129 0           $smtp_open_auth_login = 1;
130             }
131             }
132             }
133             }
134             else {
135 0           $self->log->info("AUTH LOGIN not supported by target");
136             }
137              
138             return {
139 0           smtp_feature_auth_login => $smtp_feature_auth_login,
140             smtp_open_auth_login => $smtp_open_auth_login,
141             };
142             }
143              
144             sub open_relay {
145 0     0 0   my $self = shift;
146              
147 0           my $smtp = $self->_smtp;
148 0 0         $self->brik_help_run_undef_arg('connect', $smtp) or return;
149              
150 0           my $smtp_open_relay = 0;
151 0           my $smtp_to_reject = 0;
152 0           my $smtp_to_error = 0;
153 0           my $smtp_from_reject = 0;
154 0           my $smtp_from_error = 0;
155              
156 0           my $ok = $smtp->mail('audit@example.com');
157 0 0         if ($ok) {
158 0           $ok = $smtp->to('audit@example.com');
159 0 0         if ($ok) {
160 0           $smtp_open_relay = 1;
161             }
162             else {
163 0           my $status = $smtp->status;
164 0 0         if ($status == Net::Cmd::CMD_REJECT()) {
    0          
165 0           $smtp_to_reject = 1;
166             }
167             elsif ($status == Net::Cmd::CMD_ERROR()) {
168 0           $smtp_to_error = 1;
169             }
170             else {
171 0           chomp(my $msg = $smtp->message);
172 0           $self->log->debug("open_relay: MSG[$msg]");
173             }
174             }
175             }
176             else {
177 0           my $status = $smtp->status;
178 0 0         if ($status == Net::Cmd::CMD_REJECT()) {
    0          
179 0           $smtp_from_reject = 1;
180             }
181             elsif ($status == Net::Cmd::CMD_ERROR()) {
182 0           $smtp_from_error = 1;
183             }
184             else {
185 0           chomp(my $msg = $smtp->message);
186 0           $self->log->debug("open_relay: MSG[$msg]");
187             }
188             }
189              
190             return {
191 0           smtp_open_relay => $smtp_open_relay,
192             smtp_to_reject => $smtp_to_reject,
193             smtp_to_error => $smtp_to_error,
194             smtp_from_reject => $smtp_from_reject,
195             smtp_from_error => $smtp_from_error,
196             };
197             }
198              
199             sub all {
200 0     0 0   my $self = shift;
201              
202 0           my $hash = {};
203              
204 0           my $check_001 = $self->open_auth_login;
205 0           for (keys %$check_001) { $hash->{$_} = $check_001->{$_} }
  0            
206              
207 0           my $check_002 = $self->open_relay;
208 0           for (keys %$check_002) { $hash->{$_} = $check_002->{$_} }
  0            
209              
210 0           return $hash;
211             }
212              
213             1;
214              
215             __END__