##@file # Base package for Lemonldap::NG portal ##@class Lemonldap::NG::Portal::Simple # Base class for Lemonldap::NG portal package Lemonldap::NG::Portal::Simple; use strict; use warnings; use Exporter 'import'; use warnings; use MIME::Base64; use Lemonldap::NG::Common::CGI; use CGI::Cookie; require POSIX; use Lemonldap::NG::Portal::_i18n; #inherits use Lemonldap::NG::Common::Safelib; #link protected safe Safe object use Lemonldap::NG::Common::Apache::Session ; #link protected session Apache::Session object use Safe; # Special comments for doxygen #inherits Lemonldap::NG::Portal::_SOAP #inherits Lemonldap::NG::Portal::AuthApache #inherits Lemonldap::NG::Portal::AuthDBI #inherits Lemonldap::NG::Portal::AuthCAS #inherits Lemonldap::NG::Portal::AuthLDAP #inherits Lemonldap::NG::Portal::AuthRemote #inherits Lemonldap::NG::Portal::AuthSSL #inherits Lemonldap::NG::Portal::Menu #link Lemonldap::NG::Portal::Notification protected notification #inherits Lemonldap::NG::Portal::UserDBDBI #inherits Lemonldap::NG::Portal::UserDBEnv #inherits Lemonldap::NG::Portal::UserDBLDAP #inherits Lemonldap::NG::Portal::UserDBRemote #inherits Lemonldap::NG::Portal::PasswordDBDBI #inherits Lemonldap::NG::Portal::PasswordDBLDAP #inherits Apache::Session #link Lemonldap::NG::Common::Apache::Session::SOAP protected globalStorage our $VERSION = '0.91'; use base qw(Lemonldap::NG::Common::CGI Exporter); our @ISA; # Constants use constant { # Portal errors # Developers warning, do not use PE_INFO, it's reserved to autoRedirect. # If you want to send an information, use $self->info('text'). PE_IMG_NOK => -5, PE_IMG_OK => -4, PE_INFO => -3, PE_REDIRECT => -2, PE_DONE => -1, PE_OK => 0, PE_SESSIONEXPIRED => 1, PE_FORMEMPTY => 2, PE_WRONGMANAGERACCOUNT => 3, PE_USERNOTFOUND => 4, PE_BADCREDENTIALS => 5, PE_LDAPCONNECTFAILED => 6, PE_LDAPERROR => 7, PE_APACHESESSIONERROR => 8, PE_FIRSTACCESS => 9, PE_BADCERTIFICATE => 10, PE_PP_ACCOUNT_LOCKED => 21, PE_PP_PASSWORD_EXPIRED => 22, PE_CERTIFICATEREQUIRED => 23, PE_ERROR => 24, PE_PP_CHANGE_AFTER_RESET => 25, PE_PP_PASSWORD_MOD_NOT_ALLOWED => 26, PE_PP_MUST_SUPPLY_OLD_PASSWORD => 27, PE_PP_INSUFFICIENT_PASSWORD_QUALITY => 28, PE_PP_PASSWORD_TOO_SHORT => 29, PE_PP_PASSWORD_TOO_YOUNG => 30, PE_PP_PASSWORD_IN_HISTORY => 31, PE_PP_GRACE => 32, PE_PP_EXP_WARNING => 33, PE_PASSWORD_MISMATCH => 34, PE_PASSWORD_OK => 35, PE_NOTIFICATION => 36, PE_BADURL => 37, PE_NOSCHEME => 38, PE_BADOLDPASSWORD => 39, PE_MALFORMEDUSER => 40, PE_SESSIONNOTGRANTED => 41, PE_CONFIRM => 42, PE_MAILFORMEMPTY => 43, PE_BADMAILTOKEN => 44, PE_MAILERROR => 45, PE_MAILOK => 46, PE_LOGOUT_OK => 47, # Portal messages PM_USER => 0, PM_DATE => 1, PM_IP => 2, PM_SESSIONS_DELETED => 3, PM_OTHER_SESSIONS => 4, PM_REMOVE_OTHER_SESSIONS => 5, PM_PP_GRACE => 6, PM_PP_EXP_WARNING => 7, PM_SAML_IDPSELECT => 8, PM_SAML_IDPCHOOSEN => 9, PM_REMEMBERCHOICE => 10, PM_SAML_SPLOGOUT => 11, PM_REDIRECTION => 12, }; # EXPORTER PARAMETERS our @EXPORT = qw( PE_IMG_NOK PE_IMG_OK PE_INFO PE_REDIRECT PE_DONE PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS PE_BADCERTIFICATE PE_PP_ACCOUNT_LOCKED PE_PP_PASSWORD_EXPIRED PE_CERTIFICATEREQUIRED PE_ERROR PE_PP_CHANGE_AFTER_RESET PE_PP_PASSWORD_MOD_NOT_ALLOWED PE_PP_MUST_SUPPLY_OLD_PASSWORD PE_PP_INSUFFICIENT_PASSWORD_QUALITY PE_PP_PASSWORD_TOO_SHORT PE_PP_PASSWORD_TOO_YOUNG PE_PP_PASSWORD_IN_HISTORY PE_PP_GRACE PE_PP_EXP_WARNING PE_PASSWORD_MISMATCH PE_PASSWORD_OK PE_NOTIFICATION PE_BADURL PE_NOSCHEME PE_BADOLDPASSWORD PE_MALFORMEDUSER PE_SESSIONNOTGRANTED PE_CONFIRM PE_MAILFORMEMPTY PE_BADMAILTOKEN PE_MAILERROR PE_MAILOK PE_LOGOUT_OK PM_USER PM_DATE PM_IP PM_SESSIONS_DELETED PM_OTHER_SESSIONS PM_REMOVE_OTHER_SESSIONS PM_PP_GRACE PM_PP_EXP_WARNING PM_SAML_IDPSELECT PM_SAML_IDPCHOOSEN PM_REMEMBERCHOICE PM_SAML_SPLOGOUT PM_REDIRECTION ); our %EXPORT_TAGS = ( 'all' => [ @EXPORT, 'import' ], ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); # Secure jail our $safe; our $self; # Safe cannot share a variable declared with my ##@cmethod Lemonldap::NG::Portal::Simple new(hashRef args) # Class constructor. #@param args hash reference #@return Lemonldap::NG::Portal::Simple object sub new { @ISA = qw(Lemonldap::NG::Common::CGI Exporter); binmode( STDOUT, ":utf8" ); my $class = shift; return $class if ( ref($class) ); my $self = $class->SUPER::new(); # Reinit _url $self->{_url} = ''; # Get global configuration $self->getConf(@_) or $self->abort( "Configuration error", "Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" ); # Default values $self->setDefaultValues(); # Test mandatory elements $self->abort( "Configuration error", "You've to indicate a an Apache::Session storage module !" ) unless ( $self->{globalStorage} ); eval "require " . $self->{globalStorage}; $self->abort( "Configuration error", "Module " . $self->{globalStorage} . " not found in \@INC" ) if ($@); if ( $self->{samlStorage} ne $self->{globalStorage} ) { eval "require " . $self->{samlStorage}; $self->abort( "Configuration error", "Module " . $self->{samlStorage} . " not found in \@INC" ) if ($@); } $self->abort( "Configuration error", "You've to indicate a domain for cookies" ) unless ( $self->{domain} ); $self->{domain} =~ s/^([^\.])/.$1/; # Rules to allow redirection $self->{mustRedirect} = ( ( $ENV{REQUEST_METHOD} eq 'POST' and not $self->param('newpassword') ) or $self->param('logout') ) ? 1 : 0; # Push authentication/userDB/passwordDb/issuerDB modules in @ISA foreach (qw(authentication userDB passwordDB issuerDB)) { my $module_name = 'Lemonldap::NG::Portal::'; my $db_type = $_; my $db_name = $self->{$db_type}; # Adapt module type to real module name $db_type =~ s/authentication/Auth/; $db_type =~ s/userDB/UserDB/; $db_type =~ s/passwordDB/PasswordDB/; $db_type =~ s/issuerDB/IssuerDB/; # Full module name $module_name .= $db_type . $db_name; # Remove white spaces $module_name =~ s/\s.*$//; # Try to load module $self->abort( "Configuration error", "Unable to load $module_name" ) unless $self->loadModule($module_name); # $self->{authentication} and $self->{userDB} can contains arguments # (key1 = scalar_value; key2 = ...) unless ( $db_name =~ /^Multi/ ) { $db_name =~ s/^\w+\s*//; my %h = split( /\s*[=;]\s*/, $db_name ) if ($db_name); %$self = ( %h, %$self ); } } # Notifications if ( $self->{notification} ) { require Lemonldap::NG::Portal::Notification; my $tmp; if ( $self->{notificationStorage} ) { $tmp = $self->{notificationStorage}; } else { (%$tmp) = ( %{ $self->{lmConf} } ); $self->abort( "notificationStorage not defined", "This parameter is required to use notification system" ) unless ( ref($tmp) ); $tmp->{type} =~ s/.*:://; $tmp->{table} = 'notifications'; } $tmp->{p} = $self; $self->{notifObject} = Lemonldap::NG::Portal::Notification->new($tmp); $self->abort($Lemonldap::NG::Portal::Notification::msg) unless ( $self->{notifObject} ); } # SOAP if ( $self->{Soap} or $self->{soap} ) { require Lemonldap::NG::Portal::_SOAP; push @ISA, 'Lemonldap::NG::Portal::_SOAP'; if ( $self->{notification} ) { $self->{CustomSOAPServices}->{'/notification'} = 'newNotification'; } $self->startSoapServices(); } # Trusted domains unless ( defined( $self->{trustedDomains} ) ) { $self->{trustedDomains} = $self->{domain}; } if ( $self->{trustedDomains} eq '*' ) { $self->{trustedDomains} = '|\w[\w\-\.]*\w'; } elsif ( $self->{trustedDomains} ) { $self->{trustedDomains} = '|(?:[^/]*)?(?:' . join( '|', ( map { s/\./\\\./g; $_ } split /\s+/, $self->{trustedDomains} ) ) . ')'; } return $self; } ##@method boolean loadModule(string module) # Load a module into portal namespace # @param module module name # @return boolean sub loadModule { my $self = shift; my $module = shift; return 1 unless $module; # Load module test eval "require $module"; if ($@) { $self->lmLog( "$module load error: $@", 'error' ); return 0; } # Push module in @ISA push @ISA, $module; return 1; } ##@method protected boolean getConf(hashRef args) # Copy all parameters in caller object. #@param args hash-ref #@return True sub getConf { my ($self) = shift; my %args; if ( ref( $_[0] ) ) { %args = %{ $_[0] }; } else { %args = @_; } %$self = ( %$self, %args ); 1; } ##@method protected void setDefaultValues() # Set default values. sub setDefaultValues { my $self = shift; $self->{portal} ||= "http" . ( $ENV{HTTPS} ? 's' : '' ) . '://' . $self->server_name(); $self->{whatToTrace} ||= 'uid'; $self->{whatToTrace} =~ s/^\$//; $self->{httpOnly} = 1 unless ( defined( $self->{httpOnly} ) ); $self->{portalSkin} ||= 'pastel'; $self->{portalDisplayLogout} = 1 unless ( defined( $self->{portalDisplayLogout} ) ); $self->{portalDisplayResetPassword} = 1 unless ( defined( $self->{portalDisplayResetPassword} ) ); $self->{portalDisplayChangePassword} = 1 unless ( defined( $self->{portalDisplayChangePassword} ) ); $self->{portalDisplayAppslist} = 1 unless ( defined( $self->{portalDisplayAppslist} ) ); $self->{portalAutocomplete} ||= "off"; $self->{portalRequireOldPassword} = 1 unless ( defined( $self->{portalRequireOldPassword} ) ); $self->{portalOpenLinkInNewWindow} = 0 unless ( defined( $self->{portalOpenLinkInNewWindow} ) ); $self->{portalForceAuthn} = 0 unless ( defined( $self->{portalForceAuthn} ) ); $self->{portalForceAuthnInterval} = 5 unless ( defined( $self->{portalForceAuthnInterval} ) ); $self->{portalUserAttr} ||= "_user"; $self->{portalHiddenFormValues} = (); $self->{securedCookie} ||= 0; $self->{cookieName} ||= "lemonldap"; $self->{authentication} ||= 'LDAP'; $self->{authentication} =~ s/^ldap/LDAP/; $self->{SMTPServer} ||= 'localhost'; $self->{mailLDAPFilter} ||= '(&(mail=$mail)(objectClass=inetOrgPerson))'; $self->{randomPasswordRegexp} ||= '[A-Z]{3}[a-z]{5}.\d{2}'; $self->{mailFrom} ||= "noreply@" . $self->{domain}; $self->{mailSubject} ||= "[LemonLDAP::NG] Your new password"; $self->{mailConfirmSubject} ||= "[LemonLDAP::NG] Password reset confirmation"; $self->{mailSessionKey} ||= 'mail'; $self->{mailUrl} ||= $self->{portal} . "/mail.pl"; $self->{issuerDB} ||= 'Null'; $self->{multiValuesSeparator} ||= '; '; # Set default userDB and passwordDB to DBI if authentication is DBI if ( $self->{authentication} =~ /DBI/i ) { $self->{userDB} ||= "DBI"; $self->{passwordDB} ||= "DBI"; } # Set default userDB and passwordDB to Null if authentication is Null if ( $self->{authentication} =~ /Null/i ) { $self->{userDB} ||= "Null"; $self->{passwordDB} ||= "Null"; } else { # Default to LDAP $self->{userDB} ||= "LDAP"; $self->{passwordDB} ||= "LDAP"; } # LDAP $self->{ldapGroupObjectClass} ||= "groupOfNames"; $self->{ldapGroupAttributeName} ||= "member"; $self->{ldapGroupAttributeNameUser} ||= "dn"; $self->{ldapGroupAttributeNameGroup} ||= "dn"; $self->{ldapGroupAttributeNameSearch} ||= ["cn"]; $self->{ldapGroupRecursive} ||= 0; # SAML $self->{samlIdPResolveCookie} ||= $self->{cookieName} . "idp"; $self->{samlStorage} ||= $self->{globalStorage}; $self->{samlStorageOptions} ||= $self->{globalStorageOptions}; $self->{samlMetadataForceUTF8} = 1 unless ( defined( $self->{samlMetadataForceUTF8} ) ); } ##@method protected void setHiddenFormValue(string fieldname, string value) # Add element into $self->{portalHiddenFormValues}, those values could be # used to hide values into HTML form. #@param $fieldname The field name which will contain the correponding value #@param $value The associated value sub setHiddenFormValue { my $self = shift; my $key = shift; my $val = shift; if ($val) { $key = 'lmhidden_' . $key; $self->{portalHiddenFormValues}->{$key} = encode_base64($val); } } ##@method public void getHiddenFormValue(string fieldname) # Get value into $self->{portalHiddenFormValues}. #@param $fieldname The existing field name which contains a value #@return string The associated value sub getHiddenFormValue { my $self = shift; my $key = shift; $key = 'lmhidden_' . $key; if ( my $val = $self->param($key) ) { return decode_base64($val); } return undef; } ##@method public string buildHiddenForm() # Return an HTML representation of hidden values. #@return string sub buildHiddenForm { my $self = shift; my @keys = keys %{ $self->{portalHiddenFormValues} }; my $val = ''; foreach (@keys) { $val .= ''; } return $val; } =begin WSDL _IN lang $string Language _IN code $int Error code _RETURN $string Error string =end WSDL =cut ##@method string error(string lang) # error calls Portal/_i18n.pm to display error in the wanted language. #@param $lang optional (browser language is used instead) #@return error message sub error { my $self = shift; my $lang = shift || $ENV{HTTP_ACCEPT_LANGUAGE}; my $code = shift || $self->{error}; my $tmp = &Lemonldap::NG::Portal::_i18n::error( $code, $lang ); return ( $ENV{HTTP_SOAPACTION} ? SOAP::Data->name( result => $tmp )->type('string') : $tmp ); } ##@method string error_type(int code) # error_type tells if error is positive, warning or negative # @param $code Lemonldap::NG error code # @return "positive", "warning" or "negative" sub error_type { my $self = shift; my $code = shift || $self->{error}; # Positive errors return "positive" if ( scalar( grep { /^$code$/ } ( PE_REDIRECT, PE_DONE, PE_OK, PE_PASSWORD_OK, PE_MAILOK, PE_LOGOUT_OK, ) ) ); # Warning errors return "warning" if ( scalar( grep { /^$code$/ } ( PE_INFO, PE_SESSIONEXPIRED, PE_FORMEMPTY, PE_FIRSTACCESS, PE_PP_GRACE, PE_PP_EXP_WARNING, PE_NOTIFICATION, PE_BADURL, PE_CONFIRM, PE_MAILFORMEMPTY, ) ) ); # Negative errors (default) return "negative"; } ##@method void header() # Overload CGI::header() to add Lemonldap::NG cookie. sub header { my $self = shift; if ( $self->{cookie} ) { $self->SUPER::header( @_, -cookie => $self->{cookie} ); } else { $self->SUPER::header(@_); } } ##@method void redirect() # Overload CGI::redirect() to add Lemonldap::NG cookie. sub redirect { my $self = shift; if ( $self->{cookie} ) { $self->SUPER::redirect( @_, -cookie => $self->{cookie} ); } else { $self->SUPER::redirect(@_); } } ## @method protected hashref getApacheSession(string id) # Try to recover the session corresponding to id and return session datas. # If $id is set to undef, return a new session. # @param $id session reference sub getApacheSession { my ( $self, $id, $noInfo ) = @_; my %h; # Trying to recover session from global session storage eval { tie %h, $self->{globalStorage}, $id, $self->{globalStorageOptions}; }; if ( $@ or not tied(%h) ) { # Session not available (expired ?) if ($id) { $self->lmLog( "Session $id isn't yet available ($ENV{REMOTE_ADDR})", 'info' ); } else { $self->lmLog( "Unable to create new session: $@", 'error' ); } return 0; } unless ($noInfo) { $self->setApacheUser( $h{ $self->{whatToTrace} } ) if ($id); $self->{id} = $h{_session_id}; } return \%h; } ## @method void updateSession(hashRef infos, string id) # Update session stored. # If no id is given, try to get it from cookie. # If the session is available, update datas with $info. # @param infos hash reference of information to update # @param id Session ID # @return nothing sub updateSession { # TODO: update all caches my ( $self, $infos, $id ) = splice @_; my %cookies = fetch CGI::Cookie; # Session ID unless ($id) { $id = $cookies{ $self->{cookieName} }->value if defined $cookies{ $self->{cookieName} }; } if ($id) { my $h = $self->getApacheSession($id) or return undef; # Store/update session values foreach ( keys %$infos ) { $h->{$_} = $infos->{$_}; } # Store updateTime $h->{updateTime} = &POSIX::strftime( "%Y%m%d%H%M%S", localtime() ); untie %$h; } } ## @method string getFirstValue(string value) # Get the first value of a multivaluated session value # @param value the complete value # @return first value sub getFirstValue { my ( $self, $value ) = splice @_; my @values = split /\Q$self->{multiValuesSeparator}\E/, $value; return $values[0]; } ##@method protected int _subProcess(array @subs) # Execute methods until an error is returned. # If $self->{$sub} exists, launch it, else launch $self->$sub #@param @subs array list of subroutines #@return Lemonldap::NG::Portal error sub _subProcess { my $self = shift; my @subs = @_; my $err = undef; foreach my $sub (@subs) { last if ( $err = $self->_sub($sub) ); } return $err; } ##@method protected void updateStatus() # Inform status mechanism module. # If an handler is launched on the same server with "status=>1", inform the # status module with the result (portal error). sub updateStatus { my $self = shift; print $Lemonldap::NG::Handler::Simple::statusPipe ( $self->{user} ? $self->{user} : $ENV{REMOTE_ADDR} ) . " => $ENV{SERVER_NAME}$ENV{SCRIPT_NAME} " . $self->{error} . "\n" if ($Lemonldap::NG::Handler::Simple::statusPipe); } ##@method protected string notification() #@return Notification stored by checkNotification() sub notification { my $self = shift; return $self->{_notification}; } ##@method protected string get_url() # Return url parameter # @return url parameter if good, nothing else. sub get_url { my $self = shift; return $self->{_url}; } ##@method protected string get_user() # Return user parameter # @return user parameter if good, nothing else. sub get_user { my $self = shift; return "" unless $self->{user}; return $self->{user} unless ( $self->{user} =~ m/(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/ ); $self->lmLog( "XSS attack detected (param: user | value: " . $self->{user} . ")", "warn" ); return ""; } ## @method string get_module(string type) # Return current used module # @param type auth/user/password/issuer # @return module name sub get_module { my ( $self, $type ) = splice @_; if ( $type =~ /auth/i ) { if ( defined $self->{_multi}->{stack}->[0] ) { return $self->{_multi}->{stack}->[0]->[0]->{n}; } else { return $self->{authentication}; } } if ( $type =~ /user/i ) { if ( defined $self->{_multi}->{stack}->[1] ) { return $self->{_multi}->{stack}->[1]->[0]->{n}; } else { return $self->{userDB}; } } if ( $type =~ /password/i ) { return $self->{passwordDB}; } if ( $type =~ /issuer/i ) { return $self->{issuerDB}; } return; } ##@method private Safe safe() # Provide the security jail. #@return Safe object sub safe { my $self = shift; return $safe if ($safe); $safe = new Safe; my @t = $self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : (); foreach (@t) { my $sub = $_; unless (/::/) { $sub = ref($self) . "::$_"; } else { s/^.*:://; } next if ( $self->can($_) ); eval "sub $_ { return $sub( '$self->{portal}', \@_ ); }"; $self->lmLog( $@, 'error' ) if ($@); } $safe->share_from( 'main', ['%ENV'] ); $safe->share_from( 'Lemonldap::NG::Common::Safelib', $Lemonldap::NG::Common::Safelib::functions ); $safe->share( '&encode_base64', @t ); return $safe; } ##@method private boolean _deleteSession(Apache::Session* h, boolean preserveCookie) # Delete an existing session. If "securedCookie" is set to 2, the http session # will also be removed. # @param h tied Apache::Session object # @param preserveCookie do not delete cookie # @return True if session has been deleted sub _deleteSession { my ( $self, $h, $preserveCookie ) = @_; my $result = 1; # Return false if $h is not a hashref if ( ref $h ne "HASH" ) { $self->lmLog( "_deleteSession: \$h is not a session object", 'error' ); return 0; } # Try to find a linked http session (securedCookie=>2) if ( my $id2 = $h->{_httpSession} ) { if ( my $h2 = $self->getApacheSession( $id2, 1 ) ) { # Try to purge local cache # (if an handler is running on the same server) eval { $self->{lmConf}->{refLocalStorage}->remove($id2); }; eval { tied(%$h2)->delete() }; $self->lmLog( $@, 'error' ) if ($@); # Create an obsolete cookie to remove it push @{ $self->{cookie} }, $self->cookie( -name => $self->{cookieName} . 'http', -value => 0, -domain => $self->{domain}, -path => "/", -secure => 0, -expires => '-1d', @_, ); } } my $logged_user = $h->{ $self->{whatToTrace} }; # Try to purge local cache # (if an handler is running on the same server) eval { $self->{lmConf}->{refLocalStorage}->remove( $h->{_session_id} ); }; eval { tied(%$h)->delete() }; if ($@) { $self->lmLog( $@, 'error' ); $result = 0; } # Create an obsolete cookie to remove it push @{ $self->{cookie} }, $self->cookie( -name => $self->{cookieName}, -value => 0, -domain => $self->{domain}, -path => "/", -secure => 0, -expires => '-1d', @_, ) unless ($preserveCookie); # Log $self->_sub( 'userNotice', "User $logged_user has been disconnected" ) if $logged_user; # Return the result of tied(%$h)->delete() return $result; } ##@method private void _dump( variable ) # Dump variable in debug mode # @param $variable # @return void sub _dump { my $self = shift; my $variable = shift; require Data::Dumper; $self->lmLog( "Dump: " . Data::Dumper::Dumper($variable), 'debug' ); return; } ##@method protected string info(string t) # Get or set info to display to the user. # @param $t optional text to store # @return HTML text to display sub info { my ( $self, $t ) = @_; $self->{_info} .= $t if ( defined $t ); return $self->{_info}; } ##@method public void printImage(string file, string type) # Print image to STDOUT # @param $file The path to the file to print # @param $type The content-type to use (ie: image/png) # @return void sub printImage { my ( $self, $file, $type ) = @_; binmode STDOUT; unless ( open( IMAGE, '<', $file ) ) { $self->lmLog( "Could not display image '$file'", 'error' ); return; } print $self->header( $type . '; charset=utf-8; content-length=' . ( stat($file) )[10] ); my $buffer = ""; while ( read( IMAGE, $buffer, 4096 ) ) { print $buffer; } close(IMAGE); } ############################################################### # MAIN subroutine: call all steps until one returns something # # different than PE_OK # ############################################################### ##@method boolean process() # Main method calling functions issued from: # - itself: # - controlUrlOrigin # - checkNotifBack # - controlExistingSession # - setMacros # - setLocalGroups # - removeOther # - grantSession # - store # - buildCookie # - checkNotification # - autoRedirect # - updateStatus # - authentication module: # - authInit # - extractFormInfo # - setAuthSessionInfo # - authenticate # - authFinish # - userDB module: # - userDBInit # - getUser # - setSessionInfo # - setGroups # - passwordDB module: # - passwordDBInit # - modifyPassword # - issuerDB module: # - issuerDBInit # - issuerForUnAuthUser # - issuerForAuthUser # #@return 1 if all is OK, 0 if session isn't created or a notification has to be done sub process { my ($self) = @_; $self->{error} = PE_OK; $self->{error} = $self->_subProcess( qw(controlUrlOrigin checkNotifBack controlExistingSession issuerDBInit issuerForUnAuthUser authInit extractFormInfo userDBInit getUser setAuthSessionInfo passwordDBInit modifyPassword setSessionInfo setMacros setLocalGroups setGroups authenticate removeOther grantSession store authFinish buildCookie checkNotification issuerForAuthUser autoRedirect) ); $self->updateStatus; return ( ( $self->{error} > 0 ) ? 0 : 1 ); } ##@apmethod int controlUrlOrigin() # If the user was redirected here, loads 'url' parameter. #@return Lemonldap::NG::Portal constant sub controlUrlOrigin { my $self = shift; $self->{_url} ||= ''; if ( my $url = $self->param('url') ) { # REJECT NON BASE64 URL if ( $url =~ m#[^A-Za-z0-9\+/=]# ) { $self->lmLog( "XSS attack detected (param: url | value: $url)", "warn" ); return PE_BADURL; } $self->{urldc} = decode_base64($url); $self->{urldc} =~ s/[\r\n]//sg; # For logout request, test if Referer comes from an authorizated site my $tmp = ( $self->param('logout') ? $ENV{HTTP_REFERER} : $self->{urldc} ); # REJECT [\0<'"`] in URL or encoded '%' and non protected hosts if ( $self->{urldc} =~ /(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/ or ( $tmp and $tmp !~ /^https?:\/\/(?:$self->{reVHosts}$self->{trustedDomains})(?::\d+)?(?:\/.*)?$/o ) ) { $self->lmLog( "XSS attack detected (param: " . ( $self->param('logout') ? 'HTTP Referer' : 'urldc' ) . " | value: $tmp)", "warn" ); delete $self->{urldc}; return PE_BADURL; } $self->{_url} = $url; } PE_OK; } ##@apmethod int checkNotifBack() # Checks if a message has been notified to the connected user. # Call Lemonldap::NG::Portal::Notification::checkNotification() #@return Lemonldap::NG::Portal error code sub checkNotifBack { my $self = shift; if ( $self->{notification} and grep( /^reference/, $self->param() ) ) { unless ( $self->{notifObject}->checkNotification($self) ) { $self->{_notification} = $self->{notifObject}->getNotification($self); return PE_NOTIFICATION; } else { $self->{error} = $self->_subProcess( qw(checkNotification issuerDBInit issuerForAuthUser autoRedirect) ); return $self->{error} || PE_DONE; } } PE_OK; } ##@apmethod int controlExistingSession(string id) # Control existing sessions. # To overload to control what to do with existing sessions. # what to do with existing sessions ? # - nothing: user is authenticated and process returns true (default) # - delete and create a new session (not implemented) # - re-authentication (set portalForceAuthn to 1) #@param $id optional value of the session-id else cookies are examinated. #@return Lemonldap::NG::Portal constant sub controlExistingSession { my ( $self, $id ) = @_; my %cookies; %cookies = fetch CGI::Cookie unless ($id); # Test if Lemonldap::NG cookie is available if ( $id or ( $cookies{ $self->{cookieName} } and $id = $cookies{ $self->{cookieName} }->value ) ) { my $h = $self->getApacheSession($id) or return PE_OK; %{ $self->{sessionInfo} } = %$h; # Logout if required if ( $self->param('logout') ) { # Delete session in global storage unless ( $self->_deleteSession($h) ) { $self->lmLog( "Unable to delete session $id", 'error' ); return PE_ERROR; } # Call issuerDB logout eval { $self->{error} = $self->_subProcess(qw(issuerDBInit issuerLogout)); }; if ($@) { $self->lmLog( "Error when calling issuerLogout: $@", 'debug' ); } return $self->{error} if $self->{error} > 0; # Call authentication logout eval { $self->{error} = $self->_sub('authLogout'); }; if ($@) { $self->lmLog( "Error when calling authLogout: $@", 'debug' ); } return $self->{error} if $self->{error} > 0; # Redirect or Post if asked by authLogout $self->_subProcess(qw(autoRedirect)) if ( $self->{urldc} and $self->{urldc} ne $self->{portal} ); $self->_subProcess(qw(autoPost)) if ( $self->{postUrl} ); # Display logout message return PE_LOGOUT_OK; } # If the user wants to purge other sessions elsif ( $self->param('removeOther') ) { $self->{notifyDeleted} = 1; $self->{singleSession} = 1; $self->_sub( 'removeOther', $id ); } untie %$h; $self->{id} = $id; # A session has been find => calling &existingSession my $r = $self->_sub( 'existingSession', $id, $self->{sessionInfo} ); if ( $r == PE_DONE ) { $self->{error} = $self->_subProcess( qw(checkNotification issuerDBInit issuerForAuthUser autoRedirect) ); return $self->{error} || PE_DONE; } else { return $r; } } PE_OK; } ## @method int existingSession() # Launched by controlExistingSession() to know what to do with existing # sessions. # Can return: # - PE_DONE: session is unchanged and process() return true # - PE_OK: process() return false to display the form #@return Lemonldap::NG::Portal constant sub existingSession { my $self = shift; my $forceAuthn; # Check portalForceAuthn parameter # and authForce method eval { $forceAuthn = $self->authForce(); }; if ($@) { $self->lmLog( "Error when calling authForce: $@", 'debug' ); } $forceAuthn = 1 if ( $self->{portalForceAuthn} ); if ($forceAuthn) { my $referer = $self->referer(); my $id = $self->{id}; # Do not force authentication when password is modified return PE_DONE if $self->param('newpassword'); # Do not force authentication if last successful authentication is recent my $last_authn_utime = $self->{sessionInfo}->{_lastAuthnUTime} || 0; if ( time() - $last_authn_utime < $self->{portalForceAuthnInterval} ) { $self->lmLog( "Authentication is recent, so do not force authentication for session $id", 'debug' ); return PE_DONE; } # If coming from the portal follow the normal process to update the session if ( $referer ? ( $referer =~ m#$self->{portal}#i ) : 0 ) { $self->lmLog( "Portal referer detected for session $id", 'debug' ); # Set flag to update session timestamp $self->{updateSession} = 1; # Process $self->{error} = $self->_subProcess( qw(issuerDBInit issuerForUnAuthUser authInit extractFormInfo userDBInit getUser setAuthSessionInfo setSessionInfo setMacros setLocalGroups setGroups authenticate store authFinish) ); return $self->{error} || PE_DONE; } else { $self->lmLog( "Force reauthentication for session $id", 'debug' ); return PE_OK; } } # Else return PE_DONE PE_DONE; } ## @apmethod int issuerDBInit() # Set _issuerDB # call issuerDBInit in issuerDB* module # @return Lemonldap::NG::Portal constant sub issuerDBInit { my $self = shift; # Get the current issuer module $self->{sessionInfo}->{_issuerDB} = $self->get_module("issuer"); return $self->SUPER::issuerDBInit(); } # issuerForUnAuthUser(): must be implemented in IssuerDB* module # authInit(): must be implemented in Auth* module # extractFormInfo(): must be implemented in Auth* module # * set $self->{user} # * authenticate user if possible (or do it in authenticate()) # getUser(): must be implemented in UserDB* module ## @apmethod int setAuthSessionInfo() # Set _auth # call setAuthSessionInfo in Auth* module #@return Lemonldap::NG::Portal constant sub setAuthSessionInfo { my $self = shift; # Get the current authentication module $self->{sessionInfo}->{_auth} = $self->get_module("auth"); return $self->SUPER::setAuthSessionInfo(); } ## @apmethod int passwordDBInit() # Set _passwordDB # call passwordDBInit in passwordDB* module # @return Lemonldap::NG::Portal constant sub passwordDBInit { my $self = shift; # Get the current password module $self->{sessionInfo}->{_passwordDB} = $self->get_module("password"); return $self->SUPER::passwordDBInit(); } # modifyPassword(): must be implemented in PasswordDB* module ##@apmethod int setSessionInfo() # Set ipAddr, xForwardedForAddr, startTime, updateTime, _utime and _userDB # Call setSessionInfo() in UserDB* module #@return Lemonldap::NG::Portal constant sub setSessionInfo { my $self = shift; # Get the current user module $self->{sessionInfo}->{_userDB} = $self->get_module("user"); # Store IP address $self->{sessionInfo}->{ipAddr} = $ENV{REMOTE_ADDR}; # Extract and store client IP from X-FORWARDED-FOR header my $xheader = $ENV{HTTP_X_FORWARDED_FOR}; $xheader =~ s/(.*?)(\,)+.*/$1/ if $xheader; $self->{sessionInfo}->{xForwardedForAddr} = $xheader || $ENV{REMOTE_ADDR}; # Date and time if ( $self->{updateSession} ) { $self->{sessionInfo}->{updateTime} = &POSIX::strftime( "%Y%m%d%H%M%S", localtime() ); } else { $self->{sessionInfo}->{_utime} ||= time(); $self->{sessionInfo}->{startTime} = &POSIX::strftime( "%Y%m%d%H%M%S", localtime() ); } # Get environment variables matching exportedVars foreach ( keys %{ $self->{exportedVars} } ) { if ( my $tmp = $ENV{ $self->{exportedVars}->{$_} } ) { $tmp =~ s/[\r\n]/ /gs; $self->{sessionInfo}->{$_} = $tmp; delete $self->{exportedVars}->{$_}; } } # Call UserDB setSessionInfo return $self->SUPER::setSessionInfo(); } ##@apmethod int setMacro() # Macro mechanism. # * store macro results in $self->{sessionInfo} #@return Lemonldap::NG::Portal constant sub setMacros { local $self = shift; $self->safe->share('$self'); while ( my ( $n, $e ) = each( %{ $self->{macros} } ) ) { $e =~ s/\$(?!ENV)(\w+)/\$self->{sessionInfo}->{$1}/g; $self->{sessionInfo}->{$n} = $self->safe->reval($e); } PE_OK; } ##@apmethod int setLocalGroups() # Groups mechanism. # * store all groups name that the user match in $self->{sessionInfo}->{groups} #@return Lemonldap::NG::Portal constant sub setLocalGroups { local $self = shift; my $groups; $self->safe->share('$self'); while ( my ( $group, $expr ) = each %{ $self->{groups} } ) { $expr =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g; $groups .= $group . $self->{multiValuesSeparator} if ( $self->safe->reval($expr) ); } $self->{sessionInfo}->{groups} = $groups; PE_OK; } # setGroups(): must be implemented in UserDB* module ##@apmethod int authenticate() # Call authenticate() in Auth* module and call userNotice(). #@return Lemonldap::NG::Portal constant sub authenticate { my $self = shift; my $tmp; return $tmp if ( $tmp = $self->SUPER::authenticate() ); # Log good authentication my $user = $self->{sessionInfo}->{ $self->{whatToTrace} }; $self->_sub( 'userNotice', "Good authentication for $user" ) if $user; # Set _lastAuthnUTime $self->{sessionInfo}->{_lastAuthnUTime} = time(); PE_OK; } ##@apmethod int removeOther() # check singleSession or singleIP parameters, and remove other sessions if needed #@return Lemonldap::NG::Portal constant sub removeOther { my ( $self, $current ) = @_; $self->{deleted} = []; $self->{otherSessions} = []; if ( $self->{singleSession} or $self->{singleIP} or $self->{notifyOther} ) { my $sessions = $self->{globalStorage}->searchOn( $self->{globalStorageOptions}, $self->{whatToTrace}, $self->{sessionInfo}->{ $self->{whatToTrace} } ); foreach my $id ( keys %$sessions ) { next if ( $current and ( $current eq $id ) ); my $h = $self->getApacheSession( $id, 1 ) or next; if ( $self->{singleSession} or ( $self->{singleIP} and $self->{sessionInfo}->{ipAddr} ne $h->{ipAddr} ) ) { push @{ $self->{deleted} }, { time => $h->{_utime}, ip => $h->{ipAddr}, user => $h->{ $self->{whatToTrace} }, }; $self->_deleteSession( $h, 1 ); } else { push @{ $self->{otherSessions} }, { time => $h->{_utime}, ip => $h->{ipAddr}, user => $h->{ $self->{whatToTrace} }, }; } } } if ( $self->{singleUserByIP} ) { my $sessions = $self->{globalStorage}->searchOn( $self->{globalStorageOptions}, 'ipAddr', $ENV{REMOTE_ADDR} ); foreach my $id ( keys %$sessions ) { next if ( $current and $current eq $id ); my $h = $self->getApacheSession( $id, 1 ) or next; unless ( $self->{sessionInfo}->{ $self->{whatToTrace} } eq $h->{ $self->{whatToTrace} } ) { push @{ $self->{deleted} }, { time => $h->{_utime}, ip => $h->{ipAddr}, user => $h->{ $self->{whatToTrace} }, }; $self->_deleteSession( $h, 1 ); } } } $self->info( $self->_mkDateIpArray( &Lemonldap::NG::Portal::_i18n::msg( PM_SESSIONS_DELETED, $ENV{HTTP_ACCEPT_LANGUAGE} ), @{ $self->{deleted} } ) ) if ( $self->{notifyDeleted} and @{ $self->{deleted} } ); $self->info( $self->_mkDateIpArray( &Lemonldap::NG::Portal::_i18n::msg( PM_OTHER_SESSIONS, $ENV{HTTP_ACCEPT_LANGUAGE} ), @{ $self->{otherSessions} } ) . "
" ) if ( $self->{notifyOther} and @{ $self->{otherSessions} } ); PE_OK; } ##@method private string _mkDateIpArray(string title,array datas) # Build the HTML array to display sessions deleted or found by removeOther() # @param $title Title of the array # @param @datas Array of hash ref containing sessions datas # @return HTML string sub _mkDateIpArray { my ( $self, $title, @datas ) = @_; my $tmp = "' . &Lemonldap::NG::Portal::_i18n::msg( $_, $ENV{HTTP_ACCEPT_LANGUAGE} ) . ' | ' foreach ( PM_USER, PM_DATE, PM_IP ); $tmp .= '||
---|---|---|
$_->{user} | " . "" . " | $_->{ip} |