Adding debug messages.

12 files changed, 79 insertions, 38 deletions

diff --git a/README b/README
index a282f3e..f77de36 100644
--- a/README
+++ b/README
@@ -6,9 +6,9 @@ http://fripost.org/
 Please send patches, bug reports and comments to:
 skangas@skangas.se
 
-#. Installation 
+#. Installation
 
-Read installation file INSTALL and follow those instructions. 
+Read installation file INSTALL and follow those instructions.
 
 Copy file fripost.yml.template to ~/.fripost.yml, edit it, chmod 600 it, and
 add the following:
@@ -23,7 +23,7 @@ Configure an locla Mail Transger Agent (MTA) for example exim4:
 
     $ sudo dpkg-reconfigure exim4-config
 
-Choose use smarthost for outgoing and no local e-mail. Choos your IPS's SMTP server for outgoing e-mail. 
+Choose use smarthost for outgoing and no local e-mail. Choos your IPS's SMTP server for outgoing e-mail.
 
 #. Log in to server
 
@@ -33,7 +33,7 @@ This opens an ssh-tunnel and returns to standard prompt. Use standard LDAP port
 
 #. Add a new mailbox.
 
-    $ fripost-adduser 
+    $ fripost-adduser
 
 #. Create a random new password
 
diff --git a/fripost-newalias b/fripost-newalias
index 4d448b7..e00adcb 100755
--- a/fripost-newalias
+++ b/fripost-newalias
@@ -11,7 +11,7 @@ fripost-newalias - Add a new alias to the system
 
 =head1 SYNOPSIS
 
-B<fripost-newalias> [B<--verbose>] [B<--debug>] [B<--pretend>] 
+B<fripost-newalias> [B<--verbose>] [B<--debug>] [B<--pretend>]
 [I<goto> [I<from>...]]
 
 =head1 DESCRIPTION
@@ -144,7 +144,7 @@ my $ldap = Fripost::Schema->new( $conf );
 my $goto = fix_username(shift @ARGV);
 my @addr = @ARGV;
 $goto //= prompt_email("Alias goto address: ", 'is_user');
-@addr || push @addr, prompt "Alias from address: ";
+@addr || push @addr, (split /, */, prompt "Alias from address(es): ");
 
 # Show goto adress
 say "goto adress: $goto";
@@ -171,7 +171,7 @@ if (@addr == 0) {
     warn "No valid destination adresses. Aborting...\n";
     exit 1;
 }
-say "from adress: " . (join " ", @addr);
+say "from adress(es): " . (join ", ", @addr);
 confirm_or_abort();
 
 
@@ -229,7 +229,7 @@ my $msg = MIME::Lite->new(
     $msg->data($data);
 
     $msg->replace(To => $goto);
-    
+
     if (!$conf->{pretend}) {
         confirm_or_abort("Send confirmation? ");
         $msg->send;
diff --git a/fripost-newdomain b/fripost-newdomain
index 1ce4b02..b9fcecc 100755
--- a/fripost-newdomain
+++ b/fripost-newdomain
@@ -22,7 +22,7 @@ If I<domain> is not given, the user is prompted for it.
 By default, B<fripost-newdomain> prompts for the owner of the new
 domain; Use B<--owner=>I<''> to create a "global" domain, only managed
 by the administrators.
-Several users can manage the same domain together. 
+Several users can manage the same domain together.
 If B<fripost-newdomain> warns if it is asked to register an existing
 domain to a new owner.
 
@@ -169,7 +169,7 @@ else {
     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) {
@@ -178,7 +178,7 @@ else {
         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} });
diff --git a/fripost-searchalias b/fripost-searchalias
index 0775942..2e5d35f 100755
--- a/fripost-searchalias
+++ b/fripost-searchalias
@@ -118,6 +118,13 @@ my %alias;
 $alias{goto}    = $ARGV[0] if defined $ARGV[0];
 $alias{address} = $ARGV[1] if defined $ARGV[1];
 
+if (defined $alias{address}) {
+    my ($u,$d) = split /\@/, $alias{address}, 2;
+    $d = $u if (defined $u) and not (defined $d);
+    $ldap->domain->search({ domain => $d })->count
+        or die "Error: Unknown domain `$d'.\n";
+}
+
 foreach my $alias ($ldap->alias->search( \%alias )->entries) {
     say "From:     " . (join ', ', @{$alias->{address}});
     say "Goto:     " . $alias->{goto};
diff --git a/fripost-searchdomain b/fripost-searchdomain
index 8653eb1..91e7e72 100755
--- a/fripost-searchdomain
+++ b/fripost-searchdomain
@@ -123,7 +123,7 @@ foreach my $domain ($ldap->domain->search( \%domain )->entries) {
     say "Domain:   " . $domain->{domain};
     print "Owner:    ";
     my $owners = $domain->{owner};
-    if (defined $owners) {  
+    if (defined $owners) {
         say (join ', ', @$owners);
     }
     else {
diff --git a/lib/Fripost/Prompt.pm b/lib/Fripost/Prompt.pm
index 07a1c0b..4f71faf 100755
--- a/lib/Fripost/Prompt.pm
+++ b/lib/Fripost/Prompt.pm
@@ -23,13 +23,13 @@ our @ISA = qw(Exporter);
 sub confirm {
     my ($msg) = @_;
     $msg //= "Is this OK? [no will abort] ";
-    return prompt $msg, -yn;
+    return prompt -in => \*STDIN, -out => \*STDOUT, $msg, -yn;
 }
 
 sub confirm_or_abort {
     my ($msg) = @_;
     $msg //= "Is this OK? [no will abort] ";
-    my $confirmed = prompt $msg, -yn;
+    my $confirmed = prompt -in => \*STDIN, -out => \*STDOUT, $msg, -yn;
     unless ($confirmed) {
         say "User aborted";
         exit 1;
@@ -50,7 +50,7 @@ sub prompt_email {
     $msg //= "Enter email: ";
     my $email;
     do {
-        $email = prompt $msg;
+        $email = prompt -in => \*STDIN, -out => \*STDOUT, $msg;
 
         if ($is_username) {
             $email = fix_username($email);
@@ -72,8 +72,8 @@ sub prompt_password {
 
     my $password;
     do {
-        $password   = prompt $msg,  -echo => '*';
-        my $confirm = prompt $msg2, -echo => '*';
+        $password   = prompt -in => \*STDIN, -out => \*STDOUT, $msg,  -echo => '*';
+        my $confirm = prompt -in => \*STDIN, -out => \*STDOUT, $msg2, -echo => '*';
         unless ($password eq $confirm) {
             undef $password;
             say "Passwords do not match";
@@ -83,7 +83,7 @@ sub prompt_password {
 
     if ($password eq '') {
         $password = mkpasswd();
-        say "Using password: $password";    
+        say "Using password: $password";
     }
     return $password;
 }
diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 6a92be7..f8649b7 100755
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -35,10 +35,10 @@ sub new {
 
     my $self = {_options => $h};
     bless $self, $class;
-    
+
     my $ldap = Net::LDAP->new ( $h->{server_host} )
         or die "Error: Cannot initialize connection to LDAP server at `"
-              .$h->{server_host}. "'.\n"; 
+              .$h->{server_host}. "'.\n";
 
     my $mesg;
     if ( (defined $h->{bind_dn}) and $h->{bind_dn} ne '' ) {
@@ -61,7 +61,7 @@ sub new {
         $mesg = $ldap->bind();
     }
     die "Error: " .$mesg->error. "\n" if $mesg->code;
-    
+
     $self->{_ldap} = $ldap;
     return $self;
 }
@@ -146,7 +146,7 @@ sub _dsay {
 
 =head1 NAME
 
-Fripost::Schema - 
+Fripost::Schema -
 
 =head1 AUTHOR
 
diff --git a/lib/Fripost/Schema/Search.pm b/lib/Fripost/Schema/Search.pm
index 67815bd..a9eb2ea 100644
--- a/lib/Fripost/Schema/Search.pm
+++ b/lib/Fripost/Schema/Search.pm
@@ -5,7 +5,7 @@ use warnings;
 use strict;
 
 use Fripost::Schema::Type;
-use Fripost::Schema::Utils; 
+use Fripost::Schema::Utils;
 
 use base qw/Net::LDAP::Search/;
 our $VERSION = '0.01';
diff --git a/lib/Fripost/Schema/Type/Alias.pm b/lib/Fripost/Schema/Type/Alias.pm
index 9acab0d..8c0b25e 100644
--- a/lib/Fripost/Schema/Type/Alias.pm
+++ b/lib/Fripost/Schema/Type/Alias.pm
@@ -11,19 +11,17 @@ our $VERSION = '0.01';
 #######################################################################
 
 # Search an alias, and return the corresponding entries if found. If no
-# alias is given, returns all aliases. 
+# alias is given, returns all aliases.
 # Filters on values of both keys `address' and `goto' (unless they are
 # undefined).
-# An extra key `domain' can be given to scope the search on aliases for
-# this domain only.
 sub search {
     my $self = shift;
     my $alias = shift;
 
     my ($username, $domain);
-    $domain = $alias->{domain} if defined $alias->{domain};
     ($username, $domain) = split /\@/, $alias->{address}, 2
         if defined $alias->{address};
+    $domain = $username if (defined $username) and not (defined $domain);
 
     my $base  = $self->{_options}->{base_dn};
     $base  = join ',', ( 'dc='.$domain, $base )
@@ -34,12 +32,18 @@ sub search {
         if defined $username;
     push @filters, '(mailTarget=' .$alias->{goto}. ')'
         if defined $alias->{goto};
+    my $filter = Fripost::Schema::Utils::mkAndFilter( @filters );
+
+    if ($self->{_options}->{debug}) {
+        say STDERR "DEBUG: Search base: " .$base;
+        say STDERR "DEBUG: Search filter: " .$filter;
+    }
 
     my $res = $self->{_ldap}->search(
                   base   => $base,
                   scope  => 'subtree',
                   attrs  => [ 'mailLocalAddress', 'mailTarget', 'isActive' ],
-                  filter => Fripost::Schema::Utils::mkAndFilter( @filters )
+                  filter => $filter
             );
     die "Error: " .$res->error. "\n" if $res->code;
 
@@ -60,13 +64,16 @@ sub add {
     my $base = join ',', ( 'mailTarget='.$alias->{goto}
                          , 'dc='. $domain
                          , $self->{_options}->{base_dn} );
-
     my @attrs = ( mailLocalAddress => $username );
+
+
     my $res;
-    if ($self->search({ goto => $alias->{goto}, domain => $domain })->count) {
+    if ($self->search({ goto => $alias->{goto}, address => $domain })->count) {
+        say STDERR "DEBUG: Modify base: " .$base if ($self->{_options}->{debug});
         $res = $self->{_ldap}->modify( $base, add => [ @attrs ] );
     }
     else {
+        say STDERR "DEBUG: Add base: " .$base if ($self->{_options}->{debug});
         $res = $self->{_ldap}->add( $base,
                  attrs => [ objectClass      => [ 'inetLocalMailRecipient',
                                                   'virtualAliases' ]
@@ -86,7 +93,7 @@ sub add {
 
 =head1 NAME
 
-Fripost::Schema::Type::Alias - 
+Fripost::Schema::Type::Alias -
 
 =head1 AUTHOR
 
diff --git a/lib/Fripost/Schema/Type/Domain.pm b/lib/Fripost/Schema/Type/Domain.pm
index 2b803ac..448eaed 100644
--- a/lib/Fripost/Schema/Type/Domain.pm
+++ b/lib/Fripost/Schema/Type/Domain.pm
@@ -5,7 +5,7 @@ use warnings;
 use strict;
 
 use base qw/Net::LDAP/;
-use Fripost::Schema::Utils; 
+use Fripost::Schema::Utils;
 
 our $VERSION = '0.01';
 
@@ -36,11 +36,18 @@ sub search {
             push @filters, "(owner=" .$owner. ")";
         }
     }
+    my $filter = Fripost::Schema::Utils::mkAndFilter( @filters );
+
+    if ($self->{_options}->{debug}) {
+        say STDERR "DEBUG: Search base: " .$self->{_options}->{base_dn};
+        say STDERR "DEBUG: Search filter: " .$filter;
+    }
+
     my $res = $self->{_ldap}->search(
                   base   => $self->{_options}->{base_dn},
                   scope  => 'one',
                   attrs  => [ 'dc', 'owner', 'isActive' ],
-                  filter => Fripost::Schema::Utils::mkAndFilter( @filters )
+                  filter => $filter
             );
     die "Error: " .$res->error. "\n" if $res->code;
     return $res;
@@ -57,11 +64,17 @@ sub add {
     $owner = Fripost::Schema::Utils::mkDN ( $self->{_options}, $domain->{owner} )
         if defined $domain->{owner};
 
+    say STDERR "DEBUG: Ownership: " .$owner
+        if $self->{_options}->{debug} and (defined $owner);
+
     my $res;
     if ($self->search({ domain => $domain->{domain} })->count) {
         die "Error: Cannot create self-managed domain `"
             .$domain->{domain}. "' since it already exists.\n"
           unless defined $domain->{owner};
+
+        say STDERR "DEBUG: Modify base: " .$base
+            if $self->{_options}->{debug};
         $res = $self->{_ldap}->modify( $base, add => [ owner => $owner ] );
     }
     else {
@@ -70,6 +83,9 @@ sub add {
                     );
         push @attrs, (owner => $owner)
             if defined $domain->{owner};
+
+        say STDERR "DEBUG: Add base: " .$base
+            if $self->{_options}->{debug};
         $res = $self->{_ldap}->add( $base, attrs => [ @attrs ] );
     }
     die "Error: " .$res->error. "\n" if $res->code;
@@ -84,7 +100,7 @@ sub add {
 
 =head1 NAME
 
-Fripost::Schema::Type::Domain - 
+Fripost::Schema::Type::Domain -
 
 =head1 AUTHOR
 
diff --git a/lib/Fripost/Schema/Type/User.pm b/lib/Fripost/Schema/Type/User.pm
index c3075a8..794f5e5 100644
--- a/lib/Fripost/Schema/Type/User.pm
+++ b/lib/Fripost/Schema/Type/User.pm
@@ -5,7 +5,7 @@ use warnings;
 use strict;
 
 use base qw/Net::LDAP/;
-use Fripost::Schema::Utils; 
+use Fripost::Schema::Utils;
 
 our $VERSION = '0.01';
 
@@ -27,11 +27,16 @@ sub search {
     my $base  = $self->{_options}->{base_dn};
     $base  = join ',', ( 'dc='.$domain, $base )
         if defined $domain;
-    
+
     my $filter = "(ObjectClass=virtualMailbox)";
     $filter = "(&" .$filter. "(uid=" .$username. ")" .")"
         if defined $username;
 
+    if ($self->{_options}->{debug}) {
+        say STDERR "DEBUG: Search base: " .$base;
+        say STDERR "DEBUG: Search filter: " .$filter;
+    }
+
     my $res = $self->{_ldap}->search(
                   base   => $base,
                   scope  => 'sub',
@@ -50,6 +55,9 @@ sub add {
 
     my $base = Fripost::Schema::Utils::mkDN ( $self->{_options}
                                             , $user->{username} );
+    if ($self->{_options}->{debug}) {
+        say STDERR "DEBUG: Add base: " .$base;
+    }
 
     my $res = $self->{_ldap}->add( $base,
                 attrs => [ objectClass  => 'virtualMailbox',
@@ -69,6 +77,9 @@ sub passwd {
 
     my $base = Fripost::Schema::Utils::mkDN ( $self->{_options}
                                             , $user->{username} );
+    if ($self->{_options}->{debug}) {
+        say STDERR "DEBUG: Modify base: " .$base;
+    }
 
     my $res = $self->{_ldap}->modify( $base,
                   replace => [ userPassword => $user->{userPassword} ]
@@ -84,7 +95,7 @@ sub passwd {
 
 =head1 NAME
 
-Fripost::Schema::Type::User - 
+Fripost::Schema::Type::User -
 
 =head1 AUTHOR
 
diff --git a/lib/Fripost/Schema/Utils.pm b/lib/Fripost/Schema/Utils.pm
index 382da1c..3fd6c79 100644
--- a/lib/Fripost/Schema/Utils.pm
+++ b/lib/Fripost/Schema/Utils.pm
@@ -54,7 +54,7 @@ sub mkAndFilter {
 
 =head1 NAME
 
-Fripost::Schema::Type::User - 
+Fripost::Schema::Type::User -
 
 =head1 AUTHOR