Better URL parsing (#2477)

lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build.pm

@@ -9,6 +9,7 @@ use Lemonldap::NG::Manager::Build::CTrees;
 use Lemonldap::NG::Manager::Build::PortalConstants;
 use Lemonldap::NG::Manager::Conf::Zero;
 use Data::Dumper;
+use Regexp::Common 'URI';
 use Regexp::Assemble;
 use JSON;
 use Getopt::Std;
@@ -466,6 +467,7 @@ sub buildPortalConstants() {
 
     printf STDERR $format, $self->portalConstantsFile;
     open( F, '>', $self->portalConstantsFile ) or die($!);
+    my $urire = $RE{URI}{HTTP}{ -scheme=>qr/https?/ }{-keep};
     my $content = <<EOF;
 # This file is generated by $module. Don't modify it by hand
 package Lemonldap::NG::Portal::Main::Constants;
@@ -476,6 +478,7 @@ use Exporter 'import';
 our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';
 
 use constant HANDLER => 'Lemonldap::NG::Handler::PSGI::Main';
+use constant URIRE => qr{$urire};
 use constant {
 EOF
     for my $pe (
@@ -499,7 +502,7 @@ $portalConstsStr
 }
 
 # EXPORTER PARAMETERS
-our \@EXPORT_OK = ( 'portalConsts', 'HANDLER', $exports );
+our \@EXPORT_OK = ( 'portalConsts', 'HANDLER', 'URIRE', $exports );
 our %EXPORT_TAGS = ( 'all' => [ \@EXPORT_OK, 'import' ], );
 
 our \@EXPORT = qw(import PE_OK);

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/CAS.pm

@@ -12,9 +12,10 @@ use Lemonldap::NG::Portal::Main::Constants qw(
   PE_OK
   PE_BADURL
   PE_SENDRESPONSE
+  URIRE
 );
 
-our $VERSION = '2.0.9';
+our $VERSION = '2.0.12';
 
 extends 'Lemonldap::NG::Portal::Main::Issuer',
   'Lemonldap::NG::Portal::Lib::CAS';
@@ -93,8 +94,7 @@ sub storeEnvAndCheckGateway {
         return PE_SENDRESPONSE;
     }
 
-    if ( $service and $service =~ m#^(https?://[^/]+)(/.*)?$# ) {
-        my ( $host, $uri ) = ( $1, $2 );
+    if ( $service and $service =~ URIRE ) {
         my $app = $self->getCasApp($service);
 
         if ($app) {

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/Get.pm

@@ -5,9 +5,9 @@ use Mouse;
 use URI::Escape;
 use Lemonldap::NG::Common::FormEncode;
 use Lemonldap::NG::Portal::Main::Constants
-  qw(PE_OK PE_BADURL PE_GET_SERVICE_NOT_ALLOWED);
+  qw(PE_OK PE_BADURL PE_GET_SERVICE_NOT_ALLOWED URIRE);
 
-our $VERSION = '2.0.9';
+our $VERSION = '2.0.12';
 
 extends 'Lemonldap::NG::Portal::Main::Issuer';
 
@@ -82,11 +82,11 @@ sub computeGetParams {
     # Additional GET variables
     my %getPrms;
     if ( exists $self->conf->{issuerDBGetParameters} ) {
-        unless ( $req->urldc =~ m#^https?://([^/]+)# ) {
+        unless ( $req->urldc =~ URIRE ) {
             $self->logger->error("Malformed url $req->urldc");
             return;
         }
-        my $vhost = $1;
+        my $vhost = $3 . ( $4 ? ":$4" : '' );
         my $prms  = $self->conf->{issuerDBGetParameters}->{$vhost};
         unless ($prms) {
             $self->logger->warn("IssuerGet: $vhost has no configuration");

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Lib/Choice.pm

@@ -9,10 +9,10 @@ with 'Lemonldap::NG::Portal::Lib::OverConf';
 
 our $VERSION = '2.0.11';
 
-has modules => ( is => 'rw', default => sub { {} } );
-has rules   => ( is => 'rw', default => sub { {} } );
-has type    => ( is => 'rw' );
-has catch   => ( is => 'rw', default => sub { {} } );
+has modules    => ( is => 'rw', default => sub { {} } );
+has rules      => ( is => 'rw', default => sub { {} } );
+has type       => ( is => 'rw' );
+has catch      => ( is => 'rw', default => sub { {} } );
 has sessionKey => ( is => 'ro', default => '_choice' );
 
 my $_choiceRules;

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Constants.pm

@@ -7,6 +7,8 @@ use Exporter 'import';
 our $VERSION = '2.0.12';
 
 use constant HANDLER => 'Lemonldap::NG::Handler::PSGI::Main';
+use constant URIRE =>
+qr{(((?^:https?))://((?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-9]*[a-zA-Z0-9]|[a-zA-Z])[.]?)|(?:[0-9]+[.][0-9]+[.][0-9]+[.][0-9]+)))(?::((?:[0-9]*)))?(/(((?:(?:(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*)(?:;(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*))*)(?:/(?:(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*)(?:;(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*))*))*))(?:[?]((?:(?:[;/?:@&=+$,a-zA-Z0-9\-_.!~*'()]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*)))?))?)};
 use constant {
     PE_IDPCHOICE                         => -5,
     PE_SENDRESPONSE                      => -4,
@@ -224,6 +226,7 @@ sub portalConsts {
 our @EXPORT_OK = (
     'portalConsts',
     'HANDLER',
+    'URIRE',
     'PE_IDPCHOICE',
     'PE_SENDRESPONSE',
     'PE_INFO',

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Menu.pm

@@ -5,8 +5,9 @@ package Lemonldap::NG::Portal::Main::Menu;
 use strict;
 use Mouse;
 use Clone 'clone';
+use Lemonldap::NG::Portal::Main::Constants 'URIRE';
 
-our $VERSION = '2.0.8';
+our $VERSION = '2.0.12';
 
 extends 'Lemonldap::NG::Common::Module';
 
@@ -293,11 +294,11 @@ sub _buildApplicationHash {
     my $applications;
 
     # Get application items
-    my $appname = $apphash->{options}->{name}    || $appid;
-    my $appuri  = $apphash->{options}->{uri}     || "";
+    my $appname = $apphash->{options}->{name} || $appid;
+    my $appuri  = $apphash->{options}->{uri}  || "";
     my $appdesc = $apphash->{options}->{description};
     my $applogo = $apphash->{options}->{logo};
-    my $apptip  = $apphash->{options}->{tooltip} || $appname;
+    my $apptip = $apphash->{options}->{tooltip} || $appname;
 
     # Detect sub applications
     my $subapphash;
@@ -393,9 +394,8 @@ sub _filterHash {
             # Check rights
             my $appdisplay = $apphash->{$key}->{options}->{display}
               || "auto";
-            my ( $vhost, $appuri ) =
-              $apphash->{$key}->{options}->{uri} =~ m#^https?://([^/]*)(.*)#;
-            $vhost =~ s/:\d+$//;
+            $apphash->{$key}->{options}->{uri} =~ URIRE;
+            my ( $vhost, $appuri ) = ( $3, $5 );
             $vhost = $self->p->HANDLER->resolveAlias($vhost);
             $appuri ||= '/';
 

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Process.pm

@@ -156,12 +156,16 @@ sub controlUrl {
         }
 
         # Unprotected hosts
-        my ( $proto, $vhost, $appuri ) = $tmp =~ m{^(https?://)([^/#?]*)(.*)};
-        $vhost =~ s/:\d+$//;
+        unless ( $tmp =~ URIRE ) {
+            $self->userLogger->error("Bad URL $tmp");
+            delete $req->{urldc};
+            return PE_BADURL;
+        }
+        my ( $proto, $vhost, $appuri ) = ( $2, $3, $5 );
 
         # Try to resolve alias
         my $originalVhost = $self->HANDLER->resolveAlias($vhost);
-        $vhost = $proto . $originalVhost;
+        $vhost = $proto . '://' . $originalVhost;
         $self->logger->debug( "Required URL (param: "
               . ( $req->param('logout') ? 'HTTP Referer' : 'urldc' )
               . " | value: $tmp | alias: $vhost)" );

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Run.pm

@@ -9,7 +9,7 @@
 #
 package Lemonldap::NG::Portal::Main::Run;
 
-our $VERSION = '2.0.10';
+our $VERSION = '2.0.12';
 
 package Lemonldap::NG::Portal::Main;
 
@@ -886,14 +886,16 @@ sub sendHtml {
     my $csp = $self->csp . "form-action " . $self->conf->{cspFormAction};
     if ( my $url = $req->urldc ) {
         $self->logger->debug("Required urldc : $url");
-        $url =~ s#(https?://[^/]+).*#$1#;
+        $url =~ URIRE;
+        $url = $2 . '://' . $3 . ( $4 ? ":$4" : '' );
         $self->logger->debug("Set CSP form-action with urldc : $url");
         $csp .= " $url";
     }
     my $url = $args{params}->{URL};
     if ( defined $url ) {
         $self->logger->debug("Required Params URL : $url");
-        if ( $url =~ s#(https?://[^/]+).*#$1# ) {
+        if ( $url =~ URIRE ) {
+            $url = $2 . '://' . $3 . ( $4 ? ":$4" : '' );
             $self->logger->debug("Set CSP form-action with Params URL : $url");
             $csp .= " $url";
         }

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Plugins/CDA.pm

@@ -6,9 +6,10 @@ use Lemonldap::NG::Portal::Main::Constants qw(
   PE_APACHESESSIONERROR
   PE_ERROR
   PE_OK
+  URIRE
 );
 
-our $VERSION = '2.0.8';
+our $VERSION = '2.0.12';
 
 extends 'Lemonldap::NG::Common::Module';
 
@@ -25,7 +26,8 @@ sub changeUrldc {
     my ( $self, $req ) = @_;
     my $urldc = $req->{urldc} || '';
     if (    $req->id
-        and $urldc !~ m#^https?://[^/]*$self->{conf}->{domain}(:\d+)?/#oi
+        and $urldc =~ URIRE
+        and $3 !~ m@\Q$self->{conf}->{domain}\E$@oi
         and $self->p->isTrustedUrl($urldc) )
     {
         my $ssl = $urldc =~ /^https/;

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Plugins/RESTServer.pm

@@ -62,6 +62,7 @@ use Lemonldap::NG::Portal::Main::Constants qw(
   PE_OK
   portalConsts
   PE_PASSWORD_OK
+  URIRE
 );
 
 our $VERSION = '2.0.12';
@@ -247,7 +248,7 @@ sub init {
         mysession => { ':sessionType' => 'updateMySession' },
         ['PUT']
       );
-    extends @parents if ($add);
+    extends @parents               if ($add);
     $self->setTypes( $self->conf ) if ( $self->conf->{restSessionServer} );
 
     return 1;
@@ -406,7 +407,8 @@ sub mysession {
           if ( $self->p->checkXSSAttack( 'authorizationfor', $req->urldc ) );
 
         # Split URL
-        my ( $host, $uri ) = ( $req->urldc =~ m#^https?://([^/]+)(/.*)?$# );
+        $req->urldc =~ URIRE;
+        my ( $host, $uri ) = ( $3 . ( $4 ? ":$4" : '' ), $5 );
         $uri ||= '/';
         return $self->p->sendError( $req, "Bad URL $req->{urldc}", 400 )
           unless ($host);

lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Plugins/SOAPServer.pm

@@ -16,6 +16,7 @@ use Mouse;
 use Lemonldap::NG::Portal::Main::Constants qw(
   PE_OK
   PE_FORMEMPTY
+  URIRE
 );
 
 our $VERSION = '2.0.12';
@@ -458,7 +459,7 @@ sub isAuthorizedURI {
     my ( $self, $req, $id, $url ) = @_;
     die 'id is required'  unless ($id);
     die 'uri is required' unless ($url);
-    die 'Bad uri'         unless ( $url =~ m#^https?://([^/]+)(/.*)?$# );
+    die 'Bad uri'         unless ( $url =~ URIRE );
     my ( $host, $uri ) = ( $1, $2 );
 
     # Get user session.

[Maxime Besson]

This change causes a regression in logout. Because $tmp is set to the referer, and referers are not set during redirections. I will commit a fix