src/lib/Bcd/Common/Mail.pm

   1 package Bcd::Common::Mail;
   2
   3 # This file is part of the breadcrumbs daemon (bcd).
   4 # Copyright (C) 2007 Pasqualino Ferrentino
   5
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 # General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  19 # 02110-1301, USA.
  20
  21 # Contact: lino.ferrentino@yahoo.it (in Italian, English or German).
  22
  23 use strict;
  24 use warnings;
  25
  26 use Mail::Sendmail;
  27 use Template;
  28 use MIME::Entity;
  29 use Data::Dumper;
  30 use Encode qw/encode decode/;
  31 use Net::SMTP;
  32
  33 use Bcd::Common::BcdGnuPGMail;
  34 use FindBin;
  35
  36 sub new {
  37     my ($class, $props) = @_;
  38     my $self = {};
  39
  40     #my $smtp = Net::SMTP->new('localhost', Hello => 'bricioline.it', Debug => 1);
  41     #$self->{smtp} = $smtp;
  42
  43     $self->{is_testing} = 0;
  44     $self->{mailer} = $props->{mailer};
  45     $self->{home}   = $props->{bcd_home};
  46
  47
  48     bless($self, $class);
  49     return $self;
  50 }
  51
  52 sub testing_do_not_send_mails{
  53     my $self = shift;
  54     $self->{is_testing} = 1;
  55 }
  56
  57 sub create_the_sign_object{
  58     my $self = shift;
  59
  60     local $/ = "\n";
  61
  62     my $name = $self->{home} . "/passphrase";
  63     open PASSWD, "< $name" or die "Not found the passphrase file\n";
  64     my $key        = <PASSWD>;
  65     my $passphrase = <PASSWD>;
  66     chomp $key;
  67     chomp $passphrase;
  68     close PASSWD;
  69
  70     #the home directory of the gnupg is two levels up.
  71     #maybe this can be configurable, for now it is simply fixed
  72     my $homedir = $self->{home} . "/../../.gnupg";
  73
  74     my $mg = Bcd::Common::BcdGnuPGMail->new (
  75                                              key => $key,
  76                                              passphrase => $passphrase,
  77                                              keydir     => $homedir,
  78                                              );
  79     $self->{mg} = $mg;
  80 }
  81
  82
  83 #for now the mail is very simple...
  84 sub mail_this_message{
  85     my ($self, $stash, $to, $template, $vars) = @_;
  86
  87     #do not send mails if I am testing, please
  88     return if ($self->{is_testing} == 1);
  89
  90     #lazy creation, because the tests are called by another executable
  91     $self->create_the_sign_object() if !defined($self->{mg});
  92
  93     eval{
  94
  95         local $/ = "\n";
  96
  97         my $output = '';
  98
  99         eval{
 100             $stash->process_this_template($template, $vars, \$output);
 101         };
 102
 103         if ($@){
 104             $output = "I cannot send mails, error: $@\n";
 105         }
 106
 107         my $header = encode('MIME-Q', "C'è un messaggio dalle Bricioline:");
 108
 109         my $ent = MIME::Entity->build(
 110                                       To         => $to,
 111                                       From       => 'breadcrumb@bricioline.it',
 112                                       Type        => "text/plain",
 113                                       Subject     =>  $header,
 114                                       Charset  => "utf-8",
 115                                       Encoding    => "quoted-printable",
 116                                       Data        => $output);
 117
 118         my $ans = $self->{mg}->clear_sign ($ent);
 119
 120         if ($ans != 0){
 121             $ent = MIME::Entity->build(
 122                                        To          => $to,
 123                                        From        => 'breadcrumb@bricioline.it',
 124                                        Type        => "text/plain",
 125                                        Subject     =>  $header,
 126                                        Charset     => "utf-8",
 127                                        Encoding    => "quoted-printable",
 128                                        Data        => $self->{mg}->{last_message}
 129                                        );
 130         }
 131
 132         $self->_send_this_entity_safely($ent);
 133
 134     };
 135
 136     if ($@){
 137         print "NO mail ... error $@\n";
 138         return 0;
 139     }
 140
 141     return 1;
 142 }
 143
 144 sub _send_this_entity_safely{
 145     my ($self, $entity) = @_;
 146
 147     #at max one retry
 148     for(0..1){
 149         my $smtp = $self->_get_safe_smtp_server();
 150
 151         my $res = $entity->smtpsend( Host => $smtp);
 152
 153         if (!defined ($res)){
 154             #ok, the server has gone
 155             delete($self->{smtp});
 156         } elsif ($res == 1){
 157             last; #the message was sent... go on
 158         }
 159
 160     }
 161 }
 162
 163 sub _get_safe_smtp_server{
 164     my $self = shift;
 165
 166     if (!defined($self->{smtp})){
 167         my $smtp = Net::SMTP->new($self->{mailer}, Hello => 'bricioline.it');
 168         $self->{smtp} = $smtp;
 169     }
 170
 171     return $self->{smtp};
 172 }
 173
 174 1;