From 38bbf969d6c29891f40973a0db376d5f5ee5ab07 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Tue, 29 Jan 2013 02:39:17 +0100 Subject: Factorized the code to add localparts. --- lib/Fripost/Panel/Interface.pm | 309 +++++++++++++--------------------- lib/Fripost/Schema/Local.pm | 371 +++++++++++++++++++++++++++-------------- 2 files changed, 363 insertions(+), 317 deletions(-) (limited to 'lib') diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm index a0c9dd9..7f7d770 100644 --- a/lib/Fripost/Panel/Interface.pm +++ b/lib/Fripost/Panel/Interface.pm @@ -216,8 +216,8 @@ sub ListLocals : Runmode { my @lists = grep { $_->{type} eq 'list' } @locals; # Add a link to the list (external) homepage. - map { $_->{listURL} = $CFG{'listurl_'.$_->{transport}}. - email_to_ascii($_->{name}.'@'.$domainname) } + map { $_->{list_URL} = $CFG{'listurl_'.$_->{transport}}. + email_to_ascii($_->{name}.'@'.$domainname) } @lists; my $template = $self->load_tmpl( 'list-locals.html', cache => 1, @@ -256,258 +256,183 @@ sub ListLocals : Runmode { # Can the user add lists? $template->param( canAddList => $domain->{permissions} =~ /[lop]/ ); $template->param( listCanAddList => [ map { {item => encode_entities($_)} } - @{$domain->{canAddList}} ] ) + @{$domain->{canAddList}} ] ) if $domain->{permissions} =~ /[op]/; # Should we list lists? $template->param( listLists => $#lists >= 0 || $domain->{permissions} =~ /[lop]/ ); $template->param( lists => [ - map { {&fill_HTML_template_from_entry ($_, -loop => ['destination'])} } + map { { &fill_HTML_template_from_entry ($_, -loop => ['destination'] ) + , isPending => $_->{isPending} + } } @lists ]); return $template->output; } -# In this Run Mode authenticated users can edit the entry (if they have -# the permission). -sub EditLocal : Runmode { +# In this Run Mode authenticated users can add users, aliases and lists +# (if they have the permission). +sub AddLocal : Runmode { my $self = shift; my %CFG = $self->cfg; my $q = $self->query; - return $self->redirect('../') if defined $q->param('cancel'); + return $self->redirect('./') if defined $q->param('cancel'); # Cancellation + # Get the domain name from the URL. + my $domainname = ($self->split_path)[1]; + my $t = $q->param('t') // return $self->redirect('./'); + return $self->redirect('./') unless grep { $t eq $_ } qw/user alias list/; my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - # Search for *the* matching user, alias or list. - my ($d,$l) = ($self->split_path)[1,2]; - $fp->domain->get ($d, -die => 404, -assert_exist => 1); - my %local = $fp->local->get ($l.'@'.$d, -die => 404, - -concat => "\x{0D}\x{0A}" ); - die "Unknown type" unless grep { $local{type} eq $_ } - qw/user alias list/; - die "404\n" if $local{ispending}; - my $error; # Tells whether the change submission has failed. - my $t = $local{type}; - - if (defined $q->param('a') and $q->param('a') eq 'delete') { - # Delete the entry - $error = $fp->$t->delete($l.'@'.$d, -die => 0); - unless ($error) { - $fp->done; - return $self->redirect('../'); - } - } if (defined $q->param('submit')) { # Changes have been submitted: process them - my %entry; - if ($t eq 'user') { - $entry{user} = $l.'@'.$d; - $entry{forwards} = $q->param('forwards') // undef; - - 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. - if ($q->param('newpw') ne $q->param('newpw2')) { - $error = "Passwords do not match"; - } - elsif (length $q->param('newpw') < $CFG{password_min_length}) { - $error = "Password should be at least " - .$CFG{password_min_length} - ." characters long."; - } - else { - my $fp; - eval { - my $u = email_to_unicode($self->authen->username); - $fp = Fripost::Schema::->auth( - $u, - $q->param('oldpw') // '', - %CFG, - -die => "Wrong password (for ‘".$u."’)." ); - }; - $error = $@ || $fp->user->passwd( - $entry{user}, - Fripost::Password::hash($q->param('newpw') // '') - ); - $fp->done if defined $fp; - } + my $local = &parse_CGI_query($q); + $local->{type} = $q->param('t'); + $local->{name} = $q->param('name').'@'.$domainname; + my %rest; + + if ($q->param('password') || $q->param('password2')) { + if ($q->param('password') ne $q->param('password2')) { + $error = "Passwords do not match"; } + # TODO: ! move that to Password.pm + elsif (length $q->param('password') < $CFG{password_min_length}) { + $error = "Password should be at least " + .$CFG{password_min_length} + ." characters long."; + } + else { + $local->{password} = Fripost::Password::hash($q->param('password')); + } + # TODO: inherit the user quota from the postmaster's? } - elsif ($t eq 'alias') { - $entry{alias} = $l.'@'.$d; - $entry{maildrop} = $q->param('maildrop') // undef; - } - elsif ($t eq 'list') { - $entry{list} = $l.'@'.$d; - $entry{transport} = $q->param('transport') // undef; - } - $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; - } + $local->{password} = $q->param('password') if $t eq 'list'; - my $template = $self->load_tmpl( "edit-$t.html", cache => 1 ); - $template->param( $self->userInfo ); - $template->param( domain => encode_entities($d) ); + $rest{gpg} = { use_agent => 0 + , keydir => $CFG{gpghome} + , key => $CFG{gpg_private_key_id} + , passphrase => $CFG{gpg_private_key_passphrase} + }; - if ($error and defined $q->param('submit')) { - # Preserve the (incorrect) form, except the passwords - if ($t eq 'user') { - $template->param( user => encode_entities($l) - , forwards => $q->param('forwards') // undef ); - } - elsif ($t eq 'alias') { - $template->param( alias => encode_entities($l) - , maildrop => $q->param('maildrop') // undef ); - } - elsif ($t eq 'list') { - $template->param( list => encode_entities($l) ); - } - $template->param( isactive => $q->param('isactive') // 1 - , description => $q->param('description') // undef ); - } - else { - %local = $fp->local->get ($l.'@'.$d, -die => 404, - -concat => "\x{0D}\x{0A}" ); - if ($t eq 'user') { - $template->param( user => encode_entities($local{user}) - , forwards => encode_entities($local{forwards}) ); - } - elsif ($t eq 'alias') { - $template->param( alias => encode_entities($local{alias}) - , maildrop => encode_entities($local{maildrop}) ); - } - elsif ($t eq 'list') { - $template->param( list => encode_entities($local{list}) ); + unless ($error) { + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + $fp->domain->search ($domainname, -filter => 'unlocked', -count => 1) + or die "404\n"; + $fp->local->add( $local, %rest, -error => \$error ); + $fp->done; + return $self->redirect('./') unless $error; } - $template->param( isactive => $local{isactive} - , description => $local{description} ); } - $fp->done; - my $news = (defined $q->param('submit') or - (defined $q->param('a') and $q->param('a') eq 'delete')); - $template->param( newChanges => $news ); + + # Do not send passwords back to the sender. + $q->delete(qw/password password2/); + + my $template = $self->load_tmpl( "add-$t.html", cache => 1 ); + $template->param( $self->userInfo + , domainname => encode_entities($domainname) + , &fill_HTML_template_from_query ($q)); + $template->param( transport => + [ { item => 'mailman', selected => $q->param('transport') eq 'mailman', name => 'GNU Mailman' } + , { item => 'schleuder', selected => $q->param('transport') eq 'schleuder', name => 'Schleuder' } + ]) # TODO ugly + if $t eq 'list' and defined $q->param('transport'); $template->param( error => encode_entities ($error) ) if $error; - $template->param( canDelete => 1 ) if $t eq 'alias'; - $template->param( listURL => $CFG{'listurl_'.$local{transport}}. - email_to_ascii($l.'@'.$d) ) - if $t eq 'list'; - $q->delete('a'); return $template->output; } - -# In this Run Mode authenticated users can add users, aliases and lists -# (if they have the permission). -sub AddLocal : Runmode { +# In this Run Mode authenticated users can edit the entry (if they have +# the permission). +sub EditLocal : Runmode { my $self = shift; my %CFG = $self->cfg; my $q = $self->query; - return $self->redirect('./') if defined $q->param('cancel'); + return $self->redirect('./') if defined $q->param('cancel'); # Cancellation + + # Get the domain name from the URL. + my ($localname,$domainname) = ($self->split_path)[2,1]; + my $name = $localname.'@'.$domainname; + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + + # Search for *the* matching user, alias or list. + $fp->domain->search ($domainname, -filter => 'unlocked', -count => 1) + or die "404\n"; + my $local = $fp->local->search ($name, -filter => 'unlocked') + or die "404\n"; - my $d = ($self->split_path)[1]; - my $t = $q->param('t') // die "Undefined type"; my $error; # Tells whether the change submission has failed. + if (defined $q->param('a') and $q->param('a') eq 'delete') { + # Delete the entry + $fp->local->delete($name, -error => \$error ); + unless ($error) { + $fp->done; + return $self->redirect('../'); + } + } + $fp->done; + if (defined $q->param('submit')) { # Changes have been submitted: process them - my %entry; + my $local = &parse_CGI_query($q); + $local->{type} = $q->param('t'); + $local->{name} = $name; my %rest; - if ($t eq 'user') { - $entry{user} = $q->param('user').'@'.$d; - $entry{forwards} = $q->param('forwards'); - if ($q->param('password') ne $q->param('password2')) { - $error = "Passwords do not match"; - } - elsif (length $q->param('password') < $CFG{password_min_length}) { - $error = "Password should be at least " - .$CFG{password_min_length} - ." characters long."; - } - else { - $entry{password} = Fripost::Password::hash($q->param('password')); - } - # TODO: inherit the quota from the postmaster's? - } - elsif ($t eq 'alias') { - $entry{alias} = $q->param('alias').'@'.$d; - $entry{maildrop} = $q->param('maildrop'); - } - elsif ($t eq 'list') { - $entry{list} = $q->param('list').'@'.$d; - $entry{transport} = $q->param('transport'); + + if ($q->param('password') || $q->param('password2')) { if ($q->param('password') ne $q->param('password2')) { $error = "Passwords do not match"; } + # TODO: ! move that to Password.pm + # TODO: change password elsif (length $q->param('password') < $CFG{password_min_length}) { $error = "Password should be at least " .$CFG{password_min_length} ." characters long."; } else { - $rest{gpg} = { use_agent => 0 - , keydir => $CFG{gpghome} - , key => $CFG{gpg_private_key_id} - , passphrase => $CFG{gpg_private_key_passphrase} - }; - $entry{password} = $q->param('password'); + $local->{password} = Fripost::Password::hash($q->param('password')); } } - else { - # Unknown type - return $self->redirect('./'); - } - $entry{isactive} = $q->param('isactive') // 1; - $entry{description} = $q->param('description') // undef; - - unless ($error) { - my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - $fp->domain->get ($d, -die => 404, -assert_exist => 1); - $error = $fp->$t->add( \%entry, -concat => "(\n|\x{0D}\x{0A})", %rest); - $fp->done; - return $self->redirect('./') unless $error; - } } - my $template = $self->load_tmpl( "add-$t.html", cache => 1 ); - $template->param( $self->userInfo ); - $template->param( domain => encode_entities($d) ); + # Do not send passwords back to the sender. + $q->delete(qw/password password2/); + + my $t = $local->{type}; + my $template = $self->load_tmpl( "edit-$t.html", cache => 1 ); + $template->param( $self->userInfo + , localpart => encode_entities($localname) + , domainpart => encode_entities($domainname) ); + if ($error) { # Preserve the (incorrect) form, except the passwords - if ($t eq 'user') { - $template->param( user => $q->param('user') // undef - , forwards => $q->param('forwards') // undef ); - } - elsif ($t eq 'alias') { - $template->param( alias => $q->param('alias') // undef - , maildrop => $q->param('maildrop') // undef ); - } - elsif ($t eq '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') // 1 - , description => $q->param('description') // undef - , error => encode_entities ($error) ); + $template->param( &fill_HTML_template_from_query ($q) ); } else { - $template->param( isactive => 1 ); + $template->param( &fill_HTML_template_from_entry ($local, + -hide => [qw/quota transport/]) ); } + # TODO: submit + my $news = (defined $q->param('submit') or + (defined $q->param('a') and $q->param('a') eq 'delete')); + $template->param( newChanges => $news ); + $template->param( error => encode_entities ($error) ) if $error; + $template->param( canDelete => 1 ) if $t eq 'alias'; + $template->param( list_URL => $CFG{'listurl_'.$local->{transport}}. + email_to_ascii($name) ) + if $t eq 'list'; + + $q->delete('a'); return $template->output; } + + + sub mkURL { my $host = shift; my @path = map { encodeURIComponent($_) } @_; diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm index 1f09f66..d6e32a2 100644 --- a/lib/Fripost/Schema/Local.pm +++ b/lib/Fripost/Schema/Local.pm @@ -18,7 +18,8 @@ use utf8; use parent 'Fripost::Schema'; use Fripost::Schema::Util qw/concat split_addr canonical_dn - ldap_error dn2mail/; + ldap_error dn2mail softdie email_valid + ldap_assert_absent/; use Net::IDN::Encode qw/email_to_ascii email_to_unicode/; use Net::LDAP::Util 'escape_filter_value'; @@ -58,6 +59,15 @@ them. (User only) A string e.g., C<100 MB> representing the current quota on the user's mailboxes. +=item B + +(User and list only) The user or list administrator password. It is +never given back by the server (actually noone has read access on that +attribute), hence only makes sense upon creation. In users entries, +I can be hashed on the client side when prefixed with +B<{SHA}>, B<{SSHA}>, B<{MD5}>, B<{SMD5}>, B<{CRYPT}> or B<{CLEARTEXT}>. +(Otherwise the password will be automatically salted and SHA-1 hashed.) + =item B (Alias and list only) An optional array reference containing the @@ -140,15 +150,12 @@ B for details. sub search { my $self = shift; - my $in = shift; + my ($localname, $domainname) = split_addr(shift); my %options = @_; # Nothing to do after an error. return if $options{'-error'} && ${$options{'-error'}}; - # If there is not '@', we interpret $in as a domain name. - $in =~ s/^([^\@]+)$/\@$1/; - my ($localname, $domainname) = split_addr($in); my @filters; if (defined $options{'-type'}) { @@ -218,8 +225,8 @@ sub search { my $count = 0; my @resultset; foreach my $domainname (@domainnames) { - # For query the server for each matching domain. - my $locals = $self->ldap->search( base => $self->mail2dn('@'.$domainname) + # We query the server for each matching domain. + my $locals = $self->ldap->search( base => $self->mail2dn($domainname) , scope => 'one' , deref => 'never' , filter => $filter @@ -313,7 +320,7 @@ sub _entries_to_locals { if not @$keys or grep { $_ eq 'transport' } @$keys; } else { - die "Missing translation for local attribute ‘".$attr."’."; + die "Missing translation for local attribute ‘".$attr."’"; } } @@ -324,153 +331,267 @@ sub _entries_to_locals { return @locals; } +# Map our domain keys into the LDAP attribute(s) that are required to +# fetch this information. +sub _keys_to_attrs { + my %map = ( name => 'fvl' + , type => 'objectClass' + , isActive => 'fripostIsStatusActive' + , description => 'description' + , isPending => 'objectClass' + , quota => 'fripostUserQuota' + , owner => 'fripostOwner' + , forward => 'fripostOptionalMaildrop' + , destination => 'fripostMaildrop' + , transport => 'fripostListManager' + ); + my %attrs; + foreach my $k (@_) { + die "Missing translation for key ‘".$k."’" + unless exists $map{$k}; + if (ref $map{$k} eq 'ARRAY') { + $attrs{$_} = 1 for @{$map{$k}}; + } + else { + $attrs{$map{$k}} = 1; + } + } + return keys %attrs; +} -=head1 METHODS - -=over 4 - -=item B (I, I) - -Returns a hash with all the (visible) attributes for the given entry. An -additional 'type' attribute gives the type of *the* found entry -(possible values are 'user', 'alias', and 'list'). - -=cut +my %list_commands = ( mailman => [ qw/admin bounces confirm join leave + owner request subscribe unsubscribe/ ] + , schleuder => [ qw/bounce sendkey/ ] + ); -sub get { +sub add { my $self = shift; - my $loc = shift; + my $local = shift; my %options = @_; - my $concat = $options{'-concat'}; - - my ($l,$d) = split_addr( $loc, -encode => 'ascii' ); - $l = escape_filter_value($l); - my $locals = $self->ldap->search( - base => canonical_dn({fvd => $d}, @{$self->suffix}), - scope => 'one', - deref => 'never', - filter => "(|(&(objectClass=FripostVirtualUser)(fvu=$l)) - (&(objectClass=FripostVirtualAlias)(fva=$l)) - (&(objectClass=FripostVirtualList)(fvl=$l)))", - attrs => [ qw/fvu description - fripostIsStatusActive - fripostOptionalMaildrop - fripostUserQuota - fva fripostMaildrop - fvl fripostListManager/ ] - ); - if ($locals->code) { - die $options{'-die'}."\n" if defined $options{'-die'}; - die $locals->error."\n"; - } - # The following is not supposed to happen. Note that there is - # nothing in the LDAP schema to prevent that, but it's not too - # critical as Postfix searchs for user, aliases and lists in - # that order. - die "Error: Multiple matching entries found." if $locals->count > 1; - my $local = $locals->pop_entry; - - unless (defined $local) { - die $options{'-die'}."\n" if defined $options{'-die'}; - die "No such such entry ‘".$loc."’.\n"; + # Nothing to do after an error. + return if $options{'-error'} && ${$options{'-error'}}; + softdie ("No name specified", %options) // return + unless $local->{name} =~ /^.+\@[^\@]+$/; + + my $name = $local->{name}; + my ($localname, $domainname) = split_addr($name); + # Check validity. + &_assert_valid($local, %options) // return; + + my $exists; + my $t = $local->{type}; + if ($options{'-dry-run'} or $options{'-append'}) { + # Search for an existing entry with the same name. We can't + # use our previously defined method here, since the current user + # may not have read access to the entry. There is a race + # condition since someone could modify the directory between + # this check and the actual insertion, but then the insertion + # would fail. + $exists = ldap_assert_absent( $self, $name, undef, %options ) // return; + + if ($t eq 'list') { + # Ensure that all commands are available. + foreach (@{$list_commands{$local->{transport}}}) { + my $name = $localname.'-'.$_.'@'.$domainname; + ldap_assert_absent( $self, $name, undef, %options ) // return; + } + } + return 1 if $options{'-dry-run'}; } - my %ret; - if ($local->dn =~ /^fvu=/) { - $ret{type} = 'user'; - $ret{user} = $local->get_value('fvu'); - $ret{forwards} = concat($concat, map { email_to_unicode($_) } - $local->get_value('fripostOptionalMaildrop')) - } - elsif ($local->dn =~ /^fva=/) { - $ret{type} = 'alias'; - $ret{alias} = $local->get_value('fva'); - $ret{maildrop} = concat($concat, map { email_to_unicode($_) } - $local->get_value('fripostMaildrop')) + # Convert the domain into a LDAP entry, and remove keys to empty values. + my %attrs = $self->_local_to_entry (%$local); + Fripost::Schema::Util::ldap_clean_entry( \%attrs ); + + my $mesg; + my $dn = $self->mail2dn( $local->{name} ); + if ($options{'-append'} and $exists) { + # Replace single valued attributes; Add other attributes. + my %unique; + foreach (qw/fripostIsStatusActive userPassword fripostUserQuota/) { + $unique{$_} = delete $attrs{$_} if exists $attrs{$_}; + } + $mesg = $self->ldap->modify( $dn, replace => \%unique, add => \%attrs ); } - elsif ($local->dn =~ /^fvl=/) { - $ret{type} = 'list'; - $ret{list} = $local->get_value('fvl'); - $ret{transport} = $local->get_value('fripostListManager'); + else { + # The default owner is the current user. + $attrs{fripostOwner} //= [ $self->whoami ] unless $t eq 'user'; + my $die = exists $options{'-die'}; + $options{'-die'} = { Net::LDAP::Constant::LDAP_ALREADY_EXISTS => + "‘".$name."’ exists" + , Net::LDAP::Constant::LDAP_SUCCESS => 0 } + unless $die; + + if ($t eq 'list') { + # Lists need special care since we have to create the + # commands as well, and we need to communicate with the list + # manager. + my $pw = delete $attrs{userPassword}; + $attrs{objectClass} = [ qw/FripostVirtualList FripostPendingEntry/ ]; + $attrs{fripostLocalAlias} = &_mkLocalAlias($name); + + my @done; + my $res = $self->ldap->add( $dn, attrs => [ %attrs ] ); + push @done, $dn unless $res->code; + + foreach (@{$list_commands{$local->{transport}}}) { + # Create the commands; Stop if something goes wrong + last if $res->code; + my $name = $localname.'-'.$_.'@'.$domainname; + $options{'-die'} = { Net::LDAP::Constant::LDAP_ALREADY_EXISTS => + "‘".$name."’ exists" + , Net::LDAP::Constant::LDAP_SUCCESS => 0 } + unless $die; + my %attrs = ( objectClass => [ qw/FripostVirtualListCommand + FripostPendingEntry/ ] + , fripostLocalAlias => &_mkLocalAlias($name) + ); + my $dn = $self->mail2dn( $name ); + $res = $self->ldap->add( $dn, attrs => [ %attrs ] ); + push @done, $dn unless $res->code; + } + $mesg = $res; + if ($mesg->code) { + # Something went wrong. We try to clean up after us, and + # delete the bogus entries we created. + # It's not too bad if it doesn't work out, because + # it'll be cleaned by our service hopefully. + $self->ldap->delete($_) for @done; + ldap_error($mesg, %options); + return; + } + + # TODO: send a signed + encrypted mail + } + else { + $attrs{objectClass} = $t eq 'user' ? 'FripostVirtualUser' : + $t eq 'alias'? 'FripostVirtualAlias' : + ''; + $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] ); + # TODO: send a welcome mail? + } } - $ret{isactive} = $local->get_value('fripostIsStatusActive') eq 'TRUE'; - $ret{description} = concat($concat, $local->get_value('description')); - $ret{ispending} = ($local->get_value('fripostIsStatusPending') // '') eq 'TRUE'; - return %ret; + ldap_error($mesg, %options) // return; + 1; } -=item B (I, I) +# Convert our representation of local entries into a hash which keys are +# LDAP attributes. +sub _local_to_entry { + my $self = shift; + my %local = @_; + my %entry; + + foreach my $key (keys %local) { + if ($key eq 'name') { + # Its value is forced by the DN. + } + elsif ($key eq 'type') { + # We fix that one later. + } + elsif ($key eq 'isActive') { + $entry{fripostIsStatusActive} = $local{isActive} ? 'TRUE' : 'FALSE'; + } + elsif ($key eq 'description') { + $entry{description} = $local{description}; + } + elsif ($key eq 'quota') { + $entry{fripostUserQuota} = $local{quota}; + } + elsif ($key eq 'owner') { + $entry{fripostOwner} = + [ map { $self->mail2dn($_) } @{$local{owner}} ]; + } + elsif ($key eq 'forward') { + $entry{fripostOptionalMaildrop} = $local{forward}; + } + elsif ($key eq 'destination') { + $entry{fripostMaildrop} = $local{destination}; + } + elsif ($key eq 'transport') { + $entry{fripostListManager} = $local{transport}; + } + elsif ($key eq 'password') { + $entry{userPassword} = $local{password}; + } + else { + die "Missing translation for key ‘".$key."’"; + } + } + return %entry; +} -Returns 1 if the given I@I exists, and 0 otherwise. -The authenticated user needs to have search access to the 'entry' -attribute. -=cut -sub exists { - my $self = shift; - my ($l,$d) = split_addr( shift, -encode => 'ascii' ); +sub _assert_valid { + my $l = shift; my %options = @_; + eval { + die "Unspecified type\n" unless defined $l->{type}; + die "Unknown type ‘".$l->{type}."’\n" + unless grep { $l->{type} eq $_ } qw/user alias list/; + my ($u, $d) = split_addr($l->{name}, -encode => 'ascii'); + return unless $u && $d; + # ^ To avoid unicode issues. + die "Recipient delimiter ‘+’ is not allowed in locaparts\n" + if $u =~ /\+/; # TODO: should be a config option + $l->{name} = email_valid( $u.'@'.$d, -exact => 1 ); + + unless ($options{'-append'} or $options{'-replace'}) { + my @must = qw/name isActive/; + push @must, $l->{type} eq 'user' ? 'password' : + # TODO: ^ match 'quota' against the Dovecot specifications + $l->{type} eq 'alias' ? 'destination' : + $l->{type} eq 'list' ? qw/transport password/ : + (); + Fripost::Schema::Util::must_attrs( $l, @must ); + } - # We may not have read access to the list commands - # The trick is somewhat dirty, but it's safe enough since postfix - # delivers to users, aliases, and lists with different - # priorities (and lists have the lowest). - my @cmds = qw/admin bounces confirm join leave owner request - subscribe unsubscribe bounce sendkey/; - my @tests = ( {fvu => $l}, {fva => $l}, {fvl => $l} ); - - foreach (@cmds) { - # If the entry is of the form 'foo-command', we need to ensure - # that no list 'foo' exists, otherwise the new entry would - # override foo's command. - if ($l =~ s/-$_$//) { - push @tests, {fvl => $l}; - last; + if ($l->{type} eq 'user') { + $l->{forward} = [ map { email_valid($_) } @{$l->{forward}} ] + if $l->{forward}; } - } - if (defined $options{t} and $options{t} eq 'list') { - # If that's a list that is to be created, we need to ensure that - # none of its commands exists. - foreach (@cmds) { - my $l2 = $l.'-'.$_; - push @tests, {fvu => $l2}, {fva => $l2}; + elsif ($l->{type} eq 'alias') { + $a->{destination} = [ map { email_valid($_) } @{$l->{destination}} ] + if $l->{destination}; } - } + elsif ($l->{type} eq 'list') { + die "Invalid list name: ‘".$l->{name}."’\n" + unless $u =~ /^[[:alnum:]_=\+\-\.]+$/; + + die "Invalid list name: ‘".$l->{name}."’\n" + if defined $l->{transport} and + grep {$u =~ /-$_$/} @{$list_commands{$l->{transport}}}; - foreach (@tests) { - my $dn = canonical_dn($_, {fvd => $d}, @{$self->suffix}); - my $mesg = $self->ldap->search( base => $dn - , scope => 'base' - , deref => 'never' - , filter => 'objectClass=*' - , attrs => [ '1.1' ] - ); - return 1 unless $mesg->code; # 0 Success - unless ($mesg->code == 32) { # 32 No such object - die $options{'-die'}."\n" if defined $options{'-die'}; - die $mesg->error."\n"; + die "Invalid transport: ‘".$l->{transport}."’\n" + if defined $l->{transport} and + not grep { $l->{transport} eq $_ } qw/schleuder mailman/; + + $l->{transport} //= 'mailman' + unless $options{'-append'} or $options{'-replace'}; } - } - return 0; + }; + softdie ($@, %options); } -=back +sub _mkLocalAlias { + my $name = email_to_ascii(shift); + $name =~ /^(.+)@([^\@]+)/ or return; + return $1.'#'.$2; +} + + + + -=head1 GLOBAL OPTIONS -If the B<-concat> option is present, it will intersperse multi-valued -attributes. Otherwise, an array reference containing every values will -be returned for these attributes. -The B<-die> option, if present, overides LDAP croaks and errors. -=cut =head1 AUTHOR -- cgit v1.2.3