aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@fripost.org>2013-01-20 03:04:17 +0100
committerGuilhem Moulin <guilhem.moulin@fripost.org>2013-01-20 03:04:17 +0100
commit35c4ad13a52bdcaab251358e4b7df99dd852c76d (patch)
tree8fcafeae85ae97332a6a5e9d0ff2abcd178e537b /lib/Fripost
parentf7701a60f217ab154fe53a5d13bbd223f6182150 (diff)
New domains.
Diffstat (limited to 'lib/Fripost')
-rw-r--r--lib/Fripost/Panel/Interface.pm157
-rw-r--r--lib/Fripost/Panel/Login.pm9
-rw-r--r--lib/Fripost/Schema/Domain.pm164
-rw-r--r--lib/Fripost/Schema/List.pm7
-rw-r--r--lib/Fripost/Schema/Local.pm9
-rw-r--r--lib/Fripost/Schema/User.pm54
-rw-r--r--lib/Fripost/Schema/Util.pm5
7 files changed, 324 insertions, 81 deletions
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index d04fa3a..e4724d1 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -18,7 +18,8 @@ use Fripost::Schema::Util 'split_addr';
use Fripost::Password;
use HTML::Entities 'encode_entities';
use URI::Escape::XS 'encodeURIComponent';
-use Net::IDN::Encode qw/email_to_unicode email_to_ascii/;
+use Net::IDN::Encode qw/email_to_unicode email_to_ascii domain_to_ascii/;
+use Encode;
# This method is called right before the 'setup' method below. It
@@ -38,8 +39,6 @@ sub ListDomains : StartRunmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' );
-
my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
my @domains = $fp->domain->search( -concat => "\n", -die => 403);
$fp->done;
@@ -49,6 +48,7 @@ sub ListDomains : StartRunmode {
$template->param( $self->userInfo );
$template->param( domains => [ map { { &mkLink( domain => $_->{domain})
, isactive => $_->{isactive}
+ , ispending => $_->{ispending}
, description => $_->{description} } }
@domains ]
);
@@ -62,10 +62,16 @@ sub ListLocals : Runmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' );
my $d = ($self->split_path)[1];
my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $q = $self->query;
+ if (defined $q->param('unlock') and $q->param('unlock') ne '') {
+ $fp->domain->unlock( $d, $q->param('unlock') );
+ $fp->done;
+ return $self->redirect('../');
+ }
+
# Query *the* matching domain
my %domain = $fp->domain->get( $d, -die => 404 );
@@ -156,7 +162,6 @@ sub EditDomain : Runmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' );
my $d = ($self->split_path)[1];
my $q = $self->query;
@@ -169,11 +174,11 @@ sub EditDomain : Runmode {
# Changes have been submitted: process them
$error = $fp->domain->replace({
domain => $d,
- isactive => $q->param('isactive'),
- description => $q->param('description'),
- catchalls => $q->param('catchalls'),
- canAddAlias => $q->param('canAddAlias'),
- canAddList => $q->param('canAddList')
+ isactive => $q->param('isactive') // 1,
+ description => $q->param('description') // undef,
+ catchalls => $q->param('catchalls') // undef,
+ canAddAlias => $q->param('canAddAlias') // undef,
+ canAddList => $q->param('canAddList') // undef
}, -concat => "(\n|\x{0D}\x{0A})");
}
my %domain = $fp->domain->get( $d, -die => 404 );
@@ -186,11 +191,11 @@ sub EditDomain : Runmode {
, isPostmaster => $domain{permissions} eq 'p');
if ($error) {
# Preserve the (incorrect) form
- $template->param( isactive => $q->param('isactive')
- , description => $q->param('description')
- , catchalls => $q->param('catchalls')
- , canAddAlias => $q->param('canAddAlias')
- , canAddList => $q->param('canAddList')
+ $template->param( isactive => $q->param('isactive') // 1
+ , description => $q->param('description') // undef
+ , catchalls => $q->param('catchalls') // undef
+ , canAddAlias => $q->param('canAddAlias') // undef
+ , canAddList => $q->param('canAddList') // undef
, error => encode_entities ($error) );
}
else {
@@ -241,11 +246,11 @@ sub EditLocal : Runmode {
my %entry;
if ($t eq 'user') {
$entry{user} = $l.'@'.$d;
- $entry{forwards} = $q->param('forwards');
+ $entry{forwards} = $q->param('forwards') // undef;
- if ($q->param('oldpw') ne '' or
- $q->param('newpw') ne '' or
- $q->param('newpw2') ne '') {
+ if (($q->param('oldpw') // '') ne '' or
+ ($q->param('newpw') // '') ne '' or
+ ($q->param('newpw2') // '') ne '') {
# If the user tries to change the password, we make her
# bind first, to prevent an attacker from setting a
# custom password and accessing the emails.
@@ -263,13 +268,13 @@ sub EditLocal : Runmode {
my $u = email_to_unicode($self->authen->username);
$fp = Fripost::Schema::->auth(
$u,
- $q->param('oldpw'),
+ $q->param('oldpw') // '',
%CFG,
-die => "Wrong password (for ‘".$u."’)." );
};
$error = $@ || $fp->user->passwd(
$entry{user},
- Fripost::Password::hash($q->param('newpw'))
+ Fripost::Password::hash($q->param('newpw') // '')
);
$fp->done if defined $fp;
}
@@ -277,14 +282,14 @@ sub EditLocal : Runmode {
}
elsif ($t eq 'alias') {
$entry{alias} = $l.'@'.$d;
- $entry{maildrop} = $q->param('maildrop');
+ $entry{maildrop} = $q->param('maildrop') // undef;
}
elsif ($t eq 'list') {
$entry{list} = $l.'@'.$d;
- $entry{transport} = $q->param('transport');
+ $entry{transport} = $q->param('transport') // undef;
}
- $entry{isactive} = $q->param('isactive');
- $entry{description} = $q->param('description');
+ $entry{isactive} = $q->param('isactive') // 1;
+ $entry{description} = $q->param('description') // undef;
$error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})")
unless $error;
}
@@ -297,17 +302,17 @@ sub EditLocal : Runmode {
# Preserve the (incorrect) form, except the passwords
if ($t eq 'user') {
$template->param( user => encode_entities($l)
- , forwards => $q->param('forwards') );
+ , forwards => $q->param('forwards') // undef );
}
elsif ($t eq 'alias') {
$template->param( alias => encode_entities($l)
- , maildrop => $q->param('maildrop') );
+ , maildrop => $q->param('maildrop') // undef );
}
elsif ($t eq 'list') {
$template->param( list => encode_entities($l) );
}
- $template->param( isactive => $q->param('isactive')
- , description => $q->param('description') );
+ $template->param( isactive => $q->param('isactive') // 1
+ , description => $q->param('description') // undef );
}
else {
%local = $fp->local->get ($l.'@'.$d, -die => 404,
@@ -339,6 +344,82 @@ sub EditLocal : Runmode {
return $template->output;
}
+sub AddDomain : Runmode {
+ my $self = shift;
+ my %CFG = $self->cfg;
+
+ my $q = $self->query;
+ return $self->redirect('./') if defined $q->param('cancel'); # Cancellation
+
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $domain = $q->param('domain');
+ Encode::_utf8_on($domain) if defined $domain;
+ my $session_param;
+ $session_param = 'AddDomain-Postmasters-' . domain_to_ascii($domain)
+ if defined $domain;
+
+ my $error; # Tells whether the change submission has failed.
+ if (defined $q->param('submit')) {
+ # Changes have been submitted: process them
+
+ if (defined $q->param('postmaster') and defined $session_param) {
+ my @postmasters = split /\s*,\s*/, $self->session->param($session_param);
+ $error = "‘".$q->param('postmaster')."’ was not listed among the domain owners."
+ unless defined $self->session->param($session_param)
+ and grep { $q->param('postmaster') eq $_ } @postmasters;
+ }
+
+ $error = $fp->domain->add({
+ domain => $domain,
+ send_token_to => $q->param('postmaster') // undef,
+ isactive => $q->param('isactive') // 1,
+ description => $q->param('description') // undef,
+ catchalls => $q->param('catchalls') // undef },
+ -concat => "(\n|\x{0D}\x{0A})",
+ '-dry-run' => not (defined $q->param('postmaster')),
+ -domainurl => $q->url.'/'.encode_entities($domain).'/' # TODO: try that in nginx
+ ) unless $error;
+ }
+ $fp->done;
+
+ return $self->redirect('./') # Confirmation token sent, everything OK
+ if ($error // '') eq '' and defined $q->param('postmaster');
+
+ my $tmpl_file;
+ my @postmasters;
+
+ if (($error // '') ne '' or not (defined $domain)) {
+ # Something went wrong, or the domain is unknown
+ $tmpl_file = 'add-domain-1.html';
+ }
+ else {
+ $tmpl_file = 'add-domain-2.html';
+ @postmasters = Fripost::Schema::Domain::->list_postmasters($domain);
+ }
+
+ my $template = $self->load_tmpl( $tmpl_file, cache => 1,
+ , loop_context_vars => 1 );
+ $template->param( $self->userInfo );
+ $template->param( error => encode_entities ($error) ) if $error;
+
+ $template->param( isactive => $q->param('isactive') // 1
+ , description => $q->param('description') // undef
+ , catchalls => $q->param('catchalls') // undef
+ );
+ $template->param( domain => encode_entities($domain) )
+ if defined $domain;
+
+ if (@postmasters) {
+ # Store it, to ensure the user doesn't send back a bogus email
+ $self->session->param( $session_param, join(',', @postmasters) );
+ $self->session->flush;
+
+ $template->param( postmasters => [ map {{postmaster => $_}} @postmasters ] )
+ }
+
+ return $template->output;
+}
+
# In this Run Mode authenticated users can add users, aliases and lists
# (if they have the permission).
@@ -400,8 +481,8 @@ sub AddLocal : Runmode {
# Unknown type
return $self->redirect('./');
}
- $entry{isactive} = $q->param('isactive');
- $entry{description} = $q->param('description');
+ $entry{isactive} = $q->param('isactive') // 1;
+ $entry{description} = $q->param('description') // undef;
unless ($error) {
my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
@@ -417,23 +498,23 @@ sub AddLocal : Runmode {
if ($error) {
# Preserve the (incorrect) form, except the passwords
if ($t eq 'user') {
- $template->param( user => $q->param('user')
- , forwards => $q->param('forwards') );
+ $template->param( user => $q->param('user') // undef
+ , forwards => $q->param('forwards') // undef );
}
elsif ($t eq 'alias') {
- $template->param( alias => $q->param('alias')
- , maildrop => $q->param('maildrop') );
+ $template->param( alias => $q->param('alias') // undef
+ , maildrop => $q->param('maildrop') // undef );
}
elsif ($t eq 'list') {
- $template->param( list => $q->param('list')
+ $template->param( list => $q->param('list') // undef
, isenc => $q->param('transport') eq 'schleuder' );
}
else {
# Unknown type
return $self->redirect('./');
}
- $template->param( isactive => $q->param('isactive')
- , description => $q->param('description')
+ $template->param( isactive => $q->param('isactive') // 1
+ , description => $q->param('description') // undef
, error => encode_entities ($error) );
}
else {
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index 12b0294..b0906b3 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -105,13 +105,12 @@ sub setup {
# /domain/{user,alias,list}/?query_url
my ($null,$domain,$local,$crap) = $self->split_path;
- return 'ListDomains' unless (defined $null) and $null eq '';
+ return 'ListDomains' if (defined $null) and $null ne '';
unless (defined $domain and $domain ne '') {
- # TODO
-# if (defined $a) {
-# return 'AddDomain' if $a eq 'add';
-# }
+ if (defined $a) {
+ return 'AddDomain' if $a eq 'add';
+ }
return 'ListDomains';
}
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index e86822f..993d771 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -21,6 +21,13 @@ use Fripost::Schema::Util qw/concat get_perms explode must_attrs
email_valid canonical_dn/;
use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode
email_to_ascii email_to_unicode/;
+use Encode;
+use Net::Domain::TLD 'tld_exists';
+use Net::DNS::Dig;
+use Net::Whois::Parser 'parse_whois';
+use String::Random;
+use Template;
+use MIME::Entity;
=head1 METHODS
@@ -44,7 +51,8 @@ sub search {
scope => 'one',
deref => 'never',
filter => 'objectClass=FripostVirtualDomain',
- attrs => [ qw/fvd description fripostIsStatusActive/ ]
+ attrs => [ qw/fvd description fripostIsStatusActive
+ fripostIsStatusPending/ ]
);
if ($domains->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
@@ -52,6 +60,7 @@ sub search {
}
return map { { domain => domain_to_unicode($_->get_value('fvd'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+ , ispending => defined $_->get_value('fripostIsStatusPending')
, description => concat($concat, $_->get_value('description'))
}
}
@@ -148,10 +157,158 @@ sub replace {
}
+sub list_postmasters {
+ my $self = shift;
+ my $hostname = shift;
+ my @postmasters;
+
+ my $tld = domain_to_ascii($hostname);
+ my $domain;
+ until ( tld_exists($tld) ) {
+ die "‘".$hostname."’ has an Invalid TLD.\n" unless $tld =~ /\./;
+ $domain = $tld;
+
+ my %mx = Net::DNS::Dig->new()->for( $domain, 'MX' )->rdata;
+ push @postmasters, 'postmaster@'.$domain # RFC 822, appendix C.6
+ if grep {!/\bfripost\.org$/} (values %mx);
+
+ $tld =~ s/^[^\.]*\.//;
+ }
+
+ my $info = parse_whois( domain => $domain );
+# die "Cannot WHOIS ‘".$domain."’.\n" unless defined $info;
+ # TODO: there is a bug with the encoding
+ if (defined $info) {
+ push @postmasters, @{$info->{emails}};
+ }
+
+ my %hash;
+ $hash{$_} = 1 for grep {email_valid($_ // '', -nodie => 1 )}
+ @postmasters;
+ sort keys %hash;
+}
+
sub add {
- die "TODO";
+ my $self = shift;
+ my $d = shift;
+ my %options = @_;
+
+ foreach (qw/description catchalls canAddAlias canAddList/) {
+ $d->{$_} = explode ($options{'-concat'}, $d->{$_})
+ if defined $d->{$_};
+ }
+
+ eval {
+ my $domain = $d->{domain};
+ Encode::_utf8_on($domain);
+ &_is_valid($d);
+
+ my $dn = canonical_dn( {fvd => $d->{domain}}, @{$self->suffix} );
+
+ my $mesg = $self->ldap->search(
+ base => $dn,
+ scope => 'base',
+ deref => 'never',
+ filter => 'objectClass=FripostVirtualDomain',
+ attrs => [] );
+ if ($mesg->code == 0) {
+ die "Domain ‘".$domain."’ already exists.\n";
+ }
+ elsif ($mesg->code != 32) {
+ die $mesg->error."\n";
+ }
+
+ return if $options{'-dry-run'};
+
+ my %attrs = ( objectClass => 'FripostVirtualDomain'
+ , fripostIsStatusActive => $d->{isactive} ?
+ 'TRUE' : 'FALSE'
+ );
+ $attrs{description} = $d->{description}
+ if defined $d->{description} and @{$d->{description}};
+ $attrs{fripostOptionalMaildrop} = $d->{catchalls}
+ if defined $d->{catchalls} and @{$d->{catchalls}};
+
+ if (defined $d->{owner}) {
+ $attrs{fripostOwner} = $self->_fvu2dn($d->{owner})
+ if $d->{owner} ne '';
+ }
+ else {
+ $attrs{fripostOwner} = $self->whoami;
+ }
+
+ my $token;
+ if (defined $d->{send_token_to}) {
+ $token = String::Random::->new->randregex('\w{32}');
+ $attrs{fripostIsStatusPending} = $token
+ }
+
+ $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] );
+ die $mesg->error."\n" if $mesg->code;
+
+
+ if (defined $d->{send_token_to}) {
+ my $tt = Template->new({
+ INCLUDE_PATH => './templates', # TODO: use a config option
+ INTERPOLATE => 1,
+ }) or die $Template::ERROR."\n";
+
+ my $data;
+ my $vars = { domain => $domain, token => $token };
+ $vars->{unlockurl} = $options{'-domainurl'}.'?unlock='.$token
+ if defined $options{'-domainurl'};
+ $tt->process( 'new-domain.tt', $vars, \$data)
+ or die $tt->error."\n";
+
+ my $mail = MIME::Entity::->build(
+ From => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
+ To => $d->{send_token_to},
+ Subject => "Your new domain ".$d->{domain},
+ Encoding => 'quoted-printable',
+ Charset => 'utf-8',
+ Data => $data
+ );
+ $mail->send;
+ }
+
+ };
+ return $@;
+}
+
+sub unlock {
+ my $self = shift;
+ my $d = shift;
+ my $code = shift;
+
+ eval {
+ my $dn = canonical_dn({fvd => domain_to_ascii($d)}, @{$self->suffix});
+ my $domains = $self->ldap->search(
+ base => $dn,
+ scope => 'base',
+ deref => 'never',
+ filter => '(&(objectClass=FripostVirtualDomain)'.
+ '(fripostIsStatusPending=*))',
+ attrs => [ 'fripostIsStatusPending' ]
+ );
+ die $domains->error."\n" if $domains->code;
+
+ my $domain = $domains->pop_entry;
+ die "No such such domain: ‘".$d."’\n" unless defined $domain;
+
+ die "Wrong unlock code for ‘".$d."’\n"
+ unless $domain->get_value('fripostIsStatusPending') eq $code;
+ # TODO: a more secure option would be to add a 'userPassword'
+ # attribute to domains. We can bind as the domain to check the
+ # validity of the token and add an ACL rule to give =z rights on
+ # self and =0 for everyone else.
+
+ my $mesg = $self->ldap->modify( $dn, delete => 'fripostIsStatusPending' );
+ die $mesg->error."\n" if $mesg->code;
+ };
+ return $@;
}
+
=back
=head1 GLOBAL OPTIONS
@@ -179,6 +336,9 @@ sub _is_valid {
@{$d->{canAddAlias}} ];
$d->{canAddList} = [ map { email_valid($_, -prefix => 'fake') }
@{$d->{canAddList}} ];
+
+ $d->{send_token_to} = email_valid( $d->{send_token_to} )
+ if defined $d->{send_token_to};
}
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index 18eeb29..2c4d1bc 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -42,7 +42,7 @@ sub search {
my $concat = $options{'-concat'};
my $filter = 'objectClass=FripostVirtualList';
- $filter = '(&('.$filter.')(!(fripostIsStatusPending=TRUE)))'
+ $filter = '(&('.$filter.')(!(fripostIsStatusPending=*)))'
if (defined $options{'-is_pending'}) and !$options{'-is_pending'};
my $lists = $self->ldap->search(
@@ -62,7 +62,7 @@ sub search {
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
, description => concat($concat, $_->get_value('description'))
, transport => $_->get_value('fripostListManager')
- , ispending => ($_->get_value('fripostIsStatusPending') // '') eq 'TRUE'
+ , ispending => defined $_->get_value('fripostIsStatusPending')
}
}
$lists->sorted('fvl')
@@ -144,8 +144,7 @@ sub add {
# Ask the list manager to create the list now.
my $member = email_valid( $self->_dn2fvu($self->whoami), -exact => 1);
- my $to = email_valid( 'mklist+'.$l->{transport}.'@fripost.org'
- , -exact => 1 );
+ my $to = email_valid( 'mklist+'.$l->{transport}.'@fripost.org' );
my $mail = MIME::Entity::->build(
From => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 5ca833c..c342f23 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -141,10 +141,11 @@ sub exists {
foreach (@tests) {
my $dn = canonical_dn($_, {fvd => $d}, @{$self->suffix});
- my $mesg = $self->ldap->search( base => $dn,
- scope => 'base',
- deref => 'never',
- filter => 'objectClass=*'
+ my $mesg = $self->ldap->search( base => $dn
+ , scope => 'base'
+ , deref => 'never'
+ , filter => 'objectClass=*'
+ , attrs => []
);
return 1 unless $mesg->code; # 0 Success
unless ($mesg->code == 32) { # 32 No such object
diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm
index 7d79e69..3b5cfca 100644
--- a/lib/Fripost/Schema/User.pm
+++ b/lib/Fripost/Schema/User.pm
@@ -72,23 +72,23 @@ Replace an existing account with the given one.
sub replace {
my $self = shift;
- my $m = shift;
+ my $u = shift;
my %options = @_;
foreach (qw/description forwards/) {
- $m->{$_} = explode ($options{'-concat'}, $m->{$_})
- if defined $m->{$_};
+ $u->{$_} = explode ($options{'-concat'}, $u->{$_})
+ if defined $u->{$_};
}
eval {
- my ($l,$d) = split_addr( $m->{user}, -encode => 'ascii' );
- &_is_valid($m);
+ my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
+ &_is_valid($u);
my $mesg = $self->ldap->modify(
canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
- replace => { fripostIsStatusActive => $m->{isactive} ?
+ replace => { fripostIsStatusActive => $u->{isactive} ?
'TRUE' : 'FALSE'
- , description => $m->{description}
- , fripostOptionalMaildrop => $m->{forwards}
+ , description => $u->{description}
+ , fripostOptionalMaildrop => $u->{forwards}
} );
die $mesg->error."\n" if $mesg->code;
};
@@ -126,30 +126,30 @@ Add the given account.
sub add {
my $self = shift;
- my $m = shift;
+ my $u = shift;
my %options = @_;
foreach (qw/description forwards/) {
- $m->{$_} = explode ($options{'-concat'}, $m->{$_})
- if defined $m->{$_};
+ $u->{$_} = explode ($options{'-concat'}, $u->{$_})
+ if defined $u->{$_};
}
eval {
- die "Missing user name\n" unless $m->{user} =~ /^.+\@.+$/;
- my ($l,$d) = split_addr( $m->{user}, -encode => 'ascii' );
- &_is_valid($m);
- die "‘".$m->{user}."’ already exists\n"
- if $self->local->exists($m->{user},%options);
+ die "Missing user name\n" unless $u->{user} =~ /^.+\@.+$/;
+ my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
+ &_is_valid($u);
+ die "‘".$u->{user}."’ already exists\n"
+ if $self->local->exists($u->{user},%options);
my %attrs = ( objectClass => 'FripostVirtualUser'
- , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE'
- , userPassword => $m->{password}
+ , fripostIsStatusActive => $u->{isactive} ? 'TRUE' : 'FALSE'
+ , userPassword => $u->{password}
);
- $attrs{description} = $m->{description}
- if defined $m->{description} and @{$m->{description}};
- $attrs{fripostUserQuota} = $m->{quota} if defined $m->{quota};
- $attrs{fripostOptionalMaildrop} = $m->{forwards}
- if defined $m->{forwards} and @{$m->{forwards}};
+ $attrs{description} = $u->{description}
+ if defined $u->{description} and @{$u->{description}};
+ $attrs{fripostUserQuota} = $u->{quota} if defined $u->{quota};
+ $attrs{fripostOptionalMaildrop} = $u->{forwards}
+ if defined $u->{forwards} and @{$u->{forwards}};
my $mesg = $self->ldap->add(
canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
@@ -203,10 +203,10 @@ The B<-die> option, if present, overides LDAP croaks and errors.
# Ensure that the given user is valid.
sub _is_valid {
- my $m = shift;
- must_attrs( $m, qw/user isactive/ );
- $m->{user} = email_valid( $m->{user}, -exact => 1);
- $m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ];
+ my $u = shift;
+ must_attrs( $u, qw/user isactive/ );
+ $u->{user} = email_valid( $u->{user}, -exact => 1);
+ $u->{forwards} = [ map { email_valid($_) } @{$u->{forwards}} ];
# TODO: match 'quota' against the Dovecot specifications
}
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index b26214b..2692421 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -116,7 +116,10 @@ sub email_valid {
-fqdn => 1 );
my $match = defined $addr;
$match &&= $addr eq $in if $options{'-exact'};
- die $mesg." ‘".$i."’\n" unless $match;
+ unless ($match) {
+ return if $options{'-nodie'};
+ die $mesg." ‘".$i."’\n";
+ }
$addr =~ s/^$options{'-prefix'}// if defined $options{'-prefix'};
return $addr;
}