Commit 5369f460 authored by Xavier Guimard's avatar Xavier Guimard

REST session/conf backends (#970)

parent 42a2d8cb
......@@ -4,6 +4,7 @@ lib/Lemonldap/NG/Common.pm
lib/Lemonldap/NG/Common/Apache/Session.pm
lib/Lemonldap/NG/Common/Apache/Session/Generate/SHA256.pm
lib/Lemonldap/NG/Common/Apache/Session/Lock.pm
lib/Lemonldap/NG/Common/Apache/Session/REST.pm
lib/Lemonldap/NG/Common/Apache/Session/Serialize/JSON.pm
lib/Lemonldap/NG/Common/Apache/Session/SOAP.pm
lib/Lemonldap/NG/Common/Apache/Session/Store.pm
......@@ -20,6 +21,7 @@ lib/Lemonldap/NG/Common/Conf/Backends/JSONFile.pm
lib/Lemonldap/NG/Common/Conf/Backends/LDAP.pm
lib/Lemonldap/NG/Common/Conf/Backends/MongoDB.pm
lib/Lemonldap/NG/Common/Conf/Backends/RDBI.pm
lib/Lemonldap/NG/Common/Conf/Backends/REST.pm
lib/Lemonldap/NG/Common/Conf/Backends/SOAP.pm
lib/Lemonldap/NG/Common/Conf/Compact.pm
lib/Lemonldap/NG/Common/Conf/Constants.pm
......
package Lemonldap::NG::Common::Apache::Session::REST;
use strict;
use LWP::UserAgent;
use JSON qw(from_json to_json);
our $VERSION = '2.0.0';
# PUBLIC INTERFACE
# Constructor for Perl TIE mechanism. See perltie(3) for more.
sub TIEHASH {
my ( $class, $session_id, $args ) = @_;
die "baseUrl argument is required"
unless ( $args and $args->{baseUrl} );
my $self = {
data => { _session_id => $session_id },
modified => 0,
};
foreach (qw(baseUrl user password realm localStorage localStorageOptions)) {
$self->{$_} = $args->{$_};
}
bless $self, $class;
if ( defined $session_id && $session_id ) {
die "unexistant session $session_id"
unless ( $self->get($session_id) );
}
else {
die "unable to create session"
unless ( $self->newSession() );
}
return $self;
}
sub FETCH {
my $self = shift;
my $key = shift;
return $self->{data}->{$key};
}
sub STORE {
my $self = shift;
my $key = shift;
my $value = shift;
$self->{data}->{$key} = $value;
$self->{modified} = 1;
return $value;
}
sub DELETE {
my $self = shift;
my $key = shift;
$self->{modified} = 1;
delete $self->{data}->{$key};
}
sub CLEAR {
my $self = shift;
$self->{modified} = 1;
$self->{data} = {};
}
sub EXISTS {
my $self = shift;
my $key = shift;
return exists $self->{data}->{$key};
}
sub FIRSTKEY {
my $self = shift;
my $reset = keys %{ $self->{data} };
return each %{ $self->{data} };
}
sub NEXTKEY {
my $self = shift;
return each %{ $self->{data} };
}
sub DESTROY {
my $self = shift;
$self->save;
}
sub ua {
my ($self) = @_;
return $self->{ua} if ( $self->{ua} );
my $ua = LWP::UserAgent->new( %{ $self->{lwpOpts} || {} } );
if ( $self->{user} ) {
my $url = $self->{baseUrl};
my $port = ( $url =~ /^https/ ? 443 : 80 );
$url =~ s#https?://([^/]*).*$#$1#;
$port = $1 if ( $url =~ s/:(\d+)$// );
$ua->credentials( "$url:$port", $self->{realm},
$self->{user}, $self->{password} );
}
return $self->{ua} = $ua;
}
sub getJson {
my $self = shift;
my $url = shift;
my $resp = $self->ua->get( $self->base . $url, @_ );
if ( $resp->is_success ) {
my $res;
eval { $res = from_json( $resp->content ) };
if ($@) {
print STDERR "Unable to decode session: $@\n";
return 0;
}
return $res;
}
elsif ( $resp->status_line =~ /400/ ) {
return 0;
}
else {
print STDERR 'REST server returns: ' . $resp->status_line . "\n";
return 0;
}
}
sub base {
my ($self) = @_;
$self->{baseUrl} =~ s#/*$#/#;
return $self->{baseUrl};
}
## @method hashRef get(string id)
# @param $id Apache::Session session ID.
# @return User datas
sub get {
my $self = shift;
my $id = shift;
# Check cache
if ( $self->{localStorage} && $self->cache->get("rest$id") ) {
return $self->{data} = $self->cache->get("rest$id");
}
# No cache, use REST and set cache
my $res = $self->getJson("$id") or return 0;
$self->{data} = $res;
$self->cache->set( "soap$id", $self->{data} ) if $self->{localStorage};
return $self->{data};
}
## @method hashRef newSession()
# Build a new Apache::Session session.
# @return User datas (just the session ID)
sub newSession {
my $self = shift;
my $req = HTTP::Request->new( POST => $self->base );
$req->content( to_json( { _utime => time } ) );
$req->header( 'Content-Type' => 'application/json' );
my $resp = $self->ua->request($req);
if ( $resp->is_success ) {
my $res;
eval { $res = from_json( $resp->content ) };
if ( $@ or !$res->{result} ) {
die "Unable to create session: bad REST response $@";
}
$self->{data} = $res->{session};
}
else {
die "REST server returns " . $resp->status_line;
}
# Set cache
if ( $self->{localStorage} ) {
my $id = "rest" . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
$self->cache->set( $id, $self->{data} );
}
return $self->{data};
}
## @method boolean save()
# Save user datas if modified.
sub save {
my $self = shift;
return unless ( $self->{modified} );
# Update session in cache
if ( $self->{localStorage} ) {
my $id = "soap" . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
$self->cache->set( $id, $self->{data} );
}
# REST
my $req =
HTTP::Request->new( PUT => $self->base . $self->{data}->{_session_id} );
$req->content( to_json( $self->{data} ) );
$req->header( 'Content-Type' => 'application/json' );
my $resp = $self->ua->request($req);
if ( $resp->is_success ) {
my $res;
eval { $res = from_json( $resp->content ) };
if ($@) {
die "Bad REST response: $@";
}
return $res;
}
else {
print STDERR "REST server returns " . $resp->status_line;
return;
}
}
## @method boolean delete()
# Deletes the current session.
sub delete {
my $self = shift;
# Remove session from cache
if ( $self->{localStorage} ) {
my $id = "soap" . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
}
# REST
my $req = HTTP::Request->new(
DELETE => $self->base . $self->{data}->{_session_id} );
$req->header( 'Content-Type' => 'application/json' );
my $resp = $self->ua->request($req);
return ( $resp->is_success ? 1 : 0 );
}
## @method get_key_from_all_sessions()
# Not documented.
sub get_key_from_all_sessions() {
die "Not implemented";
my ( $class, $args, $data ) = @_;
my $self = bless {}, $class;
foreach (qw(baseUrl user password realm)) {
$self->{$_} = $args->{$_};
}
die('baseUrl is required') unless ( $self->{baseUrl} );
if ( ref($data) eq 'CODE' ) {
#my $r = $self->_soapCall( "get_key_from_all_sessions", $args );
#my $res;
#if ($r) {
# foreach my $k ( keys %$r ) {
# my $tmp = &$data( $r->{$k}, $k );
# $res->{$k} = $tmp if ( defined($tmp) );
# }
#}
}
else {
#return $self->_soapCall( "get_key_from_all_sessions", $args, $data );
}
}
sub cache {
my $self = shift;
return $self->{cache} if $self->{cache};
my $module = $self->{localStorage};
eval "use $module;";
$self->{cache} = $module->new( $self->{localStorageOptions} );
return $self->{cache};
}
1;
__END__
=head1 NAME
=encoding utf8
Lemonldap::NG::Common::Apache::Session::REST - Perl extension written to
access to Lemonldap::NG Web-SSO sessions via REST.
=head1 DESCRIPTION
Lemonldap::NG::Common::Conf provides a simple interface to access to
Lemonldap::NG Web-SSO configuration. It is used by L<Lemonldap::NG::Handler>,
L<Lemonldap::NG::Portal> and L<Lemonldap::NG::Manager>.
Lemonldap::NG::Common::Apache::Session::REST used with
L<Lemonldap::NG::Portal> provides the ability to acces to
Lemonldap::NG sessions via REST: the portal act as a proxy to access to the
real Apache::Session module (see HTML documentation for more)
=head1 SEE ALSO
L<http://lemonldap-ng.org/>, L<Lemonldap::NG::Portal>, L<Apache::Session>
=head1 AUTHORS
=over
=item LemonLDAP::NG team L<http://lemonldap-ng.org/team>
=back
=head1 BUG REPORT
Use OW2 system to report bug or ask for features:
L<http://jira.ow2.org>
=head1 DOWNLOAD
Lemonldap::NG is available at
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
=head1 COPYRIGHT AND LICENSE
See COPYING file for details.
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see L<http://www.gnu.org/licenses/>.
=cut
package Lemonldap::NG::Common::Conf::Backends::REST;
use strict;
use LWP::UserAgent;
use JSON qw(from_json to_json);
our $VERSION = '2.0.0';
#parameter baseUrl, user, password, realm, lwpOpts
sub prereq {
my $self = shift;
unless ( $self->{baseUrl} ) {
$Lemonldap::NG::Common::Conf::msg .=
"url parameter is required in REST configuration type \n";
return 0;
}
if ( $self->{user} and not $self->{realm} ) {
$Lemonldap::NG::Common::Conf::msg .=
"realm is required when user/password are set\n";
return 0;
}
1;
}
sub ua {
my ($self) = @_;
return $self->{ua} if ( $self->{ua} );
my $ua = LWP::UserAgent->new( %{ $self->{lwpOpts} || {} } );
if ( $self->{user} ) {
my $url = $self->{baseUrl};
my $port = ( $url =~ /^https/ ? 443 : 80 );
$url =~ s#https?://([^/]*).*$#$1#;
$port = $1 if ( $url =~ s/:(\d+)$// );
$ua->credentials( "$url:$port", $self->{realm},
$self->{user}, $self->{password} );
}
return $self->{ua} = $ua;
}
sub getJson {
my $self = shift;
my $url = shift;
my $resp = $self->ua->get( $self->base . $url, @_ );
if ( $resp->is_success ) {
my $res;
eval { $res = from_json( $resp->content ) };
if ($@) {
$Lemonldap::NG::Common::Conf::msg .= "Request failed: $@\n";
return undef;
}
return $res;
}
else {
$Lemonldap::NG::Common::Conf::msg .=
"Request failed: status code " . $resp->status_line;
return undef;
}
}
sub base {
my ($self) = @_;
$self->{baseUrl} =~ s#/*$#/#;
return $self->{baseUrl};
}
sub available {
# TODO
print STDERR 'Not implemented for now';
return undef;
}
sub lastCfg {
my $self = shift;
my $res = $self->getJson('latest') or return;
return $res->{cfgNum};
}
# lock and unlock must not be requested by the SOAP client, since
# they will be done by the SOAP server when storing the config
sub lock {
return 1;
}
sub unlock {
return 1;
}
sub isLocked {
return 1;
}
sub store {
# TODO
print STDERR 'Not implemented for now';
return undef;
my ( $self, $conf ) = @_;
my $req = HTTP::Request->new( POST => $self->base );
$req->content( to_json($conf) );
$req->header( 'Content-Type' => 'application/json' );
my $resp = $self->ua->request($req);
if ( $resp->is_success ) {
my $res;
eval { $res = from_json( $resp->content ) };
if ($@) {
$Lemonldap::NG::Common::Conf::msg .= "Unknown error: $@";
return undef;
}
return $res->{cfgNum};
}
$Lemonldap::NG::Common::Conf::msg .= 'Unknown error: ' . $resp->status_line;
return undef;
return $self->_soapCall( 'store', @_ );
}
sub load {
my $self = shift;
my $res = $self->getJson('latest?full') or return;
return $res;
}
1;
......@@ -126,7 +126,7 @@ sub _tie_session {
eval {
# SOAP session module must be directly tied
if ( $self->storageModule =~
/Lemonldap::NG::Common::Apache::Session::SOAP/ )
/^Lemonldap::NG::Common::Apache::Session/ )
{
tie %h, $self->storageModule, $self->id,
{ %{ $self->options }, %$options };
......
......@@ -357,6 +357,7 @@ t/32-Auth-and-issuer-OIDC-implicit.t
t/33-Auth-and-issuer-OpenID2.t
t/34-Auth-Proxy-and-REST-Server.t
t/34-Auth-Proxy-and-SOAP-Server.t
t/35-REST-sessions-with-REST-server.t
t/35-SOAP-sessions-with-SOAP-server.t
t/40-Notifications-DBI.t
t/41-Register-Demo.t
......
......@@ -152,13 +152,11 @@ sub newSession {
$session->update($infos);
$self->lmLog(
'REST request to create a session for '
. $session->data->{ $self->conf->{whatToTrace} },
'debug'
);
$self->lmLog( "SOAP request create a new session (" . $session->id . ")",
'debug' );
return $self->p->sendJSONresponse( $req,
{ result => 1, sessionId => $session->data->{_session_id} } );
{ result => 1, session => $session->data } );
}
sub updateSession {
......
......@@ -73,7 +73,7 @@ ok(
expectOK($res);
ok( $res = eval { JSON::from_json( $res->[2]->[0] ) }, ' GET JSON' )
or print STDERR $@;
my $newId = $res->{sessionId};
my $newId = $res->{session}->{_session_id};
# Verify a key
ok( $res = $issuer->_get("/sessions/global/$newId/uid"), 'Verify uid' );
......
use Test::More;
use strict;
use IO::String;
BEGIN {
require 't/test-lib.pm';
}
my $debug = 'error';
my ( $issuer, $sp, $res, $spId );
my %handlerOR = ( issuer => [], sp => [] );
ok( $issuer = issuer(), 'Issuer portal' );
$handlerOR{issuer} = \@Lemonldap::NG::Handler::Main::Reload::_onReload;
switch ('sp');
ok( $sp = sp(), 'SP portal' );
$handlerOR{sp} = \@Lemonldap::NG::Handler::Main::Reload::_onReload;
count(2);
# Simple SP access
ok(
$res = $sp->_get(
'/', accept => 'text/html',
),
'Unauth SP request'
);
expectOK($res);
# Try to auth
ok(
$res = $sp->_post(
'/', IO::String->new('user=dwho&password=dwho'),
length => 23,
accept => 'text/html'
),
'Post user/password'
);
count(2);
expectRedirection( $res, 'http://auth.sp.com' );
$spId = expectCookie($res);
# Test other REST queries
switch ('issuer');
# Session content
ok( $res = $issuer->_get("/sessions/global/$spId"), 'Session content' );
expectOK($res);
ok( $res = eval { JSON::from_json( $res->[2]->[0] ) }, ' GET JSON' )
or print STDERR $@;
ok( $res->{_session_id} eq $spId, ' Good ID' )
or explain( $res, "_session_id => $spId" );
count(3);
# Session key
ok( $res = $issuer->_get("/sessions/global/$spId/[_session_id,uid]"),
'Some session keys' );
expectOK($res);
ok( $res = eval { JSON::from_json( $res->[2]->[0] ) }, ' GET JSON' )
or print STDERR $@;
ok( $res->{_session_id} eq $spId, ' Good ID' )
or explain( $res, "_session_id => $spId" );
ok( $res->{uid} eq 'dwho', ' Uid is dwho' ) or explain( $res, 'uid => dwho' );
count(4);
# Logout
switch ('sp');
ok(
$res = $sp->_get(
'/',
query => 'logout',
accept => 'text/html',
cookie => "lemonldap=$spId"
),
'Ask for logout'
);
count(1);
expectOK($res);
# Test if user is reject on IdP
ok(
$res = $sp->_get(
'/', cookie => "lemonldap=$spId",
),
'Test if user is reject on IdP'
);
count(1);
expectReject($res);
clean_sessions();
done_testing( count() );
# Redefine LWP methods for tests
no warnings 'redefine';
sub LWP::UserAgent::request {
my ( $self, $req ) = @_;
ok( $req->uri =~ m#http://auth.idp.com(.*)#, " REST request (uri: $1)" );
count(1);
my $url = $1;
my $res;
my $s = $req->content;
if ( $req->method =~ /^(post|put)$/i ) {
my $mth = '_' . lc($1);
my $s = $req->content;
ok(
$res = $issuer->$mth(
$url,
IO::String->new($s),
length => length($s),
type => $req->header('Content-Type'),
),
' Post request'
);
count(1);
expectOK($res);
}
elsif ( $req->method =~ /^(get|delete)$/i ) {
my $mth = '_' . lc($1);
ok(
$res = $issuer->$mth(
$url,
accept => $req->header('Accept'),
cookie => $req->header('Cookie')
),
' Execute request'
);
ok( ( $res->[0] == 200 or $res->[0] == 400 ),
' Response is 200 or 400' )
or explain( $res->[0], '200 or 400' );
count(2);
}
my $httpResp;
$httpResp = HTTP::Response->new( $res->[0], 'OK' );
while ( my $name = shift @{ $res->[1] } ) {
$httpResp->header( $name, shift( @{ $res->[1] } ) );
}
$httpResp->content( join( '', @{ $res->[2] } ) );
return $httpResp;
}
sub switch {
my $type = shift;
@Lemonldap::NG::Handler::Main::Reload::_onReload = @{
$handlerOR{$type};
};
}
sub issuer {
return LLNG::Manager::Test->new(
{
ini => {
logLevel => $debug,
templatesDir => 'site/htdocs/static',
domain => 'idp.com',
portal => 'http://auth.idp.com',
authentication => 'Demo',
userDB => 'Demo',
restSessionServer => 1,
restConfigServer => 1,
}