aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rwxr-xr-xlib/Fripost/Prompt.pm12
-rwxr-xr-xlib/Fripost/Schema.pm8
-rw-r--r--lib/Fripost/Schema/Search.pm2
-rw-r--r--lib/Fripost/Schema/Type/Alias.pm23
-rw-r--r--lib/Fripost/Schema/Type/Domain.pm22
-rw-r--r--lib/Fripost/Schema/Type/User.pm17
-rw-r--r--lib/Fripost/Schema/Utils.pm2
7 files changed, 60 insertions, 26 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-24 05:11:33 +0000