diff options
Diffstat (limited to 'lib/Fripost')
| -rw-r--r-- | lib/Fripost/Commands/alias_add.pm | 133 | ||||
| -rw-r--r-- | lib/Fripost/Commands/alias_search.pm | 80 | ||||
| -rw-r--r-- | lib/Fripost/Commands/domain_add.pm | 150 | ||||
| -rw-r--r-- | lib/Fripost/Commands/domain_search.pm | 60 | ||||
| -rw-r--r-- | lib/Fripost/Commands/mkpass.pm | 59 | ||||
| -rw-r--r-- | lib/Fripost/Commands/user_add.pm | 161 | ||||
| -rw-r--r-- | lib/Fripost/Commands/user_passwd.pm | 89 | ||||
| -rw-r--r-- | lib/Fripost/Commands/user_search.pm | 58 | ||||
| -rwxr-xr-x | lib/Fripost/Email.pm | 233 |
9 files changed, 1023 insertions, 0 deletions
diff --git a/lib/Fripost/Commands/alias_add.pm b/lib/Fripost/Commands/alias_add.pm new file mode 100644 index 0000000..f86b1f7 --- /dev/null +++ b/lib/Fripost/Commands/alias_add.pm @@ -0,0 +1,133 @@ +package Fripost::Commands::alias_add; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +alias_add - Add a new virtual alias + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Email::Valid; +use IO::Prompter; +use Fripost::Prompt; +use Fripost::Schema; +use Fripost::Email; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + # Get information + my $goto = fix_username(shift); + $goto //= prompt_email("Alias goto address: ", 'is_user'); + my @addr = @_; + @addr || push @addr, (split /, */, prompt "Alias from address(es): "); + + + # Show goto adress + say "Goto adress: $goto"; + + # Show from adresses + @addr = grep { + if (Email::Valid->address('fake'.$_)) { + # Warn if the domain is unknown. + my $domain = (split /\@/, $_, 2)[1]; + if ($ldap->domain->search({ domain => $domain })->count) { + 1; + } + else { + warn "WARN: Skipping unknown domain `" .$domain. "'.\n"; + undef; + } + } + else { + warn "WARN: Skipping invalid address `" .$_. "'.\n"; + undef; + } + } @addr; + if (@addr == 0) { + warn "No valid destination adresses. Aborting...\n"; + exit 1; + } + say "From adress(es): " . (join ", ", @addr); + confirm_or_abort(); + + my $msg = new_alias_info_message ($conf, $goto, \@addr); + + ## Insert alias + for my $addr (@addr) { + + my ($u,$d) = split /\@/, $addr, 2; + + # Ensure that the alias doesn't already exist. + my $rs = $ldap->alias->search({ address => $addr }); + if ($rs->count and not (defined $conf->{force})) { + print STDERR "Error: Alias $addr already exists. "; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { $_->{goto} } $rs->entries); + say STDERR ".)"; + exit 1; + } + + die "Error: Username $addr exists.\n" + if ($ldap->user->search({ username => $addr })->count); + + if ($conf->{pretend}) { + say STDERR "Did not create alias since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + $ldap->alias->add({ address => $addr, goto => $goto, + isActive => 'TRUE' }); + say "New alias added from $addr to $goto."; + } + } + + if ($conf->{pretend}) { + say STDERR "Did not send confirmation since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + if (confirm_or_abort("Send confirmation? ")) { + $msg->send(); + say "Sent confirmation (". (security_status $msg) .")."; + } + } +} + + +=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 alias_add.pm + +__END__ diff --git a/lib/Fripost/Commands/alias_search.pm b/lib/Fripost/Commands/alias_search.pm new file mode 100644 index 0000000..6e638ac --- /dev/null +++ b/lib/Fripost/Commands/alias_search.pm @@ -0,0 +1,80 @@ +package Fripost::Commands::alias_search; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +alias_search.pm - List matching virtual aliases + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Schema; + +our $VERSION = '0.01'; + +sub perform_search { + my $ldap = shift; + + foreach my $alias ($ldap->alias->search( $_[0] )->entries) { + say "" . ($alias->{isActive} ? "ACTIVE" : "INACTIVE") + . " alias for " . $alias->{goto} . " are " + . (join ', ', @{$alias->{address}}); + } +} + +sub main { + my $ldap = shift; + my $conf = shift; + + my $search = $_[0]; + + my $f = $conf->{from}; + my $g = $conf->{goto}; + my $from = $f || !$f && !$g; + my $goto = $g || !$f && !$g; + + if ($from) { + perform_search($ldap, {address => $search}); + + my ($u,$d) = split /\@/, $search, 2; + $d = $u if (defined $u) and not (defined $d); + $ldap->domain->search({ domain => $d })->count + or die "Error: Unknown domain `$d'.\n"; + } + + if ($goto) { + perform_search($ldap, {goto => $search}); + } +} + + +=head1 AUTHOR + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +Copyright 2012 Stefan Kangas <skangas@skangas.se>. + +=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 alias_search.pm + +__END__ diff --git a/lib/Fripost/Commands/domain_add.pm b/lib/Fripost/Commands/domain_add.pm new file mode 100644 index 0000000..a727623 --- /dev/null +++ b/lib/Fripost/Commands/domain_add.pm @@ -0,0 +1,150 @@ +package Fripost::Commands::domain_add; + +use 5.010_000; +use warnings; +use strict; +use utf8; + +=head1 NAME + +domain_add - Add a new virtual domain. + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Password; +use Fripost::Prompt; +use Fripost::Schema; +use Email::Valid; +use IO::Prompter; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + # Define the domain that is to be added. + my %domain; + $domain{domain} = $_[0]; + $domain{domain} //= prompt "Domain name: "; + $domain{isActive} = 'TRUE'; + + # Ensure that the domain is valid. + die "Error: Invalid domain `$domain{domain}'.\n" + unless Email::Valid->address('fake@'.$domain{domain}); + + $domain{owner} = $_[1]; + $domain{owner} //= prompt_email("Belongs to user: ", 'is_user'); + + if ($domain{owner} eq '') { + $domain{owner} = undef + } + else { + die "Error: $domain{owner} is not a valid e-mail.\n" + unless Email::Valid->address($domain{owner}); + } + + # Check that the owner exists. + die "Error: Unknown user `" .$domain{owner}. "'.\n" + unless (not defined $domain{owner}) + or $ldap->user->search({ username => $domain{owner} })->count; + + # Check that the owner doesn't already own this very domain, or that the + # domain isn't an existing "global" domain. + if ($ldap->domain->search(\%domain)->count) { + print STDERR "Error: Domain `" .$domain{domain}. "' already exists"; + print STDERR " for user `" .$domain{owner}. "'" if defined $domain{owner}; + say STDERR "."; + exit 1; + } + + # If the domain exists (but is eg, owned by someone else), produce a + # warning. + my $res = $ldap->domain->search({ domain => $domain{domain} }); + if ($res->count) { + print STDERR "WARN: Domain `" .$domain{domain}. "' already exists."; + my @owners; + map { push @owners, @{$_->{owner}} if defined $_->{owner} } $res->entries; + if (@owners) { + print STDERR " (Owned by "; + print STDERR (join ', ', map { '`' .$_. "'"} @owners); + print STDERR ".)"; + } + print STDERR "\n"; + } + + if ($conf->{pretend}) { + say STDERR "Did not add the domain since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + # Add the domain. + $ldap->domain->add(\%domain); + if (defined $domain{owner}) { + print "New domain `" .$domain{domain}. "' added"; + print " for user `" .$domain{owner}. "'" if defined $domain{owner}; + say "."; + } + else { + say "New non self-managed domain `" .$domain{domain}. "' added."; + } + + create_alias($ldap, 'abuse@' . $domain{domain}, + 'abuse@fripost.org'); + create_alias($ldap, 'postmaster@' . $domain{domain}, + 'postmaster@fripost.org'); + } +} + + +# Create aliases. +sub create_alias { + my ($ldap, $from, $to) = @_; + + my %alias = (address => $from, goto => $to); + + my $res = $ldap->alias->search(\%alias); + if ($res->count) { + print STDERR "WARN: Alias $alias{address} already exists."; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { $_->{goto} } $res->entries); + say STDERR ".)"; + return unless grep { $_->{goto} eq $alias{goto} } $res->entries; + } + + $alias{isActive} = 'TRUE'; + $ldap->alias->add( \%alias ); + say "Created alias from $from to $to."; +} + + + +=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 domain_add.pm + +__END__ diff --git a/lib/Fripost/Commands/domain_search.pm b/lib/Fripost/Commands/domain_search.pm new file mode 100644 index 0000000..8aaf775 --- /dev/null +++ b/lib/Fripost/Commands/domain_search.pm @@ -0,0 +1,60 @@ +package Fripost::Commands::domain_search; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +domain_search.pm - List matching virtual domains + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Schema; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + my %domain; + $domain{domain} = $_[0] if defined $_[0]; + $domain{owner} = $_[1] if defined $_[1]; + + foreach my $domain ($ldap->domain->search( \%domain )->entries) { + say '' . ($domain->{isActive} ? 'ACTIVE' : 'INACTIVE') + . ' domain ' . $domain->{domain} + . ' is owned by ' + . (defined $domain->{owner} ? join ', ', @{$domain->{owner}} + : '(none)'); + } +} + + +=head1 AUTHOR + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +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 domain_search.pm + +__END__ diff --git a/lib/Fripost/Commands/mkpass.pm b/lib/Fripost/Commands/mkpass.pm new file mode 100644 index 0000000..0ac2570 --- /dev/null +++ b/lib/Fripost/Commands/mkpass.pm @@ -0,0 +1,59 @@ +package Fripost::Commands::mkpass; + +use 5.010_000; +use warnings; +use strict; +use utf8; + +=head1 NAME + +mkpass.pm - Create a random new password, and returns its hash + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; +use Fripost::Password; + +our $VERSION = '0.01'; + +our @EXPORT = qw/main/; +our @ISA = qw(Exporter); + +sub main { + my $password = shift; + $password //= mkpasswd(); + + # Show the information that will be inserted + say "Password: " . $password; + say "Salted SHA-1: " . hash($password, SHA1, undef); +} + + +=head1 AUTHORS + +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 mkpass.pm + +__END__ + diff --git a/lib/Fripost/Commands/user_add.pm b/lib/Fripost/Commands/user_add.pm new file mode 100644 index 0000000..70ee638 --- /dev/null +++ b/lib/Fripost/Commands/user_add.pm @@ -0,0 +1,161 @@ +package Fripost::Commands::user_add; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +user_add - Add a new mailbox to the system + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Password; +use Fripost::Prompt; +use Fripost::Schema; +use Fripost::Email; + +our $VERSION = '0.01'; + +our @EXPORT = qw/main/; +our @ISA = qw(Exporter); + +sub assert { + my $ldap = shift; + my $username = shift; + my ($login, $domain) = split /\@/, $username, 2; + + # Error if the domain is unknown. + die "Error: Unknown domain `" .$domain. "'.\n" + unless $ldap->domain->search({ domain => $domain })->count; + + # Ensure that the username doesn't already exist. + die "Error: User `" .$username. "' already exists.\n" + if $ldap->user->search({ username => $username })->count; + + # Ensure that the username doesn't correspond to an existing alias. + my $res = $ldap->alias->search({ address => $username }); + if ($res->count) { + print STDERR "Error: Alias $username already exists. "; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { $_->{goto} } $res->entries); + say STDERR ".)"; + exit 1; + } +} + + +sub main { + my $ldap = shift; + my $conf = shift; + + # Define the new user + my $username; + { + if (defined $_[0]) { + $username = fix_username ($_[0]); + Email::Valid->address($username) + or die "Error: $username is not a valid e-mail.\n"; + } + else { + $username = prompt_email( "New username: ", 'is_user' ); + # TODO: add the assert in the hash. + } + } + + &assert ($ldap, $username); + + + my $user; + my $clearPassword; + { + my $isActive = 'TRUE'; + my $userPassword; + if ( defined $conf->{password} ) { + $userPassword = $conf->{password}; + } + else { + $clearPassword = prompt_password(); + $userPassword = hash( $clearPassword ); + } + + $user = { + username => $username, + isActive => $isActive, + userPassword => $userPassword, + }; + + say "User name: $user->{username}"; + say "Password: (hidden)"; + + confirm_or_abort(); + } + + my $welcome = new_welcome_message ($conf, $user->{username}); + my $info; + unless (defined $conf->{password}) { + if (confirm "Send email with login information? ") { + my $to = prompt_email("Where should the email be sent? "); + $info = new_user_info_message ( $conf, $user->{username}, + $clearPassword, + $to ); + } + } + + if ($conf->{pretend}) { + say STDERR "Did not create user since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + # Insert the new user + my %user = %$user; + delete $user{clearPassword}; + $ldap->user->add(\%user); + say STDERR "New account $user{username} added."; + + # Send the prepared emails + $welcome->send(); + say "Sent welcome message (". (security_status $welcome) .")."; + + # Subscribe user to announce-list + subscribe($conf, $username, 'announce@lists.fripost.org') + if confirm("Subscribe user to announce mailing list? "); + + if (defined $info) { + $info->send(); + say "Credentials sent (". (security_status $info) .")."; + } + } +} + + +=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 user_add.pm + +__END__ diff --git a/lib/Fripost/Commands/user_passwd.pm b/lib/Fripost/Commands/user_passwd.pm new file mode 100644 index 0000000..f443ef6 --- /dev/null +++ b/lib/Fripost/Commands/user_passwd.pm @@ -0,0 +1,89 @@ +#!/usr/bin/perl +package Fripost::Commands::user_passwd; + +use 5.010_000; +use warnings; +use strict; +use utf8; + +=head1 NAME + +user_add - Change user password + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Password; +use Fripost::Prompt; +use Fripost::Schema; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + my $username; + if (defined $_[0]) { + $username = fix_username ($_[0]); + Email::Valid->address($username) + or die "Error: `" .$username. "' is not a valid e-mail.\n"; + } + else { + $username = prompt_email("Username: ", 'is_user'); + } + + + # Ensure that the user exists. + my $domain = (split /\@/, $username, 2)[1]; + die "Error: Unknown domain `" .$domain. "'.\n" + unless $ldap->domain->search({ domain => $domain })->count; + die "Error: Unknown user `" .$username. "'.\n" + unless $ldap->user->search({ username => $username })->count; + + + my $password = $conf->{password}; + $password //= hash( prompt_password() ); + + + if ($conf->{pretend}) { + say STDERR "Did not change password since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + # Change the password. + $ldap->user->passwd({ username => $username, + userPassword => $password }); + say "Updated password for $username."; + } +} + + +=head1 AUTHOR + +Stefan Kangas C<< <skangas at skangas.se> >> + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +Copyright 2010 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 user_passwd.pm + +__END__ diff --git a/lib/Fripost/Commands/user_search.pm b/lib/Fripost/Commands/user_search.pm new file mode 100644 index 0000000..30ffd4d --- /dev/null +++ b/lib/Fripost/Commands/user_search.pm @@ -0,0 +1,58 @@ +package Fripost::Commands::user_search; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +user_search.pm - List matching virtual users + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Schema; + +our $VERSION = '0.01'; + +our @EXPORT = qw/main/; +our @ISA = qw(Exporter); + +sub main { + my $ldap = shift; + my $conf = shift; + + my %user; + $user{username} = $_[0] if defined $_[0]; + + foreach my $user ($ldap->user->search( \%user )->entries) { + say '' . ($user->{isActive} ? 'ACTIVE' : 'INACTIVE') + . ' user ' . $user->{username}; + } +} + +=head1 AUTHOR + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +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 user_search.pm + +__END__ 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__ |