1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
#!/usr/bin/perl
use 5.010_000;
use strict;
use warnings;
our $VERSION = '0.01';
=head1 NAME
deleteExpiredEntries.pl - Clean the LDAP directory out of expired entries.
=head1 SYNOPSIS
B<deleteExpiredEntries.pl> [maximum age in seconds]
=cut
#######################################################################
#
use Pod::Usage;
use Config::Auto;
use lib 'lib';
use Fripost::Schema::Auth;
use POSIX 'strftime';
# TODO: put that in a config file
my $config = { ldap_bind_dn => [ 'cn=DeletePendingEntries','ou=services','o=mailHosting','dc=fripost,dc=dev' ]
, ldap_uri => 'ldap://127.0.0.1:389/'
, ldap_suffix => [ 'ou=virtual','o=mailHosting','dc=fripost,dc=dev' ]
};
my $fp = Fripost::Schema::Auth->auth( undef, 'deletependingentries', %$config );
my $maxage = $ARGV[0] // 86400; # 24h by default
my $now = int(strftime "%s", gmtime);
my $maxdate = Net::LDAP::Util::escape_filter_value(
strftime ("%Y%m%d%H%M%SZ", localtime($now - $maxage))
);
my $entries = $fp->ldap->search (
base => Fripost::Schema::Util::canonical_dn(@{$fp->suffix}),
scope => 'subtree',
deref => 'never',
filter => "(&(objectClass=FripostPendingEntry)
(createTimestamp<=$maxdate))",
attrs => [ '1.1' ],
callback => \&delete_entry
);
die $entries->error."\n" if $entries->code;
$fp->done;
sub delete_entry {
my ($mesg, $obj) = @_;
if (defined $obj and $obj->isa('Net::LDAP::Entry')) {
print STDERR "Deleting DN ".$obj->dn."\n";
$obj->delete;
my $mesg = $obj->update($fp->ldap);
die $mesg->error."\n" if $mesg->code;
}
$mesg->pop_entry;
}
#######################################################################
#
=head1 AUTHOR
Guilhem Moulin C<< <guilhem at fripost.org> >>
=head1 COPYRIGHT
Copyright 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
|
