diff options
Diffstat (limited to 'fripost-newalias')
| -rwxr-xr-x | fripost-newalias | 183 |
1 files changed, 149 insertions, 34 deletions
diff --git a/fripost-newalias b/fripost-newalias index 4592522..b638e06 100755 --- a/fripost-newalias +++ b/fripost-newalias @@ -11,41 +11,135 @@ fripost-newalias - Add a new alias to the system =head1 SYNOPSIS -fripost-newalias -fripost-newalias GOTO FROM... +B<fripost-newalias> [B<--verbose>] [B<--debug>] [B<--pretend>] +[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. + +=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<--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. It has to be set, either in the +configuration file, or using the command line option B<--server_host>. + +=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::Password; use Fripost::Prompt; use Fripost::Schema; use IO::Prompt; -use Getopt::Long; +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('default.yml'); +our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); GetOptions( - 'dbi_dsn' => \$conf->{dbi_dsn}, - 'admuser=s' => \$conf->{admuser}, - 'admpass=s' => \$conf->{admpass}, - 'pretend' => \$conf->{pretend}, -) or die "Unable to get command line options."; - -# Connect to the database -my $schema = Fripost::Schema->connect( - $conf->{dbi_dsn}, $conf->{admuser}, $conf->{admpass}, {} #\%dbi_params -); + 'server_host' => \$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}, + '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); @@ -59,51 +153,68 @@ say "goto adress: $goto"; # Show from adresses @addr = grep { if (Email::Valid->address($_)) { - 1; + # 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 { - say "WARN: skipping invalid address $_"; + warn "WARN: Skipping invalid address `" .$_. "'.\n"; undef; } } @addr; if (@addr == 0) { - say "No valid destination adresses. Aborting..."; + warn "No valid destination adresses. Aborting...\n"; exit 1; } say "from adress: " . (join " ", @addr); confirm_or_abort(); + ## Insert alias into database for my $addr (@addr) { - my $rs = $schema->resultset('Alias')->search({ - address => $addr, - }); + my $rs = $ldap->alias->search({ address => $addr }); if (!$rs->count) { - my $db_alias = $schema->resultset('Alias')->new({ - address => $addr, - goto => $goto, - domain => (split /\@/, $addr)[1], - }); - if (!$conf->{pretend}) { - $db_alias->insert; - say "New alias added from $addr to $goto."; - } else { - say "Pretending, will not add alias." + 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." + } + } + else { + die "Error: Username $addr already exists.\n"; } } else { - say "There already exists an alias for $addr."; + print STDERR "Error: Alias $addr already exists. "; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { $_->{goto} } ($rs->entries)); + say STDERR ".)"; + exit 1; } } +$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@fripost.org>', + From => encode('MIME-Q', 'Friposts administratörer') . ' <' .$admin_email. '>', Subject => encode('MIME-Q', 'Nya alias till din inkorg'), Encoding => 'quoted-printable', ); @@ -126,7 +237,7 @@ my $msg = MIME::Lite->new( say "Sent verification."; } else { - say "Pretending, will not send verification."; + vsay "Pretending, will not send verification."; } } @@ -134,10 +245,14 @@ my $msg = MIME::Lite->new( 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 |