diff options
Diffstat (limited to 'lib/Fripost/Email.pm')
| -rwxr-xr-x | lib/Fripost/Email.pm | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/lib/Fripost/Email.pm b/lib/Fripost/Email.pm new file mode 100755 index 0000000..31d0efe --- /dev/null +++ b/lib/Fripost/Email.pm @@ -0,0 +1,233 @@ +package Fripost::Email; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +Email.pm - Send emails + +=cut + +our @EXPORT = qw/new_welcome_message + new_user_info_message + new_alias_info_message + subscribe + security_status/; +our @ISA = qw(Exporter); + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use MIME::Entity; +use MIME::QuotedPrint; +use File::Spec qw/devnull/; +use Encode qw/encode/; +use Template; +use Mail::GnuPG; +use GnuPG::Interface; + + + +# Create and send an email. +sub new { + my ($conf, $h) = @_; + + my $msg = MIME::Entity->build( + From => encode('MIME-Q', 'Friposts administratörer') + . $conf->{admin_email}, + To => $h->{To}, + Subject => $h->{Subject}, + Encoding => 'quoted-printable', + Charset => 'utf-8', + Data => $h->{Data} + ); + my $encrypt_to = $conf->{encrypt_to}; + $encrypt_to //= $h->{To}; + + my $encrypt = 0; + $encrypt = 1 unless $conf->{encrypt} eq 'never'; + + if ($h->{Data} ne '' and (defined $conf->{sign} or $encrypt)) { + + # To encrypt, the recipient's key has to be in the public + # keyring. + if ($encrypt) { + my $gnupg = GnuPG::Interface->new(); + my $res; + { + # The only way to supress the warning is to desactivate + # STDERR. + local *STDERR; + open *STDERR, '>', File::Spec->devnull() + or die "Can't open ".File::Spec->devnull().": $!"; + $res = $gnupg->get_public_keys( $encrypt_to ); + close *STDERR; + } + unless ($res) { + die "Error: Public key not found for $encrypt_to.\n" + if $conf->{encrypt} eq 'secure'; + warn "WARN: Public key not found for $encrypt_to. The e-mail will be sent clear.\n"; + $encrypt = 0; + } + } + + my %gpg; + $gpg{use_agent} = 1 if defined $conf->{sign}; + $gpg{always_trust} = 1 if $encrypt; + $gpg{key} = $conf->{sign} if defined $conf->{sign} and + $conf->{sign} ne ''; + my $gpg = new Mail::GnuPG( %gpg ); + + my $ret; + if ($encrypt) { + if (defined $conf->{sign}) { + $ret = $gpg->mime_signencrypt( $msg, $encrypt_to ); + } + else { + $ret = $gpg->mime_encrypt( $msg, $encrypt_to ); + } + } + elsif (defined $conf->{sign}) { + $ret = $gpg->mime_sign( $msg ); + } + + if ($ret) { + foreach (@{$gpg->{last_message}}) { + warn "WARN: $_"; + } + } + } + + &debug($msg) if $conf->{debug}; + return $msg; +} + + +sub debug { + say STDERR "------------------------------------------------------------------------"; + say STDERR decode_qp($_[0]->as_string); + say STDERR "------------------------------------------------------------------------"; +} + + +# Create a template +sub template_create { + my ($file, $vars) = @_; + + my $tt = Template->new({ + INCLUDE_PATH => "$Bin/templ", + INTERPOLATE => 1, + }) || die "$Template::ERROR\n"; + + my $data; + $tt->process($file, $vars, \$data) + || die $tt->error(), '\n'; + return $data; +} + + +sub new_welcome_message { + my ($conf, $username) = @_; + + my $data = &template_create( 'new_user_mail.tt', {} ); + + return &new ( $conf, + { To => $username + , Subject => encode('MIME-Q', 'Välkommen till Fripost!') + , Data => $data + } ); + +} + +sub new_user_info_message { + my ($conf, $username, $password, $to) = @_; + + my $data = &template_create( 'user_info.tt' + , { user => $username, + pass => $password } ); + return &new ( $conf, + { To => $to + , Subject => encode('MIME-Q', 'Välkommen till Fripost!') + , Data => $data + } ); +} + +sub new_alias_info_message { + my ($conf, $goto, $addrs) = @_; + + my $data = &template_create( 'new_alias.tt' + , { addrs => $addrs } ); + return &new ( $conf, + { To => $goto + , Subject => encode('MIME-Q', 'Nya alias till din inkorg'), + , Data => $data + } ); +} + +# Subscribe the user to the given list eg, 'announce@lists.fripost.org' +sub subscribe { + my ($conf, $user, $list) = @_; + + my ($name, $domain) = split /\@/, $list, 2; + $list = $name .'-subscribe@' . $domain; + + my $msg = MIME::Entity->build( + From => $user, + To => $list, + Subject => '', + Data => '' + ); + &debug($msg) if $conf->{debug}; + $msg->send(); +} + + +# Return the security status of the given MIME entity. Note that this +# check is done *after* the possible encryption, hence it cannot detect +# Encrypted+Signed emails (they are detected as encrypted only). +sub security_status { + my $msg = $_[0]; + my $gpg = new Mail::GnuPG( ); + if ($gpg->is_encrypted ( $msg )) { + return 'Encrypted' + } + else { + if ($gpg->is_signed ( $msg )) { + return 'Signed, Plain' + } + else { + return 'Plain' + } + } +} + + +=head1 AUTHOR + +Stefan Kangas C<< <skangas at skangas.se> >> + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +Copyright 2010,2011 Stefan Kangas. + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of Email.pm + +__END__ |