From 9508574dcb8c37ff1cb8211e2fe845b2703d9141 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 10 Jun 2012 15:38:56 +0200 Subject: A more modular prompt. --- lib/Fripost/Commands/add_alias.pm | 129 ++++++++++++++++++++++-------------- lib/Fripost/Commands/add_domain.pm | 88 ++++++++++-------------- lib/Fripost/Commands/add_user.pm | 63 ++++++------------ lib/Fripost/Commands/user_passwd.pm | 30 ++++----- 4 files changed, 146 insertions(+), 164 deletions(-) (limited to 'lib/Fripost/Commands') diff --git a/lib/Fripost/Commands/add_alias.pm b/lib/Fripost/Commands/add_alias.pm index 8581a9f..60fe378 100644 --- a/lib/Fripost/Commands/add_alias.pm +++ b/lib/Fripost/Commands/add_alias.pm @@ -19,7 +19,6 @@ use IO::Prompter; use Fripost::Prompt; use Fripost::Schema; use Fripost::Email; -use Fripost::Tests; our $VERSION = '0.01'; @@ -27,42 +26,48 @@ sub main { my $ldap = shift; my $conf = shift; - # Get information - my $goto = fix_username(shift); - $goto //= prompt_email("Alias goto address: ", 'is_user'); + my $goto = shift; my @addr = @_; - @addr || push @addr, (split /, */, prompt "Alias from address(es): "); - my $graph = build_alias_graph ($ldap->alias->search()->entries); - my @path = search_path ($graph, $goto, $addr[0]); - die "Error: Cannot create cycle " . join (' -> ', @path) . ' -> ' . $goto . "\n" - if @path; + 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; + } - # 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(); @@ -70,22 +75,6 @@ sub main { ## 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}; @@ -102,7 +91,7 @@ sub main { if $conf->{verbose} or $conf->{debug}; } else { - if (confirm_or_abort("Send confirmation? ")) { + if (confirm "Send confirmation? ") { $msg->send(); say "Sent confirmation (". (security_status $msg) .")."; } @@ -110,6 +99,46 @@ sub main { } +# 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<< >> diff --git a/lib/Fripost/Commands/add_domain.pm b/lib/Fripost/Commands/add_domain.pm index 4d53e35..fc78396 100644 --- a/lib/Fripost/Commands/add_domain.pm +++ b/lib/Fripost/Commands/add_domain.pm @@ -18,7 +18,6 @@ use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use Email::Valid; -use IO::Prompter; our $VERSION = '0.01'; @@ -28,53 +27,36 @@ sub main { # Define the domain that is to be added. my %domain; - $domain{domain} = $_[0]; - $domain{domain} //= prompt "Domain name: "; + $domain{domain} = shift; + $domain{owner} = shift; $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"; - } + prompt_if_undefined ( "New domain name: ", \$domain{domain}, + [ 'Invalid domain' => sub { Email::Valid->address('fake@'.$_) } + , 'Domain exists' => sub { defined $conf->{force} or + $ldap->domain->search({ + domain => $_ + })->count == 0 } + ] + ); + + prompt_if_undefined ( "Belongs to user: ", \$domain{owner}, + [ rewrite => sub { fix_username $_ } + , 'Invalid e-mail' => sub { Email::Valid->address($_) } + , 'Unknown domain' => sub { $ldap->domain->search({ + domain => (split /\@/, $_, 2)[1] + })->count } + , 'Unknown username' => sub { $ldap->user->search({ + username => $_ + })->count } + , "Already owns `$domain{domain}'" => + sub { $ldap->domain->search({ + domain => $domain{domain}, owner => $_ + })->count == 0 } + ] + ) + unless defined $domain{owner} and $domain{owner} eq ''; + undef $domain{owner} if $domain{owner} eq ''; if ($conf->{pretend}) { say STDERR "Did not add the domain since we are pretending." @@ -84,9 +66,8 @@ sub main { # 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 "."; + say "New domain `" .$domain{domain}. "' added for user `" + .$domain{owner}. "'."; } else { say "New non self-managed domain `" .$domain{domain}. "' added."; @@ -108,11 +89,10 @@ sub create_alias { 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; + say STDERR "WARN: Alias $alias{address} already exists." + ." (Targetting to " . (join ', ', map { $_->{goto} } $res->entries) + .".)"; + return if grep { $_->{goto} eq $alias{goto} } $res->entries; } $alias{isActive} = 'TRUE'; diff --git a/lib/Fripost/Commands/add_user.pm b/lib/Fripost/Commands/add_user.pm index 4e1cf10..41cabc7 100644 --- a/lib/Fripost/Commands/add_user.pm +++ b/lib/Fripost/Commands/add_user.pm @@ -18,57 +18,33 @@ use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use Fripost::Email; +use Email::Valid; 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 $username = shift; + prompt_if_undefined ( "New username: ", \$username, + [ rewrite => sub { fix_username $_ } + , 'Invalid e-mail' => sub { Email::Valid->address($_) } + , 'Unknown domain' => sub { $ldap->domain->search({ + domain => (split /\@/, $_, 2)[1] + })->count } + , 'User exists' => sub { $ldap->user->search({ + username => $_ + })->count == 0 } + , 'Alias exists' => sub { $ldap->alias->search({ + address => $_ + })->count == 0 } + ] + ); + my $user; my $clearPassword; @@ -99,7 +75,10 @@ sub main { my $info; unless (defined $conf->{password}) { if (confirm "Send email with login information? ") { - my $to = prompt_email("Where should the email be sent? "); + my $to; + prompt_if_undefined ( "Where should the email be sent? ", $to, + [ 'Invalid e-mail' => sub { Email::Valid->address($_) } ] + ); $info = new_user_info_message ( $conf, $user->{username}, $clearPassword, $to ); diff --git a/lib/Fripost/Commands/user_passwd.pm b/lib/Fripost/Commands/user_passwd.pm index 805b7e1..64f35d9 100644 --- a/lib/Fripost/Commands/user_passwd.pm +++ b/lib/Fripost/Commands/user_passwd.pm @@ -25,24 +25,18 @@ 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 $username = shift; + prompt_if_undefined ( "Username: ", \$username, + [ rewrite => sub { fix_username $_ } + , 'Invalid e-mail' => sub { Email::Valid->address($_) } + , 'Unknown domain' => sub { $ldap->domain->search({ + domain => (split /\@/, $_, 2)[1] + })->count } + , 'Unknown user' => sub { $ldap->user->search({ + username => $_ + })->count } + ] + ); my $password = $conf->{password}; $password //= hash( prompt_password() ); -- cgit v1.2.3