path: root/fripost

#!/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>] { add-alias | add-domain | add-user | mkpass |
search-alias | search-domain | search-user | user-passwd }

B<fripost> B<--man>

=head1 COMMANDS

=over 4

=item B<fripost> add-alias [B<--force>] [I<goto> [I<from>...]]

Add a new virtual alias.

=item B<fripost> add-domain [B<--force>] [I<domain> [I<username>]]

Add a new virtual domain.

=item B<fripost> add-user [I<username>] [B<--password=>I<password>]

Add a new virtual mailbox.

=item B<fripost> mkpass [I<password>]

Create a random new password, and returns its hash.

=item B<fripost> search-domain [I<domain> [I<username>]]

List matching virtual domains.

=item B<fripost> search-user [I<username>]

List matching virtual users.

=item B<fripost> search-alias [B<-f>|B<--from>] [B<-g>|B<--goto>] [I<address>]

List matching virtual aliases.

=item B<fripost> user-passwd [I<username>] [B<--password=>I<password>]

Change user password.

=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> add-alias [B<--force>] [I<goto> [I<from>...]]

C<add-alias> 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<add-alias> forbids the creation of such
multi-recipient aliases, unless B<--force> is set.

=item B<fripost> add-domain [B<--force>] [I<domain> [I<username>]]

C<add-domain> 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<add-domain> prompts for the owner(s) of the new
domain; Use the empty string I<''> in the command line to create a
"global" domain, only managed by Fripost's administrators.
An error is raised if I<domain> is an existing virtual domain unless
B<--force> is set, in which case
I<username> is simply added to the list of managers.

=item B<fripost> add-user [I<username>] [B<--password=>I<password>]

C<add-user> 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> 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> search-alias [B<-f>|B<--from>] [B<-g>|B<--goto>] [I<address>]

C<search-alias> 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<search-alias> lists all existing virtual
aliases.

=item B<fripost> search-domain [I<domain> [I<username>]]

C<search-domain> 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<search-domain> lists
all existing virtual domains.

=item B<fripost> search-user [I<username>]

C<search-user> 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<search-user> lists matching users for any
domains. 
Otherwise, C<search-user> 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.

=back

=head1 OPTIONS

=over 8

=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<--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<-d>, B<--debug>

Debug mode.

=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<--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<--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<-v>, B<--verbose>

Verbose 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<admin_email>

The I<From:> e-mail address to use. Defaults to C<admin@fripost.org>.

=item I<base_dn>

The root DN for every communication to the LDAP server.

=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<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).

=item I<server_host>

The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>.

=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.

=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;

## 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);

require Fripost::Schema;
require Fripost::Commands::mkpass;
require Fripost::Commands::add_user;
require Fripost::Commands::search_user;
require Fripost::Commands::user_passwd;
require Fripost::Commands::add_domain;
require Fripost::Commands::search_domain;
require Fripost::Commands::add_alias;
require Fripost::Commands::search_alias;


## 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 'add-user') {
    $main = "Fripost::Commands::add_user::main";
}
elsif ($cmd eq 'search-user') {
    $main = "Fripost::Commands::search_user::main";
}
elsif ($cmd eq 'user-passwd') {
    $main = "Fripost::Commands::user_passwd::main";
}
elsif ($cmd eq 'add-domain') {
    $main = "Fripost::Commands::add_domain::main";
}
elsif ($cmd eq 'search-domain') {
    $main = "Fripost::Commands::search_domain::main";
}
elsif ($cmd eq 'add-alias') {
    $main = "Fripost::Commands::add_alias::main";
}
elsif ($cmd eq 'search-alias') {
    $main = "Fripost::Commands::search_alias::main";
}
else {
    pod2usage( -exitstatus => 1,
               -verbose => 0,
               -msg => length $cmd > 0 ? "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