##@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.90'; use base qw(Lemonldap::NG::Common::CGI Exporter); our @ISA; # Constants use constant { # Developers warning, do not use PE_INFO, it's reserved to autoRedirect. # If you want to send an information, use $self->info('text'). PE_INFO => -4, PE_CONFIRM => -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, }; # EXPORTER PARAMETERS our @EXPORT = qw( PE_INFO PE_CONFIRM 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 ); 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 { 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 ($@); $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 eval "require $module_name"; $self->abort( "Configuration error", $@ ) if ($@); # Push module in @ISA push @ISA, $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 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->{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->{portalUserAttr} ||= "_user"; $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} ||= "Change password request"; $self->{mailBody} ||= 'Your new password is $password'; $self->{issuerDB} ||= 'Null'; # Set default userDB and passwordDB to DBI if authentication is DBI if ( $self->{authentication} =~ /DBI/i ) { $self->{userDB} ||= "DBI"; $self->{passwordDB} ||= "DBI"; } else { # Default to LDAP $self->{userDB} ||= "LDAP"; $self->{passwordDB} ||= "LDAP"; } } =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$/ } ( -2, #PE_REDIRECT -1, #PE_DONE, 0, #PE_OK 35, #PE_PASSWORD_OK ) ) ); # Warning errors return "warning" if ( scalar( grep { /^$code$/ } ( 1, #PE_SESSIONEXPIRED 2, #PE_FORMEMPTY 9, #PE_FIRSTACCESS 32, #PE_PP_GRACE 33, #PE_PP_EXP_WARNING 36, #PE_NOTIFICATION 37, #PE_BADURL ) ) ); # 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; } $self->setApacheUser( $h{ $self->{whatToTrace} } ) if ( $id and not $noInfo ); $self->{id} = $h{_session_id}; return \%h; } ##@method void updateSession(hashRef infos) # Update session stored. # If lemonldap cookie exists, reads it and search session. If the session is # available, update datas with $info. #@param $infos hash sub updateSession { # TODO: update all caches my $self = shift; my ($infos) = @_; my %cookies = fetch CGI::Cookie; # Test if Lemonldap::NG cookie is available if ( $cookies{ $self->{cookieName} } and my $id = $cookies{ $self->{cookieName} }->value ) { my $h = $self->getApacheSession($id) or return undef; # Store/update session values foreach ( keys %$infos ) { $h->{$_} = $infos->{$_}; } untie %$h; } } ##@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 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) # Delete an existing session # @param $h tied Apache::Session object sub _deleteSession { my ( $self, $h ) = @_; if ( my $id2 = $h->{_httpSession} ) { my $h2 = $self->getApacheSession($id2); eval { tied(%$h2)->delete() }; $self->lmLog( $@, 'error' ) if ($@); # Delete cookie push @{ $self->{cookie} }, $self->cookie( -name => $self->{cookieName} . 'http', -value => 0, -domain => $self->{domain}, -path => "/", -secure => 0, -expires => '-1d', @_, ); } my $r; eval { $r = tied(%$h)->delete() }; $self->lmLog( $@, 'error' ) if ($@); # Delete cookie push @{ $self->{cookie} }, $self->cookie( -name => $self->{cookieName}, -value => 0, -domain => $self->{domain}, -path => "/", -secure => 0, -expires => '-1d', @_, ); return $r; } ##@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}; } ############################################################### # 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 # - userDB module: # - userDBInit # - getUser # - setSessionInfo # - setGroups # - passwordDB module: # - passwordDBInit # - modifyPassword # - resetPasswordByMail # - 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 resetPasswordByMail setMacros setLocalGroups setGroups authenticate removeOther grantSession store 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; # REJECT [\0<'"`] in URL or encoded '%' and non protected hosts if ( $self->{urldc} =~ /(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/ or ( $self->{urldc} !~ m#^https?://(?:$self->{reVHosts}$self->{trustedDomains})(?::\d+)?(?:/.*)?$#o and not $self->param('logout') ) ) { $self->lmLog( "XSS attack detected (param: urldc | value: " . $self->{urldc} . ")", "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 existingSession => sub{PE_OK}) #@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 $self->_deleteSession($h); $self->{error} = PE_REDIRECT; # Call issuerDB logout $self->issuerLogout(); # Log $self->_sub( 'userNotice', $self->{sessionInfo}->{ $self->{whatToTrace} } . " has been disconnected" ); # Call authentication logout eval { $self->_sub('authLogout') }; # Redirect user $self->_subProcess(qw(autoRedirect)); return PE_FIRSTACCESS; } 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 { PE_DONE; } # issuerDBInit(): must be implemented in IssuerDB* module # 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()) # userDBInit(): must be implemented in UserDB* module # getUser(): must be implemented in UserDB* module # setAuthSessionInfo(): must be implemented in Auth* module: # * store exported datas in $self->{sessionInfo} # passwordDBInit(): must be implemented in PasswordDB* module # modifyPassword(): must be implemented in PasswordDB* module ##@apmethod int setSessionInfo() # Call setSessionInfo() in User* module and set ipAddr and startTime #@return Lemonldap::NG::Portal constant sub setSessionInfo { my $self = shift; # Store IP address $self->{sessionInfo}->{ipAddr} = $ENV{REMOTE_ADDR}; $self->lmLog( "Store ipAddr: " . $self->{sessionInfo}->{ipAddr} . " in session", 'debug' ); # 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}; $self->lmLog( "Store xForwardedForAddr: " . $self->{sessionInfo}->{xForwardedForAddr} . " in session", 'debug' ); # Store time $self->{sessionInfo}->{_utime} = time(); $self->{sessionInfo}->{startTime} = &POSIX::strftime( "%Y%m%d%H%M%S", localtime() ); $self->lmLog( "Store startTime: " . $self->{sessionInfo}->{startTime} . " in session", 'debug' ); return $self->SUPER::setSessionInfo(); } # resetPasswordByMail(): must be implemented in PasswordDB* module ##@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/\$(\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; " 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() ); $self->_sub( 'userNotice', "Good authentication for " . $self->{sessionInfo}->{ $self->{whatToTrace} } ); 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 = shift; $self->{deleted} = []; if ( $self->{singleSession} or $self->{singleIP} ) { my $sessions = $self->{globalStorage}->searchOn( $self->{globalStorageOptions}, $self->{whatToTrace}, $self->{sessionInfo}->{ $self->{whatToTrace} } ); foreach my $id ( keys %$sessions ) { my $h = $self->getApacheSession($id); unless ($self->{singleIP} and $self->{sessionInfo}->{ipAddr} eq $h->{ipAddr} ) { push @{ $self->{deleted} }, { time => $h->{_utime}, ip=> $h->{ipAddr} }; tied(%$h)->delete(); $self->lmLog( "Deleting session $id", 'debug' ); eval { $self->{lmConf}->{refLocalStorage}->remove($id); }; } } } if ( $self->{singleUserByIP} ) { my $sessions = $self->{globalStorage}->searchOn( $self->{globalStorageOptions}, $self->{ipAddr}, $ENV{REMOTE_ADDR} ); foreach my $id ( keys %$sessions ) { my $h = $self->getApacheSession($id); unless ( $self->{sessionInfo}->{ $self->{whatToTrace} } eq $h->{ $self->{whatToTrace} } ) { push @{ $self->{deleted} }, { time => $h->{_utime}, ip=> $h->{ipAddr} }; tied(%$h)->delete(); $self->lmLog( "Deleting session $id", 'debug' ); eval { $self->{lmConf}->{refLocalStorage}->remove($id); }; } } } if($self->{notifyDeleted} and $self->{deleted}){ my $tmp = '
'.&Lemonldap::NG::Portal::_i18n::msg( 0, $ENV{HTTP_ACCEPT_LANGUAGE} ).' :
'.&Lemonldap::NG::Portal::_i18n::msg($_,$ENV{HTTP_ACCEPT_LANGUAGE} ).' | ' foreach( 1..2 ); $tmp .= '|
---|---|
'.""." | $_->{ip} |