From a6bd894f302df904588df739f79f1b17b329a0e4 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 3 May 2012 19:47:20 +0200 Subject: Adding debug messages. --- README | 8 ++++---- fripost-newalias | 8 ++++---- fripost-newdomain | 6 +++--- fripost-searchalias | 7 +++++++ fripost-searchdomain | 2 +- lib/Fripost/Prompt.pm | 12 ++++++------ lib/Fripost/Schema.pm | 8 ++++---- lib/Fripost/Schema/Search.pm | 2 +- lib/Fripost/Schema/Type/Alias.pm | 23 +++++++++++++++-------- lib/Fripost/Schema/Type/Domain.pm | 22 +++++++++++++++++++--- lib/Fripost/Schema/Type/User.pm | 17 ++++++++++++++--- lib/Fripost/Schema/Utils.pm | 2 +- 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 [B<--verbose>] [B<--debug>] [B<--pretend>] +B [B<--verbose>] [B<--debug>] [B<--pretend>] [I [I...]] =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 is not given, the user is prompted for it. By default, B 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 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 -- cgit v1.2.3