From 2544f6ea8a6a748416e33014fec7ee66060a600d Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Sat, 23 Feb 2013 21:23:02 +0100
Subject: Fripost::Schema::Pending
---
lib/Fripost/Schema/Pending.pm | 166 ++++++++++++++++++++++++++++++++++++++++++
1 file changed, 166 insertions(+)
create mode 100644 lib/Fripost/Schema/Pending.pm
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__
--
cgit v1.2.3