REST session/conf backends (#970)
Xavier Guimard
8 years ago
parent
42a2d8cb86
commit
5369f46024
@ -0,0 +1,342 @@ |
||||
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 |
||||
@ -0,0 +1,124 @@ |
||||
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; |
||||
@ -0,0 +1,184 @@ |
||||
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, |
||||
} |
||||
} |
||||
); |
||||
} |
||||
|
||||
sub sp { |
||||
return LLNG::Manager::Test->new( |
||||
{ |
||||
ini => { |
||||
logLevel => $debug, |
||||
domain => 'sp.com', |
||||
portal => 'http://auth.sp.com', |
||||
authentication => 'Demo', |
||||
userDB => 'Demo', |
||||
globalStorage => 'Lemonldap::NG::Common::Apache::Session::REST', |
||||
globalStorageOptions => { |
||||
baseUrl => 'http://auth.idp.com/sessions/global/' |
||||
}, |
||||
persistentStorage => 'Lemonldap::NG::Common::Apache::File', |
||||
}, |
||||
} |
||||
); |
||||
} |
||||
Loading…
Reference in new issue