1 files changed, 79 insertions, 50 deletions

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<< <skangas at skangas.se> >>