diff options
| -rw-r--r-- | lib/Fripost/Schema/Pending.pm | 166 |
1 files changed, 166 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/Pending.pm b/lib/Fripost/Schema/Pending.pm new file mode 100644 index 0000000..868f591 --- /dev/null +++ b/lib/Fripost/Schema/Pending.pm @@ -0,0 +1,166 @@ +package Fripost::Schema::Pending; + +=head1 NAME + +Pending.pm - Manage pending entries + +=head1 DESCRIPTION + +This module abstracts the LDAP schema definition and provides methods to +unlock, list or delete pending entries. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use parent 'Fripost::Schema::Auth'; +use Fripost::Schema::Util qw/ldap_error dn2mail ldap_and_filter/; +use POSIX 'strftime'; + + +=head1 METHODS + +=over 4 + +=item B<unlock> (I<name>, I<token>, I<OPTIONS>) + +Unlock the pending I<name>, locked with I<token>. I<Token> may be left +undefined if I<name> is marked as pending, but is not locked. + +=over 4 + +=item B<-dry-run> => 0|1 + +Merely simulate the unlock. I<token> is still checked to be a valid code +when defined. + +=back + +Errors can be caught with options B<-die> and B<-error>; See +B<Fripost::Schema::Util> for details. + +=cut + + +sub unlock { + my $self = shift; + my $name = shift; + my $token = shift; + my %options = @_; + + # Nothing to do after an error. + return if $options{'-error'} && ${$options{'-error'}}; + + my $dn = $self->mail2dn( $name ); + my %delete = (objectClass => 'FripostPendingEntry'); + if ($token) { + my $mesg = $self->ldap->compare( $dn + , attr => 'fripostPendingToken' + , value => $token ); + my $catch = { Net::LDAP::Constant::LDAP_COMPARE_TRUE => 0 + , Net::LDAP::Constant::LDAP_COMPARE_FALSE => + "Wrong unlock code for ‘".$name."’" + }; + ldap_error($mesg, %options, -die => $catch) // return; + return 1 if $options{'-dry-run'}; + $delete{fripostPendingToken} = []; + } + + my $mesg = $self->ldap->modify( $dn, delete => \%delete ); + ldap_error($mesg, %options); +} + + +=item B<find> (I<OPTIONS>) + +List all pending entries. + +=over 4 + +=item B<-delete> => 0|1 + +When set, delete all found entries. + +=item B<-quiet> => 0|1 + +When set, do not print the list of found entries. + +=item B<-max-age> + +When set, limit found entries to those that were created before the +given date, in second since epoch. + +=back + +Errors can be caught with options B<-die> and B<-error>; See +B<Fripost::Schema::Util> for details. + +=cut + + +sub find { + my $self = shift; + my %options = @_; + + # Nothing to do after an error. + return if $options{'-error'} && ${$options{'-error'}}; + + my @filter = 'objectClass=FripostPendingEntry'; + if ($options{'-max-age'}) { + my $now = int(strftime "%s", gmtime); + my $maxdate = Net::LDAP::Util::escape_filter_value( + strftime ("%Y%m%d%H%M%SZ", + localtime($now - $options{'-max-age'})) + ); + push @filter, "createTimestamp<=$maxdate" + } + + my $base = Fripost::Schema::Util::canonical_dn(@{$self->suffix}); + my $found = $self->ldap->search ( + base => $base, + scope => 'subtree', + deref => 'never', + filter => ldap_and_filter (@filter), + attrs => [ '1.1' ], + (!$options{'-delete'} && $options{'-quiet'} ? () : + callback => + sub { + my ($mesg, $obj) = @_; + if (defined $obj and $obj->isa('Net::LDAP::Entry')) { + print STDERR "Deleting DN ".$obj->dn."\n" + unless $options{'-quiet'}; + if ($options{'-delete'}) { + $obj->delete; + my $mesg = $obj->update($self->ldap); + ldap_error($mesg, %options) // return; + } + $mesg->pop_entry; + } + }) + ); + ldap_error($found, %options); +} + +=back + +=head1 AUTHOR + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +Copyright 2012,2013 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__ |