package Lemonldap::NG::Portal::Simple; use strict; use warnings; use Exporter 'import'; use Net::LDAP; use warnings; use MIME::Base64; use CGI; our $VERSION = '0.4'; our @ISA = qw(CGI Exporter); # Constants sub PE_OK { 0 } sub PE_SESSIONEXPIRED { 1 } sub PE_FORMEMPTY { 2 } sub PE_WRONGMANAGERACCOUNT { 3 } sub PE_USERNOTFOUND { 4 } sub PE_BADCREDENTIALS { 5 } sub PE_LDAPCONNECTFAILED { 6 } sub PE_LDAPERROR { 7 } sub PE_APACHESESSIONERROR { 8 } sub PE_FIRSTACCESS { 9 } sub PE_BADCERTIFICATE { 10 } our %EXPORT_TAGS = ( 'all' => [ qw( PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS PE_BADCERTIFICATE import ) ], 'constants' => [ qw( PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS PE_BADCERTIFICATE ) ], ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS PE_BADCERTIFICATE import ); sub new { my $class = shift; my $self = $class->SUPER::new(); $self->getConf(@_) or die "Unable to get configuration"; die("You've to indicate a an Apache::Session storage module !") unless ( $self->{globalStorage} ); eval "require " . $self->{globalStorage}; die( "Module " . $self->{globalStorage} . " not found in \@INC" ) if ($@); die("You've to indicate a domain for cookies") unless ( $self->{domain} ); $self->{domain} =~ s/^([^\.])/.$1/; $self->{ldapServer} ||= 'localhost'; $self->{ldapPort} ||= 389; $self->{securedCookie} ||= 0; $self->{cookieName} ||= "lemon"; if ( $self->{authentication} eq "SSL" ) { require Lemonldap::NG::Portal::AuthSSL; %$self = ( %$self, %$Lemonldap::NG::Portal::AuthSSL::OVERRIDE ); } return $self; } sub getConf { my ($self) = shift; my %args; if ( ref( $_[0] ) ) { %args = %{ $_[0] }; } else { %args = @_; } %$self = ( %$self, %args ); 1; } sub error { my $self = shift; my $lang = shift; my @message; if ( $lang eq "fr" ) { @message = ( 'Tout est bon', 'Votre session a expiré, vous devez vous réauthentifier', 'login ou mot de passe non renseigné', "Compte ou mot de passe LDAP de l'application incorrect", 'Utilisateur inexistant', 'mot de passe ou login incorrect', 'Connexion impossible au serveur LDAP', 'Erreur anormale du serveur LDAP', 'Erreur du module Apache::Session choisi', 'Authentification exigée', ); } else { @message = ( 'Everything is OK', 'Your connection has expired; You must to be authentified once again', 'User and password fields must be filled', 'Wrong directory manager account or password', 'User not found in directory', 'Wrong credentials', 'Unable to connect to LDAP server', 'Abnormal error from LDAP server', 'Apache::Session module failed', 'Authentication required', ); } return $message[ $self->{error} ]; } sub process { my ($self) = @_; $self->{error} = PE_OK; foreach my $sub qw(controlUrlOrigin extractFormInfo formateParams formateFilter connectLDAP bind search setSessionInfo setGroups authenticate store unbind buildCookie log autoRedirect) { if ( $self->{$sub} ) { last if ( $self->{error} = &{ $self->{$sub} }($self) ); } else { last if ( $self->{error} = $self->$sub ); } } return ( $self->{error} ? 0 : 1 ); } sub _bind { my ( $ldap, $dn, $password ) = @_; my $mesg; if ( $dn and $password ) { # named bind $mesg = $ldap->bind( $dn, password => $password ); } else { # anonymous bind $mesg = $ldap->bind(); } if ( $mesg->code() != 0 ) { return 0; } return 1; } sub header { my $self = shift; if ( $self->{cookie} ) { $self->SUPER::header( @_, -cookie => $self->{cookie} ); } else { $self->SUPER::header(@_); } } sub redirect { my $self = shift; if ( $_[0]->{cookie} ) { $self->SUPER::redirect( @_, -cookie => $_[0]->{cookie} ); } else { $self->SUPER::redirect(@_); } } sub controlUrlOrigin { my $self = shift; if ( $self->param('url') ) { $self->{urldc} = decode_base64( $self->param('url') ); } PE_OK; } # TODO: delete existing sessions sub controlExistingSession { PE_OK; } sub extractFormInfo { my $self = shift; return PE_FIRSTACCESS unless ( $self->param('user') ); return PE_FORMEMPTY unless ( length( $self->{'user'} = $self->param('user') ) > 0 && length( $self->{'password'} = $self->param('password') ) > 0 ); PE_OK; } sub formateParams() { PE_OK; } sub formateFilter { my $self = shift; $self->{filter} = "(&(uid=" . $self->{user} . ")(objectClass=person))"; PE_OK; } sub connectLDAP { my $self = shift; return PE_LDAPCONNECTFAILED unless ( $self->{ldap} or $self->{ldap} = Net::LDAP->new( $self->{ldapServer}, port => $self->{ldapPort}, onerror => undef, ) ); PE_OK; } sub bind { my $self = shift; $self->connectLDAP unless ( $self->{ldap} ); return PE_WRONGMANAGERACCOUNT unless ( &_bind( $self->{ldap}, $self->{managerDn}, $self->{managerPassword} ) ); PE_OK; } sub search { my $self = shift; my $mesg = $self->{ldap}->search( base => $self->{ldapBase}, scope => 'sub', filter => $self->{filter}, ); if ( $mesg->code() != 0 ) { print STDERR $mesg->error . "\n"; return PE_LDAPERROR; } return PE_USERNOTFOUND unless ( $self->{entry} = $mesg->entry(0) ); $self->{dn} = $self->{entry}->dn(); PE_OK; } sub setSessionInfo { my ($self) = @_; $self->{sessionInfo}->{dn} = $self->{dn}; unless ( $self->{exportedVars} ) { foreach (qw(uid cn mail)) { $self->{sessionInfo}->{$_} = $self->{entry}->get_value($_) || ""; } } elsif ( ref( $self->{exportedVars} ) eq 'HASH' ) { foreach ( keys %{ $self->{exportedVars} } ) { $self->{sessionInfo}->{$_} = $self->{entry}->get_value( $self->{exportedVars}->{$_} ) || ""; } } else { foreach ( @{ $self->{exportedVars} } ) { $self->{sessionInfo}->{$_} = $self->{entry}->get_value($_) || ""; } } PE_OK; } sub setGroups { PE_OK; } sub unbind { my $self = shift; $self->{ldap}->unbind if $self->{ldap}; delete $self->{ldap}; PE_OK; } sub authenticate { my $self = shift; return PE_OK if ( $self->{id} ); $self->unbind(); my $err; return $err unless ( ( $err = $self->connectLDAP ) == PE_OK ); return PE_BADCREDENTIALS unless ( &_bind( $self->{ldap}, $self->{dn}, $self->{password} ) ); PE_OK; } sub store { my ($self) = @_; my %h; eval { tie %h, $self->{globalStorage}, undef, $self->{globalStorageOptions}; }; return PE_APACHESESSIONERROR if ($@); $self->{id} = $h{_session_id}; $h{$_} = $self->{sessionInfo}->{$_} foreach ( keys %{ $self->{sessionInfo} } ); $h{_utime} = time(); untie %h; PE_OK; } sub buildCookie { my $self = shift; $self->{cookie} = $self->cookie( -name => $self->{cookieName}, -value => $self->{id}, -domain => $self->{domain}, -path => "/", -secure => $self->{securedCookie}, @_, ); PE_OK; } sub autoRedirect { my $self = shift; if ( my $u = $self->{urldc} ) { print $self->SUPER::redirect( -uri => $u, -cookie => $self->{cookie}, -status => '302 Moved Temporary' ); # Remove this lines if your browsers does not support redirections # print << "EOF"; # #
# # # #