diff options
Diffstat (limited to 'lib/Fripost/Schema/User.pm')
| -rw-r--r-- | lib/Fripost/Schema/User.pm | 227 |
1 files changed, 227 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm new file mode 100644 index 0000000..11f5e28 --- /dev/null +++ b/lib/Fripost/Schema/User.pm @@ -0,0 +1,227 @@ +package Fripost::Schema::User; + +=head1 NAME + +User.pm - + +=head1 DESCRIPTION + +User.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual users. + +=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/; +use Net::IDN::Encode qw/domain_to_ascii + email_to_ascii email_to_unicode/; + + +=head1 METHODS + +=over 4 + +=item B<search> (I<domain>, I<OPTIONS>) + +List every known (and visible) user under the given domain. The +output is a array of hash references, sorted by user. + +=cut + +sub search { + my $self = shift; + my $d = domain_to_ascii(shift); + my %options = @_; + my $concat = $options{'-concat'}; + + my $users = $self->ldap->search( + base => "fvd=$d,".$self->suffix, + scope => 'one', + deref => 'never', + filter => 'objectClass=FripostVirtualUser', + attrs => [ qw/fvu description fripostIsStatusActive + fripostOptionalMaildrop + fripostUserQuota/ ] + ); + if ($users->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $users->error."\n"; + } + return map { { user => email_to_unicode($_->get_value('fvu')) + , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $_->get_value('description')) + , forwards => concat($concat, map { email_to_unicode($_) } + $_->get_value('fripostOptionalMaildrop')) + , quota => $_->get_value('fripostUserQuota') // undef + } + } + $users->sorted('fvu') +} + + +=item B<replace> (I<user>, I<OPTIONS>) + +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->{$_}; + } + + eval { + my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2; + &_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<passwd> (I<username>, I<password>, I<OPTIONS>) + +Change the password of the given user. I<password> is used raw, so you +may want to hash it before hand. + +=cut + +sub passwd { + my $self = shift; + my ($l,$d) = split /\@/, email_to_ascii(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<add> (I<user>, I<OPTIONS>) + +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->{$_}; + } + + eval { + die "Missing user name\n" unless $m->{user} =~ /^.+\@.+$/; + my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2; + &_is_valid($m); + die "‘".$m->{user}."’ already exists\n" + if $self->local->exists($m->{user},%options); + + my %attrs = ( objectClass => 'FripostVirtualUser' + , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE' + , userPassword => $m->{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}}; + + 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."\n"; + } + }; + return $@; +} + + +=item B<delete> (I<user>, I<OPTIONS>) + +Delete the given user. Note: this will NOT wipe the user off the disk, +but merely delete its entry in the LDAP directory. + +=cut + +sub delete { + my $self = shift; + my ($l,$d) = split /\@/, email_to_ascii(shift), 2; + my %options = @_; + + my $mesg = $self->ldap->delete( "fvu=$l,fvd=$d,".$self->suffix ); + if ($mesg->code) { + if (defined $options{'-die'}) { + return $mesg->error unless $options{'-die'}; + die $options{'-die'}."\n"; + } + die $mesg->error."\n"; + } +} + + +=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 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}} ]; + # TODO: match 'quota' against the Dovecot specifications +} + + +=head1 AUTHOR + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=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__ |