Fripost::Schema::PendingHEADmaster

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__