From 4a0d87e642c4d97ee2a026f1207e25a001518f3a Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 8 Sep 2012 19:49:11 +0200 Subject: Abstracting the LDAP stuff in an OO library. --- lib/Fripost/Password.pm | 133 +++++++++++++++++++++++++++ lib/Fripost/Schema.pm | 202 +++++++++++++++++++++++++++++++++++++++++ lib/Fripost/Schema/Alias.pm | 177 ++++++++++++++++++++++++++++++++++++ lib/Fripost/Schema/Domain.pm | 183 +++++++++++++++++++++++++++++++++++++ lib/Fripost/Schema/List.pm | 192 +++++++++++++++++++++++++++++++++++++++ lib/Fripost/Schema/Local.pm | 161 +++++++++++++++++++++++++++++++++ lib/Fripost/Schema/Mailbox.pm | 203 ++++++++++++++++++++++++++++++++++++++++++ lib/Fripost/Schema/Misc.pm | 130 +++++++++++++++++++++++++++ 8 files changed, 1381 insertions(+) create mode 100755 lib/Fripost/Password.pm create mode 100644 lib/Fripost/Schema.pm create mode 100644 lib/Fripost/Schema/Alias.pm create mode 100644 lib/Fripost/Schema/Domain.pm create mode 100644 lib/Fripost/Schema/List.pm create mode 100644 lib/Fripost/Schema/Local.pm create mode 100644 lib/Fripost/Schema/Mailbox.pm create mode 100644 lib/Fripost/Schema/Misc.pm (limited to 'lib/Fripost') diff --git a/lib/Fripost/Password.pm b/lib/Fripost/Password.pm new file mode 100755 index 0000000..c2905b2 --- /dev/null +++ b/lib/Fripost/Password.pm @@ -0,0 +1,133 @@ +package Fripost::Password; + +use 5.010_000; +use strict; +use warnings; + +=head1 NAME + +Password.pm - Hash and generate passwords + +=cut + +our $VERSION = '0.02'; + +use Exporter 'import'; +use String::MkPasswd; +use Digest::SHA; +use MIME::Base64; + +our @EXPORT_OK = qw/hash pwgen/; + + +=head1 FUNCTIONS + +=over 4 + +=item B ([I]) + +SHA-1 hash the given password. I, if defined and not empty, is +used to salt the password. If I is not defined, a random 4 bytes +salt is used. If I is the empty string, the hash is not salted. + +The used scheme precedes the hash, so the output is ready to be inserted +in a LDAP entry for instance. + +=cut + +sub hash { + my ($pw, $salt) = @_; + + $salt //= &_make_salt(); + my $str = 'SHA'; + $str = 'SSHA' if &_is_salted( $salt ); + + { no strict "refs"; + $str = '{' .$str. '}' . + &_pad_base64( MIME::Base64::encode( + Digest::SHA::sha1( $pw.$salt ) . $salt, + '' ) ); + }; + return $str; +} + + +sub _is_salted { return ( not ( defined $_[0] ) or $_[0] ne '' ) }; + + +# Generate a (random) 4 bytes salt. We only generates 4 bytes here to +# match the other way to hash & salt passwords (`slappasswd' and the +# RoundCube passwords). +sub _make_salt { + my $len = 4; + my @bytes = (); + for my $i ( 1 .. $len ) { + push( @bytes, rand(255) ); + } + return pack( 'C*', @bytes ); +} + + +# Add trailing `='s to the input string to ensure its length is a +# multiple of 4. +sub _pad_base64 { + my $b64_digest = shift; + while ( length($b64_digest) % 4 ) { + $b64_digest .= '='; + } + return $b64_digest; +} + + +=item B + +Generate a random password that complies to B's password +policy. + +=cut + +sub pwgen { + return String::MkPasswd::mkpasswd( + -length => 12, + -minnum => 2, + -minspecial => 1 + ); +} + +=back + +=cut + + +=head1 AUTHORS + +Stefan Kangas C<< >> + +Guilhem Moulin C<< >> + +=head1 BUGS + +Please report any bugs to C<< >> + +=head1 COPYRIGHT + +Copyright (c) 2010 Dominik Schulz (dominik.schulz@gauner.org). All rights reserved. + +Copyright 2010,2011 Stefan Kangas, all rights reserved. + +Copyright 2012 Guilhem Moulin, all rights reserved. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; + +__END__ diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm new file mode 100644 index 0000000..36b7d54 --- /dev/null +++ b/lib/Fripost/Schema.pm @@ -0,0 +1,202 @@ +package Fripost::Schema; + +=head1 NAME + +Schema.pm - + +=cut + +=head1 DESCRIPTION + +Schema.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual domains, mailboxes, aliases or lists. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use Net::LDAP; +use Authen::SASL; +use Fripost::Schema::Domain; +use Fripost::Schema::Mailbox; +use Fripost::Schema::Alias; +use Fripost::Schema::List; +use Fripost::Schema::Local; + + +=head1 METHODS + +=over 4 + +=item B (I, I) + +Start a LDAP connection, and SASL-authenticate using proxy +authentication for the given (fully-qualified) user. I should +contain definitions for the LDAP suffix and the authentication ID. + +=cut + +sub SASLauth { + my $class = shift; + my ($l,$d) = split /\@/, shift, 2; + my %cfg = @_; + + my $self = bless {}, $class; + $self->suffix( join ',', @{$cfg{ldap_suffix}} ); + $self->whoami( "fvu=$l,fvd=$d,".$self->suffix ); + $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 1 ) ); + + my $sasl = Authen::SASL::->new( + mechanism => 'DIGEST-MD5', + callback => { user => $cfg{ldap_authcID} + , pass => $cfg{ldap_authcPW} + , authname => 'dn:'.$self->whoami } + ); + my $mesg = $self->ldap->bind( sasl => $sasl ); + # This is not supposed to happen. + die $mesg->error if $mesg->code; + + return $self; +} + + +=item B (I, I, I) + +Start a LDAP connection, and (simples-) binds the given user. +I should contain definitions for the LDAP suffix and URI. + +=cut + +sub auth { + my $class = shift; + my ($l,$d) = split /\@/, shift, 2; + my $pw = shift; + my %cfg = @_; + + my $self = bless {}, $class; + $self->suffix( join ',', @{$cfg{ldap_suffix}} ); + $self->whoami( "fvu=$l,fvd=$d,".$self->suffix ); + $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 1 ) ); + + my $mesg = $self->ldap->bind( $self->whoami, password => $pw ); + if ($mesg->code) { + die $cfg{'-die'}."\n" if defined $cfg{'-die'}; + die $mesg->error; + } + return $self; +} + + + +# The DN of the authorization ID +sub whoami { shift->_set_or_get('_whoami',@_); } + +# The LDAP object (of class Net::LDAP) +sub ldap { shift->_set_or_get('_ldap',@_); } + +# The suffix under which virtual domains are. +sub suffix { shift->_set_or_get('_suffix',@_); } + + +# Set or get a key (the first argument), depending on whether a second +# argument is given or not. +sub _set_or_get { + my $self = shift; + my $what = shift; + + if (@_) { + $self->{$what} = $_[0]; + } + else { + return $self->{$what}; + } +} + + + +=item B + +Bless the object to C, to access +domain-specific methods. + +=cut + +sub domain { bless shift, 'Fripost::Schema::Domain'; } + + +=item B + +Bless the object to C, to access +mailbox-specific methods. + +=cut + +sub mailbox { bless shift, 'Fripost::Schema::Mailbox'; } + + +=item B + +Bless the object to C, to access +alias-specific methods. + +=cut + +sub alias { bless shift, 'Fripost::Schema::Alias'; } + + +=item B + +Bless the object to C, to access +list-specific methods. + +=cut + +sub list { bless shift, 'Fripost::Schema::List'; } + + +=item B + +Bless the object to C, to access +local-specific (mailboxes, aliases and lists) methods. + +=cut + +sub local { bless shift, 'Fripost::Schema::Local'; } + + + +=item B + +Unbinds from the LDAP server. + +=cut + +sub done { + my $self = shift; + $self->ldap->unbind if defined $self and defined $self->ldap; +} + + +=back + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm new file mode 100644 index 0000000..c413257 --- /dev/null +++ b/lib/Fripost/Schema/Alias.pm @@ -0,0 +1,177 @@ +package Fripost::Schema::Alias; + +=head1 NAME + +Alias.pm - + +=head1 DESCRIPTION + +Alias.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual aliases. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use parent 'Fripost::Schema'; +use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/; + + +=head1 METHODS + +=over 4 + +=item B (I, I) + +List every known (and visible) alias under the given domain. The output +is a array of hash references, sorted by alias. + +=cut + +sub search { + my $self = shift; + my $domain = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $aliases = $self->ldap->search( + base => "fvd=$domain,".$self->suffix, + scope => 'one', + deref => 'never', + filter => 'objectClass=FripostVirtualAlias', + attrs => [ qw/fva description fripostIsStatusActive + fripostMaildrop/ ] + ); + if ($aliases->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $aliases->error; + } + return map { { alias => $_->get_value('fva') + , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $_->get_value('description')) + , maildrop => concat($concat, $_->get_value('fripostMaildrop')) + } + } + $aliases->sorted('fva') +} + + +=item B (I, I) + +Replace an existing alias with the given one. + +=cut + +sub replace { + my $self = shift; + my $a = shift; + my %options = @_; + + foreach (qw/description maildrop/) { + $a->{$_} = explode ($options{'-concat'}, $a->{$_}) + if defined $a->{$_}; + } + + my ($l,$d) = split /\@/, $a->{alias}, 2; + + eval { + &_is_valid($a); + my $mesg = $self->ldap->modify( + "fva=$l,fvd=$d,".$self->suffix, + replace => { fripostIsStatusActive => $a->{isactive} ? + 'TRUE' : 'FALSE' + , description => $a->{description} + , fripostMaildrop => $a->{maildrop} + } ); + die $mesg->error."\n" if $mesg->code; + }; + return $@; +} + + +=item B (I, I) + +Add the given alias. + +=cut + +sub add { + my $self = shift; + my $a = shift; + my %options = @_; + + foreach (qw/description maildrop/) { + $a->{$_} = explode ($options{'-concat'}, $a->{$_}) + if defined $a->{$_}; + } + + my ($l,$d) = split /\@/, $a->{alias}, 2; + + eval { + die "Missing alias name\n" if $l eq ''; + &_is_valid($a); + die "‘".$a->{alias}."‘ alread exists\n" + if $self->local->exists($l,$d,%options); + + my %attrs = ( objectClass => 'FripostVirtualAlias' + , fripostIsStatusActive => $a->{isactive} ? 'TRUE' : 'FALSE' + , fripostMaildrop => $a->{maildrop} + , fripostOwner => $self->whoami + ); + $attrs{description} = $a->{description} + if defined $a->{description} and @{$a->{description}}; + + my $mesg = $self->ldap->add( "fva=$l,fvd=$d,".$self->suffix, + attrs => [ %attrs ] ); + if ($mesg->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $mesg->error; + } + }; + return $@; +} + +=back + +=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 + + +# Ensure that the given alias is valid. +sub _is_valid { + my $a = shift; + must_attrs( $a, qw/alias isactive maildrop/ ); + email_valid( $a->{alias}, -exact => 1 ); + $a->{maildrop} = [ map { email_valid($_) } @{$a->{maildrop}} ]; + # TODO: check for cycles? +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm new file mode 100644 index 0000000..3ff2c25 --- /dev/null +++ b/lib/Fripost/Schema/Domain.pm @@ -0,0 +1,183 @@ +package Fripost::Schema::Domain; + +=head1 NAME + +Domain.pm - + +=head1 DESCRIPTION + +Domain.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual domains. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use parent 'Fripost::Schema'; +use Fripost::Schema::Misc qw/concat get_perms explode must_attrs email_valid/; +use Email::Valid; + + +=head1 METHODS + +=over 4 + +=item B (I) + +List every known (and visible) domain. The output is a array of hash +references, sorted by domain names. + +=cut + +sub search { + my $self = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $domains = $self->ldap->search( + base => $self->suffix, + scope => 'one', + deref => 'never', + filter => 'objectClass=FripostVirtualDomain', + attrs => [ qw/fvd description fripostIsStatusActive/ ] + ); + if ($domains->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $domains->error; + } + return map { { domain => $_->get_value('fvd') + , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $_->get_value('description')) + } + } + $domains->sorted('fvd') +} + + +=item B (I, I) + +Returns a hash with all the (visible) attributes for the given domain. + +=cut + +sub get { + my $self = shift; + my $d = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $domains = $self->ldap->search( + base => "fvd=$d,".$self->suffix, + scope => 'base', + deref => 'never', + filter => 'objectClass=FripostVirtualDomain', + attrs => [ qw/fvd description + fripostIsStatusActive + fripostOptionalMaildrop + fripostCanCreateAlias + fripostCanCreateList + fripostOwner + fripostPostmaster/ ] + ); + if ($domains->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $domains->error; + } + + # The following is not supposed to happen. + die "Error: Multiple matching entries found." if $domains->count > 1; + my $domain = $domains->pop_entry; + unless (defined $domain) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die "No such such domain ‘$d‘.\n"; + } + + return ( domain => $domain->get_value('fvd') + , isactive => $domain->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $domain->get_value('description')) + , catchalls => concat($concat, $domain->get_value('fripostOptionalMaildrop')) + , permissions => get_perms($domain, $self->whoami) + ) +} + + +=item B (I, I) + +Replace an existing domain with the given one. + +=cut + +sub replace { + my $self = shift; + my $d = shift; + my %options = @_; + + foreach (qw/description catchalls/) { + $d->{$_} = explode ($options{'-concat'}, $d->{$_}) + if defined $d->{$_}; + } + + eval { + &_is_valid($d); + my $mesg = $self->ldap->modify( + 'fvd='.$d->{domain}.','.$self->suffix, + replace => { fripostIsStatusActive => $d->{isactive} ? + 'TRUE' : 'FALSE' + , description => $d->{description} + , fripostOptionalMaildrop => $d->{catchalls} + } ); + die $mesg->error."\n" if $mesg->code; + }; + return $@; +} + + +sub add { + die "TODO"; +} + +=back + +=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 + + + +# Ensure that the given domain is valid. +sub _is_valid { + my $d = shift; + must_attrs( $d, qw/domain isactive/ ); + email_valid( $d->{domain}, -prefix => 'fake@', -error => 'Invalid domain', + -exact => 1 ); + $d->{catchalls} = [ map { email_valid($_) } @{$d->{catchalls}} ]; +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm new file mode 100644 index 0000000..f3ce4b8 --- /dev/null +++ b/lib/Fripost/Schema/List.pm @@ -0,0 +1,192 @@ +package Fripost::Schema::List; + +=head1 NAME + +List.pm - + +=head1 DESCRIPTION + +List.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual mailing lists. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use parent 'Fripost::Schema'; +use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/; + + +=head1 METHODS + +=over 4 + +=item B (I, I) + +List every known (and visible) list under the given domain. The output +is a array of hash references, sorted by list. + +=cut + +sub search { + my $self = shift; + my $domain = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $lists = $self->ldap->search( + base => "fvd=$domain,".$self->suffix, + scope => 'one', + deref => 'never', + filter => 'objectClass=FripostVirtualList', + attrs => [ qw/fvl description fripostIsStatusActive + fripostListManager/ ] + ); + if ($lists->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $lists->error; + } + return map { { list => $_->get_value('fvl') + , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $_->get_value('description')) + , transport => $_->get_value('fripostListManager') + } + } + $lists->sorted('fvl') +} + + +=item B (I, I) + +Replace an existing list with the given one. + +=cut + +sub replace { + my $self = shift; + my $l = shift; + my %options = @_; + + $l->{description} = explode ($options{'-concat'}, $l->{description}) + if defined $l->{description}; + + my ($l2,$d) = split /\@/, $l->{list}, 2; + + eval { + &_is_valid($l); + my $l3 = { fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE' + , description => $l->{description} }; + $l3->{fripostListManager} = $l->{transport} if defined $l->{transport}; + my $mesg = $self->ldap->modify( + "fvl=$l2,fvd=$d,".$self->suffix, + replace => $l3 ); + die $mesg->error."\n" if $mesg->code; + }; + return $@; +} + + +=item B (I, I) + +Add the given list. + +=cut + +sub add { + my $self = shift; + my $l = shift; + my %options = @_; + + $l->{description} = explode ($options{'-concat'}, $l->{description}) + if defined $l->{description}; + + my ($l2,$d) = split /\@/, $l->{list}, 2; + + eval { + die "Missing list name\n" if $l eq ''; + must_attrs( $l, 'transport' ); + &_is_valid($l); + die "‘".$l->{list}."‘ alread exists\n" + if $self->local->exists($l2,$d,%options); + + my %attrs = ( objectClass => 'FripostVirtualList' + , fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE' + , fripostOwner => $self->whoami + , fripostListManager => $l->{transport} + ); + if ($l->{transport} eq 'mailman') { + $attrs{fripostListCommand} = + [ map { $l2.'-'.$_ } + qw/admin bounces confirm join leave loop owner + request subscribe unsubscribe/ ]; + } + elsif ($l->{transport} eq 'schleuder') { + $attrs{fripostListCommand} = + [ map { $l2.'-'.$_ } + # TODO: check that + qw/request bounce sendkey owner/ ]; + } + $attrs{description} = $l->{description} + if defined $l->{description} and @{$l->{description}}; + + my $mesg = $self->ldap->add( "fvl=$l2,fvd=$d,".$self->suffix, + attrs => [ %attrs ] ); + if ($mesg->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $mesg->error; + } + }; + return $@; +} + + + +=back + +=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 + + +# Ensure that the given alias is valid. +sub _is_valid { + my $l = shift; + must_attrs( $l, qw/list isactive/ ); + email_valid( $l->{list}, -exact => 1 ); + + say STDERR $l->{transport}; + + die "Invalid transport: ‘".$l->{transport}."‘\n" + if defined $l->{transport} and + $l->{transport} !~ /^(schleuder|mailman)$/; + # TODO: check commands +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm new file mode 100644 index 0000000..79c5420 --- /dev/null +++ b/lib/Fripost/Schema/Local.pm @@ -0,0 +1,161 @@ +package Fripost::Schema::Local; + +=head1 NAME + +Local.pm - + +=head1 DESCRIPTION + +Local.pm abstracts the LDAP schema definition and provides methods to +search for virtual mailboxes, aliases or lists alltogether. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use parent 'Fripost::Schema'; +use Fripost::Schema::Misc 'concat'; + + +=head1 METHODS + +=over 4 + +=item B (I,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 'mailbox', 'alias', and 'list'). + +=cut + +sub get { + my $self = shift; + my $l = shift; + my $d = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $locals = $self->ldap->search( + base => "fvd=$d,".$self->suffix, + scope => 'one', + deref => 'never', + filter => "(|(&(objectClass=FripostVirtualMailbox)(fvu=$l)) + (&(objectClass=FripostVirtualAlias)(fva=$l)) + (&(objectClass=FripostVirtualList)(fvl=$l)))", + attrs => [ qw/fvu description + fripostIsStatusActive + fripostOptionalMaildrop + fripostMailboxQuota + fva fripostMaildrop + fvl fripostListManager/ ] + ); + if ($locals->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $locals->error; + } + + # 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 search for mailboxes, 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 ‘".$l.'@'.$d."‘.\n"; + } + + my %ret; + if ($local->dn =~ /^fvu=/) { + $ret{type} = 'mailbox'; + $ret{user} = $local->get_value('fvu'); + $ret{forwards} = concat($concat, $local->get_value('fripostOptionalMaildrop')) + } + elsif ($local->dn =~ /^fva=/) { + $ret{type} = 'alias'; + $ret{alias} = $local->get_value('fva'); + $ret{maildrop} = concat($concat, $local->get_value('fripostMaildrop')) + } + elsif ($local->dn =~ /^fvl=/) { + $ret{type} = 'list'; + $ret{list} = $local->get_value('fvl'); + } + $ret{isactive} = $local->get_value('fripostIsStatusActive') eq 'TRUE'; + $ret{description} = concat($concat, $local->get_value('description')); + + return %ret; +} + + +=item B (I,I, I) + +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 = shift; + my $d = shift; + my %options = @_; + + # We may not have read access to the list commands + # The trick is somewhat dirty, but it's safe enough since postfix + # delivers to mailboxes, aliases, and lists with different + # priorities (and lists have the lowest). +# $l =~ s/(.*)-(admin|bounces|confirm|join|leave|loop|owner|request|subscribe|unsubscribe|bounce|sendkey)$/$1/; + # ^ TODO + + foreach my $t (qw/fvu fva fvl/) { + my $mesg = $self->ldap->search( base => "$t=$l,fvd=$d,".$self->suffix, + scope => 'base', + deref => 'never', + filter => 'objectClass=*' + ); + 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; + } + } + return 0; +} + +=back + +=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 + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ diff --git a/lib/Fripost/Schema/Mailbox.pm b/lib/Fripost/Schema/Mailbox.pm new file mode 100644 index 0000000..61d86a0 --- /dev/null +++ b/lib/Fripost/Schema/Mailbox.pm @@ -0,0 +1,203 @@ +package Fripost::Schema::Mailbox; + +=head1 NAME + +Mailbox.pm - + +=head1 DESCRIPTION + +Mailbox.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual mailboxes. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use parent 'Fripost::Schema'; +use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/; + + +=head1 METHODS + +=over 4 + +=item B (I, I) + +List every known (and visible) mailbox under the given domain. The +output is a array of hash references, sorted by mailbox. + +=cut + +sub search { + my $self = shift; + my $domain = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $mailboxes = $self->ldap->search( + base => "fvd=$domain,".$self->suffix, + scope => 'one', + deref => 'never', + filter => 'objectClass=FripostVirtualMailbox', + attrs => [ qw/fvu description fripostIsStatusActive + fripostOptionalMaildrop + fripostMailboxQuota/ ] + ); + if ($mailboxes->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $mailboxes->error; + } + return map { { user => $_->get_value('fvu') + , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $_->get_value('description')) + , forwards => concat($concat, $_->get_value('fripostOptionalMaildrop')) + , quota => $_->get_value('fripostMailboxQuota') // undef + } + } + $mailboxes->sorted('fvu') +} + + +=item B (I, I) + +Replace an existing account with the given one. + +=cut + +sub replace { + my $self = shift; + my $m = shift; + my %options = @_; + + foreach (qw/description forwards/) { + $m->{$_} = explode ($options{'-concat'}, $m->{$_}) + if defined $m->{$_}; + } + + my ($l,$d) = split /\@/, $m->{user}, 2; + + eval { + &_is_valid($m); + my $mesg = $self->ldap->modify( + "fvu=$l,fvd=$d,".$self->suffix, + replace => { fripostIsStatusActive => $m->{isactive} ? + 'TRUE' : 'FALSE' + , description => $m->{description} + , fripostOptionalMaildrop => $m->{forwards} + } ); + die $mesg->error."\n" if $mesg->code; + }; + return $@; +} + + +=item B (I, I, I) + +Change the password of the given user. I is used raw, so you +may want to hash it before hand. + +=cut + +sub passwd { + my $self = shift; + my ($l,$d) = split /\@/, shift, 2; + my $pw = shift; + my %options = @_; + + my $mesg = $self->ldap->modify( + "fvu=$l,fvd=$d,".$self->suffix, + replace => { userPassword => $pw } ); + return "Cannot change password" if $mesg->code; +} + + + +=item B (I, I) + +Add the given account. + +=cut + +sub add { + my $self = shift; + my $m = shift; + my %options = @_; + + foreach (qw/description forwards/) { + $m->{$_} = explode ($options{'-concat'}, $m->{$_}) + if defined $m->{$_}; + } + + my ($l,$d) = split /\@/, $m->{user}, 2; + + eval { + die "Missing user name\n" if $l eq ''; + &_is_valid($m); + die "‘".$m->{user}."‘ alread exists\n" + if $self->local->exists($l,$d,%options); + + my %attrs = ( objectClass => 'FripostVirtualMailbox' + , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE' + , userPassword => $m->{password} + ); + $attrs{description} = $m->{description} + if defined $m->{description} and @{$m->{description}}; + $attrs{fripostMailboxQuota} = $m->{quota} if defined $m->{quota}; + $attrs{fripostOptionalMaildrop} = $m->{forwards} + if defined $m->{forwards} and @{$m->{forwards}}; + + my $mesg = $self->ldap->add( "fvu=$l,fvd=$d,".$self->suffix, + attrs => [ %attrs ] ); + if ($mesg->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $mesg->error; + } + }; + return $@; +} + + +=back + +=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 + + +# Ensure that the given mailbox is valid. +sub _is_valid { + my $m = shift; + must_attrs( $m, qw/user isactive/ ); + email_valid( $m->{user}, -exact => 1); + $m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ]; + # TODO: match 'quota' against the Dovecot specifications +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ diff --git a/lib/Fripost/Schema/Misc.pm b/lib/Fripost/Schema/Misc.pm new file mode 100644 index 0000000..be88385 --- /dev/null +++ b/lib/Fripost/Schema/Misc.pm @@ -0,0 +1,130 @@ +package Fripost::Schema::Misc; + +=head1 NAME + +Misc.pm - + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use Exporter 'import'; +our @EXPORT_OK = qw /concat get_perms explode + must_attrs email_valid/; +use Email::Valid; + + +# Let the first argument, if defined, intersperse the other arguments. +sub concat { + my $concat = shift; + + if (defined $concat) { + return join ($concat, @_); + } + else { + return [ @_ ]; + } +} + +# The reverse of 'concat': takes a single line, and split it along +# "concat", if defined. Returns an array reference in any case. +sub explode { + my $concat = shift; + + my $out; + if (defined $concat) { + $out = [ split /$concat/, $_[0] ]; + } + else { + $out = [ @_ ]; + } + [ grep { !/^\s*$/ } @$out ]; +} + + +# This subroutine displays the access that the given DN has on the entry. +# Possible values are : +# - '': no rights +# - a: can create aliases +# - l: can create lists +# - al: can create aliases & lists +# - o: owner +# - p: postmaster +sub get_perms { + my ($entry, $dn) = @_; + my $perms = ''; + + $perms .= 'a' + if grep { $dn eq $_ or (split /,/,$dn,2)[1] eq $_ } + $entry->get_value ('fripostCanCreateAlias'); + + $perms .= 'l' + if grep { $dn eq $_ or (split /,/,$dn,2)[1] eq $_ } + $entry->get_value ('fripostCanCreateList'); + + $perms = 'o' + if grep { $dn eq $_ } $entry->get_value('fripostOwner'); + + $perms = 'p' + if grep { $dn eq $_ } $entry->get_value('fripostPostmaster'); + + return $perms; +} + + +# "&must_att $h qw/a b c .../" ensures that attributes a b c... are all +# defined in the hash reference. +sub must_attrs { + my $h = shift; + foreach (@_) { + die '‘'.$_."‘: Missing attribute.\n" + unless defined $h->{$_} and + (ref $h->{$_} eq 'ARRAY' ? @{$h->{$_}} : $h->{$_} ne '') + } +} + + +# Ensure that the first argument is a valid email. Can also be used to +# check the validity of domains using the '-prefix' option. +# '-exact' forces the input to be a bare email, ("name " is not +# allowed). +sub email_valid { + my $in = shift; + my %options = @_; + + my $i = $in; + $i =~ s/.*<([^>]+)>.*/$1/; + my $mesg = $options{'-error'} // "Invalid e-mail"; + $in = $options{'-prefix'}.$in if defined $options{'-prefix'}; + + my $addr = Email::Valid::->address( -address => $in, + -tldcheck => 1, + -fqdn => 1 ); + my $match = defined $addr; + $match &&= $addr eq $in if $options{'-exact'}; + die $mesg." ‘".$i."‘\n" unless $match; + return $addr; +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ -- cgit v1.2.3