diff options
| -rwxr-xr-x | fripost | 429 | ||||
| -rwxr-xr-x | fripost-adduser | 325 | ||||
| -rwxr-xr-x | fripost-mkpass | 64 | ||||
| -rwxr-xr-x | fripost-newalias | 295 | ||||
| -rwxr-xr-x | fripost-newdomain | 263 | ||||
| -rwxr-xr-x | fripost-passwd | 193 | ||||
| -rwxr-xr-x | fripost-searchalias | 176 | ||||
| -rwxr-xr-x | fripost-searchdomain | 146 | ||||
| -rwxr-xr-x | fripost-searchuser | 144 | ||||
| -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 |
18 files changed, 1452 insertions, 1606 deletions
@@ -0,0 +1,429 @@ +#!/usr/bin/perl + +use 5.010_000; +use strict; +use warnings; +use utf8; + +our $VERSION = '0.01'; + +=head1 NAME + +fripost - Fripost.org handling utility for virtual hosting + +=head1 SYNOPSIS + +B<fripost> [I<options>] { mkpass | user-add | user-search | user-passwd +| domain-add | domain-search | alias-add | alias-search } + +B<fripost> B<--man> + +=head1 COMMANDS + +=over 4 + +=item B<fripost> mkpass [I<password>] + +Create a random new password, and returns its hash. + +=item B<fripost> user-add [I<username>] [B<--password=>I<password>] + +Add a new virtual mailbox. + +=item B<fripost> user-search [I<username>] + +List matching virtual users. + +=item B<fripost> user-passwd [I<username>] [B<--password=>I<password>] + +Change user password. + +=item B<fripost> domain-add [I<domain> [I<username>]] + +Add a new virtual domain. + +=item B<fripost> domain-search [I<domain> [I<username>]] + +List matching virtual domains. + +=item B<fripost> alias-add [B<--force>] [I<goto> [I<from>...]] + +Add a new virtual alias. + +=item B<fripost> alias-search [B<-f>|B<--from>] [B<-g>|B<--goto>] [I<address>] + +List matching virtual aliases. + +=back + +=head1 DESCRIPTION + +Unless one of the B<-h>, B<--help>, or B<--man> option is given, one of +the following commands is required. + +=over 4 + +=item B<fripost> mkpass [I<password>] + +C<mkpass> is used to generate a salted SHA-1 hash of the given +I<password>. If no argument is given, the password is randomly +generated, respecting Fripost's password policy. + +=item B<fripost> user-add [I<username>] [B<--password=>I<password>] + +C<user-add> is used to add a new virtual mailbox to the system, unless +B<--pretend> is set. +If I<username> or I<password> are not given, the user is prompted for +their value. +If I<username> is not fully qualified, the domain C<fripost.org> is +appended. +An error is raised if I<username> is already an existing virtual user or +alias. +If I<password> is given, is it used RAW (not hashed). +This can be useful if the user does not want to give the clear copy but +only a hash, for example. +Using this option disables the sending of credentials. + +=item B<fripost> user-search [I<username>] + +C<user-search> is used to +list virtual mailboxes whose username matches exactly I<username>. +Wildcards I<*> can appear in I<username>, to match zero or more characters. +If no I<username> is given, lists all existing mailboxes. + +If I<username> has no domain part, C<user-search> lists matching users for any +domains. +Otherwise, C<user-search> looks up the matching user parts for each matching +domain. +Because of these multiple searches, the use of wildcards on the domain +part of I<username> may be inefficient. + +=item B<fripost> user-passwd [I<username>] [B<--password=>I<password>] + +C<user-passwd> is used to change the password of I<username>, unless +B<--pretend> is set. +If I<username> or I<password> are not given, the user is prompted for +their value. +If I<username> is not fully qualified, the domain C<fripost.org> is appended. +An error is raised if I<username> is not an existing virtual user. +If I<password> is given, is it used RAW (not hashed). +This can be useful if the user does not want to give the clear copy but +only a hash, for example. +Using this option disables the sending of credentials. + +=item B<fripost> domain-add [I<domain> [I<username>]] + +C<domain-add> is used add a new virtual domain to the system, unless +B<--pretend> is set. +If I<domain> is not given, the user is prompted for its value. +By default, C<domain-add> prompts for the owner(s) of the new +domain; Use the empty string I<''> to create a "global" domain, only +managed by Fripost's administrators. +If I<domain> is an existing virtual domain, the owner(s) are simply +added to the list of managers. + +=item B<fripost> domain-search [I<domain> [I<username>]] + +C<domain-search> is used to list virtual domains matching exactly I<domain>, +and whose owner is I<username>. +Wildcards I<*> can appear in I<domain>, to match zero or more characters. +If no I<username> is given, list all domains matching I<domain>, regardless +of the owner; If I<owner> is the empty string I<''>, list only the non +self-managed domains. +If neither I<domain> nor I<owner> are given, C<domain-search> lists +all existing virtual domains. + +=item B<fripost> alias-add [B<--force>] [I<goto> [I<from>...]] + +C<alias-add> is used to add a new virtual alias to the system, unless +B<--pretend> is set. +If I<goto> or I<from> are not given, the user is prompted for their +value. +If I<goto> is not fully qualified, the domain C<fripost.org> is appended. +An error is raised if I<from> is already an existing username, or if +I<from> is an existing alias and B<--force> is not set. + +Inserted aliases conform to Postfix's B<virtual>(5) alias table format; +I<from> has to be of one of the following forms: + +=over 4 + +=item . + +I<user>@I<domain>, to redirect emails for I<user>@I<domain> to I<goto>, or + +=item . + +@I<domain>, to catch all emails for users in I<domain> and redirect them +to I<goto>. +This form has the lowest precedence: If there is an alias from +I<user>@I<domain> to I<goto2>, emails to I<user>@I<domain> will be +redirected to I<goto2> only. +See B<virtual>(5) for details and warnings. + +=back + +If serveral entries are matching, for instance if there are an alias from +I<user>@I<domain> to I<goto> and another for I<user>@I<domain> to +I<goto2>, emails to I<user>@I<domain> will be redirected to BOTH I<goto> +and I<goto2>. Note that C<alias-add> forbids the creation of such +multi-recipient aliases, unless B<--force> is set. + +=item B<fripost> alias-search [B<-f>|B<--from>] [B<-g>|B<--goto>] [I<address>] + +C<alias-search> is used to list virtual aliases whose value or target +matches exactly I<address>. +As of the current version, wilcards are not allowed in I<address>; This +will be fixed soon. +To list matching aliases (resp., targets) only, use the flag B<-f> +(resp., B<-g>). +If no I<address> is given, C<alias-search> lists all existing virtual +aliases. + +=back + +=head1 OPTIONS + +=over 8 + +=item B<--pretend> + +Dry-run all operations that is, do not modify the virtual lookup tables. +But still queries the LDAP server to ensure that the modification would +be safe. (For instance, ensure that a new user is not already existing.) + +=item B<--server_host=>I<host> + +The LDAP URI to connect to. +Overrides the value read from the configuration file (see +B<CONFIGURATION>) if present. + +=item B<--bind_dn=>I<binddn> + +The Distinguished Name (DN) to bind to the LDAP directory. +Overrides the value read from the configuration file (see +B<CONFIGURATION>) if present. +If not set (the default), B<fripost> binds anonymously. + +=item B<--bind_pw=>I<password> + +The password to to bind with. +Overrides the value read from the configuration file (see +B<CONFIGURATION>) if present. + +=item B<--base_dn=>I<basedn> + +The root DN for every communication to the LDAP server. +Overrides the value read from the configuration file (see +B<CONFIGURATION>) if present. + +=item B<--sign>[B<=>I<name>] + +Use I<name> as the key to sign all non-empty emails. If I<name> is empty +or not given, use the first key found in the secret keyring, see +B<gpg>(1). A running gpg-agent is required if the private key is +protected by a passphrase. +Overrides the value read from the configuration file (see +B<CONFIGURATION>) if present. + +=item B<encrypt=>{I<never>|I<may>|I<secure>} + +Tells whether non-empty emails should be encrypted. +No email will be encrypted if I<never> is chosen (the default). +I<may> turns on opportunistic encryption that is, emails will be +encrypted as soon as the recipient is a usable user ID in the public +keyring. +I<secure> will disallow the sending of all non-empty clear emails. +Overrides the value read from the configuration file (see +B<CONFIGURATION>) if present. + +=item B<encrypt-to=>I<name> + +If one of the I<may> or I<secure> encryption level is chosen, encrypt +for the user ID I<name>. + +=item B<-v>, B<--verbose> + +Verbose mode. + +=item B<-d>, B<--debug> + +Debug mode. + +=back + +=head1 CONFIGURATION + +The configuration is read from the file C<$HOME/.fripost.yml>, and has a +lower precedence than the I<OPTIONS> above. +Valid keys include: + +=over 4 + +=item I<server_host> + +The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. + +=item I<admin_email> + +The I<From:> e-mail address to use. Defaults to C<admin@fripost.org>. + +=item I<bind_dn> + +The Distinguished Name (DN) to bind to the LDAP directory. +(If not set, B<fripost> binds anonymously.) + +=item I<bind_pw> + +The password to to bind with. + +=item I<base_dn> + +The root DN for every communication to the LDAP server. + +=item I<sign> + +The key used to sign all non-empty emails. If no key is given, +use the first one found in the secret keyring, see B<gpg>(1). +A running gpg-agent is required if the private key is +protected by a passphrase. + +=item I<encrypt> + +Tells whether non-empty emails should be encrypted. +No email will be encrypted if I<never> is chosen (the default). +I<may> turns on opportunistic encryption that is, emails will be +encrypted as soon as the recipient is a usable user ID in the public +keyring. +I<secure> will disallow the sending of all non-empty clear emails (not +recommended). + +=back + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Env qw /HOME/; +use File::Spec::Functions; +use Getopt::Long qw /:config noauto_abbrev no_ignore_case + gnu_compat bundling permute nogetopt_compat + auto_version/; +use Pod::Usage; +use YAML::Syck; + +use Fripost::Schema; +use Fripost::Commands::mkpass; +use Fripost::Commands::user_add; +use Fripost::Commands::user_search; +use Fripost::Commands::user_passwd; +use Fripost::Commands::domain_add; +use Fripost::Commands::domain_search; +use Fripost::Commands::alias_add; +use Fripost::Commands::alias_search; + + +## Get global command line options +our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); + +GetOptions( + 'server_host=s' => \$conf->{server_host}, + 'base_dn=s' => \$conf->{base_dn}, + 'bind_dn=s' => \$conf->{bind_dn}, + 'bind_pw=s' => \$conf->{bind_pw}, + 'pretend' => \$conf->{pretend}, + 'sign:s' => \$conf->{sign}, + 'encrypt=s' => \$conf->{encrypt}, + 'encrypt-to=s' => \$conf->{encrypt_to}, + 'd|debug' => \$conf->{debug}, + 'v|verbose' => \$conf->{verbose}, + 'h|help' => sub { pod2usage(-exitstatus => 0, + -sections => [ qw/SYNOPSIS COMMANDS/ ], + -verbose => 99) }, + 'man' => sub { pod2usage(-exitstatus => 0, + -verbose => 2) }, + + 'password=s' => \$conf->{password}, + 'force' => \$conf->{force}, + 'f|from' => \$conf->{from}, + 'g|goto' => \$conf->{goto}, +) or pod2usage(2); + + +## Set the default values +$conf->{server_host} //= 'ldap://127.0.0.1:389'; +$conf->{bind_dn} //= ''; +$conf->{base_dn} //= ''; +$conf->{admin_email} //= 'admin@fripost.org'; +$conf->{encrypt} //= 'never'; + +die "Illegal encrypt level: `$conf->{encrypt}'.\n" + unless grep {$_ eq $conf->{encrypt}} qw /never may secure/; + + +## Get the command + +my $cmd = shift; +my $main; + +$cmd //= ''; +if ($cmd eq 'mkpass') { + &Fripost::Commands::mkpass::main (@ARGV); + exit 0; +} +elsif ($cmd eq 'user-add') { + $main = "Fripost::Commands::user_add::main"; +} +elsif ($cmd eq 'user-search') { + $main = "Fripost::Commands::user_search::main"; +} +elsif ($cmd eq 'user-passwd') { + $main = "Fripost::Commands::user_passwd::main"; +} +elsif ($cmd eq 'domain-add') { + $main = "Fripost::Commands::domain_add::main"; +} +elsif ($cmd eq 'domain-search') { + $main = "Fripost::Commands::domain_search::main"; +} +elsif ($cmd eq 'alias-add') { + $main = "Fripost::Commands::alias_add::main"; +} +elsif ($cmd eq 'alias-search') { + $main = "Fripost::Commands::alias_search::main"; +} +else { + pod2usage( -exitstatus => 1, + -verbose => 0, + -msg => "Unknown command: `$cmd'."); +} + + +## Connect to the LDAP server +my $ldap = Fripost::Schema->new( $conf ); +{ + no strict "refs"; + &$main ($ldap, $conf, @ARGV); +} +$ldap->unbind(); + + +=head1 AUTHOR + +Stefan Kangas C<< <skangas at skangas.se> >> + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +Copyright 2010-2012 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. + +=cut diff --git a/fripost-adduser b/fripost-adduser deleted file mode 100755 index fc37489..0000000 --- a/fripost-adduser +++ /dev/null @@ -1,325 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use strict; -use warnings; -use utf8; - -=head1 NAME - -fripost-adduser - Add a new mailbox to the system - -=head1 SYNOPSIS - -B<fripost-adduser> [B<--verbose>] [B<--debug>] [B<--pretend>] [I<username>] -[B<--password=>I<password>] - -=head1 DESCRIPTION - -B<fripost-adduser> adds a new virtual mailbox to the system, unless -B<--pretend> is set. -If I<username> or I<password> are not given, the user is prompted for -them. -If I<username> is not fully qualified, C<fripost.org> is appended. -If I<username> is already an existing username or alias, -B<fripost-adduser> raises an error. - -=head1 OPTIONS - -=over 8 - -=item B<--pretend> - -Only simulates the insertion. (But still query the LDAP server to ensure -that I<username> is not already in the database.) - -=item B<--password=>I<password> - -By default, the user is prompted for his/her new password, which is -hashed, salted and then added to the LDAP entry. -By using B<--password>, I<password> is inserted RAW in the database. -This can be useful if the user does not want to give the clear copy but -only a hash, for example. -Using this option disables the sending of credentials. - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-adduser> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-adduser>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<-v>, B<--verbose> - -Verbose mode. - -=item B<--debug> - -Debug mode. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item I<admin_email> - -The I<From:> e-mail address to use. Defaults to C<admin@fripost.org>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-adduser> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-adduser>. - -=back - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Data::Dumper; -use Encode qw(encode); -use File::Slurp qw(slurp); -use Fripost::Password; -use Fripost::Prompt; -use Fripost::Schema; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use MIME::Lite; -use MIME::QuotedPrint; -use Template; -use YAML::Syck; - - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'pretend' => \$conf->{pretend}, - 'debug' => \$conf->{debug}, - 'v|verbose' => \$conf->{verbose}, - 'password=s' => \$conf->{password}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - -sub dsay { say STDERR @_ if $conf->{debug}; } -sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; } - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - - -# Define the new user -my $user; -my ($domain, $login); -{ - my $username; - if (defined $ARGV[0]) { - $username = fix_username ($ARGV[0]); - Email::Valid->address($username) - or die "Error: $username is not a valid e-mail.\n"; - } - else { - $username = prompt_email("New username: ", 'is_user'); - } - ($login, $domain) = split /\@/, $username, 2; - my $isActive = 'TRUE'; - my ($userPassword, $clearPassword); - if ( defined $conf->{password} ) { - $userPassword = $conf->{password}; - } - else { - $clearPassword = prompt_password(); - $userPassword = hash( $clearPassword ); - } - - $user = { - username => $username, - isActive => $isActive, - userPassword => $userPassword, - }; - $user->{clearPassword} = $clearPassword unless defined $conf->{password}; - - say "User name: $user->{username}"; - say "Password: (hidden)"; - - confirm_or_abort(); -} - - -{ - # 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 `" .$user->{username}. "' already exists.\n" - if $ldap->user->search({ username => $user->{username} })->count; - - # Ensure that the username doesn't correspond to an existing alias. - my $res = $ldap->alias->search({ address => $user->{username} }); - if ($res->count) { - print STDERR "Error: Alias $user->{username} already exists. "; - print STDERR "(Targetting to "; - print STDERR (join ', ', map { $_->{goto} } $res->entries); - say STDERR ".)"; - exit 1; - } -} - - -## Insert the new user -if ($conf->{pretend}) { - vsay "Did not create user since we are pretending."; -} -else { - my %user = %$user; - delete $user{clearPassword}; - $ldap->user->add(\%user); - say "New account $user{username} added."; -} - -$ldap->unbind(); - - - -### Prepare sending emails - -my $tt = Template->new({ - INCLUDE_PATH => "$Bin/templ", - INTERPOLATE => 1, -}) || die "$Template::ERROR\n"; - -my $admin_email = $conf->{admin_email}; -$admin_email //= 'admin@fripost.org'; -my $msg = MIME::Lite->new( - - From => encode('MIME-Q', 'Friposts administratörer') . ' <' .$admin_email. '>', - Subject => encode('MIME-Q', 'Välkommen till Fripost!'), - Encoding => 'quoted-printable', -); - -$msg->attr('content-type.charset' => 'utf-8'); - -### Send welcome email to new user -{ - my ($vars, $data); - $vars = {}; - - $tt->process('new_user_mail.tt', $vars, \$data) - || die $tt->error(), '\n'; - $msg->data($data); - - $msg->replace(To => $user->{username}); - - unless ($conf->{pretend}) { - $msg->send() unless $conf->{pretend}; - say "Sent welcome message."; - } - dsay "-----------------------------------"; - dsay "| Welcome mail |"; - dsay "-----------------------------------"; - dsay decode_qp($msg->as_string); - dsay "-----------------------------------"; -} - -### Subscribe user to announce-list -if (confirm("Subscribe user to announce mailing list? ")) { - $msg->replace(From => $user->{username}); - $msg->replace(To => 'announce-subscribe@lists.fripost.org'); - $msg->replace(Subject => ''); - $msg->replace(Data => ''); - $msg->send(); -} - -### Send login credentials to new user -if (exists $user->{clearPassword}) { - my ($vars, $data); - $vars = { - user => $user->{username}, - pass => $user->{clearPassword}, - }; - - $tt->process('user_info.tt', $vars, \$data) - || die $tt->error(), '\n'; - $msg->data($data); - - dsay "-----------------------------------"; - dsay "| Login credentials mail |"; - dsay "-----------------------------------"; - dsay decode_qp($msg->as_string); - dsay "-----------------------------------"; - - confirm_or_abort("Send email with login information? "); - my $to = prompt_email("Where should the email be sent? "); - $msg->replace(To => $to); - - if (!$conf->{pretend}) { - $msg->send; - say "Credentials sent."; - } - else { - say "Pretending, will not send credentials."; - } -} - -=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. - -=cut diff --git a/fripost-mkpass b/fripost-mkpass deleted file mode 100755 index 6728f74..0000000 --- a/fripost-mkpass +++ /dev/null @@ -1,64 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use warnings; -use strict; -use utf8; - -=head1 NAME - -fripost-mkpass - Create a random new password, and returns its hash - -=head1 SYNOPSIS - -B<fripost-mkpass> [I<password>] - -=head1 DESCRIPTION - -Use I<password> if given, otherwise generate a random new password, and -print both the clear copy and a salted SHA-1 hash. - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -our $VERSION = '0.01'; - -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use Fripost::Password; - -GetOptions( "man" => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } - ) or pod2usage(2); - -# Generate password -my $password = $ARGV[0]; -$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. - -=cut diff --git a/fripost-newalias b/fripost-newalias deleted file mode 100755 index 3fc68f8..0000000 --- a/fripost-newalias +++ /dev/null @@ -1,295 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use strict; -use warnings; -use utf8; - -=head1 NAME - -fripost-newalias - Add a new alias to the system - -=head1 SYNOPSIS - -B<fripost-newalias> [B<--verbose>] [B<--debug>] [B<--pretend>] -[B<--force>] [I<goto> [I<from>...]] - -=head1 DESCRIPTION - -B<fripost-newalias> adds a new virtual alias to the system, unless -B<--pretend> is set. -If I<goto> or I<from> are not given, the user is prompted for them. -If I<goto> is not fully qualified, C<fripost.org> is appended. -If I<from> is already an existing username or alias, -B<fripost-newalias> raises an error. - -Inserted aliases conform to Postfix's B<virtual>(5) alias table format, -with the restriction that I<from> has to be either in the form: - -=over 4 - -=item . - -I<user>@I<domain>, to redirect emails for I<user>@I<domain> to I<goto>, or - -=item . - -@I<domain>, to catch all emails for users in I<domain> and redirect them -to I<goto>. -This form has the lowest precedence: If there is an alias from -I<user>@I<domain> to I<goto2>, emails to I<user>@I<domain> will be -redirected to I<goto2> only. -See B<virtual>(5) for details and warnings. - -=back - -If serveral entries are matching, for instance if there are an alias from -I<user>@I<domain> to I<goto> and another for I<user>@I<domain> to -I<goto2>, emails to I<user>@I<domain> will be redirected to BOTH I<goto> -and I<goto2>. Note that B<fripost-newalias> forbids the creation of such -aliases, unless B<--force> is set. - - -=head1 OPTIONS - -=over 8 - -=item B<--pretend> - -Only simulates the insertion. (But still query the LDAP server to ensure -that the virtual domains of aliases are know, for example.) - -=item B<--force> - -Force creating the creation, even if I<from> is already an alias. Also, -disable the sending of the confirmation. - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-newalias> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-newalias>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<-v>, B<--verbose> - -Verbose mode. - -=item B<--debug> - -Debug mode. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item I<admin_email> - -The I<From:> e-mail address to use. Defaults to C<admin@fripost.org>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-newalias> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-newalias>. - -=back - - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Encode qw(encode); -use Email::Valid; -use Fripost::Prompt; -use Fripost::Schema; -use IO::Prompter; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use MIME::Base64; -use MIME::Lite; -use MIME::QuotedPrint; -use Template; -use YAML::Syck; - - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'pretend' => \$conf->{pretend}, - 'force' => \$conf->{force}, - 'debug' => \$conf->{debug}, - 'v|verbose' => \$conf->{verbose}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - -sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; } - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - - -# Get information -my $goto = fix_username(shift @ARGV); -my @addr = @ARGV; -$goto //= prompt_email("Alias goto address: ", 'is_user'); -@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(); - - -## Insert alias into database -for my $addr (@addr) { - - my ($u,$d) = split /\@/, $addr, 2; - my $rs; - - # Ensure that the alias doesn't already exist. - $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}) { - $ldap->alias->add({ address => $addr, goto => $goto, - isActive => 'TRUE' }); - say "New alias added from $addr to $goto."; - } else { - vsay "Pretending, will not add alias." - } -} - -$ldap->unbind(); - - -### Prepare sending emails -my $tt = Template->new({ - INCLUDE_PATH => "$Bin/templ", - INTERPOLATE => 1, -}) || die "$Template::ERROR\n"; - -my $admin_email = $conf->{admin_email}; -$admin_email //= 'admin@fripost.org'; -my $msg = MIME::Lite->new( - From => encode('MIME-Q', 'Friposts administratörer') . ' <' .$admin_email. '>', - Subject => encode('MIME-Q', 'Nya alias till din inkorg'), - Encoding => 'quoted-printable', -); - -unless (defined $conf->{force}) { - my ($vars, $data); - $vars = { - addrs => \@addr, - }; - - $tt->process('new_alias.tt', $vars, \$data) - || die $tt->error(), '\n'; - $msg->data($data); - - $msg->replace(To => $goto); - - if (!$conf->{pretend}) { - confirm_or_abort("Send confirmation? "); - $msg->send; - say "Sent verification."; - } - else { - vsay "Pretending, will not send verification."; - } -} - -=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. - -=cut diff --git a/fripost-newdomain b/fripost-newdomain deleted file mode 100755 index 2f204ee..0000000 --- a/fripost-newdomain +++ /dev/null @@ -1,263 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use warnings; -use strict; -use utf8; - -=head1 NAME - -fripost-newdomain - Add a new domain to the system - -=head1 SYNOPSIS - -B<fripost-newdomain> [B<--verbose>] [B<--debug>] [B<--pretend>] -[B<--owner=>I<username>] [I<domain>] - -=head1 DESCRIPTION - -B<fripost-newdomain> adds a new virtual domain to the system, unless -B<--pretend> is set. -If I<domain> is not given, the user is prompted for it. -By default, B<fripost-newdomain> prompts for the owner of the new -domain; Use B<--owner=>I<''> to create a "global" domain, only managed -by the administrators. -Several users can manage the same domain together. -If B<fripost-newdomain> warns if it is asked to register an existing -domain to a new owner. - -=head1 OPTIONS - -=over 8 - -=item B<--pretend> - -Only simulates the insertion. (But still query the LDAP server to ensure -that I<domain> is not already in the database, and that the owner -exists.) - -=item B<--owner=>I<username> - -By default, the user is prompted for the owner of the new domain. It is -possible to use this option instead. Also, to create a domain that is -not owned by anyone, hence only managed by the administrators, use -B<--owner=>I<''>. - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-newdomain> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-newdomain>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<-v>, B<--verbose> - -Verbose mode. - -=item B<--debug> - -Debug mode. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-newdomain> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-newdomain>. - -=back - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Data::Dumper; -use Fripost::Password; -use Fripost::Prompt; -use Fripost::Schema; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use Email::Valid; -use IO::Prompter; -use YAML::Syck; - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'pretend' => \$conf->{pretend}, - 'owner=s' => \$conf->{owner}, - 'debug' => \$conf->{debug}, - 'v|verbose' => \$conf->{verbose}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - -sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; } - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - - -# Define the domain that is to be added. -my %domain; -$domain{domain} = $ARGV[0]; -$domain{domain} //= prompt "Domain name: "; -$domain{isActive} = 'TRUE'; - -# Ensure that the domain is valid. -Email::Valid->address('fake@'.$domain{domain}) - or die "Error: Invalid domain `$domain{domain}'.\n"; - -if (defined $conf->{owner}) { - if ($conf->{owner} eq '') { - $domain{owner} = undef - } - else { - Email::Valid->address($conf->{owner}) - or die "Error: $conf->{owner} is not a valid e-mail.\n"; - $domain{owner} = $conf->{owner}; - } -} -else { - $domain{owner} = prompt_email("Belongs to user: ", 'is_user'); -} - - -{ - # 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}) { - vsay "Nothing to do since we are only pretending..."; - exit 0; -} - - -# 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 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."; -} - -create_alias($ldap, 'abuse@' . $domain{domain} ,'abuse@fripost.org'); -create_alias($ldap, 'postmaster@' . $domain{domain},'postmaster@fripost.org'); -$ldap->unbind(); - - -=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. - -=cut diff --git a/fripost-passwd b/fripost-passwd deleted file mode 100755 index 4374e47..0000000 --- a/fripost-passwd +++ /dev/null @@ -1,193 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use warnings; -use strict; - -=head1 NAME - -fripost-passwd - Change password of user - -=head1 SYNOPSIS - -B<fripost-passwd> [B<--verbose>] [B<--debug>] [B<--pretend>] [I<username>] -[B<--password=>I<password>] - -=head1 DESCRIPTION - -B<fripost-passwd> changes the password of I<username>, unless B<--pretend> -is set. -If I<username> or I<password> are not given, the user is prompted for them. -If I<username> is not fully qualified, C<fripost.org> is appended. -If I<username> is not an existing username, B<fripost-passwd> raises an -error. - -=head1 OPTIONS - -=over 8 - -=item B<--pretend> - -Only simulates the insertion. (But still query the LDAP server to ensure -that I<username> is a known user.) - -=item B<--password=>I<password> - -By default, the user is prompted for his/her new password, which is -hashed, salted and then added to the LDAP entry. -By using B<--password>, I<password> is inserted RAW in the database. -This can be useful if the user does not want to give the clear copy but -only a hash, for example. - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-passwd> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-passwd>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<-v>, B<--verbose> - -Verbose mode. - -=item B<--debug> - -Debug mode. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. It has to be set, either in the -configuration file, or using the command line option B<--server_host>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-passwd> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-passwd>. - -=back - -=cut - -# TODO: add flag --reset to automatically generate a new password and -# send it to the user (in case he/she has forgotten the password). - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Fripost::Password; -use Fripost::Prompt; -use Fripost::Schema; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use YAML::Syck; - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'pretend' => \$conf->{pretend}, - 'debug' => \$conf->{debug}, - 'v|verbose' => \$conf->{verbose}, - 'password=s' => \$conf->{password}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - -sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; } - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - - -my $username; -if (defined $ARGV[0]) { - $username = fix_username ($ARGV[0]); - Email::Valid->address($username) - or die "Error: `" .$username. "' is not a valid e-mail.\n"; -} -else { - $username = prompt_email("Username: ", 'is_user'); -} -my $password = $conf->{password}; -$password //= hash( prompt_password() ); - - -# 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; - - -if ($conf->{pretend}) { - vsay "Nothing to do since we are pretending..."; - exit 0; -} - - -# Change the password. -$ldap->user->passwd({ username => $username, userPassword => $password }); -say "Updated password for $username."; - -$ldap->unbind(); - - -=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. - -=cut diff --git a/fripost-searchalias b/fripost-searchalias deleted file mode 100755 index 4c4bb9f..0000000 --- a/fripost-searchalias +++ /dev/null @@ -1,176 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use strict; -use warnings; -use utf8; - -=head1 NAME - -fripost-searchalias - List matching aliases - -=head1 SYNOPSIS - -B<fripost-searchalias> [B<--debug>] [B<-f|--from>] [B<-g|--goto>] [address] - -B<fripost-searchalias> [B<--man>] - -=head1 DESCRIPTION - -B<fripost-seardomain> list virtual aliases matching exactly I<from>, -targetting to I<goto>. -If no I<from> is given, list all aliases whose target matches I<goto>. -If neither I<goto> nor I<from> are given, B<fripost-searchalias> list -all existing virtual aliases. - -=head1 OPTIONS - -=over 8 - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-searchalias> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-searchalias>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<-d>, B<--debug> - -Debug mode. - -=item B<-f>, B<--from> - -Match on 'from' addresses. -The default is to match both the 'from' and 'goto' address. - -=item B<-g>, B<--goto> - -Match on 'goto' addresses. -The default is to match both the 'from' and 'goto' address. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-searchalias> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-searchalias>. - -=back - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Fripost::Schema; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use YAML::Syck; - - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'debug|d' => \$conf->{debug}, - 'from|f' => \$conf->{from}, - 'goto|g' => \$conf->{goto}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - -sub perform_search { - my %alias = @_; - - foreach my $alias ($ldap->alias->search( \%alias )->entries) { - say "" . ($alias->{isActive} ? "ACTIVE" : "INACTIVE") - . " alias for " . $alias->{goto} . " are " - . (join ', ', @{$alias->{address}}); - } -} - -my $search = $ARGV[0]; - -my $f = $conf->{from}; -my $g = $conf->{goto}; -my $from = $f || !$f && !$g; -my $goto = $g || !$f && !$g; - -if ($from) { - perform_search(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(goto => $search); -} - -$ldap->unbind(); - - -=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. - -=cut diff --git a/fripost-searchdomain b/fripost-searchdomain deleted file mode 100755 index 0896683..0000000 --- a/fripost-searchdomain +++ /dev/null @@ -1,146 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use strict; -use warnings; -use utf8; - -=head1 NAME - -fripost-searchdomain - List matching domains - -=head1 SYNOPSIS - -B<fripost-searchdomain> [B<--debug>] [I<domain> [I<owner>]] - -=head1 DESCRIPTION - -B<fripost-seardomain> list virtual domains matching exactly I<domain>, -and whose owner is I<owner>. -Wildcards I<*> can appear in I<domain>, to match zero or more characters. -If no I<owner> is given, list all domains I<domain>, regardless of the -owner; If I<owner> is the empty string I<''>, list only the non -self-managed domains. -If neither I<domain> nor I<owner> are given, B<fripost-searchdomain> lists -all existing virtual domains. - -=head1 OPTIONS - -=over 8 - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-searchdomain> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-searchdomain>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<-d>, B<--debug> - -Debug mode. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-searchdomain> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-searchdomain>. - -=back - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Fripost::Schema; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use YAML::Syck; - - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'pretend' => \$conf->{pretend}, - 'debug|d' => \$conf->{debug}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - -my %domain; -$domain{domain} = $ARGV[0] if defined $ARGV[0]; -$domain{owner} = $ARGV[1] if defined $ARGV[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)'); -} - -$ldap->unbind(); - - -=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. - -=cut diff --git a/fripost-searchuser b/fripost-searchuser deleted file mode 100755 index c7b2b9b..0000000 --- a/fripost-searchuser +++ /dev/null @@ -1,144 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use strict; -use warnings; -use utf8; - -=head1 NAME - -fripost-searchuser - List matching users - -=head1 SYNOPSIS - -B<fripost-searchuser> [B<--debug>] [I<username>] - -=head1 DESCRIPTION - -B<fripost-searchuser> lists virtual mailboxes whose username exactly matches -I<username>. -Wildcards I<*> can appear in I<username>, to match zero or more characters. -If no I<username> is given, B<fripost-searchuser> list all existing mailboxes. -If I<username> has no domain part, lists matching users for any domains. -Otherwise, B<fripost-searchuser> first searches for matching domains, -and then for each of them, looks up the matching users. - -Because of these multiple searches, the use of wildcards on the domain -part of I<username> may be inefficient. - -=head1 OPTIONS - -=over 8 - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-searchuser> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-searchuser>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--debug> - -Debug mode. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-searchuser> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-searchuser>. - -=back - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Fripost::Schema; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use YAML::Syck; - - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'pretend' => \$conf->{pretend}, - 'debug' => \$conf->{debug}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - -my %user; -$user{username} = $ARGV[0] if defined $ARGV[0]; - -foreach my $user ($ldap->user->search( \%user )->entries) { - say '' . ($user->{isActive} ? 'ACTIVE' : 'INACTIVE') - . ' user ' . $user->{username}; -} - -$ldap->unbind(); - - -=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. - -=cut 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__ |