#595 in progress

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

@@ -7,6 +7,6 @@ our $VERSION = '2.0.0';
 
 extends 'Lemonldap::NG::Portal::Main::Module';
 
-has authnLevel => (is => 'rw');
+has authnLevel => ( is => 'rw' );
 
 1;

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

@@ -27,8 +27,8 @@ has _authentication => ( is => 'rw' );
 has _userDB         => ( is => 'rw' );
 
 # Macros and groups
-has _macros => (is => 'rw');
-has _groups => (is => 'rw');
+has _macros => ( is => 'rw' );
+has _groups => ( is => 'rw' );
 
 # Lists to store plugins entry-points
 has beforeAuth => (
@@ -91,7 +91,10 @@ sub reloadConf {
     }
 
     # Reinitialize arrays
-    foreach (qw(_macros _groups beforeAuth betweenAuthAndDatas afterDatas forAuthUser)) {
+    foreach (
+        qw(_macros _groups beforeAuth betweenAuthAndDatas afterDatas forAuthUser)
+      )
+    {
         $self->{$_} = [];
     }
 
@@ -160,8 +163,7 @@ sub loadPlugin {
     my ( $self, $plugin ) = @_;
     my $obj;
     return 0
-      unless ( $obj =
-        $self->loadModule("$plugin") );
+      unless ( $obj = $self->loadModule("$plugin") );
     foreach my $sub (
         qw(beforeAuthProcess addSessionData afterAuthProcess forAuthUser))
     {
@@ -177,7 +179,7 @@ sub loadPlugin {
 sub loadModule {
     my ( $self, $module ) = @_;
     my $obj;
-    $module = "Lemonldap::NG::Portal$module" if($module =~/^::/);
+    $module = "Lemonldap::NG::Portal$module" if ( $module =~ /^::/ );
 
     eval "require $module";
     if ($@) {

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

@@ -43,7 +43,7 @@ sub enabledPlugins {
     foreach my $type (qw(password register)) {
         my $tmp = $self->conf->{$type};
         if ( $tmp and $tmp ne 'Null' ) {
-            $tmp = '::'.ucfirst($type) . "DB::$tmp";
+            $tmp = '::' . ucfirst($type) . "DB::$tmp";
             $self->lmLog("$tmp enabled");
             push @res, $tmp;
         }

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

@@ -8,6 +8,28 @@ use MIME::Base64;
 
 our $VERSION = '2.0.0';
 
+# Main method
+# -----------
+# Launch all methods declared in request "steps" array. Methods can be
+# declared by their name (in Lemonldap::NG::Portal::Main namespace) or point
+# to a subroutine (see Lemonldap::NG::Portal::Main::Run.pm)
+
+sub process {
+    my ( $self, $req ) = @_;
+
+    #$req->error(PE_OK);
+    my $err = PE_OK;
+    while ( my $sub = shift @{ $req->steps } ) {
+        if ( ref $sub ) {
+            last if ( $sub->($req) );
+        }
+        else {
+            last if ( $err = $self->$sub($req) );
+        }
+    }
+    return $err;
+}
+
 # First process block: check args
 # -------------------------------
 
@@ -15,6 +37,7 @@ our $VERSION = '2.0.0';
 sub restoreArgs {
     my ( $self, $req ) = @_;
     $req->parseBody;
+    $req->mustRedirect(1);
     return ( %{ $req->params } ? PE_OK : PE_FORMEMPTY );
 }
 
@@ -24,19 +47,20 @@ sub controlUrl {
     $req->datas->{_url} ||= '';
     if ( my $url = $req->param('url') ) {
 
-        # REJECT NON BASE64 URL except for CAS IssuerDB
-        if ( $self->get_module('issuer') ne "CAS" ) {
+        # REJECT NON BASE64 URL
+        if ( $req->urlNotBase64 ) {
+            $req->datas->{urldc} = $url;
+        }
+        else {
             if ( $url =~ m#[^A-Za-z0-9\+/=]# ) {
                 $self->lmLog(
                     "Value must be in BASE64 (param: url | value: $url)",
                     "warn" );
                 return PE_BADURL;
             }
-
             $req->datas->{urldc} = decode_base64($url);
             $req->datas->{urldc} =~ s/[\r\n]//sg;
         }
-        else { $req->datas->{urldc} = $url; }
 
         # For logout request, test if Referer comes from an authorizated site
         my $tmp =
@@ -97,7 +121,8 @@ sub setSessionInfo {
     my ( $self, $req ) = @_;
 
     # Get the current user module
-    $req->{sessionInfo}->{_userDB} = $self->get_module("user");
+    $req->{sessionInfo}->{_auth}   = $self->getModule("auth");
+    $req->{sessionInfo}->{_userDB} = $self->getModule("user");
 
     # Store IP address from remote address or X-FORWARDED-FOR header
     $req->{sessionInfo}->{ipAddr} = $req->remote_ip;
@@ -127,153 +152,153 @@ sub setSessionInfo {
     $req->{sessionInfo}->{_url} = $req->datas->{urldc};
 
     # Call UserDB setSessionInfo
-    return $self->_userDB->setSessionInfo($req) );
+    return $self->_userDB->setSessionInfo($req);
 
     PE_OK;
 }
 
 sub setMacros {
-      my ( $self, $req ) = @_;
-      foreach ( sort keys %{ $self->_macros } ) {
-          $req->{sessionInfo}->{$_} = $self->_macros->{$_}->($req);
-      }
-      PE_OK;
+    my ( $self, $req ) = @_;
+    foreach ( sort keys %{ $self->_macros } ) {
+        $req->{sessionInfo}->{$_} = $self->_macros->{$_}->($req);
+    }
+    PE_OK;
 }
 
 sub setGroups {
-      my ( $self, $req ) = @_;
-      return $self->_userDB->setGroups(@_);
+    my ( $self, $req ) = @_;
+    return $self->_userDB->setGroups(@_);
 }
 
 sub setPersistentSessionInfo {
-      my ( $self, $req ) = @_;
+    my ( $self, $req ) = @_;
 
-      # Do not restore infos if session already opened
-      unless ( $req->{id} ) {
-          my $key = $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
+    # Do not restore infos if session already opened
+    unless ( $req->{id} ) {
+        my $key = $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
 
-          return PE_OK unless ( $key and length($key) );
+        return PE_OK unless ( $key and length($key) );
 
-          my $persistentSession = $self->getPersistentSession($key);
+        my $persistentSession = $self->getPersistentSession($key);
 
-          if ($persistentSession) {
-              $self->lmLog( "Persistent session found for $key", 'debug' );
-              foreach my $k ( keys %{ $persistentSession->data } ) {
+        if ($persistentSession) {
+            $self->lmLog( "Persistent session found for $key", 'debug' );
+            foreach my $k ( keys %{ $persistentSession->data } ) {
 
-                  # Do not restore some parameters
-                  next if $k =~ /^_(?:utime|session_(?:u?id|kind))$/;
-                  $self->lmLog( "Restore persistent parameter $k", 'debug' );
-                  $req->{sessionInfo}->{$k} = $persistentSession->data->{$k};
-              }
-          }
-      }
+                # Do not restore some parameters
+                next if $k =~ /^_(?:utime|session_(?:u?id|kind))$/;
+                $self->lmLog( "Restore persistent parameter $k", 'debug' );
+                $req->{sessionInfo}->{$k} = $persistentSession->data->{$k};
+            }
+        }
+    }
 
-      PE_OK;
+    PE_OK;
 }
 
 sub setLocalGroups {
-      my ( $self, $req ) = @_;
-      foreach ( sort keys %{ $self->_groups } ) {
-          if ( $self->_groups->{$_}->($req) ) )
-            {
-                $req->{sessionInfo}->{groups} .=
-                  $self->conf->{multiValuesSeparator} . $_;
-                $req->{sessionInfo}->{hGroups}->{$_}->{name} = $_;
-          }
-      }
-
-      # Clear values separator at the beginning
-      if ( $req->{sessionInfo}->{groups} ) {
-            $req->{sessionInfo}->{groups} =~
-              s/^\Q$self->conf->{multiValuesSeparator}\E//o;
-      }
-      PE_OK;
+    my ( $self, $req ) = @_;
+    foreach ( sort keys %{ $self->_groups } ) {
+        if ( $self->_groups->{$_}->($req) ) {
+            $req->{sessionInfo}->{groups} .=
+              $self->conf->{multiValuesSeparator} . $_;
+            $req->{sessionInfo}->{hGroups}->{$_}->{name} = $_;
+        }
+    }
+
+    # Clear values separator at the beginning
+    if ( $req->{sessionInfo}->{groups} ) {
+        $req->{sessionInfo}->{groups} =~
+          s/^\Q$self->conf->{multiValuesSeparator}\E//o;
+    }
+    PE_OK;
 }
 
 sub store {
-      my ( $self, $req ) = @_;
-
-      # Now, user is authenticated => inform handler
-      $req->userData( $req->sessionInfo );
-
-      # Create second session for unsecure cookie
-      if ( $self->conf->{securedCookie} == 2 ) {
-          my $session2 = $self->getApacheSession( undef, 1 );
-
-          my %infos = %{ $req->{sessionInfo} };
-          $infos{_httpSessionType} = 1;
-
-          $session2->update( \%infos );
-
-          $req->{sessionInfo}->{_httpSession} = $session2->id;
-      }
-
-      # Main session
-      my $session = $self->getApacheSession( $req->{id}, 0, $self->{force} );
-      return PE_APACHESESSIONERROR unless ($session);
-
-      # Compute unsecure cookie value if needed
-      if ( $self->conf->{securedCookie} == 3 ) {
-          $req->{sessionInfo}->{_httpSession} =
-            $self->conf->{cipher}->encryptHex( $self->{id}, "http" );
-      }
-
-      # Fill session
-      my $infos = {};
-      foreach my $k ( keys %{ $req->{sessionInfo} } ) {
-          next unless defined $req->{sessionInfo}->{$k};
-          my $displayValue = $req->{sessionInfo}->{$k};
-          if ( $self->conf->{hiddenAttributes} =~ /\b$k\b/ ) {
-              $displayValue = '****';
-          }
-          $self->lmLog( "Store $displayValue in session key $k", 'debug' );
-          $self->_dump($displayValue) if ref($displayValue);
-          $infos->{$k} = $self->{sessionInfo}->{$k};
-      }
-      $session->update($infos);
-
-      PE_OK;
+    my ( $self, $req ) = @_;
+
+    # Now, user is authenticated => inform handler
+    $req->userData( $req->sessionInfo );
+
+    # Create second session for unsecure cookie
+    if ( $self->conf->{securedCookie} == 2 ) {
+        my $session2 = $self->getApacheSession( undef, 1 );
+
+        my %infos = %{ $req->{sessionInfo} };
+        $infos{_httpSessionType} = 1;
+
+        $session2->update( \%infos );
+
+        $req->{sessionInfo}->{_httpSession} = $session2->id;
+    }
+
+    # Main session
+    my $session = $self->getApacheSession( $req->{id}, 0, $self->{force} );
+    return PE_APACHESESSIONERROR unless ($session);
+
+    # Compute unsecure cookie value if needed
+    if ( $self->conf->{securedCookie} == 3 ) {
+        $req->{sessionInfo}->{_httpSession} =
+          $self->conf->{cipher}->encryptHex( $self->{id}, "http" );
+    }
+
+    # Fill session
+    my $infos = {};
+    foreach my $k ( keys %{ $req->{sessionInfo} } ) {
+        next unless defined $req->{sessionInfo}->{$k};
+        my $displayValue = $req->{sessionInfo}->{$k};
+        if ( $self->conf->{hiddenAttributes} =~ /\b$k\b/ ) {
+            $displayValue = '****';
+        }
+        $self->lmLog( "Store $displayValue in session key $k", 'debug' );
+        $self->_dump($displayValue) if ref($displayValue);
+        $infos->{$k} = $self->{sessionInfo}->{$k};
+    }
+    $session->update($infos);
+
+    PE_OK;
 }
 
 sub buildCookie {
-      my ( $self, $req ) = @_;
-      push @{ $req->respCookies }, $self->cookie(
-          name     => $self->{cookieName},
-          value    => $self->{id},
-          domain   => $self->{domain},
-          path     => "/",
-          secure   => $self->{securedCookie},
-          HttpOnly => $self->{httpOnly},
-          expires  => $self->{cookieExpiration},
-          @_,
-        );
-      if ( $self->conf->{securedCookie} >= 2 ) {
-          push @{ $req->respCookies },
-            $self->cookie(
-              name     => $self->{cookieName} . "http",
-              value    => $self->{sessionInfo}->{_httpSession},
-              domain   => $self->{domain},
-              path     => "/",
-              secure   => 0,
-              HttpOnly => $self->{httpOnly},
-              expires  => $self->{cookieExpiration},
-              @_,
-            );
-      }
-      PE_OK;
+    my ( $self, $req ) = @_;
+    push @{ $req->respCookies },
+      $self->cookie(
+        name     => $self->{cookieName},
+        value    => $self->{id},
+        domain   => $self->{domain},
+        path     => "/",
+        secure   => $self->{securedCookie},
+        HttpOnly => $self->{httpOnly},
+        expires  => $self->{cookieExpiration},
+        @_,
+      );
+    if ( $self->conf->{securedCookie} >= 2 ) {
+        push @{ $req->respCookies },
+          $self->cookie(
+            name     => $self->{cookieName} . "http",
+            value    => $self->{sessionInfo}->{_httpSession},
+            domain   => $self->{domain},
+            path     => "/",
+            secure   => 0,
+            HttpOnly => $self->{httpOnly},
+            expires  => $self->{cookieExpiration},
+            @_,
+          );
+    }
+    PE_OK;
 }
 
 sub cookie {
-      my ( $self, %h ) = @_;
-      my @res;
-      $req[0] = "$h{name}" or die("name required");
-      my $res[0] .= "=$h{value}";
-      foreach (qw(domain path expires max_age)) {
-          my $f = $_;
-          s/_/-/g;
-          push @res, "$_=$h{$f}" if ( $h{$f} );
-      }
-      return join( '; ', @res );
+    my ( $self, %h ) = @_;
+    my @res;
+    $res[0] = "$h{name}" or die("name required");
+    $res[0] .= "=$h{value}";
+    foreach (qw(domain path expires max_age)) {
+        my $f = $_;
+        s/_/-/g;
+        push @res, "$_=$h{$f}" if ( $h{$f} );
+    }
+    return join( '; ', @res );
 }
 
 1;

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

 package Lemonldap::NG::Portal::Main::Request;
 
+# Developpers, be careful: new() is never called so default values will not be
+# taken in account (see Portal::Run::handler())
+
 use strict;
 use Mouse;
 
 extends 'Lemonldap::NG::Common::PSGI::Request';
 
 # List of methods to call
-has steps       => ( is => 'rw' );
+has steps => ( is => 'rw' );
 
 # Datas shared between methods
-has datas       => ( is => 'rw', default => sub { {} } );
+has datas => ( is => 'rw', default => sub { {} } );
 
 # Session datas when created
 has id          => ( is => 'rw' );
@@ -19,7 +22,13 @@ has sessionInfo => ( is => 'rw' );
 has respCookies => ( is => 'rw' );
 
 # Template to display (if not defined, login or menu)
-has template    => ( is => 'rw' );
+has template => ( is => 'rw' );
+
+# Boolean to indicate that response must be a redirection
+has mustRedirect => ( is => 'rw' );
+
+# Boolean to indicate that url isn't Base64 encoded
+has urlNotBase64 => ( is => 'rw' );
 
 sub wantJSON {
     return $_[0]->accept =~ m#(?:application|text)/json# ? 1 : 0;

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

 ##@class Lemonldap::NG::Portal::Main::Run
 # Serve request part of Lemonldap::NG portal
 #
-# Methods:
-#  - handler(): verify that portal configuration is the same that the
-#               underlying handler configuration before launching
-#               Lemonldap::NG::Common::PSGI::Router::handler() (which parse
-#               routes)
+# Parts of this file:
+#  - response handler
+#  - main entry points
+#  - running methods
+#  - utilities
 #
-# Entry points:
-#  - "/test": - authenticated() for already authenticated users
-#             - pleaseAuth() for others
-#  - "/":     - login() ~first access
-#             - postLogin(), same for POST requests
-#             - authenticatedRequest() for authenticated users
 package Lemonldap::NG::Portal::Main::Run;
 
 use strict;
@@ -22,6 +16,21 @@ use Lemonldap::NG::Portal::Main::Request;
 
 our $VERSION = '2.0.0';
 
+# List constants
+sub authProcess { qw(extractFormInfo getUser authenticate) }
+
+sub sessionDatas {
+    qw(setSessionInfo setMacros setGroups setPersistentSessionInfo
+      setLocalGroups store buildCookie);
+}
+
+# RESPONSE HANDLER
+# ----------------
+#
+# - check if conf has changed
+# - replace Lemonldap::NG::Common::PSGI::Request request by
+#   Lemonldap::NG::Portal::Main::Request
+# - launch Lemonldap::NG::Common::PSGI::Request::handler()
 sub handler {
     my ( $self, $req ) = shift;
     unless ($self->conf->{cfgNum}
@@ -33,9 +42,16 @@ sub handler {
     return $self->SUPER::handler($req);
 }
 
-# CORE REST API
+# MAIN ENTRY POINTS (declared in Lemonldap::NG::Portal::Main::Init)
+# -----------------
+#
+# Entry points:
+#  - "/test": - authenticated() for already authenticated users
+#             - pleaseAuth() for others
+#  - "/":     - login() ~first access
+#             - postLogin(), same for POST requests
+#             - authenticatedRequest() for authenticated users
 
-# Methods that handle /test
 sub authenticated {
     my ( $self, $req ) = @_;
     return $self->sendJSONresponse( $req, { status => 1 } );
@@ -46,15 +62,6 @@ sub pleaseAuth {
     return $self->sendJSONresponse( $req, { status => 0 } );
 }
 
-# MAIN ENTRY POINTS
-
-# List constants
-sub authProcess { qw(extractFormInfo getUser authenticate) }
-
-sub sessionDatas {
-    qw(setSessionInfo setMacros setGroups setPersistentSessionInfo
-      setLocalGroups store buildCookie);
-}
 
 sub login {
     my ( $self, $req ) = @_;
@@ -73,9 +80,10 @@ sub postLogin {
     return $req->do(
         $req,
         [
-            'restoreArgs', 'controlUrl' @{ $self->beforeAuth },
-            &authProcess,  @{ $self->betweenAuthAndDatas },
-            &sessionDatas, @{ $self->afterdatas },
+            'restoreArgs',                   'controlUrl',
+            @{ $self->beforeAuth },          &authProcess,
+            @{ $self->betweenAuthAndDatas }, &sessionDatas,
+            @{ $self->afterdatas },
         ]
     );
 }
@@ -85,6 +93,9 @@ sub authenticatedRequest {
     return $req->do( $req, $self->forAuthUser );
 }
 
+# RUNNING METHODS
+# ---------------
+
 sub do {
     my ( $self, $req, $steps ) = @_;
     $req->steps($steps);
@@ -117,18 +128,32 @@ sub do {
     }
 }
 
-sub process {
-    my ( $self, $req ) = @_;
-
-    #$req->error(PE_OK);
-    my $err = PE_OK;
-    while ( my $sub = shift @{ $req->steps } ) {
-        last if ( $err = $self->$sub($req) );
+# Utilities
+# ---------
+
+sub getModule {
+    my ( $self, $req, $type ) = @_;
+    if (
+        my $mod = {
+            auth     => '_authentication',
+            user     => '_userDB',
+            password => '_passwordDB'
+        }->{$type}
+      )
+    {
+        if ( $self->$mod->can('name') ) {
+            return $self->$mod->can('name');
+        }
+        else {
+            return ref( $self->$mod );
+        }
+    }
+    elsif ( $type eq 'issuer' ) {
+        return $req->{_activeIssuerDB};
+    }
+    else {
+        die "Unknown type $type";
     }
-    return $err;
 }
 
-# TODO in run
-#  - mustRedirect
-
 1;