Commit c1fb44a2 authored by Xavier Guimard's avatar Xavier Guimard

Many changes in notifications (#595)

parent 201913d6
......@@ -899,8 +899,8 @@ zip-dist:
manifest: configure
@for i in ${SRCCOMMONDIR} ${SRCHANDLERDIR} ${SRCPORTALDIR} ${SRCMANAGERDIR}; do \
cd $$i; \
rm -vf MANIFEST*; \
make manifest; \
rm -vf MANIFEST.*; \
cd -; \
done
......
......@@ -27,10 +27,12 @@ lib/Lemonldap/NG/Common/Conf/SAML/Metadata.pm
lib/Lemonldap/NG/Common/Conf/Serializer.pm
lib/Lemonldap/NG/Common/Conf/SOAP.pm
lib/Lemonldap/NG/Common/Crypto.pm
lib/Lemonldap/NG/Common/Module.pm
lib/Lemonldap/NG/Common/Notification.pm
lib/Lemonldap/NG/Common/Notification/DBI.pm
lib/Lemonldap/NG/Common/Notification/File.pm
lib/Lemonldap/NG/Common/Notification/LDAP.pm
lib/Lemonldap/NG/Common/Notifications.pm
lib/Lemonldap/NG/Common/Notifications/DBI.pm
lib/Lemonldap/NG/Common/Notifications/File.pm
lib/Lemonldap/NG/Common/Notifications/LDAP.pm
lib/Lemonldap/NG/Common/PSGI.pm
lib/Lemonldap/NG/Common/PSGI/Cli/Lib.pm
lib/Lemonldap/NG/Common/PSGI/Constants.pm
......
package Lemonldap::NG::Portal::Main::Module;
package Lemonldap::NG::Common::Module;
use strict;
use Mouse;
our $VERSION = '2.0.0';
# Object that provides lmLog and error methods (typically PSGI object)
has p => ( is => 'rw', weak_ref => 1 );
# Lemonldap::NG configuration hash ref
has conf => ( is => 'rw', weak_ref => 1 );
sub lmLog {
......
package Lemonldap::NG::Common::Notifications;
use strict;
use Mouse;
use XML::LibXML;
our $VERSION = '2.0.0';
extends 'Lemonldap::NG::Common::Module';
# XML parser. TODO: replace this by JSON
has parser => (
is => 'rw',
builder => sub {
return XML::LibXML->new();
}
);
has notifField => (
is => 'rw',
builder => sub {
my $uid =
$_[0]->conf->{notificationField}
|| $_[0]->conf->{whatToTrace}
|| 'uid';
$uid =~ s/^\$//;
return $uid;
}
);
sub getNotifications {
my ( $self, $uid ) = @_;
my $forUser = $self->get($uid);
my $forAll = $self->get( $self->conf->{notificationWildcard} );
if ( $forUser and $forAll ) {
return { %$forUser, %$forAll };
}
else {
return ( ( $forUser ? $forUser : $forAll ), $forUser );
}
}
# Check XML datas and insert new notifications.
# @param $xml XML string containing notification
# @return number of notifications done
sub newNotification {
my ( $self, $xml ) = @_;
eval { $xml = $self->parser->parse_string($xml); };
if ($@) {
$self->lmLog( "Unable to read XML file : $@", 'error' );
return 0;
}
my @notifs;
my ( $version, $encoding ) = ( $xml->version(), $xml->encoding() );
foreach
my $notif ( $xml->documentElement->getElementsByTagName('notification') )
{
my @datas = ();
# Mandatory information
foreach (qw(date uid reference)) {
my $tmp;
unless ( $tmp = $notif->getAttribute($_) ) {
$self->lmLog( "Attribute $_ is missing", 'error' );
return 0;
}
push @datas, $tmp;
}
# Other information
foreach (qw(condition)) {
my $tmp;
if ( $tmp = $notif->getAttribute($_) ) {
push @datas, $tmp;
}
else { push @datas, ""; }
}
my $result = XML::LibXML::Document->new( $version, $encoding );
my $root = XML::LibXML::Element->new('root');
$root->appendChild($notif);
$result->setDocumentElement($root);
push @notifs, [ @datas, $result ];
}
my $tmp = $self->{type};
my $count;
foreach (@notifs) {
$count++;
my ( $r, $err ) = $self->newNotif(@$_);
die "$err" unless ($r);
}
return $count;
}
## Delete notifications for the connected user
## @param $uid of the user
## @param $myref notification's reference
## @return number of deleted notifications
sub deleteNotification {
my ( $self, $uid, $myref ) = @_;
my @data;
# Check input parameters
unless ( $uid and $myref ) {
$self->lmLog(
"SOAP service deleteNotification called without all parameters",
'error' );
return 0;
}
$self->lmLog(
"SOAP service deleteNotification called for uid $uid and reference $myref",
'debug'
);
# Get notifications
my $user = $self->get($uid);
# Return 0 if no files were found
return 0 unless ($user);
# Counting
my $count = 0;
foreach my $ref ( keys %$user ) {
my $xml = $self->parser->parse_string( $user->{$ref} );
# Browse notification in file
foreach my $notif (
$xml->documentElement->getElementsByTagName('notification') )
{
# Get notification's data
if ( $notif->getAttribute('reference') eq $myref ) {
push @data, $ref;
}
# Delete the notification (really)
foreach (@data) {
if ( $self->purge( $_, 1 ) ) {
$self->lmLog( "Notification $_ was removed.", 'debug' );
$count++;
}
}
}
}
return $count;
}
1;
......@@ -3,42 +3,62 @@
## @class
# DBI storage methods for notifications
package Lemonldap::NG::Common::Notification::DBI;
package Lemonldap::NG::Common::Notifications::DBI;
use strict;
use Mouse;
use Time::Local;
use DBI;
use utf8;
use Encode;
our $VERSION = '2.0.0';
## @method boolean prereq()
# Check if DBI parameters are set.
# @return true if all is OK
sub prereq {
my $self = shift;
$self->{dbiTable} = $self->{table} if ( $self->{table} );
unless ( $self->{dbiChain} ) {
$Lemonldap::NG::Common::Notification::msg =
'"dbiChain" is required in DBI notification type';
return 0;
extends 'Lemonldap::NG::Common::Notifications';
has dbiTable => (
is => 'ro',
default => sub { $_[0]->{table} || 'notifications' }
);
has dbiChain => (
is => 'ro',
required => 1
);
has dbiUser => (
is => 'ro',
default => sub {
$_[0]->p->lmLog( 'Warning: "dbiUser" parameter is not set', 'warn' );
return '';
}
$self->lmLog( 'Warning: "dbiUser" parameter is not set', 'warn' )
unless ( $self->{dbiUser} );
1;
}
);
has dbiPassword => ( is => 'ro', default => '' );
# Database handle object
has _dbh => (
is => 'rw',
lazy => 1,
builder => sub {
my $self = shift;
my $r = DBI->connect_cached(
$self->{dbiChain}, $self->{dbiUser},
$self->{dbiPassword}, { RaiseError => 0 }
);
$self->lmLog( $DBI::errstr, 'error' ) unless ($r);
return $r;
}
);
# Current query
has sth => ( is => 'rw' );
## @method hashref get(string uid,string ref)
# Returns notifications corresponding to the user $uid.
# If $ref is set, returns only notification corresponding to this reference.
# @param $uid UID
# @param $ref Notification reference
# @return hashref where keys are internal reference and values are XML strings
sub get {
my ( $self, $uid, $ref ) = @_;
return () unless ($uid);
_execute(
$self,
$self->_execute(
"SELECT * FROM $self->{dbiTable} WHERE done IS NULL AND uid=?"
. ( $ref ? " AND ref=?" : '' )
. "ORDER BY date",
......@@ -46,7 +66,7 @@ sub get {
( $ref ? $ref : () )
) or return ();
my $result;
while ( my $h = $self->{sth}->fetchrow_hashref() ) {
while ( my $h = $self->sth->fetchrow_hashref() ) {
# Get XML message
my $xml = $h->{xml};
......@@ -59,7 +79,7 @@ sub get {
&getIdentifier( $self, $h->{uid}, $h->{ref}, $h->{date} );
$result->{$identifier} = $xml;
}
$self->lmLog( $self->{sth}->err(), 'warn' ) if ( $self->{sth}->err() );
$self->lmLog( $self->sth->err(), 'warn' ) if ( $self->sth->err() );
return $result;
}
......@@ -69,10 +89,10 @@ sub get {
# keys date, uid and ref.
sub getAll {
my $self = shift;
_execute( $self,
"SELECT * FROM $self->{dbiTable} WHERE done IS NULL ORDER BY date" );
$self->_execute(
"SELECT * FROM $self->{dbiTable} WHERE done IS NULL ORDER BY date");
my $result;
while ( my $h = $self->{sth}->fetchrow_hashref() ) {
while ( my $h = $self->sth->fetchrow_hashref() ) {
$result->{"$h->{date}#$h->{uid}#$h->{ref}"} = {
date => $h->{date},
uid => $h->{uid},
......@@ -80,7 +100,7 @@ sub getAll {
condition => $h->{condition}
};
}
$self->lmLog( $self->{sth}->err(), 'warn' ) if ( $self->{sth}->err() );
$self->lmLog( $self->sth->err(), 'warn' ) if ( $self->sth->err() );
return $result;
}
......@@ -98,15 +118,10 @@ sub delete {
my @ts = localtime();
$ts[5] += 1900;
$ts[4]++;
return _execute(
$self,
"UPDATE $self->{dbiTable} "
return $self->_execute( "UPDATE $self->{dbiTable} "
. "SET done='$ts[5]-$ts[4]-$ts[3] $ts[2]:$ts[1]' "
. "WHERE done IS NULL AND uid=? AND ref=? AND date=?",
$u,
$r,
$d
);
$u, $r, $d );
}
## @method boolean purge(string myref, boolean force)
......@@ -126,14 +141,9 @@ sub purge {
my $clause;
$clause = "done IS NOT NULL AND" unless ($force);
return _execute(
$self,
"DELETE FROM $self->{dbiTable} "
return $self->_execute( "DELETE FROM $self->{dbiTable} "
. "WHERE $clause uid=? AND ref=? AND date=?",
$u,
$r,
$d
);
$u, $r, $d );
}
## @method boolean newNotif(string date, string uid, string ref, string condition, string xml)
......@@ -152,24 +162,13 @@ sub newNotif {
my $res =
$condition =~ /.+/
? _execute(
$self,
? $self->_execute(
"INSERT INTO $self->{dbiTable} (date,uid,ref,cond,xml) "
. "VALUES(?,?,?,?,?)",
$date,
$uid,
$ref,
$condition,
$xml
)
: _execute(
$self,
$date, $uid, $ref, $condition, $xml )
: $self->_execute(
"INSERT INTO $self->{dbiTable} (date,uid,ref,xml) " . "VALUES(?,?,?,?)",
$date,
$uid,
$ref,
$xml
);
$date, $uid, $ref, $xml );
return $res;
}
......@@ -179,17 +178,16 @@ sub newNotif {
# keys notified, uid and ref.
sub getDone {
my ($self) = @_;
_execute( $self,
"SELECT * FROM $self->{dbiTable} WHERE done IS NOT NULL ORDER BY done"
);
$self->_execute(
"SELECT * FROM $self->{dbiTable} WHERE done IS NOT NULL ORDER BY done");
my $result;
while ( my $h = $self->{sth}->fetchrow_hashref() ) {
while ( my $h = $self->sth->fetchrow_hashref() ) {
my @t = split( /\D+/, $h->{date} );
my $done = timelocal( $t[5], $t[4], $t[3], $t[2], $t[1], $t[0] );
$result->{"$h->{date}#$h->{uid}#$h->{ref}"} =
{ notified => $done, uid => $h->{uid}, ref => $h->{ref}, };
}
$self->lmLog( $self->{sth}->err(), 'warn' ) if ( $self->{sth}->err() );
$self->lmLog( $self->sth->err(), 'warn' ) if ( $self->sth->err() );
return $result;
}
......@@ -198,34 +196,19 @@ sub getDone {
# @return number of lines touched or 1 if select succeed
sub _execute {
my ( $self, $query, @args ) = @_;
my $dbh = _dbh($self) or return 0;
unless ( $self->{sth} = $dbh->prepare($query) ) {
my $dbh = $self->_dbh or return 0;
unless ( $self->sth( $dbh->prepare($query) ) ) {
$self->lmLog( $dbh->errstr(), 'warn' );
return 0;
}
my $tmp;
unless ( $tmp = $self->{sth}->execute(@args) ) {
$self->lmLog( $self->{sth}->errstr(), 'warn' );
unless ( $tmp = $self->sth->execute(@args) ) {
$self->lmLog( $self->sth->errstr(), 'warn' );
return 0;
}
return $tmp;
}
## @method object private _dbh()
# Return the DBI object (build it if needed).
# @return database handle object
sub _dbh {
my $self = shift;
$self->{dbiTable} ||= "notifications";
return $self->{dbh} if ( $self->{dbh} and $self->{dbh}->ping );
my $r = DBI->connect_cached(
$self->{dbiChain}, $self->{dbiUser},
$self->{dbiPassword}, { RaiseError => 0 }
);
$self->lmLog( $DBI::errstr, 'error' ) unless ($r);
return $r;
}
## @method string getIdentifier(string uid, string ref, string date)
# Get notification identifier
# @param $uid uid
......
......@@ -3,7 +3,7 @@
## @class
# File storage methods for notifications
package Lemonldap::NG::Common::Notification::File;
package Lemonldap::NG::Common::Notifications::File;
use strict;
use Mouse;
......@@ -11,7 +11,9 @@ use MIME::Base64;
our $VERSION = '2.0.0';
has dirName => ( is => 'rw', required => 1 );
extends 'Lemonldap::NG::Common::Notifications';
has dirName => ( is => 'ro', required => 1 );
has table => (
is => 'rw',
......
......@@ -4,9 +4,10 @@
## @class
# LDAP storage methods for notifications
package Lemonldap::NG::Common::Notification::LDAP;
package Lemonldap::NG::Common::Notifications::LDAP;
use strict;
use Mouse;
use Time::Local;
use MIME::Base64;
use Net::LDAP;
......@@ -14,42 +15,41 @@ use utf8;
our $VERSION = '2.0.0';
## @method boolean prereq()
# Check if LDAP parameters are set.
# @return true if all is OK
sub prereq {
my $self = shift;
unless ( $self->{ldapServer} ) {
$self->lmLog( '"ldapServer" is required in LDAP notification type',
'error' );
$Lemonldap::NG::Common::Notification::msg =
'"ldapServer" is required in LDAP notification type';
return 0;
}
if ( $self->{table} ) {
$self->{ldapConfBase} =~ s/^\w+=\w+(,.*)$/ou=$self->{table}$1/;
extends 'Lemonldap::NG::Common::Notifications';
has ldapServer => (
is => 'ro',
required => 1,
);
has ldapConfBase => (
is => 'ro',
trigger => sub {
if ( my $table = $_[0]->{table} ) {
$_[0]->{ldapConfBase} =~ s/^\w+=\w+(,.*)$/ou=$table$1/;
}
}
);
$self->lmLog( 'Warning: "ldapBindDN" parameter is not set', 'warn' )
unless ( $self->{ldapBindDN} );
1;
}
has ldapBindDN => (
is => 'ro',
default => sub {
$_[0]->p->lmLog( 'Warning: "ldapBindDN" parameter is not set', 'warn' );
return '';
}
);
## @method hashref get(string uid,string ref)
# Returns notifications corresponding to the user $uid.
# If $ref is set, returns only notification corresponding to this reference.
# @param $uid UID
# @param $ref Notification reference
# @return hashref where keys are internal reference and values are XML strings
sub get {
my ( $self, $uid, $ref ) = @_;
return () unless ($uid);
my $filter = '(&(objectClass=applicationProcess)(!(description={done}*))';
$filter .= '(description={uid}' . $uid . ')';
$filter .= '(description={ref}' . $ref . ')' if $ref;
$filter .= ')';
my @entries = _search( $self, "$filter" );
my $filter =
'(&(objectClass=applicationProcess)(!(description={done}*))'
. "(description={uid}$uid)"
. ( $ref ? '(description={ref}' . $ref . ')' : '' ) . ')';
my @entries = _search( $self, $filter );
my $result = {};
foreach my $entry (@entries) {
......@@ -69,7 +69,6 @@ sub get {
}
return $result;
}
## @method hashref getAll()
......@@ -79,8 +78,8 @@ sub get {
sub getAll {
my $self = shift;
my @entries = _search( $self,
'(&(objectClass=applicationProcess)(!(description={done}*)))' );
my @entries = $self->_search(
'(&(objectClass=applicationProcess)(!(description={done}*)))');
my $result = {};
foreach my $entry (@entries) {
......@@ -110,7 +109,6 @@ sub delete {
my ( $self, $myref ) = @_;
my ( $d, $u, $r );
unless ( ( $d, $u, $r ) = ( $myref =~ /^([^#]+)#(.+?)#(.+)$/ ) ) {
$Lemonldap::NG::Common::Notification::msg = "Bad reference $myref";
$self->lmLog( "Bad reference $myref", 'warn' );
return 0;
}
......@@ -119,13 +117,11 @@ sub delete {
$ts[4]++;
return _modify(
$self,
'(&(objectClass=applicationProcess)(description={uid}'
. $u
. ')(description={ref}'
. $r
. ')(description={date}'
. $d
. ')(!(description={done}*)))',
'(&(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]"
);
......@@ -140,25 +136,18 @@ sub purge {
my ( $self, $myref, $force ) = @_;
my ( $d, $u, $r );
unless ( ( $d, $u, $r ) = ( $myref =~ /^([^#]+)#(.+?)#(.+)$/ ) ) {
$Lemonldap::NG::Common::Notification::msg = "Bad reference $myref";
$self->lmLog( "Bad reference $myref", 'warn' );
return 0;
}
my $clause;
$clause = '(description={done}*)' unless ($force);
return _delete( $self,
'(&(objectClass=applicationProcess)(description={uid}'
. $u
. ')(description={ref}'
. $r
. ')(description={date}'
. $d . ')'
. $clause
. ')' );
my $clause = ($force ? '' : '(description={done}*)');
return $self->_delete( '(&(objectClass=applicationProcess)'
. "(description={uid}$u)"
. "(description={ref}$r)"
. "(description={date}$d)"
. "$clause)" );
}
## @method boolean newNotif(string date, string uid, string ref, string condition, string xml)
# Insert a new notification
# @param date Date
# @param uid UID
......@@ -168,7 +157,7 @@ sub purge {
# @return true if succeed
sub newNotif {
my ( $self, $date, $uid, $ref, $condition, $xml ) = @_;
my $fns = $self->{fileNameSeparator};
my $fns = $self->conf->{fileNameSeparator};
$fns ||= '_';
$date =~ s/-//g;
return ( 0, "Bad date" ) unless ( $date =~ /^\d{8}/ );
......
......@@ -74,7 +74,6 @@ sub notifAccess {
$self->error($Lemonldap::NG::Common::Conf::msg);
return 0;
}
my $args;
# TODO: refresh system
$self->{$_} //= $conf->{$_}
......@@ -91,29 +90,31 @@ sub notifAccess {
'notificationStorage is not defined in configuration' );
return 0;
}
$args->{type} = $self->{notificationStorage};
foreach ( keys %{ $self->{notificationStorageOptions} } ) {
$args->{$_} = $self->{notificationStorageOptions}->{$_};
}
# Get the type
$args->{type} =~ s/.*:://;
$args->{type} =~ s/(CBDI|RDBI)/DBI/; # CDBI/RDBI are DBI
# If type not File or DBI, abort
unless ( $args->{type} =~ /^(File|DBI|LDAP)$/ ) {
$self->handlerAbort( notifications =>
"Only File, DBI or LDAP supported for Notifications" );
my $type =
"Lemonldap::NG::Common::Notifications::$self->{notificationStorage}";
$type =~ s/(?:C|R)DBI$/DBI/;
eval "require $type";
if ($@) {
$self->handlerAbort( notifications => "Unable to load $type: $@" );
return 0;
}
# Force table name
$args->{p} = $self;
unless (
$self->_notifAccess( Lemonldap::NG::Common::Notification->new($args) ) )
eval {
$self->_notifAccess(
$type->new(
{
%{ $self->{notificationStorageOptions} },
p => $self,
conf => $self
}
)
);
}
)
{
$self->handlerAbort(
notifications => $Lemonldap::NG::Common::Notification::msg );
$self->handlerAbort( notifications => $@ );
return 0;
}
return $self->_notifAccess();
......@@ -224,7 +225,7 @@ sub notification {
if ( $type eq 'actives' ) {