111 lines
2.9 KiB
Perl
111 lines
2.9 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
# Copyright (c) 2014 Axel Angel <axel-oss@vneko.ch>. All rights reserved.
|
||
|
|
# This program is free software; you can redistribute it and/or
|
||
|
|
# modify it under the same terms as Perl itself.
|
||
|
|
|
||
|
|
# require: https://github.com/axel-angel/ldap-sync-listener
|
||
|
|
# require: libnet-ldap-perl libtime-out-perl
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
|
||
|
|
use Time::Out qw(timeout);
|
||
|
|
use Net::LDAP::SyncDiffListener;
|
||
|
|
use Net::LDAP::Util qw{ldap_explode_dn};
|
||
|
|
|
||
|
|
my $host = 'ldaps://gnusrv2.epfl.ch';
|
||
|
|
my $base = 'ou=Lists,dc=unipoly,dc=epfl,dc=ch';
|
||
|
|
my $user = 'cn=unipoly-mlmmj,ou=Services,dc=unipoly,dc=epfl,dc=ch';
|
||
|
|
my $pass = 'secretsecretsecretsecret';
|
||
|
|
my @lists = qw{amis info news membres};
|
||
|
|
my $mlmmj_folder = '/var/spool/mlmmj/';
|
||
|
|
my $reco_interval = 86400; # 24 hours
|
||
|
|
|
||
|
|
sub mlmmj_sub($$) {
|
||
|
|
my ($list, $addr) = @_;
|
||
|
|
print "mlmmj_sub $addr to $list\n";
|
||
|
|
my $folder = $mlmmj_folder . $list;
|
||
|
|
system('/usr/bin/mlmmj-sub', '-L', $folder, '-a', $addr);
|
||
|
|
warn "mlmml exited with code ", $? >> 8 ,": $!" if $?;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub mlmmj_unsub($$) {
|
||
|
|
my ($list, $addr) = @_;
|
||
|
|
print "mlmmj_unsub $addr from $list\n";
|
||
|
|
my $folder = $mlmmj_folder . $list;
|
||
|
|
system('/usr/bin/mlmmj-unsub', '-L', $folder, '-a', $addr);
|
||
|
|
}
|
||
|
|
|
||
|
|
my %search = (
|
||
|
|
base => $base,
|
||
|
|
scope => 'sub',
|
||
|
|
filter => "(objectClass=groupOfUniqueNames)",
|
||
|
|
attrs => ['*'],
|
||
|
|
);
|
||
|
|
|
||
|
|
sub handle_change($$$$) {
|
||
|
|
my ($isadd, $entry, $attr, $value) = @_;
|
||
|
|
|
||
|
|
my $cn = $entry->get_value('cn');
|
||
|
|
print "Handle change cn={$cn} attr={$attr} value={$value}\n";
|
||
|
|
|
||
|
|
unless ($cn ~~ @lists) {
|
||
|
|
warn "We don't manage: $cn";
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($attr ne "uniqueMember") {
|
||
|
|
warn "We don't care about attr: $attr";
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $list = $cn .'@unipoly.ch';
|
||
|
|
my $addr = ldap_explode_dn($value)->[0]{MAIL};
|
||
|
|
my $action = $isadd ? \&mlmmj_sub : \&mlmmj_unsub;
|
||
|
|
$action->($list, $addr);
|
||
|
|
}
|
||
|
|
|
||
|
|
my %callbacks = (
|
||
|
|
add_entry => sub {
|
||
|
|
my ($entry) = @_;
|
||
|
|
print "add_entry: ", $entry->dn(), "\n";
|
||
|
|
},
|
||
|
|
del_entry => sub {
|
||
|
|
my ($dn) = @_;
|
||
|
|
print "del_entry: ", $dn, "\n";
|
||
|
|
},
|
||
|
|
add_attr_value => sub {
|
||
|
|
my ($entry, $attr, $value) = @_;
|
||
|
|
handle_change(1, $entry, $attr, $value);
|
||
|
|
},
|
||
|
|
del_attr_value => sub {
|
||
|
|
my ($entry, $attr, $value) = @_;
|
||
|
|
handle_change(0, $entry, $attr, $value);
|
||
|
|
},
|
||
|
|
);
|
||
|
|
|
||
|
|
# restart after a delay, make sure connection is still alive
|
||
|
|
my $state = $ENV{HOME} .'/mlmmj-unipoly-ldap.state.yaml';
|
||
|
|
while (1) {
|
||
|
|
my $ldap = Net::LDAP::SyncDiffListener->new($host, keepalive => 1)
|
||
|
|
or die "$@";
|
||
|
|
$ldap->bind($user, password => $pass);
|
||
|
|
|
||
|
|
my $trapper = sub {
|
||
|
|
$ldap->unbind;
|
||
|
|
$ldap->disconnect;
|
||
|
|
die "Stopped as requested";
|
||
|
|
};
|
||
|
|
$SIG{INT} = $trapper;
|
||
|
|
$SIG{TERM} = $trapper;
|
||
|
|
$SIG{HUP} = $trapper;
|
||
|
|
|
||
|
|
timeout $reco_interval => sub {
|
||
|
|
$ldap->listen($state, \%search, \%callbacks);
|
||
|
|
};
|
||
|
|
|
||
|
|
$ldap->unbind;
|
||
|
|
$ldap->disconnect;
|
||
|
|
print "Timed out, restarting\n";
|
||
|
|
}
|