diff options
Diffstat (limited to 'lib/Fripost/Schema/Local.pm')
| -rw-r--r-- | lib/Fripost/Schema/Local.pm | 371 |
1 files changed, 246 insertions, 125 deletions
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<password> + +(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<password> 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<owner> (Alias and list only) An optional array reference containing the @@ -140,15 +150,12 @@ B<Fripost::Schema::Util> 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<get> (I<local>, I<OPTIONS>) - -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<exists> (I<local>, I<OPTIONS>) +# 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<local>@I<domain> 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 |