Talk with LDAP
This commit is contained in:
Mercier Pierre-Olivier
parent
4cb9831d49
commit
21e54466e4
344
ACU/LDAP.pm
Normal file
344
ACU/LDAP.pm
Normal file
@ -0,0 +1,344 @@
|
||||
#! /usr/bin/env perl
|
||||
|
||||
package LDAP;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Net::LDAPS;
|
||||
use Net::LDAP::Util qw(ldap_error_text);
|
||||
|
||||
use ACU::Password;
|
||||
use ACU::Right;
|
||||
|
||||
my $ldaphost = "ldap.acu.epita.fr";
|
||||
my $binddn = "cn=intra,dc=acu,dc=epita,dc=fr";
|
||||
my $bindsecret = Password::get_password ".secret_ldap";
|
||||
|
||||
sub ldap_connect()
|
||||
{
|
||||
my $ldap = Net::LDAPS->new($ldaphost) or die ("$@");
|
||||
my $mesg = $ldap->bind($binddn, password => $bindsecret) or die ("$@");
|
||||
|
||||
if ($mesg->code) {
|
||||
die "An error occurred: " .ldap_error_text($mesg->code)."\n";
|
||||
}
|
||||
|
||||
return $ldap;
|
||||
}
|
||||
|
||||
sub ldap_connect_anon()
|
||||
{
|
||||
my $ldap = Net::LDAPS->new($ldaphost) or die ("$@");
|
||||
my $mesg = $ldap->bind or die ("$@");
|
||||
|
||||
if ($mesg->code) {
|
||||
die "An error occurred: " .ldap_error_text($mesg->code)."\n";
|
||||
}
|
||||
|
||||
return $ldap;
|
||||
}
|
||||
|
||||
sub add_attribute($$$)
|
||||
{
|
||||
my $dn = shift;
|
||||
my $what = shift;
|
||||
my $value = shift;
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "$dn",
|
||||
attrs => [ $what ],
|
||||
scope => "base"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "$dn not found or not a valid entry"; }
|
||||
|
||||
my @data = $mesg->entry(0)->get_value($what);
|
||||
if (! grep(/^$value$/, @data)) {
|
||||
push @data, $value;
|
||||
$mesg->entry(0)->replace($what => \@data) or die $!;
|
||||
$mesg->entry(0)->update($ldap) or die $!;
|
||||
|
||||
print "Add $what $value to $dn.";
|
||||
}
|
||||
else {
|
||||
print "$dn already has $what $value.";
|
||||
}
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
}
|
||||
|
||||
sub add_group($$;$)
|
||||
{
|
||||
my $cn = shift;
|
||||
my $year = shift;
|
||||
my $ou = shift // "intra"; # expected roles or intra
|
||||
|
||||
my $dn = "cn=$cn,ou=$year,ou=$ou,ou=groups,dc=acu,dc=epita,dc=fr";
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->add( $dn,
|
||||
attrs => [
|
||||
cn => $cn,
|
||||
]
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
|
||||
return $dn;
|
||||
}
|
||||
|
||||
sub delete_attribute($$$)
|
||||
{
|
||||
my $dn = shift;
|
||||
my $what = shift;
|
||||
my $value = shift;
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "$dn",
|
||||
attrs => [ $what ],
|
||||
scope => "base"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "$dn not found or not a valid entry"; }
|
||||
|
||||
my @data = $mesg->entry(0)->get_value($what);
|
||||
if (! grep(/^$value$/, @data)) {
|
||||
print "$dn has no $what $value.";
|
||||
}
|
||||
else {
|
||||
@data = grep(!/$value$/, @data);
|
||||
|
||||
$mesg->entry(0)->replace($what => \@data) or die $!;
|
||||
$mesg->entry(0)->update($ldap) or die $!;
|
||||
|
||||
print "Delete $what $value to $dn.";
|
||||
}
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
}
|
||||
|
||||
sub delete_attributes($$$)
|
||||
{
|
||||
my $dn = shift;
|
||||
my $what = shift;
|
||||
my $values = shift;
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "$dn",
|
||||
attrs => [ $what ],
|
||||
scope => "base"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "$dn not found or not a valid entry"; }
|
||||
|
||||
my @data = $mesg->entry(0)->get_value($what);
|
||||
for my $value ($values) {
|
||||
if (! grep(/^$value$/, @data)) {
|
||||
print "$dn has no $what $value.";
|
||||
}
|
||||
else {
|
||||
@data = grep(!/$value$/, @data);
|
||||
|
||||
print "Delete $what $value to $dn.";
|
||||
}
|
||||
}
|
||||
$mesg->entry(0)->replace($what => \@data) or die $!;
|
||||
$mesg->entry(0)->update($ldap) or die $!;
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
}
|
||||
|
||||
sub delete_entry($$;$)
|
||||
{
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
$ldap->delete( shift );
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
}
|
||||
|
||||
sub delete_group($$;$)
|
||||
{
|
||||
my $cn = shift;
|
||||
my $year = shift;
|
||||
my $ou = shift // "intra"; # expected roles or intra
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "cn=$cn",
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "$cn not found or multiple entries match"; }
|
||||
|
||||
$ldap->delete( $mesg->entry(0)->dn );
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
}
|
||||
|
||||
sub flush_attribute($$)
|
||||
{
|
||||
my $dn = shift;
|
||||
my $what = shift;
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "$dn",
|
||||
scope => "base"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "$dn not found or not a valid entry"; }
|
||||
|
||||
$ldap->modify($mesg->entry(0)->dn, delete => [$what]);
|
||||
|
||||
print "Flush $what for $dn.";
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
}
|
||||
|
||||
sub get_attribute($$)
|
||||
{
|
||||
my $dn = shift;
|
||||
my $what = shift;
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "$dn",
|
||||
attrs => [ $what ],
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "$dn not found or not a valid entry"; }
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
|
||||
return $mesg->entry(0)->get_value($what);
|
||||
}
|
||||
|
||||
sub get_year()
|
||||
{
|
||||
my $ldap = ldap_connect_anon();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "cn=year,dc=acu,dc=epita,dc=fr",
|
||||
filter => "(cn=year)",
|
||||
attrs => [ "year" ],
|
||||
scope => "base"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "Year not found or not a valid entry"; }
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
|
||||
return $mesg->entry(0)->get_value("year");
|
||||
}
|
||||
|
||||
sub update_attribute($$$)
|
||||
{
|
||||
my $dn = shift;
|
||||
my $what = shift;
|
||||
my $value = shift;
|
||||
|
||||
my $ldap = ldap_connect();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "$dn",
|
||||
attrs => [ $what ],
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "$dn not found or not a valid entry"; }
|
||||
|
||||
$mesg->entry(0)->replace($what => $value) or die $!;
|
||||
$mesg->entry(0)->update($ldap) or die $!;
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
}
|
||||
|
||||
|
||||
sub has_right($$)
|
||||
{
|
||||
my $login = shift;
|
||||
my $right = shift;
|
||||
|
||||
my $ok = 0;
|
||||
|
||||
for my $r (get_rights($login)) {
|
||||
if ($r->{right} eq $right) {
|
||||
return 0 if ($r->{negate});
|
||||
$ok = $r;
|
||||
}
|
||||
}
|
||||
|
||||
return $ok;
|
||||
}
|
||||
|
||||
sub get_rights($)
|
||||
{
|
||||
my $login = shift;
|
||||
my @rights;
|
||||
|
||||
my $ldap = ldap_connect_anon();
|
||||
|
||||
my $mesg = $ldap->search( # search
|
||||
base => "ou=roles,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "&(memberUid=$login)(objectClass=intraGroup)",
|
||||
attrs => [ 'intraRight' ],
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
|
||||
|
||||
for my $r ($mesg->entry(0)->get_value('intraRight')) {
|
||||
push @rights, Right->new($r);
|
||||
}
|
||||
|
||||
|
||||
$mesg = $ldap->search( # search
|
||||
base => "ou=intra,ou=groups,dc=acu,dc=epita,dc=fr",
|
||||
filter => "&(memberUid=$login)(objectClass=intraGroup)",
|
||||
attrs => [ 'intraRight' ],
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
|
||||
|
||||
for my $r ($mesg->entry(0)->get_value('intraRight')) {
|
||||
push @rights, Right->new($r);
|
||||
}
|
||||
|
||||
|
||||
$mesg = $ldap->search( # search
|
||||
base => "ou=users,dc=acu,dc=epita,dc=fr",
|
||||
filter => "&(uid=$login)(objectClass=intraAccount)",
|
||||
attrs => [ 'intraRight' ],
|
||||
scope => "sub"
|
||||
);
|
||||
if ($mesg->code != 0) { die $mesg->error; }
|
||||
if ($mesg->count != 1) { die "User $login not found or multiple presence"; }
|
||||
|
||||
for my $r ($mesg->entry(0)->get_value('intraRight')) {
|
||||
push @rights, Right->new($r);
|
||||
}
|
||||
|
||||
|
||||
$ldap->unbind or die ("couldn't disconnect correctly");
|
||||
|
||||
return @rights;
|
||||
}
|
||||
|
||||
1;
|
||||
46
ACU/Right.pm
Normal file
46
ACU/Right.pm
Normal file
@ -0,0 +1,46 @@
|
||||
#! /usr/bin/env perl
|
||||
|
||||
package Right;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub new ($$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
negate => 0,
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
if ($self->parse(shift)) {
|
||||
return $self;
|
||||
}
|
||||
else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub parse($$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $right = shift;
|
||||
|
||||
if ($right =~ /^(!)?(((([0-9]{4}):)?([^:]*):)?([^:]*):)?([a-zA-Z0-9_]+)(;(([^;]+);)?(.*))?/)
|
||||
{
|
||||
$self->{negate} = 1 if ($1);
|
||||
$self->{year} = $5 if ($5);
|
||||
$self->{module} = $6 if ($6);
|
||||
$self->{project} = $7 if ($7);
|
||||
$self->{right} = $8;
|
||||
$self->{arg} = $11 if ($11);
|
||||
$self->{comm} = $12 if ($12);
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user