AuthLLDAPSympa

 view release on metacpan or  search on metacpan

lib/Apache2/AuthLLDAPSympa.pm  view on Meta::CPAN

our $VERSION = '0.4.0';

=head1 SYNOPSIS

This module authorize a LemonLDAP account to connect to sympa lists server.


Sample httpd.conf example:
<VirtualHost *:80>
    ServerAdmin webmaster@dummy-host.example.com
    DocumentRoot /www/docs/dummy-host.example.com
    ServerName dummy-host.example.com
    ErrorLog logs/dummy-host.example.com-error_log
    CustomLog logs/dummy-host.example.com-access_log common
    
    AddHandler cgi-script .cgi .pl
    PerlModule Apache2::compat

    #the repertory of the libs of sympa
    PerlSwitches -I/repertory/to/sympa/sympa/bin/
    #For loading the handler
    PerlPostReadRequestHandler Apache2::AuthLLDAPSympa
    #The LDAP host 
    PerlSetVar LemonLDAPSympaHost            ldpcentraledev.alize:10389
    #The LDAP Filter
    PerlSetVar LemonLDAPSympaFilter   	    (objectclass=*)
    #The LDAP attribute for email
    PerlSetVar LemonLDAPSympaEmailAttribute  mail
    #The choice of the email
    PerlSetVar LemonLDAPSympaEmailSelect  0
    #The configuration file of sympa (important for secret)
    PerlSetVar LemonLDAPSympaConfFile    /repertory/to/sympa/sympa/etc/sympa.conf
    #The configuration file of the cgi wwsympa.pl
    PerlSetVar LemonLDAPSympaWWConfFile    /repertory/to/sympa/sympa/etc/wwsympa.conf
    #the Directory of libs of sympa
    PerlSetVar LemonLDAPSympaDirectory /repertory/to/sympa/sympa/bin/
    #the name with directory where is the tools.pl
    PerlSetVar LemonLDAPSympaToolScript /repertory/to/sympa/sympa/bin/tools.pl
    #The log filename
    PerlSetVar LemonLDAPSympaLogFile /logs/to/sympa/loghandler.log
    #The log mode precision
    PerlSetVar LemonLDAPSympaLogMode INFO
    #The script wwsympa
    ScriptAlias /sympa "/repertory/to/sympa/sympa/bin/wwsympa.fcgi"
</VirtualHost>


=head1 FUNCTIONS

=head2 handler

=cut

sub handler {
	my $r=shift;
	$fileLog=$r->dir_config('LemonLDAPSympaLogFile')||'LemonSympaPlu.log';
        $logMode=$r->dir_config('LemonLDAPSympaLogMode')||'ERROR';
        if ($fileLog eq "") { $fileLog='LemonSympaPlu.log';}
        if ($logMode eq "") { $logMode='ERROR';}
	&logDebug('Start the Handler');
        my $myCookies=$r->headers_in->get('Cookie');
	&logDebug("The cookies are:$myCookies");
	my $auth = $r->header_in("Authorization");
	&logDebug("The Authorization is:$auth");
	my ($user, $pass);
	if ($auth ne "")
	{
	 $auth =~ s/Basic//;
         ($user, $pass)=split(/:/, decode_base64($auth));
	}
	&logDebug("The user is:$user");
	#If Authentification and no cookie sympa user we add a new cookie sympauser
        if ($auth ne "" && $user ne "" && $myCookies !~ /sympauser/)
        {
	 &logDebug("There is no Cookie sympauser");
	 &logDebug("There user is:$user");
	 
	 &logDebug("Read mod_perl parameters");
	 #Read the parameters for the plugin
	 my $LDAPHOST=$r->dir_config('LemonLDAPSympaHost');
       my $LDAPFilter=$r->dir_config('LemonLDAPSympaFilter');
	 my $LDAPEmailAttr=$r->dir_config('LemonLDAPSympaEmailAttribute');
	 my $LDAPEmailSel=$r->dir_config('LemonLDAPSympaEmailSelect');
	 my $LemonConf=$r->dir_config('LemonLDAPSympaConfFile');
	 my $LemonWWConf=$r->dir_config('LemonLDAPSympaWWConfFile');
	 my $SympaDirectory=$r->dir_config('LemonLDAPSympaDirectory'); 
	 my $SympaToolScript=$r->dir_config('LemonLDAPSympaToolScript');
	 $fileLog=$r->dir_config('LemonLDAPSympaLogFile');
	 $logMode=$r->dir_config('LemonLDAPSympaLogMode');
	 if ($fileLog eq "") { $fileLog='LemonSympaPlu.log';}
	 if ($logMode eq "") { $logMode='ERROR';}
	 &logDebug("The parameter LemonLDAPSympaHost=$LDAPHOST");
	 &logDebug("The parameter LemonLDAPSympaFilter=$LDAPFilter");
	 &logDebug("The parameter LemonLDAPSympaEmailAttribute=$LDAPEmailAttr");
	 &logDebug("The parameter LemonLDAPSympaEmailSelect=$LDAPEmailSel");
	 &logDebug("The parameter LemonLDAPSympaConfFile=$LemonConf");
	 &logDebug("The parameter LemonLDAPSympaWWConfFile=$LemonWWConf");
	 &logDebug("The parameter LemonLDAPSympaDirectory=$SympaDirectory");
	 &logDebug("The parameter LemonLDAPSympaToolScript=$SympaToolScript");
	 &logDebug("The parameter LemonLDAPSympaLogFile=$fileLog");
	 &logDebug("The parameter LemonLDAPSympaLogMode=$logMode");
	 
	 #get page uri and host
	 my $document_root = $r->document_root;
         my $uri = $r->uri;
	 local $_ = $uri;
	 if ($LDAPHOST eq "")
	 {
		&logError("The parameter LemonLDAPSympaHost is empty");
	        $r->warn("$uri => The parameter LemonLDAPSympaHost is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
	 }
	 
	 if ($LDAPFilter eq "")
         {
                &logError("The parameter LemonLDAPSympaFilter is empty");
		$r->warn("$uri => The parameter LemonLDAPSympaFilter is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }
	 if ($LDAPEmailAttr eq "")
         {
                &logError("The parameter LemonLDAPSympaEmailAttribute is empty");
		$r->warn("$uri => The parameter LemonLDAPSympaEmailAttribute is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }
	 if ($LDAPEmailSel eq "")
         {
                &logError("The parameter LemonLDAPSympaEmailSelect is empty");
	 	$r->warn("$uri => The parameter LemonLDAPSympaEmailSelect is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }

lib/Apache2/AuthLLDAPSympa.pm  view on Meta::CPAN

         {
                &logError("The parameter LemonLDAPSympaConfFile is empty");
		$r->warn("$uri => The parameter LemonLDAPSympaConfFile is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }
	 if ($LemonWWConf eq "")
         {
                &logError("The parameter LemonLDAPSympaWWConfFile is empty");
		$r->warn("$uri => The parameter LemonLDAPSympaWWConfFile is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }
	 if ($SympaDirectory eq "")
         {
                &logError("The parameter LemonLDAPSympaDirectory is empty");
		$r->warn("$uri => The parameter LemonLDAPSympaDirectory is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }
	 if ($SympaToolScript eq "")
         {
                &logError("The parameter LemonLDAPSympaToolScript is empty");
                $r->warn("$uri => The parameter LemonLDAPSympaDirectory is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }
	 if ($fileLog eq "")
         {
                &logError("The parameter LemonLDAPSympaLogFile is empty");
		$r->warn("$uri => The parameter LemonLDAPSympaLogFile is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }
	 if ($logMode eq "")
         {
                &logError("The parameter LemonLDAPSympaLogMode is empty");
		$r->warn("$uri => The parameter LemonLDAPSympaLogMode is empty at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
         }

	 &logDebug("Load the libraries");
	 &logDebug("Sympa Directory is $SympaDirectory");
	 
	 use wwslib;
         use Log;
         use Conf;
         use Exporter;
	 
	 use List;
	 use mail;
	 use smtp;
	 use Conf;
	 use Commands;
	 use Language;
	 use Log;
	 use Auth;
	 use admin ;
	 use CGI;
	 use CGI::Cookie ;
	 require $SympaToolScript;
         ## Configuration
         my $wwsconf = {};

         ## Change to your wwsympa.conf location
         my $conf_file = $LemonWWConf;
         my $sympa_conf_file = $LemonConf;
         my $robot ;
         my $param;
         my $ip;
	 
	 &logDebug ("Load the configuration of Sympa");
	 ## Load config
	 unless ($wwsconf = &wwslib::load_config($conf_file))
	 {
	 	&logError("Error on loading Config File $conf_file");
                $r->warn("$uri => Error on loading Config File $conf_file at $document_root$_");
                $r->filename("$document_root$_");
                return 0;		
	 }
	 ## Load sympa config
	 unless (&Conf::load( $sympa_conf_file ))
	 {
		&logError("Error on loading Config File $sympa_conf_file");
                $r->warn("$uri => Error on loading Config File $sympa_conf_file at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
	 }
	 
         &logDebug ("Calculate the cookie Domain");
	 #Calculate the cookie_domain
         if (defined $Conf{'robot_by_http_host'}{$ENV{'SERVER_NAME'}}) {
          my ($selected_robot, $selected_path);
          my ($k,$v);
          while (($k, $v) = each %{$Conf{'robot_by_http_host'}{$ENV{'SERVER_NAME'}}}) {
             if ($ENV{'REQUEST_URI'} =~ /^$k/) {
                ## Longer path wins
                 if (length($k) > length($selected_path)) {
                     ($selected_robot, $selected_path) = ($v, $k);
                 }
             }
          }
          $robot = $selected_robot;
         }

         $robot = $Conf{'host'} unless $robot;

         $param->{'cookie_domain'} = $Conf{'robots'}{$robot}{'cookie_domain'} if $Conf{'robots'}{$robot};
         $param->{'cookie_domain'} ||= $wwsconf->{'cookie_domain'};
         $ip = $ENV{'REMOTE_HOST'};
         $ip = $ENV{'REMOTE_ADDR'} unless ($ip);
         $ip = 'undef' unless ($ip);
         ## In case HTTP_HOST does not match cookie_domain
         my $http_host = $ENV{'HTTP_HOST'};
         $http_host =~ s/:\d+$//; ## suppress port
         unless (($http_host =~ /$param->{'cookie_domain'}$/) ||
            ($param->{'cookie_domain'} eq 'localhost')) {
            &wwslog('notice', 'Cookie_domain(%s) does NOT match HTTP_HOST; setting cookie_domain to %s', $param->{'cookie_domain'}, $http_host);
	    my $cookLog=$param->{'cookie_domain'};
	    &logDebug("Cookie_domain($cookLog=) does NOT match HTTP_HOST; setting cookie_domain to $http_host");
            $param->{'cookie_domain'} = $http_host;
         }
	 

	 #The LDAP Traitment
	 &logDebug ("Load LDAP libraries");
         use Net::LDAP;

         #my($ldap) = Net::LDAP->new('ldpcentraledev.alize', port => 10389) or die "Can't bind to ldap: $!\n";
	 &logDebug ("Connect to LDAP");

         my($ldap) = Net::LDAP->new($LDAPHOST) ||"ERROR";
	 if ($ldap eq "ERROR")
	 {
		&logError("Error LDAP on connecting to $LDAPHOST");
                $r->warn("$uri => Error LDAP on connecting to $LDAPHOST at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
	 }
	 &logDebug ("Bind LDAP");
         $ldap->bind;
	 
         #my($mesg) = $ldap->search( base => $user,
         #                                     filter => '(objectclass=*)');
	 &logDebug ("Search on LDAP");
         my($mesg) = $ldap->search( base => $user,
                                          filter => $LDAPFilter);
	 if ($mesg->error ne "Success")
	 {
		my $messageEr=$mesg->error;
	    	&logError("Error LDAP on searching $user with Filter $LDAPFilter and message=$messageEr");
                $r->warn("$uri => Error LDAP on searching $user with Filter $LDAPFilter at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
	 }
         $mesg->code && die $mesg->error;
	 
	 
         my($entryL);
         my @enrtyLi;

         my $emailFinded="";
	 
  	 #List all Entries
	 &logDebug ("List Entries on LDAP");
         foreach $entryL ($mesg->all_entries) {
          #@enrtyLi=$entryL->get('mail');
	  @enrtyLi=$entryL->get($LDAPEmailAttr);
          #$emailFinded=@enrtyLi[0];
	  if ($LDAPEmailSel ge scalar(@enrtyLi)||$LDAPEmailSel lt 0)
          {
                my $NbEntries=scalar(@enrtyLi);
                &logError("The email selection item($LDAPEmailSel) is not good.There is $NbEntries entries.");
                $r->warn("$uri => The email selection item($LDAPEmailSel) is not good.There is $NbEntries entries. at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
          }
	  $emailFinded=$enrtyLi[$LDAPEmailSel];
	  &logDebug ("We Find : $emailFinded");
         }
	 
 	 &logDebug ("We unbind LDAP");
         $ldap->unbind;
	 

	 if ($emailFinded eq "")
	 {
		&logError("We don't find the email adress of the user $user.");
                $r->warn("$uri => We don't find the email adress of the user $user. at $document_root$_");
                $r->filename("$document_root$_");
                return 0;
	 }
	 #Calculate Delay
	 &logDebug ("Calculate the delay");
	 my $delayL;
         $delayL = $param->{'user'}{'cookie_delay'};
         unless (defined $delayL) {
          $delayL = $wwsconf->{'cookie_expire'};
         }
         if ($delayL == 0) {
          $delayL = 'session';
         }

	 #Generate the cookie of Sympa
	 &logDebug ("Generate the cookie");
         my $cookieVal= &set_cookie_ext($emailFinded, $Conf{'cookie'},$param->{'cookie_domain'}, $delayL, 'classic');
	 #my $cookieAltVal= &set_cookie_alte_ext($emailFinded, $Conf{'cookie'},$param->{'cookie_domain'}, $delayL, 'classic');
	 &logDebug ("The cookie is :$cookieVal");
	 #&logDebug ("The cookie Alte is :$cookieAltVal");
	 #$cookieVal="$cookieVal;$cookieAltVal"
         $r->header_in('Cookie',"$myCookies;$cookieVal");
	 &logDebug ("The cookie is added to cookie List");
	 &logInfo ("The user $user is connected on Sympa with the email $emailFinded");
	
         
	}
	return Apache2::Const::OK;
}


## Set user $email cookie, ckecksum use $secret, expire=(now|session|#sec) domain=(localhost|<a domain>)
sub set_cookie_ext {
    my ($email, $secret, $http_domain, $expires, $auth) = @_ ;
    &logDebug("Enter on sub set_cookie_ext with parameters $email, $secret, $http_domain, $expires, $auth");
    unless ($email) {
       return undef;
    }
    my $expiration;
    if ($expires =~ /now/i) {
        ## 10 years ago
        $expiration = '-10y';
    }else{
        $expiration = '+'.$expires.'m';
    }

    if ($http_domain eq 'localhost') {
        $http_domain="";
    }

    my $value = sprintf '%s:%s', $email, &get_mac_extra($email,$secret);
    if ($auth ne 'classic') {
        $value .= ':'.$auth;
    }
    my $cookie;
    if ($expires =~ /session/i) {
        $cookie = new CGI::Cookie (-name    => 'sympauser',
                                  -value   => $value,
                                   -domain  => $http_domain,
                                   -path    => '/'
                                   );
    }else {
        $cookie = new CGI::Cookie (-name    => 'sympauser',
                                   -value   => $value,
                                   -expires => $expiration,
                                   -domain  => $http_domain,
                                   -path    => '/'
                                   );
    }
    ## Send cookie to the client
    return  $cookie->as_string;
}
## Set user $email cookie, ckecksum use $secret, expire=(now|session|#sec) domain=(localhost|<a domain>)
sub set_cookie_alte_ext {
    my ($email, $secret, $http_domain, $expires, $auth) = @_ ;
    &logDebug("Enter on sub set_cookie_ext with parameters $email, $secret, $http_domain, $expires, $auth");
    unless ($email) {
       return undef;
    }
    my $expiration;
    if ($expires =~ /now/i) {
        ## 10 years ago
        $expiration = '-10y';
    }else{
        $expiration = '+'.$expires.'m';
    }

    if ($http_domain eq 'localhost') {
        $http_domain="";
    }

    my $value = sprintf '%s:%s', $email, &get_mac_extra($email,$secret);
    if ($auth ne 'classic') {
        $value .= ':'.$auth;
    }
    my $cookie;
    if ($expires =~ /session/i) {
        $cookie = new CGI::Cookie (-name    => 'sympa_altemails',
                                  -value   => $value,
                                   -domain  => $http_domain,
                                   -path    => '/'
                                   );
    }else {
        $cookie = new CGI::Cookie (-name    => 'sympa_altemails',
                                   -value   => $value,
                                   -expires => $expiration,
                                   -domain  => $http_domain,
                                   -path    => '/'
                                   );
    }
    ## Send cookie to the client
    return  $cookie->as_string;
}
sub get_mac_extra {
        my $email = shift ;
        my $secret = shift ;
	
	&logDebug("Enter on sub get_mac_extra with parameters $email, $secret");
        unless ($secret) {
            &logError( 'get_mac : failure missing server secret for cookie MD5 digest');
            return undef;
        }
        unless ($email) {
            &logError( 'get_mac : failure missing email adresse or cookie MD5 digest');
            return undef;
        }



       my $md5 = new Digest::MD5;

      $md5->reset;
      $md5->add($email.$secret);
      return substr( unpack("H*", $md5->digest) , -8 );
}


sub logInfo {
	my $messageToLog=shift;
	if (uc($logMode) eq 'INFO'||uc($logMode) eq 'DEBUG')
	{
		&logFile("INFO:$messageToLog");
	}
}

sub logError {
        my $messageToLog=shift;
	if (uc($logMode) eq 'ERROR'||uc($logMode) eq 'INFO'||uc($logMode) eq 'DEBUG')
        {
                &logFile("ERROR:$messageToLog");
        }
}

sub logDebug {
        my $messageToLog=shift;
	if (uc($logMode) eq 'DEBUG')
        {
                &logFile("DEBUG:$messageToLog");
        }
}
sub logFile {
	my $messageToLog=shift;
	my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);



( run in 0.673 second using v1.01-cache-2.11-cpan-39bf76dae61 )