550 lines
15 KiB
Perl
550 lines
15 KiB
Perl
## @file
|
|
# LDAP storage methods for notifications
|
|
|
|
## @class
|
|
# LDAP storage methods for notifications
|
|
|
|
package Lemonldap::NG::Common::Notifications::LDAP;
|
|
|
|
use strict;
|
|
use Mouse;
|
|
use Time::Local;
|
|
use MIME::Base64 qw/encode_base64url/;
|
|
use Net::LDAP;
|
|
use utf8;
|
|
|
|
our $VERSION = '2.1.0';
|
|
|
|
extends 'Lemonldap::NG::Common::Notifications';
|
|
|
|
sub import {
|
|
shift;
|
|
return Lemonldap::NG::Common::Notifications->import(@_);
|
|
}
|
|
|
|
has ldapServer => (
|
|
is => 'ro',
|
|
lazy => 1,
|
|
default => sub {
|
|
$_[0]->conf->{ldapServer};
|
|
}
|
|
);
|
|
|
|
has ldapPort => (
|
|
is => 'ro',
|
|
lazy => 1,
|
|
default => sub {
|
|
$_[0]->conf->{ldapPort};
|
|
}
|
|
);
|
|
|
|
has ldapCAFile => (
|
|
is => 'ro',
|
|
lazy => 1,
|
|
default => sub {
|
|
$_[0]->conf->{ldapCAFile};
|
|
}
|
|
);
|
|
|
|
has ldapCAPath => (
|
|
is => 'ro',
|
|
lazy => 1,
|
|
default => sub {
|
|
$_[0]->conf->{ldapCAPath};
|
|
}
|
|
);
|
|
|
|
has ldapVerify => (
|
|
is => 'ro',
|
|
lazy => 1,
|
|
default => sub {
|
|
$_[0]->conf->{ldapVerify};
|
|
}
|
|
);
|
|
|
|
has ldapConfBase => (
|
|
is => 'ro',
|
|
trigger => sub {
|
|
if ( my $table = $_[0]->{table} ) {
|
|
$_[0]->{ldapConfBase} =~ s/^\w+=\w+(,.*)$/ou=$table$1/;
|
|
}
|
|
}
|
|
);
|
|
|
|
has ldapBindDN => (
|
|
is => 'ro',
|
|
lazy => 1,
|
|
default => sub {
|
|
$_[0]->conf->{managerDn};
|
|
}
|
|
);
|
|
|
|
has ldapBindPassword => (
|
|
is => 'ro',
|
|
lazy => 1,
|
|
default => sub {
|
|
$_[0]->conf->{managerPassword};
|
|
}
|
|
);
|
|
|
|
# Returns notifications corresponding to the user $uid.
|
|
# If $ref is set, returns only notification corresponding to this reference.
|
|
sub get {
|
|
my ( $self, $uid, $ref ) = @_;
|
|
return () unless ($uid);
|
|
|
|
my $filter =
|
|
'(&(objectClass=applicationProcess)(!(description={done}*))'
|
|
. "(description={uid}$uid)"
|
|
. ( $ref ? '(description={ref}' . $ref . ')' : '' ) . ')';
|
|
my @entries = _search( $self, $filter );
|
|
|
|
my $result;
|
|
foreach my $entry (@entries) {
|
|
my @notifValues = $entry->get_value('description');
|
|
my $f = {};
|
|
foreach (@notifValues) {
|
|
my ( $k, $v ) = ( $_ =~ /\{(.*?)\}(.*)/smg );
|
|
$v = decodeLdapValue($v);
|
|
$f->{$k} = $v;
|
|
}
|
|
my $xml = $f->{xml};
|
|
utf8::encode($xml);
|
|
my $identifier =
|
|
&getIdentifier( $self, $f->{uid}, $f->{ref}, $f->{date} );
|
|
$result->{$identifier} = "$xml";
|
|
$self->logger->info("notification $identifier found");
|
|
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
# Returns accepted notifications corresponding to the user $uid.
|
|
# If $ref is set, returns only notification corresponding to this reference.
|
|
sub getAccepted {
|
|
my ( $self, $uid, $ref ) = @_;
|
|
return () unless ($uid);
|
|
|
|
my $filter =
|
|
'(&(objectClass=applicationProcess)(description={done}*)'
|
|
. "(description={uid}$uid)(description={ref}$ref))";
|
|
my @entries = _search( $self, $filter );
|
|
|
|
my $result;
|
|
foreach my $entry (@entries) {
|
|
my @notifValues = $entry->get_value('description');
|
|
my $f = {};
|
|
foreach (@notifValues) {
|
|
my ( $k, $v ) = ( $_ =~ /\{(.*?)\}(.*)/smg );
|
|
$v = decodeLdapValue($v);
|
|
$f->{$k} = $v;
|
|
}
|
|
my $xml = $f->{xml};
|
|
utf8::encode($xml);
|
|
my $identifier =
|
|
&getIdentifier( $self, $f->{uid}, $f->{ref}, $f->{date} );
|
|
$result->{$identifier} = "$xml";
|
|
$self->logger->info("notification $identifier found");
|
|
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
## @method hashref getAll()
|
|
# Return all pending notifications.
|
|
# @return hashref where keys are internal reference and values are hashref with
|
|
# keys date, uid, ref and condition.
|
|
sub getAll {
|
|
my $self = shift;
|
|
my @entries = $self->_search(
|
|
'(&(objectClass=applicationProcess)(!(description={done}*)))');
|
|
my $result = {};
|
|
foreach my $entry (@entries) {
|
|
my @notifValues = $entry->get_value('description');
|
|
my $f = {};
|
|
foreach (@notifValues) {
|
|
my ( $k, $v ) = ( $_ =~ /\{(.*?)\}(.*)/smg );
|
|
$v = decodeLdapValue($v);
|
|
$f->{$k} = $v;
|
|
}
|
|
$result->{"$f->{date}#$f->{uid}#$f->{ref}"} = {
|
|
date => $f->{date},
|
|
uid => $f->{uid},
|
|
ref => $f->{ref},
|
|
cond => $f->{condition},
|
|
};
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
## @method hashref getExisting()
|
|
# Return all notifications.
|
|
# @return hashref where keys are internal reference and values are hashref with
|
|
# keys date, uid, ref and condition.
|
|
sub getExisting {
|
|
my $self = shift;
|
|
my @entries = $self->_search('objectClass=applicationProcess');
|
|
my $result = {};
|
|
foreach my $entry (@entries) {
|
|
my @notifValues = $entry->get_value('description');
|
|
my $f = {};
|
|
foreach (@notifValues) {
|
|
my ( $k, $v ) = ( $_ =~ /\{(.*?)\}(.*)/smg );
|
|
$v = decodeLdapValue($v);
|
|
$f->{$k} = $v;
|
|
}
|
|
$result->{"$f->{date}#$f->{uid}#$f->{ref}"} = {
|
|
date => $f->{date},
|
|
uid => $f->{uid},
|
|
ref => $f->{ref},
|
|
cond => $f->{condition},
|
|
};
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
## @method boolean delete(string myref)
|
|
# Mark a notification as done.
|
|
# @param $myref identifier returned by get() or getAll()
|
|
sub delete {
|
|
my ( $self, $myref ) = @_;
|
|
my ( $d, $u, $r );
|
|
unless ( ( $d, $u, $r ) = ( $myref =~ /^([^#]+)#(.+?)#(.+)$/ ) ) {
|
|
$self->logger->warn("Bad reference $myref");
|
|
return 0;
|
|
}
|
|
my @ts = localtime();
|
|
$ts[5] += 1900;
|
|
$ts[4]++;
|
|
return _modify(
|
|
$self,
|
|
'(&(objectClass=applicationProcess)'
|
|
. "(description={uid}$u)"
|
|
. "(description={ref}$r)"
|
|
. "(description={date}$d)"
|
|
. '(!(description={done}*)))',
|
|
"description",
|
|
"{done}$ts[5]-$ts[4]-$ts[3] $ts[2]:$ts[1]"
|
|
);
|
|
}
|
|
|
|
## @method boolean purge(string myref, boolean force)
|
|
# Purge notification (really delete record)
|
|
# @param $myref identifier returned by get or getAll
|
|
# @param $force force purge for not deleted session
|
|
# @return true if something was deleted
|
|
sub purge {
|
|
my ( $self, $myref, $force ) = @_;
|
|
my ( $d, $u, $r );
|
|
unless ( ( $d, $u, $r ) = ( $myref =~ /^([^#]+)#(.+?)#(.+)$/ ) ) {
|
|
$self->logger->warn("Bad reference $myref");
|
|
return 0;
|
|
}
|
|
|
|
my $clause = ( $force ? '' : '(description={done}*)' );
|
|
return $self->_delete( '(&(objectClass=applicationProcess)'
|
|
. "(description={uid}$u)"
|
|
. "(description={ref}$r)"
|
|
. "(description={date}$d)"
|
|
. "$clause)" );
|
|
}
|
|
|
|
# Insert a new notification
|
|
# @param date Date
|
|
# @param uid UID
|
|
# @param ref Reference of the notification
|
|
# @param condition Condition for the notification
|
|
# @param xml XML notification
|
|
# @return true if succeed
|
|
sub newNotif {
|
|
my ( $self, $date, $uid, $ref, $condition, $xml ) = @_;
|
|
my $fns = $self->conf->{fileNameSeparator};
|
|
$fns ||= '_';
|
|
my @t = split( /\D+/, $date );
|
|
$t[1]--;
|
|
eval {
|
|
timelocal( $t[5] || 0, $t[4] || 0, $t[3] || 0, $t[2], $t[1], $t[0] );
|
|
};
|
|
return ( 0, "Bad date" ) if ($@);
|
|
$date =~ s/-//g;
|
|
return ( 0, "Bad date" ) unless ( $date =~ /^\d{8}/ );
|
|
my $cn = "${date}${fns}${uid}${fns}" . encode_base64url( $ref, '' );
|
|
$cn .= "${fns}" . encode_base64url( $condition, '' ) if $condition;
|
|
|
|
my $fields =
|
|
$condition =~ /.+/
|
|
? {
|
|
"date" => "$date",
|
|
"uid" => "$uid",
|
|
"ref" => "$ref",
|
|
"xml" => "$xml",
|
|
"cond" => "$condition",
|
|
}
|
|
: {
|
|
"date" => "$date",
|
|
"uid" => "$uid",
|
|
"ref" => "$ref",
|
|
"xml" => "$xml",
|
|
};
|
|
|
|
return _store( $self, $cn, $fields );
|
|
}
|
|
|
|
## @method hashref getDone()
|
|
# Returns a list of notifications that have been done
|
|
# @return hashref where keys are internal reference and values are hashref with
|
|
# keys notified, uid and ref.
|
|
sub getDone {
|
|
my ($self) = @_;
|
|
my @entries = _search( $self,
|
|
'(&(objectClass=applicationProcess)(description={done}*))' );
|
|
|
|
my $result = {};
|
|
foreach my $entry (@entries) {
|
|
my @notifValues = $entry->get_value('description');
|
|
my $f = {};
|
|
foreach (@notifValues) {
|
|
my ( $k, $v ) = ( $_ =~ /\{(.*?)\}(.*)/smg );
|
|
$v = decodeLdapValue($v);
|
|
$f->{$k} = $v;
|
|
}
|
|
my @t = split( /\D+/, $f->{done} );
|
|
$t[1]--;
|
|
my $done =
|
|
eval { timelocal( $t[5], $t[4], $t[3], $t[2], $t[1], $t[0] ) };
|
|
if ($@) {
|
|
$self->logger->warn("Bad date: $f->{done}");
|
|
return {};
|
|
}
|
|
$result->{"$f->{date}#$f->{uid}#$f->{ref}"} =
|
|
{ notified => $done, uid => $f->{uid}, ref => $f->{ref}, };
|
|
}
|
|
|
|
# $ldap->unbind() && delete $self->{ldap};
|
|
return $result;
|
|
}
|
|
|
|
## @method object private _ldap()
|
|
# Return the ldap object (build it if needed).
|
|
# @param filter The LDAP filter to apply
|
|
# @return list of entries returned by the LDAP search (set of Net::LDAP::Entry)
|
|
sub _search {
|
|
my ( $self, $filter ) = @_;
|
|
|
|
my $ldap = _ldap($self);
|
|
|
|
my $search = $ldap->search(
|
|
base => $self->{ldapConfBase},
|
|
filter => "$filter",
|
|
scope => 'sub',
|
|
attrs => ['description'],
|
|
);
|
|
|
|
if ( $search->code ) {
|
|
$self->logger->error( "search error: " . $search->error() );
|
|
return ();
|
|
}
|
|
|
|
return $search->entries();
|
|
}
|
|
|
|
## @method object private _delete()
|
|
# Deletes the all entries found by the given LDAP filter
|
|
# @param filter The LDAP filter to apply
|
|
# @return 1 if operation success, else 0
|
|
sub _delete {
|
|
my ( $self, $filter ) = @_;
|
|
|
|
my @entries = _search( $self, "$filter" );
|
|
my $mesg = {};
|
|
foreach my $entry (@entries) {
|
|
$mesg = $self->{ldap}->delete( $entry->dn() );
|
|
$mesg->code && return 0;
|
|
}
|
|
|
|
# $ldap->unbind() && delete $self->{ldap};
|
|
return 1;
|
|
}
|
|
|
|
## @method object private _modify()
|
|
# add the given attribute value to all entries found by LDAP filter
|
|
# @param filter The LDAP filter to apply
|
|
# @param attr : name of the attribute to modify
|
|
# @param value : new value to add
|
|
# @return 1 if operation success, else 0
|
|
sub _modify {
|
|
my ( $self, $filter, $attr, $value ) = @_;
|
|
|
|
my @entries = _search( $self, "$filter" );
|
|
|
|
my $mesg = {};
|
|
foreach my $entry (@entries) {
|
|
$mesg =
|
|
$self->{ldap}
|
|
->modify( $entry->dn(), add => { "$attr" => "$value", }, );
|
|
$mesg->code && return 0;
|
|
}
|
|
|
|
# $ldap->unbind() && delete $self->{ldap};
|
|
return 1;
|
|
}
|
|
|
|
## @method object private _store()
|
|
# creates the notification defined by dn: cn=$cn,$ldapConfBase and $fields
|
|
# stored in the description attribute
|
|
# @param cn : cn value, used as a dn component
|
|
# @param fields : set of values to store in description attribute
|
|
# @return 1 if operation success, else 0
|
|
sub _store {
|
|
my ( $self, $cn, $fields ) = @_;
|
|
my $ldap = _ldap($self) or return 0;
|
|
|
|
my $notifName = "$cn";
|
|
my $notifDN = "cn=$notifName," . $self->{ldapConfBase};
|
|
|
|
# Store values as {key}value
|
|
my @notifValues;
|
|
foreach my $k ( keys %$fields ) {
|
|
my $v = encodeLdapValue( $fields->{$k} );
|
|
push @notifValues, "{$k}$v";
|
|
}
|
|
|
|
my $add = $ldap->add(
|
|
$notifDN,
|
|
attrs => [
|
|
objectClass => [ 'top', 'applicationProcess' ],
|
|
cn => $notifName,
|
|
description => \@notifValues,
|
|
]
|
|
);
|
|
|
|
if ( $add->code ) {
|
|
$self->logger->error( $add->error );
|
|
return 0;
|
|
}
|
|
|
|
#$ldap->unbind() && delete $self->{ldap};
|
|
return 1;
|
|
}
|
|
|
|
## @method object private encodeLdapValue()
|
|
# encode ldap value in utf8 (try to encode to latin1, and if it fails, encode to utf8)
|
|
# @param value value to encode
|
|
# @return value encoded in utf8
|
|
sub encodeLdapValue {
|
|
my $value = shift;
|
|
|
|
eval {
|
|
my $safevalue = $value;
|
|
Encode::from_to( $safevalue, "utf8", "iso-8859-1", Encode::FB_CROAK );
|
|
};
|
|
if ($@) {
|
|
Encode::from_to( $value, "iso-8859-1", "utf8", Encode::FB_CROAK );
|
|
}
|
|
|
|
return $value;
|
|
|
|
}
|
|
|
|
## @method object private decodeLdapValue()
|
|
# decode ldap value from utf8 to latin1
|
|
# @param value value to decode
|
|
# @return value decoded in latin1
|
|
sub decodeLdapValue {
|
|
my $value = shift;
|
|
|
|
Encode::from_to( $value, "utf8", "iso-8859-1", Encode::FB_CROAK );
|
|
|
|
return $value;
|
|
|
|
}
|
|
|
|
## @method object private _ldap()
|
|
# Return the ldap object (build it if needed).
|
|
# @return ldap handle object
|
|
sub _ldap {
|
|
my $self = shift;
|
|
|
|
return $self->{ldap} if ( $self->{ldap} );
|
|
|
|
# Parse servers configuration
|
|
my $useTls = 0;
|
|
my $tlsParam;
|
|
my @servers = ();
|
|
foreach my $server ( split /[\s,]+/, $self->ldapServer ) {
|
|
if ( $server =~ m{^ldap\+tls://([^/]+)/?\??(.*)$} ) {
|
|
$useTls = 1;
|
|
$server = $1;
|
|
$tlsParam = $2 || "";
|
|
}
|
|
else {
|
|
$useTls = 0;
|
|
}
|
|
push @servers, $server;
|
|
}
|
|
|
|
# Connect
|
|
my $ldap = Net::LDAP->new(
|
|
\@servers,
|
|
onerror => undef,
|
|
keepalive => 1,
|
|
( $self->ldapPort ? ( port => $self->ldapPort ) : () ),
|
|
( $self->ldapVerify ? ( verify => $self->ldapVerify ) : () ),
|
|
( $self->ldapCAFile ? ( cafile => $self->ldapCAFile ) : () ),
|
|
( $self->ldapCAPath ? ( capath => $self->ldapCAPath ) : () ),
|
|
);
|
|
|
|
unless ($ldap) {
|
|
use Data::Dumper;
|
|
die 'connexion failed: ' . $@;
|
|
}
|
|
elsif ( $Net::LDAP::VERSION < '0.64' ) {
|
|
|
|
# CentOS7 has a bug in which IO::Socket::SSL will return a broken
|
|
# socket when certificate validation fails. Net::LDAP does not catch
|
|
# it, and the process ends up crashing.
|
|
# As a precaution, make sure the underlying socket is doing fine:
|
|
if ( $ldap->socket->isa('IO::Socket::SSL')
|
|
and $ldap->socket->errstr < 0 )
|
|
{
|
|
die "SSL connection error: " . $ldap->socket->errstr;
|
|
}
|
|
}
|
|
|
|
# Start TLS if needed
|
|
if ($useTls) {
|
|
my %h = split( /[&=]/, $tlsParam );
|
|
$h{cafile} ||= $self->ldapCAFile if ( $self->ldapCAFile );
|
|
$h{capath} ||= $self->ldapCAPath if ( $self->ldapCAPath );
|
|
$h{verify} ||= $self->ldapVerify if ( $self->ldapVerify );
|
|
my $start_tls = $ldap->start_tls(%h);
|
|
if ( $start_tls->code ) {
|
|
die 'tls failed: ' . $start_tls->error;
|
|
}
|
|
}
|
|
|
|
# Bind with credentials
|
|
my $bind =
|
|
$ldap->bind( $self->ldapBindDN, password => $self->ldapBindPassword );
|
|
if ( $bind->code ) {
|
|
die 'bind failed: ' . $bind->error;
|
|
}
|
|
|
|
$self->{ldap} = $ldap;
|
|
return $ldap;
|
|
}
|
|
|
|
## @method string getIdentifier(string uid, string ref, string date)
|
|
# Get notification identifier
|
|
# @param $uid uid
|
|
# @param $ref ref
|
|
# @param $date date
|
|
# @return the notification identifier
|
|
sub getIdentifier {
|
|
my ( $self, $uid, $ref, $date ) = @_;
|
|
return $date . "#" . $uid . "#" . $ref;
|
|
}
|
|
|
|
1;
|
|
|