package Fripost::Commands::add_alias; use 5.010_000; use strict; use warnings; use utf8; =head1 NAME add_alias - 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; my $goto = shift; my @addr = @_; prompt_if_undefined ( "Alias goto address: ", \$goto, [ rewrite => sub { fix_username $_ } , 'Invalid e-mail' => sub { Email::Valid->address($_) } ] ); # Since we don't have that many users and aliases for the time # being, it's probably better to load the whole graph of aliases in # memory, not to make too many queries to the LDAP server. my $graph = &build_alias_graph( $ldap->alias->search()->entries ); prompt_if_undefined ( "Alias from address(es): ", \@addr, [ rewrite => sub { fix_username $_ } , 'Invalid e-mail' => sub { Email::Valid->address('fake'.$_) } , 'Unknown domain' => sub { $ldap->domain->search({ domain => (split /\@/, $_, 2)[1] })->count } , 'User exists' => sub { $ldap->user->search({ username => $_ })->count == 0 } , 'Alias exists' => sub { $conf->{force} or $ldap->alias->search({ address => $_ })->count == 0 } , "Is already an alias for `$goto'" => sub { $ldap->alias->search({ address => $_, goto => $goto })->count == 0 } , "Reachable from `$goto'" => sub { !&search_path ($graph, $goto, $_, ($conf->{debug} or $conf->{verbose})) } ] ); unless (@addr) { say "All right, not much to do."; exit 0; } say "Goto adress: $goto"; say "From adress(es): " . (join ", ", @addr); confirm_or_abort(); my $msg = new_alias_info_message ($conf, $goto, \@addr); ## Insert alias for my $addr (@addr) { 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 "Send confirmation? ") { $msg->send(); say "Sent confirmation (". (security_status $msg) .")."; } } } # Build the graph of aliases. It is a hash where the keys are the 'from' # part of the aliases, and the values are array references of the 'goto' # part. # For 'search_path' it is better to do it that way, as for a given # 'from' the list of 'goto' is likely to be of length one only. (Hence # the stack won't blow up.) sub build_alias_graph { my $graph; foreach (@_) { my $to = $_->{goto}; foreach my $from (@{$_->{address}}) { push @{$graph->{$from}}, $to; } } return $graph; } # Search a path in the given graph. sub search_path { my ($graph, $from, $to, $verbose) = @_; my @stack; push @stack, [$from]; while (@stack) { my $path = pop @stack; my $last = @{$path}[$#$path]; if ($last eq $to) { say STDERR 'Path found: ', join (' -> ', @$path) if $verbose; return @$path; } foreach (@{$graph->{$last}}) { push @stack, [@$path,$_]; } } } =head1 AUTHOR Stefan Kangas C<< >> Guilhem Moulin C<< >> =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 add_alias.pm __END__