Commit a09d1203 authored by Xavier Guimard's avatar Xavier Guimard

Some big changes (#595)

Replace uri_escape by WWW::Form::UrlEncoded
Replace PSGI:Request by inheritance from Plack::Request
parent 3146feeb
......@@ -125,8 +125,8 @@ sub sendError {
# SOAP responses
if (
$req->accept =~ m#(?:application|text)/xml#
or ( $req->contentType
and $req->contentType =~ m#(?:application|text)/xml# )
or ( $req->content_type
and $req->content_type =~ m#(?:application|text)/xml# )
)
{
my $s = '<soapenv:Body>
......@@ -235,7 +235,7 @@ sub sendHtml {
my $sp = $self->staticPrefix;
$sp =~ s/\/*$/\//;
$htpl->param(
SCRIPT_NAME => $req->scriptname,
SCRIPT_NAME => $req->script_name,
STATIC_PREFIX => $sp,
AVAILABLE_LANGUAGES => $self->languages,
PORTAL => $self->portal,
......
......@@ -3,10 +3,13 @@ package Lemonldap::NG::Common::PSGI::Request;
use strict;
use Mouse;
use JSON;
use Plack::Request;
use URI::Escape;
our $VERSION = '2.0.0';
our @ISA = ('Plack::Request');
# http :// server / path ? query # fragment
# m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
......@@ -17,125 +20,78 @@ sub BUILD {
}
}
has HTTP_ACCEPT => ( is => 'ro', reader => 'accept' );
has HTTP_ACCEPT_ENCODING => ( is => 'ro', reader => 'encodings' );
has HTTP_ACCEPT_LANGUAGE => ( is => 'ro', reader => 'languages' );
has HTTP_AUTHORIZATION => ( is => 'ro', reader => 'authorization' );
has HTTP_COOKIE => ( is => 'ro', reader => 'cookies' );
has HTTP_HOST => ( is => 'ro', reader => 'hostname' );
has REFERER => ( is => 'ro', reader => 'referer' );
has REMOTE_ADDR => ( is => 'ro', isa => 'Str', reader => 'remote_ip' );
has REMOTE_PORT => ( is => 'ro', isa => 'Int', reader => 'port' );
has REQUEST_METHOD => ( is => 'ro', isa => 'Str', reader => 'method' );
has SCRIPT_NAME => ( is => 'ro', isa => 'Str', reader => 'scriptname' );
has SERVER_PORT => ( is => 'ro', isa => 'Int', reader => 'get_server_port' );
has X_ORIGINAL_URI => ( is => 'ro', isa => 'Str' );
has PATH_INFO => (
is => 'ro',
reader => 'path',
lazy => 1,
default => '',
trigger => sub {
my $tmp = $_[0]->{SCRIPT_NAME};
$_[0]->{PATH_INFO} =~ s|^$tmp|/|;
$_[0]->{PATH_INFO} =~ s|//+|/|g;
},
);
has REQUEST_URI => (
is => 'ro',
reader => 'uri',
lazy => 1,
default => '/',
trigger => sub {
my $uri = $_[0]->{X_ORIGINAL_URI} || $_[0]->{REQUEST_URI};
$_[0]->{unparsed_uri} = $uri;
$_[0]->{REQUEST_URI} = uri_unescape($uri);
$_[0]->{REQUEST_URI} =~ s|//+|/|g;
},
);
has unparsed_uri => ( is => 'rw', isa => 'Str' );
has 'psgi.errors' => ( is => 'rw', reader => 'stderr' );
# Authentication
has REMOTE_USER => (
is => 'rw',
reader => 'user',
trigger => sub {
$_[0]->{userData} = { $Lemonldap::NG::Handler::Main::tsv->{whatTotrace}
|| _whatToTrace => $_[0]->{REMOTE_USER}, };
},
);
has userData => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
# Query parameters
has _params => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has QUERY_STRING => (
is => 'ro',
reader => 'query',
trigger => sub {
my $self = shift;
$self->_urlcode2params( $self->{QUERY_STRING} );
},
);
sub _urlcode2params {
my ( $self, $str ) = @_;
my @tmp = $str ? map { uri_unescape($_) } split( /&/, $str ) : ();
foreach my $s (@tmp) {
if ( $s =~ /^(.+?)=(.+)$/ ) { $self->{_params}->{$1} = $2; }
else { $self->{_params}->{$s} = 1; }
}
sub new {
my $self = Plack::Request::new(@_);
my $tmp = $self->script_name;
$self->env->{REQUEST_URI} = $self->env->{X_ORIGINAL_URI}
if ( $self->env->{X_ORIGINAL_URI} );
$self->env->{PATH_INFO} =~ s|^$tmp|/|;
$self->env->{PATH_INFO} =~ s|//+|/|g;
$self->{uri} = uri_unescape( $self->env->{REQUEST_URI} );
$self->{uri} =~ s|//+|/|g;
$self->{error} = 0;
$self->{respHeaders} = [];
return $self;
}
*param = *params;
sub uri { $_[0]->{uri} }
sub params {
my ( $self, $key, $value ) = @_;
return $self->_params unless ($key);
$self->_params->{$key} = $value if ( defined $value );
return $self->_params->{$key};
sub userData {
my($self,$v)=@_;
return $_[0]->{userData} = $v if($v);
return $_[0]->{userData} || { _whatToTrace => $_[0]->user, };
}
# POST management
#
# When CONTENT_LENGTH is set, store body in memory in `body` key
has 'psgix.input.buffered' => ( is => 'ro', reader => '_psgixBuffered', );
has 'psgi.input' => ( is => 'ro', reader => '_psgiInput', );
has body => ( is => 'rw', isa => 'Str', default => '' );
has CONTENT_TYPE => ( is => 'ro', isa => 'Str', reader => 'contentType', );
has CONTENT_LENGTH => (
is => 'ro',
reader => 'contentLength',
lazy => 1,
default => 0,
trigger => sub {
my $self = shift;
if ( $self->method eq 'GET' ) { $self->{body} = undef; }
elsif ( $self->method =~ /^(?:POST|PUT)$/ ) {
$self->{body} = '';
if ( $self->_psgixBuffered ) {
my $length = $self->{CONTENT_LENGTH};
while ( $length > 0 ) {
my $buffer;
$self->_psgiInput->read( $buffer,
( $length < 8192 ) ? $length : 8192 );
$length -= length($buffer);
$self->{body} .= $buffer;
}
}
else {
$self->_psgiInput->read( $self->{body},
$self->{CONTENT_LENGTH}, 0 );
sub respHeaders {
my ( $self, $respHeaders ) = @_;
$self->{respHeaders} = $respHeaders if ($respHeaders);
return $self->{respHeaders};
}
sub accept { $_[0]->env->{HTTP_ACCEPT} }
sub encodings { $_[0]->env->{HTTP_ACCEPT_ENCODING} }
sub languages { $_[0]->env->{HTTP_ACCEPT_LANGUAGE} }
sub authorization { $_[0]->env->{HTTP_AUTHORIZATION} }
sub hostname { $_[0]->env->{HTTP_HOST} }
sub referer { $_[0]->env->{REFERER} }
sub error {
my ( $self, $err ) = @_;
$self->{error} = $err if ($err);
return $self->{error};
}
sub read_body {
my $self = shift;
if ( $self->method eq 'GET' ) { return undef; }
elsif ( $self->method =~ /^(?:POST|PUT)$/ ) {
my $body = '';
if ( $self->env->{'_psgix.buffered'} ) {
my $length = $self->content_length;
while ( $length > 0 ) {
my $buffer;
$self->body->read( $buffer,
( $length < 8192 ) ? $length : 8192 );
$length -= length($buffer);
$body .= $buffer;
}
utf8::upgrade( $self->{body} );
}
else {
$self->body->read( $body, $self->content_length, 0 );
}
utf8::upgrade($body);
return $body;
}
);
has error => ( is => 'rw', isa => 'Str', default => '' );
}
has respHeaders => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
*params = \&Plack::Request::param;
sub set_param {
my ( $self, $k, $v ) = @_;
$self->param;
$self->env->{'plack.request.merged'}->{$k} =
$self->env->{'plack.request.query'}->{$k} = $v;
}
sub wantJSON {
return 1
......@@ -147,7 +103,8 @@ sub wantJSON {
# JSON parser
sub jsonBodyToObj {
my $self = shift;
unless ( $self->contentType =~ /application\/json/ ) {
return $self->{json_body} if ( $self->{json_body} );
unless ( $self->content_type =~ /application\/json/ ) {
$self->error('Data is not JSON');
return undef;
}
......@@ -155,24 +112,12 @@ sub jsonBodyToObj {
$self->error('No data');
return undef;
}
return $self->body if ( ref( $self->body ) );
my $j = eval { from_json( $self->body ) };
my $j = eval { from_json( $self->read_body ) };
if ($@) {
$self->error("$@$!");
return undef;
}
return $self->{body} = $j;
}
sub parseBody {
my $self = shift;
if ( $self->contentType =~ /application\/json/ ) {
%{ $self->_params } =
( %{ $self->_params }, %{ $self->jsonBodyToObj } );
}
elsif ( $self->contentType =~ /^application\/x-www-form-urlencoded/ ) {
$self->_urlcode2params( $self->body );
}
return $self->{json_body} = $j;
}
1;
......@@ -244,10 +189,6 @@ Client TCP port.
HTTP method asked by client (GET/POST/PUT/DELETE).
=head3 scriptname
SCRIPT_NAME environment variable provided by HTTP server.
=head3 get_server_port
Server port.
......
......@@ -118,8 +118,9 @@ sub handler {
if ( !@path and $self->defaultRoute ) {
@path = ( $self->defaultRoute );
}
my $res = $self->followPath( $req, $self->routes->{ $req->method }, \@path );
return $res ? $res : $self->sendError($req,'Bad request',400);
my $res =
$self->followPath( $req, $self->routes->{ $req->method }, \@path );
return $res ? $res : $self->sendError( $req, 'Bad request', 400 );
}
sub followPath {
......@@ -130,12 +131,12 @@ sub followPath {
return $routes->{$w}->( $self, $req, @$path );
}
my $res = $self->followPath( $req, $routes->{$w}, $path );
return $res if($res);
return $res if ($res);
unshift @$path, $w;
}
if ( $routes->{':'} ) {
my $v = shift @$path;
$req->params->{ $routes->{'#'} } = $v;
$req->set_param($routes->{'#'}, $v);
if ( ref( $routes->{':'} ) eq 'CODE' ) {
return $routes->{':'}->( $self, $req, @$path );
}
......
......@@ -33,6 +33,7 @@ sub build_jail {
my @t =
$self->customFunctions ? split( /\s+/, $self->customFunctions ) : ();
foreach (@t) {
no warnings 'redefine';
$api->lmLog( "Custom function : $_", 'debug' );
my $sub = $_;
unless (/::/) {
......
......@@ -66,7 +66,7 @@ sub handler {
my $hdrs = $req->{respHeaders};
$req->{respHeaders} = [];
my @convertedHdrs =
( 'Content-Length' => 0, Cookie => ( $req->cookies // '' ) );
( 'Content-Length' => 0, Cookie => ( $req->env->{HTTP_COOKIE} // '' ) );
my $i = 0;
while ( my $k = shift @$hdrs ) {
my $v = shift @$hdrs;
......
......@@ -62,7 +62,7 @@ sub set_user {
sub header_in {
my ( $class, $header ) = @_;
$header ||= $class; # to use header_in as a method or as a function
return $request->{ cgiName($header) };
return $request->env->{ cgiName($header) };
}
## @method void set_header_in(hash headers)
......@@ -71,7 +71,7 @@ sub header_in {
sub set_header_in {
my ( $class, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$request->{ cgiName($h) } = $v;
$request->env->{ cgiName($h) } = $v;
}
}
......@@ -81,7 +81,7 @@ sub set_header_in {
sub unset_header_in {
my ( $class, @headers ) = @_;
foreach my $h (@headers) {
delete $request->{ cgiName($h) };
delete $request->env->{ cgiName($h) };
}
}
......@@ -108,7 +108,7 @@ sub hostname {
# returns client IP address
# @return IP_Addr string client IP
sub remote_ip {
return $request->remote_ip;
return $request->address;
}
## @method boolean is_initial_req
......@@ -122,7 +122,7 @@ sub is_initial_req {
# gets the query string
# @return args string Query string
sub args {
return $request->query;
return $request->query_string;
}
## @method string uri
......@@ -140,21 +140,21 @@ sub uri {
# returns the URI, with arguments and with path portion normalized
# @return URI with normalized path portion
sub uri_with_args {
return $request->uri;
return $request->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->unparsed_uri;
return $request->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->get_server_port;
return $request->port;
}
## @method string method
......
......@@ -61,6 +61,7 @@ sub _run {
$self->lmLog(
"User not authenticated, Try in use, cancel redirection",
'debug' );
$req->userData( {} );
$req->respHeaders( [] );
$self->routes( $self->unAuthRoutes );
}
......
......@@ -69,8 +69,8 @@ clean();
sub Lemonldap::NG::Handler::PSGI::handler {
my ( $self, $req ) = @_;
ok( $req->{HTTP_AUTH_USER} eq 'dwho', 'Header is given to app' )
or explain( $req->{HTTP_REMOTE_USER}, 'dwho' );
ok( $req->env->{HTTP_AUTH_USER} eq 'dwho', 'Header is given to app' )
or explain( $req->env->{HTTP_AUTH_USER}, 'dwho' );
count(1);
return [ 200, [ 'Content-Type', 'text/plain' ], ['Hello'] ];
}
......@@ -42,7 +42,7 @@ count(2);
# Check headers
%h = @{ $res->[1] };
ok( $h{'Auth-User'} eq 'dwho', 'Header Auth-User is set to "dwho"' )
or explain( $h, 'Auth-User => "dwho"' );
or explain( \%h, 'Auth-User => "dwho"' );
count(1);
# Denied query
......
......@@ -10,6 +10,8 @@ our $client;
our $count = 1;
$Data::Dumper::Deparse = 1;
no warnings 'redefine';
my $module;
our $sessionId =
'f5eec18ebb9bc96352595e2d8ce962e8ecf7af7c9a98cb9a43f9cd181cf4b545';
......@@ -84,7 +86,7 @@ has app => (
return $module->run(
{
configStorage => { type => 'File', dirName => 't' },
logLevel => 'warn',
logLevel => 'error',
cookieName => 'lemonldap',
securedCookie => 0,
https => 0,
......
......@@ -97,7 +97,7 @@ sub getConfKey {
# when 'latest' => replace by last cfgNum
if ( $req->params('cfgNum') eq 'latest' ) {
my $tmp = $self->confAcc->lastCfg;
$req->params( 'cfgNum', $tmp );
$req->set_param( 'cfgNum', $tmp );
if ($Lemonldap::NG::Common::Conf::msg) {
$req->error($Lemonldap::NG::Common::Conf::msg);
return undef;
......@@ -107,7 +107,9 @@ sub getConfKey {
$req->error("cfgNum must be a number");
return undef;
}
unless ( defined $self->getConfByNum( $req->params('cfgNum'), @args ) ) {
unless (
defined $self->getConfByNum( scalar( $req->params('cfgNum') ), @args ) )
{
$req->error( "Configuration "
. $req->params('cfgNum')
. " is not available ("
......@@ -1050,7 +1052,8 @@ sub diff {
my ( $self, $req, @path ) = @_;
return $self->sendError( $req, 'to many arguments in path info', 400 )
if (@path);
my @cfgNum = ( $req->params('conf1'), $req->params('conf2') );
my @cfgNum =
( scalar( $req->param('conf1') ), scalar( $req->param('conf2') ) );
my @conf;
# Load the 2 configurations
......
......@@ -123,7 +123,7 @@ sub scanTree {
$self->newConf->{cfgAuthor} =
$self->req->userData->{ $Lemonldap::NG::Handler::Main::tsv->{whatToTrace}
|| '_whatToTrace' } // "anonymous";
$self->newConf->{cfgAuthorIP} = $self->req->remote_ip;
$self->newConf->{cfgAuthorIP} = $self->req->address;
$self->newConf->{cfgDate} = time;
$self->newConf->{key} ||=
join( '', map { chr( int( rand(94) ) + 33 ) } ( 1 .. 16 ) );
......
......@@ -150,7 +150,7 @@ sub notifications {
return $self->notification( $req, $notif, $type ) if ($notif);
# Case 2: list
my $params = $req->params();
my $params = $req->parameters();
my ( $notifs, $res );
$notifs = $self->notifAccess->$sub();
......
......@@ -83,7 +83,7 @@ sub sessions {
my $mod = $self->getMod($req)
or return $self->sendError( $req, undef, 400 );
my $params = $req->params();
my $params = $req->parameters();
my $type = delete $params->{sessionType};
$type = $type eq 'global' ? 'SSO' : ucfirst($type);
......@@ -164,7 +164,7 @@ sub sessions {
my $total = ( keys %$res );
# 2.4 Special case doubleIp (users connected from more than 1 IP)
if ( $params->{doubleIp} ) {
if ( defined $params->{doubleIp} ) {
my %r;
# 2.4.1 Store user IP addresses in %r
......
......@@ -300,6 +300,7 @@
"logout": "Logout",
"logoutServices": "Logout forward",
"logParams": "Logs",
"lwpSslOpts": "SSL options for server requests",
"macros": "Macros",
"mailBody": "Success mail content",
"mailCharset": "Charset",
......@@ -350,6 +351,7 @@
"newRule": "New rule",
"newValue": "New value",
"next": "Next",
"nginxCustomHandlers": "Custom Nginx handlers",
"noAjaxHook": "Keep redirections for Ajax",
"noDatas": "No datas to display",
"notABoolean": "Not a boolean",
......
......@@ -300,6 +300,7 @@
"logout": "Déconnexion",
"logoutServices": "Transfert de la déconnexion",
"logParams": "Journalisation",
"lwpSslOpts": "Options SSL pour les requêtes serveur",
"macros": "Macros",
"mailBody": "Contenu du message de succès",
"mailCharset": "Charset",
......@@ -350,6 +351,7 @@
"newRule": "Nouvelle règle",
"newValue": "Nouvelle valeur",
"next": "Suivante",
"nginxCustomHandlers": "Handlers Nginx personnalisés",
"noAjaxHook": "Conserver les redirections pour Ajax",
"noDatas": "Aucune donnée à afficher",
"notABoolean": "Pas un booléen",
......
......@@ -18,7 +18,7 @@ sub init {
sub extractFormInfo {
my ( $self, $req ) = @_;
unless ( $req->{user} = $req->{REMOTE_USER} ) {
unless ( $req->{user} = $req->env->{REMOTE_USER} ) {
$self->lmLog( 'Apache is not configured to authenticate users!',
'error' );
return PE_ERROR;
......
......@@ -81,7 +81,7 @@ sub extractFormInfo {
# if we are receving SAML request or response
my $url = $req->uri;
my $request_method = $req->method;
my $content_type = $req->contentType;
my $content_type = $req->content_type;
# 1.1 SSO assertion consumer
if ( $url =~ $self->sloAssConsumerRe ) {
......@@ -774,7 +774,7 @@ sub extractFormInfo {
'debug' );
# Artifact request are sent with SOAP trough POST
my $art_request = $req->body;
my $art_request = $req->read_body;
my $art_response;
# Create Login object
......@@ -874,11 +874,12 @@ sub extractFormInfo {
. "<p><i>"
. $idp
. "</i></p>\n"
. ( $req->param("url")
. (
$req->param("url")
? "<input type=\"hidden\" name=\"url\" value=\""
. $req->param("url") . "\" />"
: '' )
. "<input type=\"hidden\" name=\"idp\" value=\"$idp\" />\n";
: ''
) . "<input type=\"hidden\" name=\"idp\" value=\"$idp\" />\n";
$self->p->info( $req, $html );
......@@ -1420,12 +1421,7 @@ sub getIDP {
my $idp;
my $idpName;
my $idp_cookie;
if ( $req->cookies
&& $req->cookies =~ /$self->{conf}->{samlIdPResolveCookie}=([^,; ]+)/o )
{
$idp_cookie = $1;
}
my $idp_cookie = $req->cookies->{ $self->{conf}->{samlIdPResolveCookie} };
# Case 1: Recover IDP from idp URL Parameter
unless ( $idp = $req->param("idp") ) {
......
......@@ -25,7 +25,7 @@ sub init {
sub extractFormInfo {
my ( $self, $req ) = @_;
return PE_OK
if ( $req->user( $req->{ $self->SSLField } ) );
if ( $req->user( $req->env->{ $self->SSLField } ) );
if ( $req->{SSL_CLIENT_S_DN} ) {
$self->p->userError(
"$self->SSLField was not found in user certificate");
......
......@@ -27,7 +27,7 @@ sub extractFormInfo {
$user_header = 'HTTP_' . uc($user_header);
$user_header =~ s/\-/_/g;
unless ( $req->{user} = $req->{$user_header} ) {
unless ( $req->{user} = $req->env->{$user_header} ) {
$self->lmLog( "No header " . $self->conf->{slaveUserHeader} . " found",
'error' );
return PE_USERNOTFOUND;
......
......@@ -875,7 +875,6 @@ qq'<h3 trspan="oidcConsent,$display_name">The application $display_name would li
# Handle token endpoint
sub token {
my ( $self, $req ) = @_;
$req->parseBody if ( $req->method =~ /^post$/i );
$self->lmLog( "URL detected as an OpenID Connect TOKEN URL", 'debug' );
# Check authentication
......@@ -1034,7 +1033,6 @@ sub token {
sub userInfo {
my ( $self, $req ) = @_;
$self->lmLog( "URL detected as an OpenID Connect USERINFO URL", 'debug' );
$req->parseBody if ( $req->method =~ /^post$/i );
my $access_token = $self->getEndPointAccessToken($req);
......@@ -1091,7 +1089,6 @@ sub userInfo {
sub jwks {
my ( $self, $req ) = @_;
$self->lmLog( "URL detected as an OpenID Connect JWKS URL", 'debug' );
$req->parseBody if ( $req->method =~ /^post$/i );
my $jwks = { keys => [] };
......@@ -1117,7 +1114,7 @@ sub registration {
# TODO: check Initial Access Token
# Specific message to allow DOS detection
my $source_ip = $req->remote_ip;
my $source_ip = $req->address;
$self->lmLog( "OpenID Connect Registration request from $source_ip",
'warn' );
......@@ -1128,7 +1125,7 @@ sub registration {
}
# Get client metadata
my $client_metadata_json = $req->body;
my $client_metadata_json = $req->read_body;
unless ($client_metadata_json) {
return $self->p->sendError( $req, 'Missing POST datas', 400 );
}
......@@ -1221,7 +1218,6 @@ sub endSessionDone {
my ( $self, $req ) = @_;
$self->lmLog( "URL detected as an OpenID Connect END SESSION URL",
'debug' );
$req->parseBody if ( $req->method =~ /^post$/i );
$self->lmLog( "User is already logged out", 'debug' );
my $post_logout_redirect_uri = $req->param('post_logout_redirect_uri');
......@@ -1246,7 +1242,6 @@ sub checkSession {
my ( $self, $req ) = @_;
$self->lmLog( "URL detected as an OpenID Connect CHECK SESSION URL",
'debug' );
$req->parseBody if ( $req->method =~ /^post$/i );
my $portalPath = $self->conf->{portal};
$portalPath =~ s#^https?://[^/]+/?#/#;
......
......@@ -147,7 +147,7 @@ sub run {
# if we are receving SAML request or response
my $url = $req->uri;
my $request_method = $req->param('issuerMethod') || $req->method;
my $content_type = $req->contentType();
my $content_type = $req->content_type();
my $idp_initiated = $req->param('IDPInitiated');
my $idp_initiated_sp = $req->param('sp');
my $idp_initiated_spConfKey = $req->param('spConfKey');