view release on metacpan or  search on metacpan

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

	    if ($type_error eq 'ERROR'){
		$r->log_error("Apache2::AuthZSympa : $location, SOAP error $detail (server $SympaSoapServer)");
	    }else{
		$r->log->notice("Apache2::AuthZSympa : $location, $detail (server $SympaSoapServer)");
	    };
	    $cache_lists{$list} = 0;
	    next;
	}else{
	    $result = $response->result;
	    if ($result == 1){
		if (defined $cache){
		    $cache_lists{$list} = 1;
		    $cache->set($user_key, \%cache_lists,$exptime);
		}
		return Apache2::Const::OK;
	    }else{
		$cache_lists{$list} = 0;
	    }	    
	}
    }
    $cache->set($user_key, \%cache_lists,$exptime);
    my $lists_string = join(", nor in ",@SympaLists);
    $r->log->notice("Apache2::AuthZSympa : $location. $mail_user is not registred on server $SympaSoapServer in ",$lists_string);  
    return Apache2::Const::HTTP_UNAUTHORIZED;	


}

sub traite_soap_error {
    my ($soap, $res) = @_;
    my $detail = "";
    my $type = "";

    if(ref(\$res) eq 'REF'){
	$detail = $res->faultdetail;
	$type = "NOTICE";
    }else{
	$detail = $soap->transport->status;
	$type = "ERROR";
    };
    return ($type, $detail);
}

sub casGetMail(){
    my ($r) = @_;
    my $error="";
    use Net::LDAP;
    my $user = $r->user;
    my $ldap_host = $r->dir_config('LDAPHost');
    my $ldap_suffix = $r->dir_config('LDAPSuffix');
    my $uid_filter = $r->dir_config('LDAPEmailFilter');
    my $attribute = $r->dir_config('LDAPEmailAttribute');
    my $scope = $r->dir_config('LDAPScope') || "sub";
    my $location = $r->location;
    my $ldap;
    unless($ldap = Net::LDAP->new($ldap_host)){
	$r->log_error("Apache2::AuthZSympa : $location, unable to create Net::LDAP object with $ldap_host"); 
	return "";
    }
    my $mesg; 
    unless($mesg = $ldap->bind){
	$r->log_error("Apache2::AuthZSympa : $location, unable to bind $ldap_host");
	return "";
    }
    my $filter = $uid_filter;
    $filter =~ s/\[uid\]/$user/;
    $mesg = $ldap->search( # perform a search
			   base   => $ldap_suffix,
			   scope => $scope,
			   attrs => [$attribute],
			   filter => $filter,
			   );
    my $nb_entries = $mesg->count;
    if(($nb_entries == 0) | ($nb_entries>1)){
	$r->log->notice("Apache2::AuthZSympa : $location, $nb_entries entries returned while querying $ldap_host, maybe wrong parameter ?"); 
	$ldap->unbind;
	return "";
    }
    my $entry = $mesg->entry(0);
    my $mail_user = $entry->get_value($attribute);
    $ldap->unbind;
    return $mail_user;
    
}
=head1 AUTHOR

Dominique Launay,Comite Reseau des Universites, C<< <dominique.launay AT cru.fr> >>


=head1 COPYRIGHT & LICENSE

Copyright 2005 Comite Reseau des Universites L<http://www.cru.fr> All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Apache2::AuthZSympa