File Coverage

blib/lib/Metabrik/Network/Smtp.pm
Criterion Covered Total %
statement 9 46 19.5
branch 0 20 0.0
condition 0 15 0.0
subroutine 3 6 50.0
pod 1 3 33.3
total 13 90 14.4


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::smtp Brik
5             #
6             package Metabrik::Network::Smtp;
7 2     2   698 use strict;
  2         5  
  2         57  
8 2     2   11 use warnings;
  2         4  
  2         63  
9              
10 2     2   12 use base qw(Metabrik);
  2         5  
  2         1197  
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             server => [ qw(server) ],
20             port => [ qw(port) ],
21             hello => [ qw(domain) ],
22             username => [ qw(username) ],
23             password => [ qw(password) ],
24             auth_mechanism => [ qw(none|GSSAPI) ],
25             use_starttls => [ qw(0|1) ],
26             _smtp => [ qw(INTERNAL) ],
27             },
28             attributes_default => {
29             server => 'localhost',
30             port => 25,
31             auth_mechanism => 'none',
32             use_starttls => 0,
33             },
34             commands => {
35             open => [ qw(server|OPTIONAL port|OPTIONAL username|OPTIONAL password|OPTIONAL) ],
36             close => [ ],
37             },
38             need_packages => {
39             ubuntu => [ qw(libgssapi-perl) ],
40             debian => [ qw(libgssapi-perl) ],
41             kali => [ qw(libgssapi-perl) ],
42             freebsd => [ qw(p5-GSSAPI) ],
43             },
44             require_modules => {
45             'Authen::SASL' => [ qw(Perl) ],
46             'Authen::SASL::Perl::GSSAPI' => [ ],
47             'Net::SMTP' => [ ],
48             },
49             };
50             }
51              
52             sub open {
53 0     0 0   my $self = shift;
54 0           my ($server, $port, $username, $password) = @_;
55              
56 0   0       $server ||= $self->server;
57 0   0       $port ||= $self->port;
58 0 0         $self->brik_help_run_undef_arg('open', $server) or return;
59 0 0         $self->brik_help_run_undef_arg('open', $port) or return;
60              
61 0   0       $username ||= $self->username;
62 0   0       $password ||= $self->password;
63 0 0         if (!defined($username)) {
64 0           $username = '';
65             }
66 0 0         if (!defined($password)) {
67 0           $password = '';
68             }
69 0           my $auth_mechanism = $self->auth_mechanism;
70              
71 0           my @args = (
72             $server,
73             Port => $port,
74             );
75              
76 0           my $hello = $self->hello;
77 0 0         if (defined($hello)) {
78 0           push @args, ( Hello => $hello );
79             }
80              
81 0           my $smtp;
82 0           eval {
83 0           $smtp = Net::SMTP->new(@args);
84             };
85 0 0 0       if (! defined($smtp) || $@) {
86 0           chomp($@);
87 0           return $self->log->error("open: Net::SMTP new failed for server [$server] port [$port] with [$!]: [$@]");
88             }
89              
90 0 0         if ($auth_mechanism ne 'none') {
    0          
91 0           my $sasl = Authen::SASL->new(
92             mechanism => $auth_mechanism,
93             callback => {
94             pass => $password,
95             user => $username,
96             }
97             );
98              
99 0           $smtp->starttls();
100              
101 0           my $r = $smtp->auth($sasl);
102 0           $self->log->info("open: auth: returned [$r]");
103             }
104             elsif ($self->use_starttls) {
105 0 0         $smtp->starttls() or return $self->log->error("open: can't STARTTLS");
106             }
107              
108             #$self->log->info(Data::Dumper::Dumper($smtp));
109              
110 0           return $self->_smtp($smtp);
111             }
112              
113             sub close {
114 0     0 0   my $self = shift;
115              
116 0           my $smtp = $self->_smtp;
117 0 0         if (defined($smtp)) {
118 0           $smtp->quit;
119 0           $self->_smtp(undef);
120             }
121              
122 0           return 1;
123             }
124              
125             1;
126              
127             __END__