Replace request management in handler (#1044)
Note: this is a big change, more tests needed
This commit is contained in:
parent
cc1fc22dcb
commit
2e59ea441a
|
@ -29,11 +29,14 @@ sub new {
|
||||||
$self->env->{PATH_INFO} =~ s|^$tmp|/|;
|
$self->env->{PATH_INFO} =~ s|^$tmp|/|;
|
||||||
$self->{uri} = uri_unescape( $self->env->{REQUEST_URI} );
|
$self->{uri} = uri_unescape( $self->env->{REQUEST_URI} );
|
||||||
$self->{uri} =~ s|//+|/|g;
|
$self->{uri} =~ s|//+|/|g;
|
||||||
|
$self->{datas} = {};
|
||||||
$self->{error} = 0;
|
$self->{error} = 0;
|
||||||
$self->{respHeaders} = [];
|
$self->{respHeaders} = [];
|
||||||
return $self;
|
return bless( $self, $_[0] );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub datas { $_[0]->{datas} }
|
||||||
|
|
||||||
sub uri { $_[0]->{uri} }
|
sub uri { $_[0]->{uri} }
|
||||||
|
|
||||||
sub userData {
|
sub userData {
|
||||||
|
|
|
@ -9,6 +9,7 @@ lib/Lemonldap/NG/Handler/ApacheMP2/CDA.pm
|
||||||
lib/Lemonldap/NG/Handler/ApacheMP2/DevOps.pm
|
lib/Lemonldap/NG/Handler/ApacheMP2/DevOps.pm
|
||||||
lib/Lemonldap/NG/Handler/ApacheMP2/Main.pm
|
lib/Lemonldap/NG/Handler/ApacheMP2/Main.pm
|
||||||
lib/Lemonldap/NG/Handler/ApacheMP2/Menu.pm
|
lib/Lemonldap/NG/Handler/ApacheMP2/Menu.pm
|
||||||
|
lib/Lemonldap/NG/Handler/ApacheMP2/Request.pm
|
||||||
lib/Lemonldap/NG/Handler/ApacheMP2/SecureToken.pm
|
lib/Lemonldap/NG/Handler/ApacheMP2/SecureToken.pm
|
||||||
lib/Lemonldap/NG/Handler/ApacheMP2/ServiceToken.pm
|
lib/Lemonldap/NG/Handler/ApacheMP2/ServiceToken.pm
|
||||||
lib/Lemonldap/NG/Handler/ApacheMP2/ZimbraPreAuth.pm
|
lib/Lemonldap/NG/Handler/ApacheMP2/ZimbraPreAuth.pm
|
||||||
|
@ -48,7 +49,6 @@ META.yml
|
||||||
README
|
README
|
||||||
t/01-Lemonldap-NG-Handler-Main.t
|
t/01-Lemonldap-NG-Handler-Main.t
|
||||||
t/05-Lemonldap-NG-Handler-Reload.t
|
t/05-Lemonldap-NG-Handler-Reload.t
|
||||||
t/10-Lemonldap-NG-Handler-SharedConf.t
|
|
||||||
t/12-Lemonldap-NG-Handler-Jail.t
|
t/12-Lemonldap-NG-Handler-Jail.t
|
||||||
t/13-Lemonldap-NG-Handler-Fake-Safe.t
|
t/13-Lemonldap-NG-Handler-Fake-Safe.t
|
||||||
t/50-Lemonldap-NG-Handler-SecureToken.t
|
t/50-Lemonldap-NG-Handler-SecureToken.t
|
||||||
|
|
|
@ -4,6 +4,7 @@
|
||||||
package Lemonldap::NG::Handler::ApacheMP2;
|
package Lemonldap::NG::Handler::ApacheMP2;
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
|
use Lemonldap::NG::Handler::ApacheMP2::Request;
|
||||||
|
|
||||||
use Lemonldap::NG::Handler::ApacheMP2::Main;
|
use Lemonldap::NG::Handler::ApacheMP2::Main;
|
||||||
|
|
||||||
|
@ -13,30 +14,31 @@ our $VERSION = '2.0.0';
|
||||||
|
|
||||||
sub handler {
|
sub handler {
|
||||||
shift if ($#_);
|
shift if ($#_);
|
||||||
my ($res) = getClass(@_)->run(@_);
|
return launch( 'run', @_ );
|
||||||
return $res;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub logout {
|
sub logout {
|
||||||
shift if ($#_);
|
shift if ($#_);
|
||||||
return getClass(@_)->unlog(@_);
|
return launch( 'unlog', @_ );
|
||||||
}
|
}
|
||||||
|
|
||||||
sub status {
|
sub status {
|
||||||
shift if ($#_);
|
shift if ($#_);
|
||||||
return getClass(@_)->getStatus(@_);
|
return launch( 'getStatus', @_ );
|
||||||
}
|
}
|
||||||
|
|
||||||
# Internal method to get class to load
|
# Internal method to get class to load
|
||||||
sub getClass {
|
sub launch {
|
||||||
my $type = Lemonldap::NG::Handler::ApacheMP2::Main->checkType(@_);
|
my ( $sub, $r ) = @_;
|
||||||
|
my $req = Lemonldap::NG::Handler::Apache2::Request->new($r);
|
||||||
|
my $type = Lemonldap::NG::Handler::ApacheMP2::Main->checkType($req);
|
||||||
if ( my $t = $_[0]->dir_config('VHOSTTYPE') ) {
|
if ( my $t = $_[0]->dir_config('VHOSTTYPE') ) {
|
||||||
$type = $t;
|
$type = $t;
|
||||||
}
|
}
|
||||||
my $class = "Lemonldap::NG::Handler::ApacheMP2::$type";
|
my $class = "Lemonldap::NG::Handler::ApacheMP2::$type";
|
||||||
eval "require $class";
|
eval "require $class";
|
||||||
die $@ if ($@);
|
die $@ if ($@);
|
||||||
return $class;
|
return $class->$sub($req);
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -43,33 +43,6 @@ our $request; # Apache2::RequestRec object for current request
|
||||||
|
|
||||||
#*run = \&Lemonldap::NG::Handler::Main::run;
|
#*run = \&Lemonldap::NG::Handler::Main::run;
|
||||||
|
|
||||||
## @rmethod protected int redirectFilter(string url, Apache2::Filter f)
|
|
||||||
# Launch the current HTTP request then redirects the user to $url.
|
|
||||||
# Used by logout_app and logout_app_sso targets
|
|
||||||
# @param $url URL to redirect the user
|
|
||||||
# @param $f Current Apache2::Filter object
|
|
||||||
# @return Constant $class->OK
|
|
||||||
sub redirectFilter {
|
|
||||||
my $class = shift;
|
|
||||||
my $url = shift;
|
|
||||||
my $f = shift;
|
|
||||||
unless ( $f->ctx ) {
|
|
||||||
|
|
||||||
# Here, we can use Apache2 functions instead of set_header_out
|
|
||||||
# since this function is used only with Apache2.
|
|
||||||
$f->r->status( $class->REDIRECT );
|
|
||||||
$f->r->status_line("303 See Other");
|
|
||||||
$f->r->headers_out->unset('Location');
|
|
||||||
$f->r->err_headers_out->set( 'Location' => $url );
|
|
||||||
$f->ctx(1);
|
|
||||||
}
|
|
||||||
while ( $f->read( my $buffer, 1024 ) ) {
|
|
||||||
}
|
|
||||||
$class->updateStatus( $f->r, '$class->REDIRECT',
|
|
||||||
$class->datas->{ $class->tsv->{whatToTrace} }, 'filter' );
|
|
||||||
return $class->OK;
|
|
||||||
}
|
|
||||||
|
|
||||||
__PACKAGE__->init();
|
__PACKAGE__->init();
|
||||||
|
|
||||||
# INTERNAL METHODS
|
# INTERNAL METHODS
|
||||||
|
@ -99,36 +72,21 @@ sub setServerSignature {
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub newRequest {
|
|
||||||
my ( $class, $r ) = @_;
|
|
||||||
$request = $r;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method void set_user(string user)
|
## @method void set_user(string user)
|
||||||
# sets remote_user
|
# sets remote_user
|
||||||
# @param user string username
|
# @param user string username
|
||||||
sub set_user {
|
sub set_user {
|
||||||
my ( $class, $user ) = @_;
|
my ( $class, $request, $user ) = @_;
|
||||||
$request->user($user);
|
$request->env->{'psgi.r'}->user($user);
|
||||||
}
|
|
||||||
|
|
||||||
## @method string header_in(string header)
|
|
||||||
# returns request header value
|
|
||||||
# @param header string request header
|
|
||||||
# @return request header value
|
|
||||||
sub header_in {
|
|
||||||
my ( $class, $header ) = @_;
|
|
||||||
$header ||= $class; # to use header_in as a method or as a function
|
|
||||||
return $request->headers_in->{$header};
|
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method void set_header_in(hash headers)
|
## @method void set_header_in(hash headers)
|
||||||
# sets or modifies request headers
|
# sets or modifies request headers
|
||||||
# @param headers hash containing header names => header value
|
# @param headers hash containing header names => header value
|
||||||
sub set_header_in {
|
sub set_header_in {
|
||||||
my ( $class, %headers ) = @_;
|
my ( $class, $request, %headers ) = @_;
|
||||||
while ( my ( $h, $v ) = each %headers ) {
|
while ( my ( $h, $v ) = each %headers ) {
|
||||||
$request->headers_in->set( $h => $v );
|
$request->env->{'psgi.r'}->headers_in->set( $h => $v );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -138,11 +96,11 @@ sub set_header_in {
|
||||||
# header 'Auth-User' is removed, 'Auth_User' be removed also
|
# header 'Auth-User' is removed, 'Auth_User' be removed also
|
||||||
# @param headers array with header names to remove
|
# @param headers array with header names to remove
|
||||||
sub unset_header_in {
|
sub unset_header_in {
|
||||||
my ( $class, @headers ) = @_;
|
my ( $class, $request, @headers ) = @_;
|
||||||
foreach my $h1 (@headers) {
|
foreach my $h1 (@headers) {
|
||||||
$h1 = lc $h1;
|
$h1 = lc $h1;
|
||||||
$h1 =~ s/-/_/g;
|
$h1 =~ s/-/_/g;
|
||||||
$request->headers_in->do(
|
$request->env->{'psgi.r'}->headers_in->do(
|
||||||
sub {
|
sub {
|
||||||
my $h = shift;
|
my $h = shift;
|
||||||
my $h2 = lc $h;
|
my $h2 = lc $h;
|
||||||
|
@ -158,120 +116,65 @@ sub unset_header_in {
|
||||||
# sets response headers
|
# sets response headers
|
||||||
# @param headers hash containing header names => header value
|
# @param headers hash containing header names => header value
|
||||||
sub set_header_out {
|
sub set_header_out {
|
||||||
my ( $class, %headers ) = @_;
|
my ( $class, $request, %headers ) = @_;
|
||||||
while ( my ( $h, $v ) = each %headers ) {
|
while ( my ( $h, $v ) = each %headers ) {
|
||||||
$request->err_headers_out->set( $h => $v );
|
$request->env->{'psgi.r'}->err_headers_out->set( $h => $v );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method string hostname()
|
|
||||||
# returns host, as set by full URI or Host header
|
|
||||||
# @return host string Host value
|
|
||||||
sub hostname {
|
|
||||||
my $class = shift;
|
|
||||||
return $request->hostname;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string remote_ip
|
|
||||||
# returns client IP address
|
|
||||||
# @return IP_Addr string client IP
|
|
||||||
sub remote_ip {
|
|
||||||
my $class = shift;
|
|
||||||
my $remote_ip = (
|
|
||||||
$request->connection->can('remote_ip')
|
|
||||||
? $request->connection->remote_ip
|
|
||||||
: $request->connection->client_ip
|
|
||||||
);
|
|
||||||
return $remote_ip;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method boolean is_initial_req
|
## @method boolean is_initial_req
|
||||||
# returns true unless the current request is a subrequest
|
# returns true unless the current request is a subrequest
|
||||||
# @return is_initial_req boolean
|
# @return is_initial_req boolean
|
||||||
sub is_initial_req {
|
sub is_initial_req {
|
||||||
my $class = shift;
|
return $_[1]->env->{'psgi.r'}->is_initial_req;
|
||||||
return $request->is_initial_req;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string args(string args)
|
|
||||||
# gets the query string
|
|
||||||
# @return args string Query string
|
|
||||||
sub args {
|
|
||||||
my $class = shift;
|
|
||||||
return $request->args();
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string uri
|
|
||||||
# returns the path portion of the URI, normalized, i.e. :
|
|
||||||
# * URL decoded (characters encoded as %XX are decoded,
|
|
||||||
# except ? in order not to merge path and query string)
|
|
||||||
# * references to relative path components "." and ".." are resolved
|
|
||||||
# * two or more adjacent slashes are merged into a single slash
|
|
||||||
# @return path portion of the URI, normalized
|
|
||||||
sub uri {
|
|
||||||
my $class = shift;
|
|
||||||
my $uri = $request->uri;
|
|
||||||
$uri =~ s#//+#/#g;
|
|
||||||
$uri =~ s#\?#%3F#g;
|
|
||||||
return $uri;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string uri_with_args
|
|
||||||
# returns the URI, with arguments and with path portion normalized
|
|
||||||
# @return URI with normalized path portion
|
|
||||||
sub uri_with_args {
|
|
||||||
my $class = shift;
|
|
||||||
return uri . ( $request->args ? "?" . $request->args : "" );
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string unparsed_uri
|
|
||||||
# returns the full original request URI, with arguments
|
|
||||||
# @return full original request URI, with arguments
|
|
||||||
sub unparsed_uri {
|
|
||||||
my $class = shift;
|
|
||||||
return $request->unparsed_uri;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string get_server_port
|
|
||||||
# returns the port the server is receiving the current request on
|
|
||||||
# @return port string server port
|
|
||||||
sub get_server_port {
|
|
||||||
my $class = shift;
|
|
||||||
return $request->get_server_port;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string method
|
|
||||||
# returns the port the server is receiving the current request on
|
|
||||||
# @return port string server port
|
|
||||||
sub method {
|
|
||||||
my $class = shift;
|
|
||||||
return $request->method;
|
|
||||||
}
|
|
||||||
|
|
||||||
## Return environment variables as hash
|
|
||||||
sub env {
|
|
||||||
return \%ENV;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method void print(string data)
|
## @method void print(string data)
|
||||||
# write data in HTTP response body
|
# write data in HTTP response body
|
||||||
# @param data Text to add in response body
|
# @param data Text to add in response body
|
||||||
sub print {
|
sub print {
|
||||||
my ( $class, $data ) = @_;
|
my ( $class, $request, $data ) = @_;
|
||||||
$request->print($data);
|
$request->env->{'psgi.r'}->print($data);
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
|
## @rmethod protected int redirectFilter(string url, Apache2::Filter f)
|
||||||
|
# Launch the current HTTP request then redirects the user to $url.
|
||||||
|
# Used by logout_app and logout_app_sso targets
|
||||||
|
# @param $url URL to redirect the user
|
||||||
|
# @param $f Current Apache2::Filter object
|
||||||
|
# @return Constant $class->OK
|
||||||
|
sub redirectFilter {
|
||||||
|
my $class = shift;
|
||||||
|
my $url = shift;
|
||||||
|
my $f = shift;
|
||||||
|
unless ( $f->ctx ) {
|
||||||
|
|
||||||
|
# Here, we can use Apache2 functions instead of set_header_out
|
||||||
|
# since this function is used only with Apache2.
|
||||||
|
$f->r->status( $class->REDIRECT );
|
||||||
|
$f->r->status_line("303 See Other");
|
||||||
|
$f->r->headers_out->unset('Location');
|
||||||
|
$f->r->err_headers_out->set( 'Location' => $url );
|
||||||
|
$f->ctx(1);
|
||||||
|
}
|
||||||
|
while ( $f->read( my $buffer, 1024 ) ) {
|
||||||
|
}
|
||||||
|
$class->updateStatus( $f->r, '$class->REDIRECT',
|
||||||
|
$class->datas->{ $class->tsv->{whatToTrace} }, 'filter' );
|
||||||
|
return $class->OK;
|
||||||
|
}
|
||||||
|
|
||||||
## @method void addToHtmlHead(string data)
|
## @method void addToHtmlHead(string data)
|
||||||
# add data at end of html head
|
# add data at end of html head
|
||||||
# @param data Text to add in html head
|
# @param data Text to add in html head
|
||||||
sub addToHtmlHead {
|
sub addToHtmlHead {
|
||||||
use APR::Bucket ();
|
use APR::Bucket ();
|
||||||
use APR::Brigade ();
|
use APR::Brigade ();
|
||||||
my ( $class, $data ) = @_;
|
my ( $class, $request, $data ) = @_;
|
||||||
$request->add_output_filter(
|
$request->add_output_filter(
|
||||||
sub {
|
sub {
|
||||||
my $f = shift;
|
my $f = shift;
|
||||||
|
@ -322,7 +225,7 @@ sub flatten_bb {
|
||||||
# add or modify parameters in POST request body
|
# add or modify parameters in POST request body
|
||||||
# @param $params hashref containing name => value
|
# @param $params hashref containing name => value
|
||||||
sub setPostParams {
|
sub setPostParams {
|
||||||
my ( $class, $params ) = @_;
|
my ( $class, $request, $params ) = @_;
|
||||||
$request->add_input_filter(
|
$request->add_input_filter(
|
||||||
sub {
|
sub {
|
||||||
my $f = shift;
|
my $f = shift;
|
||||||
|
|
|
@ -0,0 +1,49 @@
|
||||||
|
package Lemonldap::NG::Handler::ApacheMP2::Request;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use base 'Plack::Request';
|
||||||
|
use Plack::Util;
|
||||||
|
use URI;
|
||||||
|
use URI::Escape;
|
||||||
|
|
||||||
|
# Build Plack::Request (inspired from Plack::Handler::Apache2)
|
||||||
|
sub new {
|
||||||
|
my ( $class, $r ) = @_;
|
||||||
|
|
||||||
|
# Apache populates ENV:
|
||||||
|
$r->subprocess_env;
|
||||||
|
my $env = {
|
||||||
|
%ENV,
|
||||||
|
'psgi.version' => [ 1, 1 ],
|
||||||
|
'psgi.url_scheme' => ( $ENV{HTTPS} || 'off' ) =~ /^(?:on|1)$/i
|
||||||
|
? 'https'
|
||||||
|
: 'http',
|
||||||
|
'psgi.input' => $r,
|
||||||
|
'psgi.errors' => *STDERR,
|
||||||
|
'psgi.multithread' => Plack::Util::FALSE,
|
||||||
|
'psgi.multiprocess' => Plack::Util::TRUE,
|
||||||
|
'psgi.run_once' => Plack::Util::FALSE,
|
||||||
|
'psgi.streaming' => Plack::Util::TRUE,
|
||||||
|
'psgi.nonblocking' => Plack::Util::FALSE,
|
||||||
|
'psgix.harakiri' => Plack::Util::TRUE,
|
||||||
|
'psgix.cleanup' => Plack::Util::TRUE,
|
||||||
|
'psgix.cleanup.handlers' => [],
|
||||||
|
'psqi.r' => $r,
|
||||||
|
};
|
||||||
|
if ( defined( my $HTTP_AUTHORIZATION = $r->headers_in->{Authorization} ) ) {
|
||||||
|
$env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION;
|
||||||
|
}
|
||||||
|
my $uri = URI->new( "http://" . $r->hostname . $r->{env}->{REQUEST_URI} );
|
||||||
|
$env->{PATH_INFO} = uri_unescape( $uri->path );
|
||||||
|
|
||||||
|
my $self = Plack::Request->new($env);
|
||||||
|
bless $self, $class;
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub datas {
|
||||||
|
my($self) = @_;
|
||||||
|
return $self->{datas} ||= {};
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
|
@ -24,8 +24,8 @@ our @EXPORT_OK = @EXPORT;
|
||||||
# using indefinitely a session id disclosed accidentally or maliciously.
|
# using indefinitely a session id disclosed accidentally or maliciously.
|
||||||
# @return session id
|
# @return session id
|
||||||
sub fetchId {
|
sub fetchId {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
if ( my $creds = $class->header_in('Authorization') ) {
|
if ( my $creds = $req->env->{'HTTP_AUTHORIZATION'} ) {
|
||||||
$creds =~ s/^Basic\s+//;
|
$creds =~ s/^Basic\s+//;
|
||||||
my @date = localtime;
|
my @date = localtime;
|
||||||
my $day = $date[5] * 366 + $date[7];
|
my $day = $date[5] * 366 + $date[7];
|
||||||
|
@ -41,17 +41,19 @@ sub fetchId {
|
||||||
# and if needed, ask portal to create it through a SOAP request
|
# and if needed, ask portal to create it through a SOAP request
|
||||||
# @return true if the session was found, false else
|
# @return true if the session was found, false else
|
||||||
sub retrieveSession {
|
sub retrieveSession {
|
||||||
my ( $class, $id ) = @_;
|
my ( $class, $req, $id ) = @_;
|
||||||
|
|
||||||
# First check if session already exists
|
# First check if session already exists
|
||||||
if ( my $res = $class->Lemonldap::NG::Handler::Main::retrieveSession($id) )
|
if ( my $res =
|
||||||
|
$class->Lemonldap::NG::Handler::Main::retrieveSession( $req, $id ) )
|
||||||
{
|
{
|
||||||
return $res;
|
return $res;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Then ask portal to create it
|
# Then ask portal to create it
|
||||||
if ( $class->createSession($id) ) {
|
if ( $class->createSession( $req, $id ) ) {
|
||||||
return $class->Lemonldap::NG::Handler::Main::retrieveSession($id);
|
return $class->Lemonldap::NG::Handler::Main::retrieveSession( $req,
|
||||||
|
$id );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return 0;
|
return 0;
|
||||||
|
@ -62,12 +64,12 @@ sub retrieveSession {
|
||||||
# Ask portal to create it through a SOAP request
|
# Ask portal to create it through a SOAP request
|
||||||
# @return true if the session is created, else false
|
# @return true if the session is created, else false
|
||||||
sub createSession {
|
sub createSession {
|
||||||
my ( $class, $id ) = @_;
|
my ( $class, $req, $id ) = @_;
|
||||||
|
|
||||||
# Add client IP as X-Forwarded-For IP in SOAP request
|
# Add client IP as X-Forwarded-For IP in SOAP request
|
||||||
my $xheader = $class->header_in('X-Forwarded-For');
|
my $xheader = $req->env->{'HTTP_X_FORWARDED_FOR'};
|
||||||
$xheader .= ", " if ($xheader);
|
$xheader .= ", " if ($xheader);
|
||||||
$xheader .= $class->remote_ip;
|
$xheader .= $req->{env}->{REMOTE_ADDR};
|
||||||
|
|
||||||
#my $soapHeaders = HTTP::Headers->new( "X-Forwarded-For" => $xheader );
|
#my $soapHeaders = HTTP::Headers->new( "X-Forwarded-For" => $xheader );
|
||||||
## TODO: use adminSession or sessions
|
## TODO: use adminSession or sessions
|
||||||
|
@ -76,7 +78,7 @@ sub createSession {
|
||||||
# default_headers => $soapHeaders
|
# default_headers => $soapHeaders
|
||||||
#)->uri('urn:Lemonldap/NG/Common/PSGI/SOAPService');
|
#)->uri('urn:Lemonldap/NG/Common/PSGI/SOAPService');
|
||||||
|
|
||||||
my $creds = $class->header_in('Authorization');
|
my $creds = $req->env->{'HTTP_AUTHORIZATION'};
|
||||||
$creds =~ s/^Basic\s+//;
|
$creds =~ s/^Basic\s+//;
|
||||||
my ( $user, $pwd ) = ( decode_base64($creds) =~ /^(.*?):(.*)$/ );
|
my ( $user, $pwd ) = ( decode_base64($creds) =~ /^(.*?):(.*)$/ );
|
||||||
$class->logger->debug("AuthBasic authentication for user: $user");
|
$class->logger->debug("AuthBasic authentication for user: $user");
|
||||||
|
@ -84,18 +86,18 @@ sub createSession {
|
||||||
#my $soapRequest = $soapClient->getCookies( $user, $pwd, $id );
|
#my $soapRequest = $soapClient->getCookies( $user, $pwd, $id );
|
||||||
my $url = $class->tsv->{portal}->() . "/sessions/global/$id?auth";
|
my $url = $class->tsv->{portal}->() . "/sessions/global/$id?auth";
|
||||||
$url =~ s#//sessions/#/sessions/#g;
|
$url =~ s#//sessions/#/sessions/#g;
|
||||||
my $req = HTTP::Request->new( POST => $url );
|
my $get = HTTP::Request->new( POST => $url );
|
||||||
$req->header( 'X-Forwarded-For' => $xheader );
|
$get->header( 'X-Forwarded-For' => $xheader );
|
||||||
$req->header( 'Content-Type' => 'application/x-www-form-urlencoded' );
|
$get->header( 'Content-Type' => 'application/x-www-form-urlencoded' );
|
||||||
$req->header( Accept => 'application/json' );
|
$get->header( Accept => 'application/json' );
|
||||||
$req->content(
|
$get->content(
|
||||||
build_urlencoded(
|
build_urlencoded(
|
||||||
user => $user,
|
user => $user,
|
||||||
password => $pwd,
|
password => $pwd,
|
||||||
secret => $class->tsv->{cipher}->encrypt(time)
|
secret => $class->tsv->{cipher}->encrypt(time)
|
||||||
)
|
)
|
||||||
);
|
);
|
||||||
my $resp = $class->ua->request($req);
|
my $resp = $class->ua->request($get);
|
||||||
|
|
||||||
if ( $resp->is_success ) {
|
if ( $resp->is_success ) {
|
||||||
$class->userLogger->notice("Good REST authentication for $user");
|
$class->userLogger->notice("Good REST authentication for $user");
|
||||||
|
@ -130,9 +132,9 @@ sub createSession {
|
||||||
## @rmethod protected void hideCookie()
|
## @rmethod protected void hideCookie()
|
||||||
# Hide user credentials to the protected application
|
# Hide user credentials to the protected application
|
||||||
sub hideCookie {
|
sub hideCookie {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
$class->logger->debug("removing Authorization header");
|
$class->logger->debug("removing Authorization header");
|
||||||
$class->unset_header_in('Authorization');
|
$class->unset_header_in( $req, 'Authorization' );
|
||||||
}
|
}
|
||||||
|
|
||||||
## @rmethod protected int goToPortal(string url, string arg)
|
## @rmethod protected int goToPortal(string url, string arg)
|
||||||
|
@ -142,12 +144,13 @@ sub hideCookie {
|
||||||
# @param $arg optionnal GET parameters
|
# @param $arg optionnal GET parameters
|
||||||
# @return Apache2::Const::REDIRECT or Apache2::Const::AUTH_REQUIRED
|
# @return Apache2::Const::REDIRECT or Apache2::Const::AUTH_REQUIRED
|
||||||
sub goToPortal {
|
sub goToPortal {
|
||||||
my ( $class, $url, $arg ) = @_;
|
my ( $class, $req, $url, $arg ) = @_;
|
||||||
if ($arg) {
|
if ($arg) {
|
||||||
return $class->Lemonldap::NG::Handler::Main::goToPortal( $url, $arg );
|
return $class->Lemonldap::NG::Handler::Main::goToPortal( $req, $url,
|
||||||
|
$arg );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$class->set_header_out(
|
$class->set_header_out( $req,
|
||||||
'WWW-Authenticate' => 'Basic realm="LemonLDAP::NG"' );
|
'WWW-Authenticate' => 'Basic realm="LemonLDAP::NG"' );
|
||||||
return $class->AUTH_REQUIRED;
|
return $class->AUTH_REQUIRED;
|
||||||
}
|
}
|
||||||
|
|
|
@ -6,11 +6,12 @@ our $VERSION = '2.0.0';
|
||||||
|
|
||||||
sub run {
|
sub run {
|
||||||
my ( $class, $req, $rule, $protection ) = @_;
|
my ( $class, $req, $rule, $protection ) = @_;
|
||||||
my $uri = $class->unparsed_uri;
|
my $uri = $req->{env}->{REQUEST_URI};
|
||||||
my $cn = $class->tsv->{cookieName};
|
my $cn = $class->tsv->{cookieName};
|
||||||
my ( $id, $session );
|
my ( $id, $session );
|
||||||
if ( $uri =~ s/[\?&;]${cn}cda=(\w+)$//oi ) {
|
if ( $uri =~ s/[\?&;]${cn}cda=(\w+)$//oi ) {
|
||||||
if ( $id = $class->fetchId and $session = $class->retrieveSession($id) )
|
if ( $id = $class->fetchId($req)
|
||||||
|
and $session = $class->retrieveSession( $req, $id ) )
|
||||||
{
|
{
|
||||||
$class->logger->info(
|
$class->logger->info(
|
||||||
'CDA asked for an already available session, skipping');
|
'CDA asked for an already available session, skipping');
|
||||||
|
@ -19,19 +20,20 @@ sub run {
|
||||||
my $cdaid = $1;
|
my $cdaid = $1;
|
||||||
$class->logger->debug("CDA request with id $cdaid");
|
$class->logger->debug("CDA request with id $cdaid");
|
||||||
|
|
||||||
my $cdaInfos = $class->getCDAInfos($cdaid);
|
my $cdaInfos = $class->getCDAInfos( $req, $cdaid );
|
||||||
unless ( $cdaInfos->{cookie_value} and $cdaInfos->{cookie_name} ) {
|
unless ( $cdaInfos->{cookie_value} and $cdaInfos->{cookie_name} ) {
|
||||||
$class->logger->error("CDA request for id $cdaid is not valid");
|
$class->logger->error("CDA request for id $cdaid is not valid");
|
||||||
return $class->FORBIDDEN;
|
return $class->FORBIDDEN;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $redirectUrl = $class->_buildUrl($uri);
|
my $redirectUrl = $class->_buildUrl( $req, $uri );
|
||||||
my $redirectHttps = ( $redirectUrl =~ m/^https/ );
|
my $redirectHttps = ( $redirectUrl =~ m/^https/ );
|
||||||
$class->set_header_out(
|
$class->set_header_out(
|
||||||
|
$req,
|
||||||
'Location' => $redirectUrl,
|
'Location' => $redirectUrl,
|
||||||
'Set-Cookie' => $cdaInfos->{cookie_name} . "=" . 'c:'
|
'Set-Cookie' => $cdaInfos->{cookie_name} . "=" . 'c:'
|
||||||
. $class->tsv->{cipher}->encrypt(
|
. $class->tsv->{cipher}->encrypt(
|
||||||
$cdaInfos->{cookie_value} . ' ' . $class->resolveAlias
|
$cdaInfos->{cookie_value} . ' ' . $class->resolveAlias($req)
|
||||||
)
|
)
|
||||||
. "; path=/"
|
. "; path=/"
|
||||||
. ( $redirectHttps ? "; secure" : "" )
|
. ( $redirectHttps ? "; secure" : "" )
|
||||||
|
@ -53,7 +55,7 @@ sub run {
|
||||||
# Tries to retrieve the CDA session, get infos and delete session
|
# Tries to retrieve the CDA session, get infos and delete session
|
||||||
# @return CDA session infos
|
# @return CDA session infos
|
||||||
sub getCDAInfos {
|
sub getCDAInfos {
|
||||||
my ( $class, $id ) = @_;
|
my ( $class, $req, $id ) = @_;
|
||||||
my $infos = {};
|
my $infos = {};
|
||||||
|
|
||||||
# Get the session
|
# Get the session
|
||||||
|
|
|
@ -16,33 +16,36 @@ sub ua {
|
||||||
}
|
}
|
||||||
|
|
||||||
sub grant {
|
sub grant {
|
||||||
my ( $class, $session, $uri, $cond, $vhost ) = @_;
|
my ( $class, $req, $session, $uri, $cond, $vhost ) = @_;
|
||||||
$vhost ||= $class->resolveAlias;
|
$vhost ||= $class->resolveAlias($req);
|
||||||
$class->tsv->{lastVhostUpdate} //= {};
|
$class->tsv->{lastVhostUpdate} //= {};
|
||||||
unless ( $class->tsv->{defaultCondition}->{$vhost}
|
unless ( $class->tsv->{defaultCondition}->{$vhost}
|
||||||
and ( time() - $class->tsv->{lastVhostUpdate}->{$vhost} < 600 ) )
|
and ( time() - $class->tsv->{lastVhostUpdate}->{$vhost} < 600 ) )
|
||||||
{
|
{
|
||||||
$class->loadVhostConfig($vhost);
|
$class->loadVhostConfig( $req, $vhost );
|
||||||
}
|
}
|
||||||
return $class->Lemonldap::NG::Handler::Main::grant( $session, $uri, $cond,
|
return $class->Lemonldap::NG::Handler::Main::grant( $req, $session, $uri,
|
||||||
$vhost );
|
$cond, $vhost );
|
||||||
}
|
}
|
||||||
|
|
||||||
sub loadVhostConfig {
|
sub loadVhostConfig {
|
||||||
my ( $class, $vhost ) = @_;
|
my ( $class, $req, $vhost ) = @_;
|
||||||
my $json;
|
my $json;
|
||||||
if ( $class->tsv->{useSafeJail} ) {
|
if ( $class->tsv->{useSafeJail} ) {
|
||||||
my $base = $class->localConfig->{loopBackUrl}
|
my $base = $class->localConfig->{loopBackUrl}
|
||||||
|| "http://127.0.0.1:" . $class->get_server_port;
|
|| "http://127.0.0.1:" . $req->{env}->{SERVER_PORT};
|
||||||
my $req = HTTP::Request->new( GET => "$base/rules.json" );
|
my $get = HTTP::Request->new( GET => "$base/rules.json" );
|
||||||
$req->header( Host => $vhost );
|
$get->header( Host => $vhost );
|
||||||
my $resp = $class->ua->request($req);
|
my $resp = $class->ua->request($get);
|
||||||
if ( $resp->is_success ) {
|
if ( $resp->is_success ) {
|
||||||
eval { $json = from_json( $resp->content ) };
|
eval { $json = from_json( $resp->content ) };
|
||||||
if ($@) {
|
if ($@) {
|
||||||
$class->logger->error(
|
$class->logger->error(
|
||||||
"Bad rules.json for $vhost, skipping ($@)");
|
"Bad rules.json for $vhost, skipping ($@)");
|
||||||
}
|
}
|
||||||
|
else {
|
||||||
|
$class->logger->info("Compiling rules.json for $vhost");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
|
|
@ -33,13 +33,13 @@ BEGIN {
|
||||||
sub run {
|
sub run {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
my $r = $_[0];
|
my $r = $_[0];
|
||||||
my $ret = $class->SUPER::run();
|
my $ret = $class->SUPER::run($r);
|
||||||
|
|
||||||
# Continue only if user is authorized
|
# Continue only if user is authorized
|
||||||
return $ret unless ( $ret == $class->OK );
|
return $ret unless ( $ret == $class->OK );
|
||||||
|
|
||||||
# Get current URI
|
# Get current URI
|
||||||
my $uri = Lemonldap::NG::Handler::API->uri_with_args($r);
|
my $uri = $r->{env}->{REQUEST_URI};
|
||||||
|
|
||||||
# Catch Secure Token parameters
|
# Catch Secure Token parameters
|
||||||
my $localConfig = $class->localConfig;
|
my $localConfig = $class->localConfig;
|
||||||
|
@ -101,7 +101,7 @@ sub run {
|
||||||
return $class->_returnError( $r, $secureTokenAllowOnError ) unless $key;
|
return $class->_returnError( $r, $secureTokenAllowOnError ) unless $key;
|
||||||
|
|
||||||
# Header location
|
# Header location
|
||||||
$class->set_header_in( $secureTokenHeader => $key );
|
$class->set_header_in( $r, $secureTokenHeader => $key );
|
||||||
|
|
||||||
# Remove token
|
# Remove token
|
||||||
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
||||||
|
|
|
@ -5,9 +5,9 @@ use strict;
|
||||||
our $VERSION = '2.0.0';
|
our $VERSION = '2.0.0';
|
||||||
|
|
||||||
sub fetchId {
|
sub fetchId {
|
||||||
my ($class) = @_;
|
my ( $class, $req ) = @_;
|
||||||
my $token = $class->header_in('X-Llng-Token');
|
my $token = $req->{env}->{HTTP_X_LLNG_TOKEN};
|
||||||
return $class->Lemonldap::NG::Handler::Main::fetchId() unless ($token);
|
return $class->Lemonldap::NG::Handler::Main::fetchId($req) unless ($token);
|
||||||
$class->logger->debug('Found token header');
|
$class->logger->debug('Found token header');
|
||||||
my $s = $class->tsv->{cipher}->decrypt($token);
|
my $s = $class->tsv->{cipher}->decrypt($token);
|
||||||
my ( $t, $_session_id, @vhosts ) = split /:/, $s;
|
my ( $t, $_session_id, @vhosts ) = split /:/, $s;
|
||||||
|
@ -19,7 +19,7 @@ sub fetchId {
|
||||||
$class->userLogger->warn('Expired token');
|
$class->userLogger->warn('Expired token');
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
my $vh = $class->resolveAlias;
|
my $vh = $class->resolveAlias($req);
|
||||||
unless ( grep { $_ eq $vh } @vhosts ) {
|
unless ( grep { $_ eq $vh } @vhosts ) {
|
||||||
$class->userLogger->error(
|
$class->userLogger->error(
|
||||||
"$vh not authorizated in token (" . join( ', ', @vhosts ) . ')' );
|
"$vh not authorizated in token (" . join( ', ', @vhosts ) . ')' );
|
||||||
|
|
|
@ -22,7 +22,7 @@ sub run {
|
||||||
return $ret unless ( $ret == $class->OK );
|
return $ret unless ( $ret == $class->OK );
|
||||||
|
|
||||||
# Get current URI
|
# Get current URI
|
||||||
my $uri = $class->uri_with_args($req);
|
my $uri = $req->{env}->{REQUEST_URI};
|
||||||
|
|
||||||
# Get Zimbra parameters
|
# Get Zimbra parameters
|
||||||
my $localConfig = $class->localConfig;
|
my $localConfig = $class->localConfig;
|
||||||
|
@ -52,7 +52,7 @@ sub run {
|
||||||
|
|
||||||
# Build URL
|
# Build URL
|
||||||
my $zimbra_url =
|
my $zimbra_url =
|
||||||
$class->_buildZimbraPreAuthUrl( $zimbraPreAuthKey, $zimbraUrl,
|
$class->_buildZimbraPreAuthUrl( $req, $zimbraPreAuthKey, $zimbraUrl,
|
||||||
$class->datas->{$zimbraAccountKey},
|
$class->datas->{$zimbraAccountKey},
|
||||||
$zimbraBy, $timeout );
|
$zimbraBy, $timeout );
|
||||||
|
|
||||||
|
@ -72,7 +72,7 @@ sub run {
|
||||||
# @param timeout Timout
|
# @param timeout Timout
|
||||||
# @return Zimbra PreAuth URL
|
# @return Zimbra PreAuth URL
|
||||||
sub _buildZimbraPreAuthUrl {
|
sub _buildZimbraPreAuthUrl {
|
||||||
my ( $class, $key, $url, $account, $by, $timeout ) = @_;
|
my ( $class, $req, $key, $url, $account, $by, $timeout ) = @_;
|
||||||
|
|
||||||
# Expiration time is calculated with _utime and timeout
|
# Expiration time is calculated with _utime and timeout
|
||||||
my $expires =
|
my $expires =
|
||||||
|
|
|
@ -4,7 +4,6 @@ use strict;
|
||||||
|
|
||||||
use Safe;
|
use Safe;
|
||||||
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
||||||
use constant SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 );
|
|
||||||
use Mouse;
|
use Mouse;
|
||||||
|
|
||||||
has customFunctions => ( is => 'rw', isa => 'Maybe[Str]' );
|
has customFunctions => ( is => 'rw', isa => 'Maybe[Str]' );
|
||||||
|
@ -66,16 +65,10 @@ sub build_jail {
|
||||||
$self->jail->share_from( 'Lemonldap::NG::Common::Safelib',
|
$self->jail->share_from( 'Lemonldap::NG::Common::Safelib',
|
||||||
$Lemonldap::NG::Common::Safelib::functions );
|
$Lemonldap::NG::Common::Safelib::functions );
|
||||||
|
|
||||||
$self->jail->share_from(
|
|
||||||
$api,
|
|
||||||
[
|
|
||||||
qw( &hostname &remote_ip &uri &uri_with_args
|
|
||||||
&unparsed_uri &args &method &header_in &env )
|
|
||||||
]
|
|
||||||
);
|
|
||||||
$self->jail->share_from( __PACKAGE__, [ @t, '&encrypt', '&token' ] );
|
$self->jail->share_from( __PACKAGE__, [ @t, '&encrypt', '&token' ] );
|
||||||
$self->jail->share_from( 'MIME::Base64', ['&encode_base64'] );
|
$self->jail->share_from( 'MIME::Base64', ['&encode_base64'] );
|
||||||
$self->jail->share_from( 'Lemonldap::NG::Handler::Main', ['$_v'] );
|
|
||||||
|
#$self->jail->share_from( 'Lemonldap::NG::Handler::Main', ['$_v'] );
|
||||||
|
|
||||||
# Initialize cryptographic functions to be able to use them in jail.
|
# Initialize cryptographic functions to be able to use them in jail.
|
||||||
eval { token('a') };
|
eval { token('a') };
|
||||||
|
@ -142,7 +135,7 @@ sub share_from {
|
||||||
}
|
}
|
||||||
|
|
||||||
## @imethod protected jail_reval()
|
## @imethod protected jail_reval()
|
||||||
# Build and return restricted eval command with SAFEWRAP, if activated
|
# Build and return restricted eval command
|
||||||
# @return evaluation of $reval or $reval2
|
# @return evaluation of $reval or $reval2
|
||||||
sub jail_reval {
|
sub jail_reval {
|
||||||
my ( $self, $reval ) = @_;
|
my ( $self, $reval ) = @_;
|
||||||
|
@ -151,14 +144,7 @@ sub jail_reval {
|
||||||
# the "no safe wrap" reval
|
# the "no safe wrap" reval
|
||||||
|
|
||||||
my $res;
|
my $res;
|
||||||
eval {
|
eval { $res = ( $self->jail->reval($reval) ) };
|
||||||
$res = (
|
|
||||||
SAFEWRAP
|
|
||||||
and $self->useSafeJail
|
|
||||||
? $self->jail->wrap_code_ref( $self->jail->reval($reval) )
|
|
||||||
: $self->jail->reval($reval)
|
|
||||||
);
|
|
||||||
};
|
|
||||||
if ($@) {
|
if ($@) {
|
||||||
$self->error($@);
|
$self->error($@);
|
||||||
return undef;
|
return undef;
|
||||||
|
|
|
@ -462,12 +462,11 @@ sub conditionSub {
|
||||||
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
||||||
return (
|
return (
|
||||||
sub {
|
sub {
|
||||||
$Lemonldap::NG::Handler::ApacheMP2::Main::request
|
$_[0]->add_output_filter(
|
||||||
->add_output_filter(
|
|
||||||
sub {
|
sub {
|
||||||
return $class->redirectFilter( $u, @_ );
|
return $class->redirectFilter( $u, @_ );
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
1;
|
1;
|
||||||
},
|
},
|
||||||
0
|
0
|
||||||
|
@ -481,8 +480,7 @@ sub conditionSub {
|
||||||
|
|
||||||
#TODO: check this
|
#TODO: check this
|
||||||
$class->localUnlog;
|
$class->localUnlog;
|
||||||
$Lemonldap::NG::Handler::ApacheMP2::Main::request
|
$_[0]->add_output_filter(
|
||||||
->add_output_filter(
|
|
||||||
sub {
|
sub {
|
||||||
my $r = $_[0]->r;
|
my $r = $_[0]->r;
|
||||||
return $class->redirectFilter(
|
return $class->redirectFilter(
|
||||||
|
@ -492,7 +490,7 @@ sub conditionSub {
|
||||||
@_
|
@_
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
1;
|
1;
|
||||||
},
|
},
|
||||||
0
|
0
|
||||||
|
@ -535,12 +533,12 @@ sub substitute {
|
||||||
|
|
||||||
# substitute special vars, just for retro-compatibility
|
# substitute special vars, just for retro-compatibility
|
||||||
$expr =~ s/\$date\b/&date/sg;
|
$expr =~ s/\$date\b/&date/sg;
|
||||||
$expr =~ s/\$vhost\b/&hostname/sg;
|
$expr =~ s/\$vhost\b/\$ENV{HTTP_HOST}/sg;
|
||||||
$expr =~ s/\$ip\b/&remote_ip/sg;
|
$expr =~ s/\$ip\b/\$ENV{REMOTE_ADDR}/sg;
|
||||||
|
|
||||||
# substitute vars with session datas, excepts special vars $_ and $\d+
|
# substitute vars with session datas, excepts special vars $_ and $\d+
|
||||||
$expr =~ s/\$(?!ENV)(_*[a-zA-Z]\w*)/\$session->{$1}/sg;
|
$expr =~ s/\$(?!ENV)(_*[a-zA-Z]\w*)/\$s->{$1}/sg;
|
||||||
$expr =~ s/\$ENV\{/&env()->\{/g;
|
$expr =~ s/\$ENV\{/\$r->{env}->\{/g;
|
||||||
|
|
||||||
return $expr;
|
return $expr;
|
||||||
}
|
}
|
||||||
|
@ -548,7 +546,7 @@ sub substitute {
|
||||||
sub buildSub {
|
sub buildSub {
|
||||||
my ( $class, $val ) = @_;
|
my ( $class, $val ) = @_;
|
||||||
my $res =
|
my $res =
|
||||||
$class->tsv->{jail}->jail_reval("sub{my \$session=\$_[0];return($val)}");
|
$class->tsv->{jail}->jail_reval("sub{my (\$r,\$s)=\@_;return($val)}");
|
||||||
unless ($res) {
|
unless ($res) {
|
||||||
$class->logger->error( $class->tsv->{jail}->error );
|
$class->logger->error( $class->tsv->{jail}->error );
|
||||||
}
|
}
|
||||||
|
|
|
@ -23,37 +23,35 @@ sub handler {
|
||||||
sub logout {
|
sub logout {
|
||||||
my $class;
|
my $class;
|
||||||
$class = $#_ ? shift : __PACKAGE__;
|
$class = $#_ ? shift : __PACKAGE__;
|
||||||
$class->newRequest( $_[0] );
|
return $class->unlog(@_);
|
||||||
return $class->unlog();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub status {
|
sub status {
|
||||||
my $class;
|
my $class;
|
||||||
$class = $#_ ? shift : __PACKAGE__;
|
$class = $#_ ? shift : __PACKAGE__;
|
||||||
$class->newRequest( $_[0] );
|
return $class->getStatus(@_);
|
||||||
return $class->getStatus();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Public methods
|
# Public methods
|
||||||
|
|
||||||
# Return Handler::Lib::Status output
|
# Return Handler::Lib::Status output
|
||||||
sub getStatus {
|
sub getStatus {
|
||||||
my ($class) = @_;
|
my ( $class, $req ) = @_;
|
||||||
$class->logger->debug("Request for status");
|
$class->logger->debug("Request for status");
|
||||||
my $statusPipe = $class->tsv->{statusPipe};
|
my $statusPipe = $class->tsv->{statusPipe};
|
||||||
my $statusOut = $class->tsv->{statusOut};
|
my $statusOut = $class->tsv->{statusOut};
|
||||||
return $class->abort("$class: status page can not be displayed")
|
return $class->abort( $req, "$class: status page can not be displayed" )
|
||||||
unless ( $statusPipe and $statusOut );
|
unless ( $statusPipe and $statusOut );
|
||||||
print $statusPipe "STATUS"
|
print $statusPipe "STATUS" . ( $req->{env}->{QUERY_STRING} || '' ) . "\n";
|
||||||
. ( $class->args ? " " . $class->args : '' ) . "\n";
|
|
||||||
my $buf;
|
my $buf;
|
||||||
|
|
||||||
while (<$statusOut>) {
|
while (<$statusOut>) {
|
||||||
last if (/^END$/);
|
last if (/^END$/);
|
||||||
$buf .= $_;
|
$buf .= $_;
|
||||||
}
|
}
|
||||||
$class->set_header_out( ( "Content-Type" => "text/html; charset=UTF-8" ) );
|
$class->set_header_out( $req,
|
||||||
$class->print($buf);
|
"Content-Type" => "text/html; charset=UTF-8" );
|
||||||
|
$class->print( $req, $buf );
|
||||||
return $class->OK;
|
return $class->OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -62,12 +60,11 @@ sub getStatus {
|
||||||
sub checkType {
|
sub checkType {
|
||||||
my ( $class, $req ) = @_;
|
my ( $class, $req ) = @_;
|
||||||
|
|
||||||
$class->newRequest($req);
|
|
||||||
if ( time() - $class->lastCheck > $class->checkTime ) {
|
if ( time() - $class->lastCheck > $class->checkTime ) {
|
||||||
die("$class: No configuration found")
|
die("$class: No configuration found")
|
||||||
unless ( $class->checkConf );
|
unless ( $class->checkConf );
|
||||||
}
|
}
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
return ( defined $class->tsv->{type}->{$vhost} )
|
return ( defined $class->tsv->{type}->{$vhost} )
|
||||||
? $class->tsv->{type}->{$vhost}
|
? $class->tsv->{type}->{$vhost}
|
||||||
: 'Main';
|
: 'Main';
|
||||||
|
@ -84,14 +81,14 @@ sub run {
|
||||||
my ( $class, $req, $rule, $protection ) = @_;
|
my ( $class, $req, $rule, $protection ) = @_;
|
||||||
my ( $id, $session );
|
my ( $id, $session );
|
||||||
|
|
||||||
return $class->DECLINED unless ( $class->is_initial_req );
|
return $class->DECLINED unless ( $class->is_initial_req($req) );
|
||||||
|
|
||||||
# Direct return if maintenance mode is active
|
# Direct return if maintenance mode is active
|
||||||
if ( $class->checkMaintenanceMode ) {
|
if ( $class->checkMaintenanceMode($req) ) {
|
||||||
|
|
||||||
if ( $class->tsv->{useRedirectOnError} ) {
|
if ( $class->tsv->{useRedirectOnError} ) {
|
||||||
$class->logger->debug("Go to portal with maintenance error code");
|
$class->logger->debug("Go to portal with maintenance error code");
|
||||||
return $class->goToError( '/', $class->MAINTENANCE );
|
return $class->goToError( $req, '/', $class->MAINTENANCE );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$class->logger->debug("Return maintenance error code");
|
$class->logger->debug("Return maintenance error code");
|
||||||
|
@ -100,25 +97,25 @@ sub run {
|
||||||
}
|
}
|
||||||
|
|
||||||
# Cross domain authentication
|
# Cross domain authentication
|
||||||
my $uri = $class->unparsed_uri;
|
my $uri = $req->{env}->{REQUEST_URI};
|
||||||
|
|
||||||
$uri = $class->uri_with_args;
|
$uri = $req->{env}->{REQUEST_URI};
|
||||||
my ($cond);
|
my ($cond);
|
||||||
( $cond, $protection ) = $class->conditionSub($rule) if ($rule);
|
( $cond, $protection ) = $class->conditionSub($rule) if ($rule);
|
||||||
$protection = $class->isUnprotected($uri) || 0
|
$protection = $class->isUnprotected( $req, $uri ) || 0
|
||||||
unless ( defined $protection );
|
unless ( defined $protection );
|
||||||
|
|
||||||
if ( $protection == $class->SKIP ) {
|
if ( $protection == $class->SKIP ) {
|
||||||
$class->logger->debug("Access control skipped");
|
$class->logger->debug("Access control skipped");
|
||||||
$class->updateStatus('SKIP');
|
$class->updateStatus( $req, 'SKIP' );
|
||||||
$class->hideCookie;
|
$class->hideCookie($req);
|
||||||
$class->cleanHeaders;
|
$class->cleanHeaders($req);
|
||||||
return $class->OK;
|
return $class->OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Try to recover cookie and user session
|
# Try to recover cookie and user session
|
||||||
if ( $id = $class->fetchId
|
if ( $id = $class->fetchId($req)
|
||||||
and $session = $class->retrieveSession($id) )
|
and $session = $class->retrieveSession( $req, $id ) )
|
||||||
{
|
{
|
||||||
|
|
||||||
# AUTHENTICATION done
|
# AUTHENTICATION done
|
||||||
|
@ -127,24 +124,25 @@ sub run {
|
||||||
my $kc = keys %{$session}; # in order to detect new local macro
|
my $kc = keys %{$session}; # in order to detect new local macro
|
||||||
|
|
||||||
# ACCOUNTING (1. Inform web server)
|
# ACCOUNTING (1. Inform web server)
|
||||||
$class->set_user( $session->{ $class->tsv->{whatToTrace} } );
|
$class->set_user( $req, $session->{ $class->tsv->{whatToTrace} } );
|
||||||
|
|
||||||
# AUTHORIZATION
|
# AUTHORIZATION
|
||||||
return ( $class->forbidden($session), $session )
|
return ( $class->forbidden( $req, $session ), $session )
|
||||||
unless ( $class->grant( $session, $uri, $cond ) );
|
unless ( $class->grant( $req, $session, $uri, $cond ) );
|
||||||
$class->updateStatus( 'OK', $session->{ $class->tsv->{whatToTrace} } );
|
$class->updateStatus( $req, 'OK',
|
||||||
|
$session->{ $class->tsv->{whatToTrace} } );
|
||||||
|
|
||||||
# ACCOUNTING (2. Inform remote application)
|
# ACCOUNTING (2. Inform remote application)
|
||||||
$class->sendHeaders($session);
|
$class->sendHeaders( $req, $session );
|
||||||
|
|
||||||
# Store local macros
|
# Store local macros
|
||||||
if ( keys %$session > $kc ) {
|
if ( keys %$session > $kc ) {
|
||||||
$class->logger->debug("Update local cache");
|
$class->logger->debug("Update local cache");
|
||||||
$class->session->update( $session, { updateCache => 2 } );
|
$req->datas->{session}->update( $session, { updateCache => 2 } );
|
||||||
}
|
}
|
||||||
|
|
||||||
# Hide Lemonldap::NG cookie
|
# Hide Lemonldap::NG cookie
|
||||||
$class->hideCookie;
|
$class->hideCookie($req);
|
||||||
|
|
||||||
# Log access granted
|
# Log access granted
|
||||||
$class->logger->debug( "User "
|
$class->logger->debug( "User "
|
||||||
|
@ -152,8 +150,8 @@ sub run {
|
||||||
. " was granted to access to $uri" );
|
. " was granted to access to $uri" );
|
||||||
|
|
||||||
# Catch POST rules
|
# Catch POST rules
|
||||||
$class->postOutputFilter( $session, $uri );
|
$class->postOutputFilter( $req, $session, $uri );
|
||||||
$class->postInputFilter( $session, $uri );
|
$class->postInputFilter( $req, $session, $uri );
|
||||||
|
|
||||||
return ( $class->OK, $session );
|
return ( $class->OK, $session );
|
||||||
}
|
}
|
||||||
|
@ -162,9 +160,9 @@ sub run {
|
||||||
|
|
||||||
# Ignore unprotected URIs
|
# Ignore unprotected URIs
|
||||||
$class->logger->debug("No valid session but unprotected access");
|
$class->logger->debug("No valid session but unprotected access");
|
||||||
$class->updateStatus('UNPROTECT');
|
$class->updateStatus( $req, 'UNPROTECT' );
|
||||||
$class->hideCookie;
|
$class->hideCookie($req);
|
||||||
$class->cleanHeaders;
|
$class->cleanHeaders($req);
|
||||||
return $class->OK;
|
return $class->OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -175,8 +173,8 @@ sub run {
|
||||||
unless ($id);
|
unless ($id);
|
||||||
|
|
||||||
# if the cookie was fetched, a log is sent by retrieveSession()
|
# if the cookie was fetched, a log is sent by retrieveSession()
|
||||||
$class->updateStatus( $id ? 'EXPIRED' : 'REDIRECT' );
|
$class->updateStatus( $req, $id ? 'EXPIRED' : 'REDIRECT' );
|
||||||
return $class->goToPortal( $class->unparsed_uri );
|
return $class->goToPortal( $req, $req->{env}->{REQUEST_URI} );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -184,10 +182,10 @@ sub run {
|
||||||
# Call localUnlog() then goToPortal() to unlog the current user.
|
# Call localUnlog() then goToPortal() to unlog the current user.
|
||||||
# @return Constant value returned by goToPortal()
|
# @return Constant value returned by goToPortal()
|
||||||
sub unlog {
|
sub unlog {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
$class->localUnlog(@_);
|
$class->localUnlog( $req, @_ );
|
||||||
$class->updateStatus('LOGOUT');
|
$class->updateStatus( $req, 'LOGOUT' );
|
||||||
return $class->goToPortal( '/', 'logout=1' );
|
return $class->goToPortal( $req, '/', 'logout=1' );
|
||||||
}
|
}
|
||||||
|
|
||||||
# INTERNAL METHODS
|
# INTERNAL METHODS
|
||||||
|
@ -198,12 +196,14 @@ sub unlog {
|
||||||
# @param optional user string Username to log, if undefined defaults to remote IP
|
# @param optional user string Username to log, if undefined defaults to remote IP
|
||||||
# @param optional url string URL to log, if undefined defaults to request URI
|
# @param optional url string URL to log, if undefined defaults to request URI
|
||||||
sub updateStatus {
|
sub updateStatus {
|
||||||
my ( $class, $action, $user, $url ) = @_;
|
my ( $class, $req, $action, $user, $url ) = @_;
|
||||||
my $statusPipe = $class->tsv->{statusPipe} or return;
|
my $statusPipe = $class->tsv->{statusPipe} or return;
|
||||||
$user ||= $class->remote_ip;
|
$user ||= $req->{env}->{REMOTE_ADDR};
|
||||||
$url ||= $class->uri_with_args;
|
$url ||= $req->{env}->{REQUEST_URI};
|
||||||
eval {
|
eval {
|
||||||
print $statusPipe "$user => " . $class->hostname . "$url $action\n";
|
print $statusPipe "$user => "
|
||||||
|
. $req->{env}->{HTTP_HOST}
|
||||||
|
. "$url $action\n";
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -220,8 +220,8 @@ sub lmLog {
|
||||||
# Check if we are in maintenance mode
|
# Check if we are in maintenance mode
|
||||||
# @return true if maintenance mode
|
# @return true if maintenance mode
|
||||||
sub checkMaintenanceMode {
|
sub checkMaintenanceMode {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
my $_maintenance =
|
my $_maintenance =
|
||||||
( defined $class->tsv->{maintenance}->{$vhost} )
|
( defined $class->tsv->{maintenance}->{$vhost} )
|
||||||
? $class->tsv->{maintenance}->{$vhost}
|
? $class->tsv->{maintenance}->{$vhost}
|
||||||
|
@ -240,10 +240,10 @@ sub checkMaintenanceMode {
|
||||||
# @param $cond optional Function granting access
|
# @param $cond optional Function granting access
|
||||||
# @return True if the user is granted to access to the current URL
|
# @return True if the user is granted to access to the current URL
|
||||||
sub grant {
|
sub grant {
|
||||||
my ( $class, $session, $uri, $cond, $vhost ) = @_;
|
my ( $class, $req, $session, $uri, $cond, $vhost ) = @_;
|
||||||
return $cond->($session) if ($cond);
|
return $cond->( $req, $session ) if ($cond);
|
||||||
|
|
||||||
$vhost ||= $class->resolveAlias;
|
$vhost ||= $class->resolveAlias($req);
|
||||||
if ( my $level = $class->tsv->{authnLevel}->{$vhost} ) {
|
if ( my $level = $class->tsv->{authnLevel}->{$vhost} ) {
|
||||||
if ( $session->{authenticationLevel} < $level ) {
|
if ( $session->{authenticationLevel} < $level ) {
|
||||||
$session->{_upgrade} = 1;
|
$session->{_upgrade} = 1;
|
||||||
|
@ -260,7 +260,8 @@ sub grant {
|
||||||
$class->logger->debug( 'Regexp "'
|
$class->logger->debug( 'Regexp "'
|
||||||
. $class->tsv->{locationConditionText}->{$vhost}->[$i]
|
. $class->tsv->{locationConditionText}->{$vhost}->[$i]
|
||||||
. '" match' );
|
. '" match' );
|
||||||
return $class->tsv->{locationCondition}->{$vhost}->[$i]->($session);
|
return $class->tsv->{locationCondition}->{$vhost}->[$i]
|
||||||
|
->( $req, $session );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
unless ( $class->tsv->{defaultCondition}->{$vhost} ) {
|
unless ( $class->tsv->{defaultCondition}->{$vhost} ) {
|
||||||
|
@ -270,7 +271,7 @@ sub grant {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
$class->logger->debug("$vhost: Apply default rule");
|
$class->logger->debug("$vhost: Apply default rule");
|
||||||
return $class->tsv->{defaultCondition}->{$vhost}->($session);
|
return $class->tsv->{defaultCondition}->{$vhost}->( $req, $session );
|
||||||
}
|
}
|
||||||
|
|
||||||
## @rmethod protected int forbidden(string uri)
|
## @rmethod protected int forbidden(string uri)
|
||||||
|
@ -279,33 +280,33 @@ sub grant {
|
||||||
# @param $uri URI
|
# @param $uri URI
|
||||||
# @return Constant $class->FORBIDDEN
|
# @return Constant $class->FORBIDDEN
|
||||||
sub forbidden {
|
sub forbidden {
|
||||||
my ( $class, $session, $vhost ) = @_;
|
my ( $class, $req, $session, $vhost ) = @_;
|
||||||
my $uri = $class->unparsed_uri;
|
my $uri = $req->{env}->{REQUEST_URI};
|
||||||
$vhost ||= $class->resolveAlias;
|
$vhost ||= $class->resolveAlias($req);
|
||||||
|
|
||||||
if ( $session->{_logout} ) {
|
if ( $session->{_logout} ) {
|
||||||
$class->updateStatus( 'LOGOUT',
|
$class->updateStatus( $req, 'LOGOUT',
|
||||||
$session->{ $class->tsv->{whatToTrace} } );
|
$session->{ $class->tsv->{whatToTrace} } );
|
||||||
my $u = $session->{_logout};
|
my $u = $session->{_logout};
|
||||||
$class->localUnlog;
|
$class->localUnlog($req);
|
||||||
return $class->goToPortal( $u, 'logout=1' );
|
return $class->goToPortal( $req, $u, 'logout=1' );
|
||||||
}
|
}
|
||||||
|
|
||||||
if ( $session->{_upgrade} ) {
|
if ( $session->{_upgrade} ) {
|
||||||
return $class->goToPortal( $class->unparsed_uri, undef,
|
return $class->goToPortal( $req, $uri, undef, '/upgradesession' );
|
||||||
'/upgradesession' );
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Log forbidding
|
# Log forbidding
|
||||||
$class->userLogger->notice( "User "
|
$class->userLogger->notice( "User "
|
||||||
. $session->{ $class->tsv->{whatToTrace} }
|
. $session->{ $class->tsv->{whatToTrace} }
|
||||||
. " was forbidden to access to $vhost$uri" );
|
. " was forbidden to access to $vhost$uri" );
|
||||||
$class->updateStatus( 'REJECT', $session->{ $class->tsv->{whatToTrace} } );
|
$class->updateStatus( $req, 'REJECT',
|
||||||
|
$session->{ $class->tsv->{whatToTrace} } );
|
||||||
|
|
||||||
# Redirect or Forbidden?
|
# Redirect or Forbidden?
|
||||||
if ( $class->tsv->{useRedirectOnForbidden} ) {
|
if ( $class->tsv->{useRedirectOnForbidden} ) {
|
||||||
$class->logger->debug("Use redirect for forbidden access");
|
$class->logger->debug("Use redirect for forbidden access");
|
||||||
return $class->goToError( $uri, 403 );
|
return $class->goToError( $req, $uri, 403 );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$class->logger->debug("Return forbidden access");
|
$class->logger->debug("Return forbidden access");
|
||||||
|
@ -316,16 +317,16 @@ sub forbidden {
|
||||||
## @rmethod protected void hideCookie()
|
## @rmethod protected void hideCookie()
|
||||||
# Hide Lemonldap::NG cookie to the protected application.
|
# Hide Lemonldap::NG cookie to the protected application.
|
||||||
sub hideCookie {
|
sub hideCookie {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
$class->logger->debug("removing cookie");
|
$class->logger->debug("removing cookie");
|
||||||
my $cookie = $class->header_in('Cookie');
|
my $cookie = $req->env->{HTTP_COOKIE};
|
||||||
my $cn = $class->tsv->{cookieName};
|
my $cn = $class->tsv->{cookieName};
|
||||||
$cookie =~ s/$cn(http)?=[^,;]*[,;\s]*//og;
|
$cookie =~ s/$cn(http)?=[^,;]*[,;\s]*//og;
|
||||||
if ($cookie) {
|
if ($cookie) {
|
||||||
$class->set_header_in( 'Cookie' => $cookie );
|
$class->set_header_in( $req, 'Cookie' => $cookie );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$class->unset_header_in('Cookie');
|
$class->unset_header_in( $req, 'Cookie' );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -333,8 +334,8 @@ sub hideCookie {
|
||||||
# Encode URl in the format used by Lemonldap::NG::Portal for redirections.
|
# Encode URl in the format used by Lemonldap::NG::Portal for redirections.
|
||||||
# @return Base64 encoded string
|
# @return Base64 encoded string
|
||||||
sub encodeUrl {
|
sub encodeUrl {
|
||||||
my ( $class, $url ) = @_;
|
my ( $class, $req, $url ) = @_;
|
||||||
$url = $class->_buildUrl($url) if ( $url !~ m#^https?://# );
|
$url = $class->_buildUrl( $req, $url ) if ( $url !~ m#^https?://# );
|
||||||
return encode_base64( $url, '' );
|
return encode_base64( $url, '' );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -344,24 +345,26 @@ sub encodeUrl {
|
||||||
# @param $arg optionnal GET parameters
|
# @param $arg optionnal GET parameters
|
||||||
# @return Constant $class->REDIRECT
|
# @return Constant $class->REDIRECT
|
||||||
sub goToPortal {
|
sub goToPortal {
|
||||||
my ( $class, $url, $arg, $path ) = @_;
|
my ( $class, $req, $url, $arg, $path ) = @_;
|
||||||
$path ||= '';
|
$path ||= '';
|
||||||
my ( $ret, $msg );
|
my ( $ret, $msg );
|
||||||
my $urlc_init = $class->encodeUrl($url);
|
my $urlc_init = $class->encodeUrl( $req, $url );
|
||||||
$class->logger->debug(
|
$class->logger->debug(
|
||||||
"Redirect " . $class->remote_ip . " to portal (url was $url)" );
|
"Redirect $req->{env}->{REMOTE_ADDR} to portal (url was $url)");
|
||||||
$class->set_header_out( 'Location' => $class->tsv->{portal}->()
|
$class->set_header_out( $req,
|
||||||
|
'Location' => $class->tsv->{portal}->()
|
||||||
. "$path?url=$urlc_init"
|
. "$path?url=$urlc_init"
|
||||||
. ( $arg ? "&$arg" : "" ) );
|
. ( $arg ? "&$arg" : "" ) );
|
||||||
return $class->REDIRECT;
|
return $class->REDIRECT;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub goToError {
|
sub goToError {
|
||||||
my ( $class, $url, $code ) = @_;
|
my ( $class, $req, $url, $code ) = @_;
|
||||||
my $urlc_init = $class->encodeUrl($url);
|
my $urlc_init = $class->encodeUrl( $req, $url );
|
||||||
$class->logger->debug(
|
$class->logger->debug(
|
||||||
"Redirect " . $class->remote_ip . " to lmError (url was $url)" );
|
"Redirect $req->{env}->{REMOTE_ADDR} to lmError (url was $url)");
|
||||||
$class->set_header_out( 'Location' => $class->tsv->{portal}->()
|
$class->set_header_out( $req,
|
||||||
|
'Location' => $class->tsv->{portal}->()
|
||||||
. "/lmerror/$code"
|
. "/lmerror/$code"
|
||||||
. "?url=$urlc_init" );
|
. "?url=$urlc_init" );
|
||||||
return $class->REDIRECT;
|
return $class->REDIRECT;
|
||||||
|
@ -371,9 +374,9 @@ sub goToError {
|
||||||
# Get user cookies and search for Lemonldap::NG cookie.
|
# Get user cookies and search for Lemonldap::NG cookie.
|
||||||
# @return Value of the cookie if found, 0 else
|
# @return Value of the cookie if found, 0 else
|
||||||
sub fetchId {
|
sub fetchId {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
my $t = $class->header_in('Cookie') or return 0;
|
my $t = $req->{env}->{HTTP_COOKIE} or return 0;
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
my $lookForHttpCookie = (
|
my $lookForHttpCookie = (
|
||||||
$class->tsv->{securedCookie} =~ /^(2|3)$/
|
$class->tsv->{securedCookie} =~ /^(2|3)$/
|
||||||
and !( defined( $class->tsv->{https}->{$vhost} ) )
|
and !( defined( $class->tsv->{https}->{$vhost} ) )
|
||||||
|
@ -404,7 +407,7 @@ sub fetchId {
|
||||||
# Tries to retrieve the session whose index is id
|
# Tries to retrieve the session whose index is id
|
||||||
# @return true if the session was found, false else
|
# @return true if the session was found, false else
|
||||||
sub retrieveSession {
|
sub retrieveSession {
|
||||||
my ( $class, $id ) = @_;
|
my ( $class, $req, $id ) = @_;
|
||||||
my $now = time();
|
my $now = time();
|
||||||
|
|
||||||
# 1. Search if the user was the same as previous (very efficient in
|
# 1. Search if the user was the same as previous (very efficient in
|
||||||
|
@ -418,7 +421,7 @@ sub retrieveSession {
|
||||||
}
|
}
|
||||||
|
|
||||||
# 2. Get the session from cache or backend
|
# 2. Get the session from cache or backend
|
||||||
my $session = $class->session(
|
my $session = $req->datas->{session} = (
|
||||||
Lemonldap::NG::Common::Session->new(
|
Lemonldap::NG::Common::Session->new(
|
||||||
{
|
{
|
||||||
storageModule => $class->tsv->{sessionStorageModule},
|
storageModule => $class->tsv->{sessionStorageModule},
|
||||||
|
@ -460,11 +463,11 @@ sub retrieveSession {
|
||||||
$class->tsv->{timeoutActivityInterval} )
|
$class->tsv->{timeoutActivityInterval} )
|
||||||
)
|
)
|
||||||
{
|
{
|
||||||
$class->session->update( { '_lastSeen' => $now } );
|
$req->datas->{session}->update( { '_lastSeen' => $now } );
|
||||||
|
|
||||||
if ( $session->error ) {
|
if ( $session->error ) {
|
||||||
$class->logger->error("Cannot update session $id");
|
$class->logger->error("Cannot update session $id");
|
||||||
$class->logger->error( $class->session->error );
|
$class->logger->error( $req->datas->{session}->error );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$class->logger->debug("Update _lastSeen with $now");
|
$class->logger->debug("Update _lastSeen with $now");
|
||||||
|
@ -487,8 +490,8 @@ sub retrieveSession {
|
||||||
# @param $s path
|
# @param $s path
|
||||||
# @return URL
|
# @return URL
|
||||||
sub _buildUrl {
|
sub _buildUrl {
|
||||||
my ( $class, $s ) = @_;
|
my ( $class, $req, $s ) = @_;
|
||||||
my $vhost = $class->hostname;
|
my $vhost = $req->{env}->{HTTP_HOST};
|
||||||
my $_https = (
|
my $_https = (
|
||||||
defined( $class->tsv->{https}->{$vhost} )
|
defined( $class->tsv->{https}->{$vhost} )
|
||||||
? $class->tsv->{https}->{$vhost}
|
? $class->tsv->{https}->{$vhost}
|
||||||
|
@ -497,7 +500,7 @@ sub _buildUrl {
|
||||||
my $portString =
|
my $portString =
|
||||||
$class->tsv->{port}->{$vhost}
|
$class->tsv->{port}->{$vhost}
|
||||||
|| $class->tsv->{port}->{_}
|
|| $class->tsv->{port}->{_}
|
||||||
|| $class->get_server_port;
|
|| $req->{env}->{SERVER_PORT};
|
||||||
$portString = (
|
$portString = (
|
||||||
( $_https && $portString == 443 )
|
( $_https && $portString == 443 )
|
||||||
or ( !$_https && $portString == 80 )
|
or ( !$_https && $portString == 80 )
|
||||||
|
@ -513,8 +516,8 @@ sub _buildUrl {
|
||||||
# $class->UNPROTECT if it is unprotected by "unprotect",
|
# $class->UNPROTECT if it is unprotected by "unprotect",
|
||||||
# SKIP if is is unprotected by "skip"
|
# SKIP if is is unprotected by "skip"
|
||||||
sub isUnprotected {
|
sub isUnprotected {
|
||||||
my ( $class, $uri ) = @_;
|
my ( $class, $req, $uri ) = @_;
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
for (
|
for (
|
||||||
my $i = 0 ;
|
my $i = 0 ;
|
||||||
$i < ( $class->tsv->{locationCount}->{$vhost} || 0 ) ;
|
$i < ( $class->tsv->{locationCount}->{$vhost} || 0 ) ;
|
||||||
|
@ -531,12 +534,12 @@ sub isUnprotected {
|
||||||
## @rmethod void sendHeaders()
|
## @rmethod void sendHeaders()
|
||||||
# Launch function compiled by forgeHeadersInit() for the current virtual host
|
# Launch function compiled by forgeHeadersInit() for the current virtual host
|
||||||
sub sendHeaders {
|
sub sendHeaders {
|
||||||
my ( $class, $session ) = @_;
|
my ( $class, $req, $session ) = @_;
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
if ( defined $class->tsv->{forgeHeaders}->{$vhost} ) {
|
if ( defined $class->tsv->{forgeHeaders}->{$vhost} ) {
|
||||||
|
|
||||||
# Log headers in debug mode
|
# Log headers in debug mode
|
||||||
my %headers = $class->tsv->{forgeHeaders}->{$vhost}->($session);
|
my %headers = $class->tsv->{forgeHeaders}->{$vhost}->( $req, $session );
|
||||||
foreach my $h ( sort keys %headers ) {
|
foreach my $h ( sort keys %headers ) {
|
||||||
if ( defined( my $v = $headers{$h} ) ) {
|
if ( defined( my $v = $headers{$h} ) ) {
|
||||||
$class->logger->debug("Send header $h with value $v");
|
$class->logger->debug("Send header $h with value $v");
|
||||||
|
@ -545,25 +548,26 @@ sub sendHeaders {
|
||||||
$class->logger->debug("Send header $h with empty value");
|
$class->logger->debug("Send header $h with empty value");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
$class->set_header_in(%headers);
|
$class->set_header_in( $req, %headers );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
## @rmethod void cleanHeaders()
|
## @rmethod void cleanHeaders()
|
||||||
# Unset HTTP headers, when sendHeaders is skipped
|
# Unset HTTP headers, when sendHeaders is skipped
|
||||||
sub cleanHeaders {
|
sub cleanHeaders {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
if ( defined( $class->tsv->{headerList}->{$vhost} ) ) {
|
if ( defined( $class->tsv->{headerList}->{$vhost} ) ) {
|
||||||
$class->unset_header_in( @{ $class->tsv->{headerList}->{$vhost} } );
|
$class->unset_header_in( $req,
|
||||||
|
@{ $class->tsv->{headerList}->{$vhost} } );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
## @rmethod string resolveAlias
|
## @rmethod string resolveAlias
|
||||||
# returns vhost whose current hostname is an alias
|
# returns vhost whose current hostname is an alias
|
||||||
sub resolveAlias {
|
sub resolveAlias {
|
||||||
my $class = shift;
|
my ( $class, $req ) = @_;
|
||||||
my $vhost = $class->hostname;
|
my $vhost = $req->{env}->{HTTP_HOST};
|
||||||
return $class->tsv->{vhostAlias}->{$vhost} || $vhost;
|
return $class->tsv->{vhostAlias}->{$vhost} || $vhost;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -575,18 +579,18 @@ sub resolveAlias {
|
||||||
# @param $msg Message to log
|
# @param $msg Message to log
|
||||||
# @return Constant ($class->REDIRECT, $class->SERVER_ERROR)
|
# @return Constant ($class->REDIRECT, $class->SERVER_ERROR)
|
||||||
sub abort {
|
sub abort {
|
||||||
my ( $class, $msg ) = @_;
|
my ( $class, $req, $msg ) = @_;
|
||||||
|
|
||||||
# If abort is called without a valid request, fall to die
|
# If abort is called without a valid request, fall to die
|
||||||
eval {
|
eval {
|
||||||
my $uri = $class->unparsed_uri;
|
my $uri = $req->{env}->{REQUEST_URI};
|
||||||
|
|
||||||
$class->logger->error($msg);
|
$class->logger->error($msg);
|
||||||
|
|
||||||
# Redirect or die
|
# Redirect or die
|
||||||
if ( $class->tsv->{useRedirectOnError} ) {
|
if ( $class->tsv->{useRedirectOnError} ) {
|
||||||
$class->logger->debug("Use redirect for error");
|
$class->logger->debug("Use redirect for error");
|
||||||
return $class->goToError( $uri, 500 );
|
return $class->goToError( $req, $uri, 500 );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $class->SERVER_ERROR;
|
return $class->SERVER_ERROR;
|
||||||
|
@ -598,9 +602,9 @@ sub abort {
|
||||||
## @rmethod protected void localUnlog()
|
## @rmethod protected void localUnlog()
|
||||||
# Delete current user from local cache entry.
|
# Delete current user from local cache entry.
|
||||||
sub localUnlog {
|
sub localUnlog {
|
||||||
my ( $class, $id ) = @_;
|
my ( $class, $req, $id ) = @_;
|
||||||
$class->logger->debug('Local handler logout');
|
$class->logger->debug('Local handler logout');
|
||||||
if ( $id //= $class->fetchId ) {
|
if ( $id //= $class->fetchId($req) ) {
|
||||||
|
|
||||||
# Delete thread datas
|
# Delete thread datas
|
||||||
if ( $class->datas->{_session_id}
|
if ( $class->datas->{_session_id}
|
||||||
|
@ -608,6 +612,7 @@ sub localUnlog {
|
||||||
{
|
{
|
||||||
$class->datas( {} );
|
$class->datas( {} );
|
||||||
}
|
}
|
||||||
|
delete $req->datas->{session};
|
||||||
|
|
||||||
# Delete local cache
|
# Delete local cache
|
||||||
if ( $class->tsv->{refLocalStorage}
|
if ( $class->tsv->{refLocalStorage}
|
||||||
|
@ -622,18 +627,18 @@ sub localUnlog {
|
||||||
# Add a javascript to html page in order to fill html form with fake data
|
# Add a javascript to html page in order to fill html form with fake data
|
||||||
# @param uri URI to catch
|
# @param uri URI to catch
|
||||||
sub postOutputFilter {
|
sub postOutputFilter {
|
||||||
my ( $class, $session, $uri ) = @_;
|
my ( $class, $req, $session, $uri ) = @_;
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
|
|
||||||
if ( defined( $class->tsv->{outputPostData}->{$vhost}->{$uri} ) ) {
|
if ( defined( $class->tsv->{outputPostData}->{$vhost}->{$uri} ) ) {
|
||||||
$class->logger->debug("Filling a html form with fake data");
|
$class->logger->debug("Filling a html form with fake data");
|
||||||
|
|
||||||
$class->unset_header_in("Accept-Encoding");
|
$class->unset_header_in( $req, "Accept-Encoding" );
|
||||||
my %postdata =
|
my %postdata =
|
||||||
$class->tsv->{outputPostData}->{$vhost}->{$uri}->($session);
|
$class->tsv->{outputPostData}->{$vhost}->{$uri}->( $req, $session );
|
||||||
my $formParams = $class->tsv->{postFormParams}->{$vhost}->{$uri};
|
my $formParams = $class->tsv->{postFormParams}->{$vhost}->{$uri};
|
||||||
my $js = $class->postJavascript( \%postdata, $formParams );
|
my $js = $class->postJavascript( $req, \%postdata, $formParams );
|
||||||
$class->addToHtmlHead($js);
|
$class->addToHtmlHead( $req, $js );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -641,17 +646,18 @@ sub postOutputFilter {
|
||||||
# Replace request body with form datas defined in configuration
|
# Replace request body with form datas defined in configuration
|
||||||
# @param uri URI to catch
|
# @param uri URI to catch
|
||||||
sub postInputFilter {
|
sub postInputFilter {
|
||||||
my ( $class, $session, $uri ) = @_;
|
my ( $class, $req, $session, $uri ) = @_;
|
||||||
my $vhost = $class->resolveAlias;
|
my $vhost = $class->resolveAlias($req);
|
||||||
|
|
||||||
if ( defined( $class->tsv->{inputPostData}->{$vhost}->{$uri} ) ) {
|
if ( defined( $class->tsv->{inputPostData}->{$vhost}->{$uri} ) ) {
|
||||||
$class->logger->debug("Replacing fake data with real form data");
|
$class->logger->debug("Replacing fake data with real form data");
|
||||||
|
|
||||||
my %data = $class->tsv->{inputPostData}->{$vhost}->{$uri}->($session);
|
my %data =
|
||||||
|
$class->tsv->{inputPostData}->{$vhost}->{$uri}->( $req, $session );
|
||||||
foreach ( keys %data ) {
|
foreach ( keys %data ) {
|
||||||
$data{$_} = uri_escape( $data{$_} );
|
$data{$_} = uri_escape( $data{$_} );
|
||||||
}
|
}
|
||||||
$class->setPostParams( \%data );
|
$class->setPostParams( $req, \%data );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -659,7 +665,7 @@ sub postInputFilter {
|
||||||
# build a javascript to fill a html form with fake data
|
# build a javascript to fill a html form with fake data
|
||||||
# @param data hashref containing input => value
|
# @param data hashref containing input => value
|
||||||
sub postJavascript {
|
sub postJavascript {
|
||||||
my ( $class, $data, $formParams ) = @_;
|
my ( $class, $req, $data, $formParams ) = @_;
|
||||||
|
|
||||||
my $form = $formParams->{formSelector} || "form";
|
my $form = $formParams->{formSelector} || "form";
|
||||||
|
|
||||||
|
|
|
@ -24,7 +24,7 @@ BEGIN {
|
||||||
};
|
};
|
||||||
|
|
||||||
# Current sessions properties
|
# Current sessions properties
|
||||||
our $_v = { session => {}, datas => {}, datasUpdate => {}, };
|
our $_v = { datas => {}, datasUpdate => {}, };
|
||||||
|
|
||||||
# Thread shared accessors
|
# Thread shared accessors
|
||||||
foreach ( keys %$_tshv ) {
|
foreach ( keys %$_tshv ) {
|
||||||
|
|
|
@ -19,14 +19,6 @@ use constant AUTH_REQUIRED => 401;
|
||||||
use constant MAINTENANCE => 503;
|
use constant MAINTENANCE => 503;
|
||||||
use constant defaultLogger => 'Lemonldap::NG::Common::Logger::Std';
|
use constant defaultLogger => 'Lemonldap::NG::Common::Logger::Std';
|
||||||
|
|
||||||
our $request;
|
|
||||||
|
|
||||||
## @method void setServerSignature(string sign)
|
|
||||||
# modifies web server signature
|
|
||||||
# @param $sign String to add to server signature
|
|
||||||
sub setServerSignature {
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method void thread_share(string $variable)
|
## @method void thread_share(string $variable)
|
||||||
# share or not the variable (if authorized by specific module)
|
# share or not the variable (if authorized by specific module)
|
||||||
# @param $variable the name of the variable to share
|
# @param $variable the name of the variable to share
|
||||||
|
@ -35,40 +27,27 @@ sub thread_share {
|
||||||
# nothing to do in PSGI
|
# nothing to do in PSGI
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method void newRequest($r)
|
## @method void setServerSignature(string sign)
|
||||||
# Store request in global $request variable
|
# modifies web server signature
|
||||||
#
|
# @param $sign String to add to server signature
|
||||||
#@param $r Lemonldap::NG::Common::PSGI::Request
|
sub setServerSignature {
|
||||||
sub newRequest {
|
|
||||||
my ( $class, $r ) = @_;
|
|
||||||
$request = $r;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method void set_user(string user)
|
## @method void set_user(string user)
|
||||||
# sets remote_user in response headers
|
# sets remote_user in response headers
|
||||||
# @param user string username
|
# @param user string username
|
||||||
sub set_user {
|
sub set_user {
|
||||||
my ( $class, $user ) = @_;
|
my ( $class, $req, $user ) = @_;
|
||||||
push @{ $request->{respHeaders} }, 'Lm-Remote-User' => $user;
|
push @{ $req->{respHeaders} }, 'Lm-Remote-User' => $user;
|
||||||
}
|
|
||||||
|
|
||||||
## @method string header_in(string header)
|
|
||||||
# returns request header value
|
|
||||||
# @param header string request header
|
|
||||||
# @return request header value
|
|
||||||
sub header_in {
|
|
||||||
my ( $class, $header ) = @_;
|
|
||||||
$header ||= $class; # to use header_in as a method or as a function
|
|
||||||
return $request->{env}->{ cgiName($header) };
|
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method void set_header_in(hash headers)
|
## @method void set_header_in(hash headers)
|
||||||
# sets or modifies request headers
|
# sets or modifies request headers
|
||||||
# @param headers hash containing header names => header value
|
# @param headers hash containing header names => header value
|
||||||
sub set_header_in {
|
sub set_header_in {
|
||||||
my ( $class, %headers ) = @_;
|
my ( $class, $req, %headers ) = @_;
|
||||||
while ( my ( $h, $v ) = each %headers ) {
|
while ( my ( $h, $v ) = each %headers ) {
|
||||||
$request->{env}->{ cgiName($h) } = $v;
|
$req->{env}->{ cgiName($h) } = $v;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -76,9 +55,9 @@ sub set_header_in {
|
||||||
# removes request headers
|
# removes request headers
|
||||||
# @param headers array with header names to remove
|
# @param headers array with header names to remove
|
||||||
sub unset_header_in {
|
sub unset_header_in {
|
||||||
my ( $class, @headers ) = @_;
|
my ( $class, $req, @headers ) = @_;
|
||||||
foreach my $h (@headers) {
|
foreach my $h (@headers) {
|
||||||
delete $request->{env}->{ cgiName($h) };
|
delete $req->{env}->{ cgiName($h) };
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -86,28 +65,12 @@ sub unset_header_in {
|
||||||
# sets response headers
|
# sets response headers
|
||||||
# @param headers hash containing header names => header value
|
# @param headers hash containing header names => header value
|
||||||
sub set_header_out {
|
sub set_header_out {
|
||||||
my ( $class, %headers ) = @_;
|
my ( $class, $req, %headers ) = @_;
|
||||||
while ( my ( $h, $v ) = each %headers ) {
|
while ( my ( $h, $v ) = each %headers ) {
|
||||||
push @{ $request->{respHeaders} }, $h => $v;
|
push @{ $req->{respHeaders} }, $h => $v;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method string hostname
|
|
||||||
# returns host, as set by full URI or Host header
|
|
||||||
# @return host string Host value
|
|
||||||
sub hostname {
|
|
||||||
my $h = $request->{env}->{HTTP_HOST};
|
|
||||||
$h =~ s/:\d+//;
|
|
||||||
return $h;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string remote_ip
|
|
||||||
# returns client IP address
|
|
||||||
# @return IP_Addr string client IP
|
|
||||||
sub remote_ip {
|
|
||||||
return $request->{env}->{REMOTE_ADDR};
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method boolean is_initial_req
|
## @method boolean is_initial_req
|
||||||
# always returns true
|
# always returns true
|
||||||
# @return is_initial_req boolean
|
# @return is_initial_req boolean
|
||||||
|
@ -115,69 +78,12 @@ sub is_initial_req {
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method string args(string args)
|
|
||||||
# gets the query string
|
|
||||||
# @return args string Query string
|
|
||||||
sub args {
|
|
||||||
return $request->{env}->{QUERY_STRING};
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string uri
|
|
||||||
# returns the path portion of the URI, normalized, i.e. :
|
|
||||||
# * URL decoded (characters encoded as %XX are decoded,
|
|
||||||
# except ? in order not to merge path and query string)
|
|
||||||
# * references to relative path components "." and ".." are resolved
|
|
||||||
# * two or more adjacent slashes are merged into a single slash
|
|
||||||
# @return path portion of the URI, normalized
|
|
||||||
sub uri {
|
|
||||||
return $request->uri;
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string uri_with_args
|
|
||||||
# returns the URI, with arguments and with path portion normalized
|
|
||||||
# @return URI with normalized path portion
|
|
||||||
sub uri_with_args {
|
|
||||||
return $request->{env}->{REQUEST_URI};
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string unparsed_uri
|
|
||||||
# returns the full original request URI, with arguments
|
|
||||||
# @return full original request URI, with arguments
|
|
||||||
sub unparsed_uri {
|
|
||||||
return $request->{env}->{REQUEST_URI};
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string get_server_port
|
|
||||||
# returns the port the server is receiving the current request on
|
|
||||||
# @return port string server port
|
|
||||||
sub get_server_port {
|
|
||||||
return $request->{env}->{SERVER_PORT};
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method string method
|
|
||||||
# returns the request method
|
|
||||||
# @return port string server port
|
|
||||||
sub method {
|
|
||||||
return $request->{env}->{REQUEST_METHOD};
|
|
||||||
}
|
|
||||||
|
|
||||||
## Return FastCGI environment variables as hash
|
|
||||||
sub env {
|
|
||||||
return $request->{env};
|
|
||||||
}
|
|
||||||
|
|
||||||
## @method void print(string data)
|
## @method void print(string data)
|
||||||
# write data in HTTP response body
|
# write data in HTTP response body
|
||||||
# @param data Text to add in response body
|
# @param data Text to add in response body
|
||||||
sub print {
|
sub print {
|
||||||
my ( $class, $data ) = @_;
|
my ( $class, $req, $data ) = @_;
|
||||||
$request->{respBody} .= $data;
|
$req->{respBody} .= $data;
|
||||||
}
|
|
||||||
|
|
||||||
sub cgiName {
|
|
||||||
my $h = uc(shift);
|
|
||||||
$h =~ s/-/_/g;
|
|
||||||
return "HTTP_$h";
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub addToHtmlHead {
|
sub addToHtmlHead {
|
||||||
|
@ -188,6 +94,12 @@ sub addToHtmlHead {
|
||||||
;
|
;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub cgiName {
|
||||||
|
my $h = uc(shift);
|
||||||
|
$h =~ s/-/_/g;
|
||||||
|
return "HTTP_$h";
|
||||||
|
}
|
||||||
|
|
||||||
*setPostParams = *addToHtmlHead;
|
*setPostParams = *addToHtmlHead;
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -18,43 +18,29 @@ use constant defaultLogger => 'Lemonldap::NG::Common::Logger::Syslog';
|
||||||
# sets or modifies request headers
|
# sets or modifies request headers
|
||||||
# @param headers hash containing header names => header value
|
# @param headers hash containing header names => header value
|
||||||
sub set_header_in {
|
sub set_header_in {
|
||||||
my ( $class, %headers ) = @_;
|
my ( $class, $req, %headers ) = @_;
|
||||||
for my $k ( keys %headers ) {
|
for my $k ( keys %headers ) {
|
||||||
$Lemonldap::NG::Handler::PSGI::Main::request->{ cgiName($k) } =
|
$req->{env}->{ cgiName($k) } = $headers{$k};
|
||||||
$headers{$k};
|
|
||||||
}
|
}
|
||||||
push @{ $Lemonldap::NG::Handler::PSGI::Main::request->{respHeaders} },
|
push @{ $req->{respHeaders} }, %headers;
|
||||||
%headers;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub unset_header_in {
|
sub unset_header_in {
|
||||||
my ( $class, $header ) = @_;
|
my ( $class, $req, $header ) = @_;
|
||||||
$Lemonldap::NG::Handler::PSGI::Main::request->{respHeaders} =
|
$req->{respHeaders} = [ grep { $_ ne $header } @{ $req->{respHeaders} } ];
|
||||||
[ grep { $_ ne $header }
|
|
||||||
@{ $Lemonldap::NG::Handler::PSGI::Main::request->{respHeaders} } ];
|
|
||||||
$header =~ s/-/_/g;
|
$header =~ s/-/_/g;
|
||||||
delete $Lemonldap::NG::Handler::PSGI::Main::request->{ cgiName($header) };
|
delete $req->{env}->{$header};
|
||||||
|
delete $req->{env}->{"HTTP_$header"};
|
||||||
}
|
}
|
||||||
|
|
||||||
# Inheritence is broken in this case with Debian >= jessie
|
# Inheritence is broken in this case with Debian >= jessie
|
||||||
*checkType = *Lemonldap::NG::Handler::PSGI::Main::checkType;
|
*checkType = *Lemonldap::NG::Handler::PSGI::Main::checkType;
|
||||||
*setServerSignature = *Lemonldap::NG::Handler::PSGI::Main::setServerSignature;
|
*setServerSignature = *Lemonldap::NG::Handler::PSGI::Main::setServerSignature;
|
||||||
*thread_share = *Lemonldap::NG::Handler::PSGI::Main::thread_share;
|
*thread_share = *Lemonldap::NG::Handler::PSGI::Main::thread_share;
|
||||||
*newRequest = *Lemonldap::NG::Handler::PSGI::Main::newRequest;
|
|
||||||
*set_user = *Lemonldap::NG::Handler::PSGI::Main::set_user;
|
*set_user = *Lemonldap::NG::Handler::PSGI::Main::set_user;
|
||||||
*header_in = *Lemonldap::NG::Handler::PSGI::Main::header_in;
|
|
||||||
*set_header_out = *Lemonldap::NG::Handler::PSGI::Main::set_header_out;
|
*set_header_out = *Lemonldap::NG::Handler::PSGI::Main::set_header_out;
|
||||||
*hostname = *Lemonldap::NG::Handler::PSGI::Main::hostname;
|
|
||||||
*remote_ip = *Lemonldap::NG::Handler::PSGI::Main::remote_ip;
|
|
||||||
*is_initial_req = *Lemonldap::NG::Handler::PSGI::Main::is_initial_req;
|
*is_initial_req = *Lemonldap::NG::Handler::PSGI::Main::is_initial_req;
|
||||||
*args = *Lemonldap::NG::Handler::PSGI::Main::args;
|
|
||||||
*env = *Lemonldap::NG::Handler::PSGI::Main::env;
|
|
||||||
*uri = *Lemonldap::NG::Handler::PSGI::Main::uri;
|
|
||||||
*uri_with_args = *Lemonldap::NG::Handler::PSGI::Main::uri_with_args;
|
|
||||||
*unparsed_uri = *Lemonldap::NG::Handler::PSGI::Main::unparsed_uri;
|
|
||||||
*get_server_port = *Lemonldap::NG::Handler::PSGI::Main::get_server_port;
|
|
||||||
*method = *Lemonldap::NG::Handler::PSGI::Main::method;
|
|
||||||
*print = *Lemonldap::NG::Handler::PSGI::Main::print;
|
*print = *Lemonldap::NG::Handler::PSGI::Main::print;
|
||||||
*cgiName = *Lemonldap::NG::Handler::PSGI::Main::cgiName;
|
|
||||||
*addToHtmlHead = *Lemonldap::NG::Handler::PSGI::Main::addToHtmlHead;
|
*addToHtmlHead = *Lemonldap::NG::Handler::PSGI::Main::addToHtmlHead;
|
||||||
|
*cgiName = *Lemonldap::NG::Handler::PSGI::Main::cgiName;
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -3,7 +3,7 @@ use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
require 't/test.pm';
|
require 't/test.pm';
|
||||||
|
|
||||||
use Test::More tests => 10;
|
use Test::More tests => 4;
|
||||||
BEGIN { use_ok('Lemonldap::NG::Handler::Main') }
|
BEGIN { use_ok('Lemonldap::NG::Handler::Main') }
|
||||||
|
|
||||||
# get a standard basic configuration in $args hashref
|
# get a standard basic configuration in $args hashref
|
||||||
|
@ -22,12 +22,13 @@ $ENV{SERVER_NAME} = "test1.example.com";
|
||||||
#open STDERR, '>/dev/null';
|
#open STDERR, '>/dev/null';
|
||||||
|
|
||||||
my $conf = {
|
my $conf = {
|
||||||
'cfgNum' => 1,
|
cfgNum => 1,
|
||||||
'logLevel' => 'error',
|
logLevel => 'error',
|
||||||
'portal' => 'http://auth.example.com/',
|
portal => 'http://auth.example.com/',
|
||||||
'globalStorage' => 'Apache::Session::File',
|
globalStorage => 'Apache::Session::File',
|
||||||
'post' => {},
|
post => {},
|
||||||
'locationRules' => {
|
key => 1,
|
||||||
|
locationRules => {
|
||||||
'test1.example.com' => {
|
'test1.example.com' => {
|
||||||
|
|
||||||
# Basic rules
|
# Basic rules
|
||||||
|
@ -51,10 +52,3 @@ ok( !$@, 'init' );
|
||||||
ok( $h->configReload($conf), 'Load conf' );
|
ok( $h->configReload($conf), 'Load conf' );
|
||||||
|
|
||||||
ok( $h->tsv->{portal}->() eq 'http://auth.example.com/', 'portal' );
|
ok( $h->tsv->{portal}->() eq 'http://auth.example.com/', 'portal' );
|
||||||
|
|
||||||
ok( $h->grant( undef, '/s' ), 'basic rule "accept"' );
|
|
||||||
ok( !$h->grant( undef, '/no' ), 'basic rule "deny"' );
|
|
||||||
ok( $h->grant( undef, '/a/a' ), 'bad ordered rule 1/2' );
|
|
||||||
ok( $h->grant( undef, '/a' ), 'bad ordered rule 2/2' );
|
|
||||||
ok( !$h->grant( undef, '/b/a' ), 'good ordered rule 1/2' );
|
|
||||||
ok( $h->grant( undef, '/b' ), 'good ordered rule 2/2' );
|
|
||||||
|
|
|
@ -1,69 +0,0 @@
|
||||||
# Before `make install' is performed this script should be runnable with
|
|
||||||
# `make test'. After `make install' it should work as `perl Lemonldap-NG-Handler-SharedConf.t'
|
|
||||||
|
|
||||||
#########################
|
|
||||||
|
|
||||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
|
||||||
|
|
||||||
use Test::More tests => 6;
|
|
||||||
use Cwd 'abs_path';
|
|
||||||
use File::Basename;
|
|
||||||
use File::Temp;
|
|
||||||
require 't/test.pm';
|
|
||||||
|
|
||||||
my $ini = File::Temp->new();
|
|
||||||
my $dir = dirname( abs_path($0) );
|
|
||||||
my $tmp = File::Temp::tempdir();
|
|
||||||
|
|
||||||
print $ini "[all]
|
|
||||||
logger = Lemonldap::NG::Common::Logger::Std
|
|
||||||
logLevel = error
|
|
||||||
[configuration]
|
|
||||||
type=File
|
|
||||||
dirName=$dir
|
|
||||||
localStorage=Cache::FileCache
|
|
||||||
localStorageOptions={ \\
|
|
||||||
'namespace' => 'lemonldap-ng-config',\\
|
|
||||||
'default_expires_in' => 600, \\
|
|
||||||
'directory_umask' => '007', \\
|
|
||||||
'cache_root' => '$tmp', \\
|
|
||||||
'cache_depth' => 0, \\
|
|
||||||
}
|
|
||||||
|
|
||||||
";
|
|
||||||
|
|
||||||
$ini->flush();
|
|
||||||
|
|
||||||
use Env qw(LLNG_DEFAULTCONFFILE);
|
|
||||||
$LLNG_DEFAULTCONFFILE = $ini->filename;
|
|
||||||
|
|
||||||
#open STDERR, '>/dev/null';
|
|
||||||
|
|
||||||
#########################
|
|
||||||
|
|
||||||
# Insert your test code below, the Test::More module is use()ed here so read
|
|
||||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
|
||||||
|
|
||||||
use_ok('Lemonldap::NG::Handler::Main');
|
|
||||||
|
|
||||||
my $ret;
|
|
||||||
|
|
||||||
our $apacheRequest;
|
|
||||||
|
|
||||||
my $h = 'Lemonldap::NG::Handler::Test';
|
|
||||||
|
|
||||||
ok( $h->init(), 'Initialize handler' );
|
|
||||||
|
|
||||||
ok( $h->checkType($apacheRequest) eq 'Main', 'Get Main type' );
|
|
||||||
|
|
||||||
ok( $ret = $h->run($apacheRequest),
|
|
||||||
'run Handler with basic configuration and no cookie' );
|
|
||||||
|
|
||||||
ok( $ret = 302, 'Return code is 302' );
|
|
||||||
|
|
||||||
ok(
|
|
||||||
$Lemonldap::NG::Handler::Test::header eq
|
|
||||||
'Location:http://auth.example.com/?url=aHR0cDovL3Rlc3QxLmV4YW1wbGUuY29tLw==',
|
|
||||||
'testing redirection URL from previous run'
|
|
||||||
) or print STDERR "Got: $Lemonldap::NG::Handler::Test::header\n";
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use Test::More tests => 12;
|
use Test::More tests => 9;
|
||||||
require 't/test.pm';
|
require 't/test.pm';
|
||||||
BEGIN { use_ok('Lemonldap::NG::Handler::Main::Jail') }
|
BEGIN { use_ok('Lemonldap::NG::Handler::Main::Jail') }
|
||||||
|
|
||||||
|
@ -47,12 +47,3 @@ ok(
|
||||||
ok( $res = &$code, "Function works" );
|
ok( $res = &$code, "Function works" );
|
||||||
ok( $res == 1, 'Get good result' );
|
ok( $res == 1, 'Get good result' );
|
||||||
|
|
||||||
$sub = "sub { return (hostname()) }";
|
|
||||||
$code = $jail->jail_reval($sub);
|
|
||||||
ok(
|
|
||||||
( defined($code) and ref($code) eq 'CODE' ),
|
|
||||||
'hostname api function is defined'
|
|
||||||
);
|
|
||||||
ok( $res = &$code, "Function works $res" );
|
|
||||||
ok( $res eq 'test1.example.com', 'Get good result' );
|
|
||||||
|
|
||||||
|
|
|
@ -1417,7 +1417,7 @@ sub getIDP {
|
||||||
foreach ( keys %{ $self->idpList } ) {
|
foreach ( keys %{ $self->idpList } ) {
|
||||||
my $idpConfKey = $self->idpList->{$_}->{confKey};
|
my $idpConfKey = $self->idpList->{$_}->{confKey};
|
||||||
my $cond = $self->idpRules->{$idpConfKey} or next;
|
my $cond = $self->idpRules->{$idpConfKey} or next;
|
||||||
if ( $cond->( $req->sessionInfo ) ) {
|
if ( $cond->( $req, $req->sessionInfo ) ) {
|
||||||
$self->logger->debug(
|
$self->logger->debug(
|
||||||
"IDP $idpConfKey resolution rule match");
|
"IDP $idpConfKey resolution rule match");
|
||||||
$idp = $_;
|
$idp = $_;
|
||||||
|
|
|
@ -113,7 +113,11 @@ sub run {
|
||||||
return PE_ERROR;
|
return PE_ERROR;
|
||||||
}
|
}
|
||||||
my ( $host, $uri ) = ( $1, $2 );
|
my ( $host, $uri ) = ( $1, $2 );
|
||||||
if ( $self->p->HANDLER->grant( $req->sessionInfo, $1, undef, $2 ) )
|
if (
|
||||||
|
$self->p->HANDLER->grant(
|
||||||
|
$req, $req->sessionInfo, $1, undef, $2
|
||||||
|
)
|
||||||
|
)
|
||||||
{
|
{
|
||||||
$self->logger->debug("CAS service $service access allowed");
|
$self->logger->debug("CAS service $service access allowed");
|
||||||
}
|
}
|
||||||
|
|
|
@ -295,7 +295,7 @@ sub run {
|
||||||
|
|
||||||
# Check if this RP is authorizated
|
# Check if this RP is authorizated
|
||||||
if ( my $rule = $self->rpRules->{$rp} ) {
|
if ( my $rule = $self->rpRules->{$rp} ) {
|
||||||
unless ( $rule->( $req->sessionInfo ) ) {
|
unless ( $rule->( $req, $req->sessionInfo ) ) {
|
||||||
$self->userLogger->warn( 'User '
|
$self->userLogger->warn( 'User '
|
||||||
. $req->sessionInfo->{ $self->conf->{whatToTrace} }
|
. $req->sessionInfo->{ $self->conf->{whatToTrace} }
|
||||||
. "was not authorizated to access to $rp" );
|
. "was not authorizated to access to $rp" );
|
||||||
|
|
|
@ -324,7 +324,7 @@ sub run {
|
||||||
$req->env->{llng_saml_spconfkey} = $spConfKey;
|
$req->env->{llng_saml_spconfkey} = $spConfKey;
|
||||||
|
|
||||||
if ( my $rule = $self->spRules->{$sp} ) {
|
if ( my $rule = $self->spRules->{$sp} ) {
|
||||||
unless ( $rule->( $req->sessionInfo ) ) {
|
unless ( $rule->( $req, $req->sessionInfo ) ) {
|
||||||
$self->userLogger->warn( 'User '
|
$self->userLogger->warn( 'User '
|
||||||
. $req->sessionInfo->{ $self->conf->{whatToTrace} }
|
. $req->sessionInfo->{ $self->conf->{whatToTrace} }
|
||||||
. "was not authorizated to access to $sp" );
|
. "was not authorizated to access to $sp" );
|
||||||
|
|
|
@ -90,7 +90,7 @@ sub getNotifBack {
|
||||||
or return $self->sendError( $req, 'Unable to decrypt', 500 );
|
or return $self->sendError( $req, 'Unable to decrypt', 500 );
|
||||||
|
|
||||||
# Verify that session exists
|
# Verify that session exists
|
||||||
$req->userData( $self->p->HANDLER->retrieveSession($id) )
|
$req->userData( $self->p->HANDLER->retrieveSession( $req, $id ) )
|
||||||
or return $self->sendError( $req, 'Unknown session', 401 );
|
or return $self->sendError( $req, 'Unknown session', 401 );
|
||||||
|
|
||||||
# Restore datas
|
# Restore datas
|
||||||
|
|
|
@ -102,7 +102,7 @@ sub checkForNotifications {
|
||||||
next LOOP;
|
next LOOP;
|
||||||
}
|
}
|
||||||
|
|
||||||
unless ( $condition->( $req->sessionInfo ) ) {
|
unless ( $condition->( $req, $req->sessionInfo ) ) {
|
||||||
$self->logger->debug(
|
$self->logger->debug(
|
||||||
'Notification condition not authorizated');
|
'Notification condition not authorizated');
|
||||||
|
|
||||||
|
@ -152,7 +152,7 @@ sub getNotifBack {
|
||||||
or return $self->sendError( $req, 'Unable to decrypt', 500 );
|
or return $self->sendError( $req, 'Unable to decrypt', 500 );
|
||||||
|
|
||||||
# Verify that session exists
|
# Verify that session exists
|
||||||
$req->userData( $self->p->HANDLER->retrieveSession($id) )
|
$req->userData( $self->p->HANDLER->retrieveSession( $req, $id ) )
|
||||||
or return $self->sendError( $req, 'Unknown session', 401 );
|
or return $self->sendError( $req, 'Unknown session', 401 );
|
||||||
|
|
||||||
# Restore datas
|
# Restore datas
|
||||||
|
|
|
@ -43,8 +43,6 @@ has ua => (
|
||||||
is => 'rw',
|
is => 'rw',
|
||||||
lazy => 1,
|
lazy => 1,
|
||||||
builder => sub {
|
builder => sub {
|
||||||
|
|
||||||
# TODO : LWP options to use a proxy for example
|
|
||||||
my $ua = Lemonldap::NG::Common::UserAgent->new( $_[0]->{conf} );
|
my $ua = Lemonldap::NG::Common::UserAgent->new( $_[0]->{conf} );
|
||||||
$ua->env_proxy();
|
$ua->env_proxy();
|
||||||
return $ua;
|
return $ua;
|
||||||
|
|
|
@ -377,7 +377,7 @@ sub getSkin {
|
||||||
|
|
||||||
# Load specific skin from skinRules
|
# Load specific skin from skinRules
|
||||||
foreach my $rule ( @{ $self->conf->{skinRules} } ) {
|
foreach my $rule ( @{ $self->conf->{skinRules} } ) {
|
||||||
if ( $rule->[1]->( $req->sessionInfo ) ) {
|
if ( $rule->[1]->( $req, $req->sessionInfo ) ) {
|
||||||
$skin = $rule->[0];
|
$skin = $rule->[0];
|
||||||
$self->logger->debug("Skin $skin selected from skin rule");
|
$self->logger->debug("Skin $skin selected from skin rule");
|
||||||
}
|
}
|
||||||
|
|
|
@ -111,7 +111,7 @@ sub displayModules {
|
||||||
foreach my $module ( @{ $self->menuModules } ) {
|
foreach my $module ( @{ $self->menuModules } ) {
|
||||||
$self->logger->debug("Check if $module->[0] has to be displayed");
|
$self->logger->debug("Check if $module->[0] has to be displayed");
|
||||||
|
|
||||||
if ( $module->[1]->() ) {
|
if ( $module->[1]->( $req, $req->sessionInfo ) ) {
|
||||||
my $moduleHash = { $module->[0] => 1 };
|
my $moduleHash = { $module->[0] => 1 };
|
||||||
if ( $module->[0] eq 'Appslist' ) {
|
if ( $module->[0] eq 'Appslist' ) {
|
||||||
$moduleHash->{'APPSLIST_LOOP'} = $self->appslist($req);
|
$moduleHash->{'APPSLIST_LOOP'} = $self->appslist($req);
|
||||||
|
@ -465,8 +465,7 @@ sub _filterHash {
|
||||||
delete $apphash->{$key}
|
delete $apphash->{$key}
|
||||||
unless (
|
unless (
|
||||||
$self->p->HANDLER->grant(
|
$self->p->HANDLER->grant(
|
||||||
$req->sessionInfo,
|
$req, $req->sessionInfo, $appuri, undef, $vhost
|
||||||
$appuri, undef, $vhost
|
|
||||||
)
|
)
|
||||||
);
|
);
|
||||||
next;
|
next;
|
||||||
|
|
|
@ -344,7 +344,7 @@ sub setMacros {
|
||||||
my ( $self, $req ) = @_;
|
my ( $self, $req ) = @_;
|
||||||
foreach ( sort keys %{ $self->_macros } ) {
|
foreach ( sort keys %{ $self->_macros } ) {
|
||||||
$req->{sessionInfo}->{$_} =
|
$req->{sessionInfo}->{$_} =
|
||||||
$self->_macros->{$_}->( $req->sessionInfo );
|
$self->_macros->{$_}->( $req, $req->sessionInfo );
|
||||||
}
|
}
|
||||||
PE_OK;
|
PE_OK;
|
||||||
}
|
}
|
||||||
|
@ -383,7 +383,7 @@ sub setPersistentSessionInfo {
|
||||||
sub setLocalGroups {
|
sub setLocalGroups {
|
||||||
my ( $self, $req ) = @_;
|
my ( $self, $req ) = @_;
|
||||||
foreach ( sort keys %{ $self->_groups } ) {
|
foreach ( sort keys %{ $self->_groups } ) {
|
||||||
if ( $self->_groups->{$_}->( $req->sessionInfo ) ) {
|
if ( $self->_groups->{$_}->( $req, $req->sessionInfo ) ) {
|
||||||
$req->{sessionInfo}->{groups} .=
|
$req->{sessionInfo}->{groups} .=
|
||||||
$self->conf->{multiValuesSeparator} . $_;
|
$self->conf->{multiValuesSeparator} . $_;
|
||||||
$req->{sessionInfo}->{hGroups}->{$_}->{name} = $_;
|
$req->{sessionInfo}->{hGroups}->{$_}->{name} = $_;
|
||||||
|
|
|
@ -17,9 +17,6 @@ has steps => ( is => 'rw' );
|
||||||
# Authentication result
|
# Authentication result
|
||||||
has authResult => ( is => 'rw' );
|
has authResult => ( is => 'rw' );
|
||||||
|
|
||||||
# Datas shared between methods
|
|
||||||
has datas => ( is => 'rw' );
|
|
||||||
|
|
||||||
# Session datas when created
|
# Session datas when created
|
||||||
has id => ( is => 'rw' );
|
has id => ( is => 'rw' );
|
||||||
has sessionInfo => ( is => 'rw' );
|
has sessionInfo => ( is => 'rw' );
|
||||||
|
|
|
@ -260,7 +260,7 @@ sub autoRedirect {
|
||||||
|
|
||||||
# Redirection should be made if urldc defined
|
# Redirection should be made if urldc defined
|
||||||
if ( $req->{urldc} ) {
|
if ( $req->{urldc} ) {
|
||||||
if ( $self->_jsRedirect->() ) {
|
if ( $self->_jsRedirect->( $req, $req->sessionInfo ) ) {
|
||||||
$req->error(PE_REDIRECT);
|
$req->error(PE_REDIRECT);
|
||||||
$req->datas->{redirectFormMethod} = "get";
|
$req->datas->{redirectFormMethod} = "get";
|
||||||
}
|
}
|
||||||
|
@ -490,7 +490,7 @@ sub _deleteSession {
|
||||||
) unless ($preserveCookie);
|
) unless ($preserveCookie);
|
||||||
}
|
}
|
||||||
|
|
||||||
HANDLER->localUnlog( $session->id );
|
HANDLER->localUnlog( $req, $session->id );
|
||||||
$session->remove;
|
$session->remove;
|
||||||
|
|
||||||
# Create an obsolete cookie to remove it
|
# Create an obsolete cookie to remove it
|
||||||
|
|
|
@ -48,7 +48,7 @@ sub init {
|
||||||
|
|
||||||
sub _run {
|
sub _run {
|
||||||
my ( $self, $req ) = @_;
|
my ( $self, $req ) = @_;
|
||||||
return PE_OK unless ( $self->rule->( $req->sessionInfo ) );
|
return PE_OK unless ( $self->rule->( $req, $req->sessionInfo ) );
|
||||||
$self->userLogger->info( 'Second factor required ('
|
$self->userLogger->info( 'Second factor required ('
|
||||||
. $self->prefix
|
. $self->prefix
|
||||||
. ') for '
|
. ') for '
|
||||||
|
|
|
@ -41,7 +41,7 @@ sub grantSession {
|
||||||
}
|
}
|
||||||
foreach ( sort sortByComment keys %{ $self->rules } ) {
|
foreach ( sort sortByComment keys %{ $self->rules } ) {
|
||||||
$self->logger->debug("Grant session condition \"$_\"");
|
$self->logger->debug("Grant session condition \"$_\"");
|
||||||
unless ( $self->rules->{$_}->( $req->sessionInfo ) ) {
|
unless ( $self->rules->{$_}->( $req, $req->sessionInfo ) ) {
|
||||||
$req->userData( {} );
|
$req->userData( {} );
|
||||||
$self->userLogger->error( 'User '
|
$self->userLogger->error( 'User '
|
||||||
. $req->user
|
. $req->user
|
||||||
|
|
|
@ -316,7 +316,7 @@ sub mysession {
|
||||||
|
|
||||||
# Now check for authorization
|
# Now check for authorization
|
||||||
my $res =
|
my $res =
|
||||||
$self->p->HANDLER->grant( $req->userData, $uri, undef, $host );
|
$self->p->HANDLER->grant( $req, $req->userData, $uri, undef, $host );
|
||||||
$self->logger->debug(" Result is $res");
|
$self->logger->debug(" Result is $res");
|
||||||
return $self->p->sendJSONresponse( $req, { result => $res } );
|
return $self->p->sendJSONresponse( $req, { result => $res } );
|
||||||
}
|
}
|
||||||
|
|
|
@ -391,7 +391,8 @@ sub isAuthorizedURI {
|
||||||
}
|
}
|
||||||
|
|
||||||
$req->{sessionInfo} = $session->data;
|
$req->{sessionInfo} = $session->data;
|
||||||
my $r = $self->p->HANDLER->grant( $req, $uri, undef, $host );
|
my $r =
|
||||||
|
$self->p->HANDLER->grant( $req, $req->{sessionInfo}, $uri, undef, $host );
|
||||||
|
|
||||||
return $r;
|
return $r;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user