Commit 2e5911ac authored by Yadd's avatar Yadd
Browse files

LEMONLDAP::NG : Doxygen in progress.

parent 985bdc25
package Lemonldap::NG::Handler;
print STDERR
"See Lemonldap::NG::Handler(3) to know which Lemonldap::NG::Handler::* module to use.";
our $VERSION = "0.9";
our @ISA = ('Lemonldap::NG::Handler::SharedConf');
1;
......
##@file
# Auth-basic authentication with Lemonldap::NG rights management
#
#@copy 2008 Xavier Guimard <x.guimard@free.fr>
##@class
# Auth-basic authentication with Lemonldap::NG rights management
package Lemonldap::NG::Handler::AuthBasic;
use strict;
......@@ -25,7 +32,10 @@ BEGIN {
}
}
# overload of run subroutine
## @method int run(Apache2::RequestRec $apacheRequest)
# overload run subroutine to implement Auth-Basic mechanism.
# @param $apacheRequest current request
# @return Apache constant
sub run ($$) {
my $class;
( $class, $apacheRequest ) = @_;
......
##@file
# Cross-domain mechanism for handler
#
#@copy 2005, 2006, 2007, 2008 Xavier Guimard <x.guimard@free.fr>
##@class
# Cross-domain mechanism for handler
package Lemonldap::NG::Handler::CDA;
use strict;
......@@ -11,6 +18,10 @@ use base qw(Lemonldap::NG::Handler::SharedConf);
*EXPORT_TAGS = *Lemonldap::NG::Handler::SharedConf::EXPORT_TAGS;
*EXPORT_OK = *Lemonldap::NG::Handler::SharedConf::EXPORT_OK;
## @method int run(Apache2::RequestRec $apacheRequest)
# overload run subroutine to implement cross-domain mechanism.
# @param $apacheRequest
# @return Apache constant
sub run ($$) {
my $class;
( $class, $apacheRequest ) = @_;
......
## @file
# Auto-protected CGI machanism
#
# @copy 2008 Xavier Guimard <x.guimard@free.fr>
## @class
# Base class for auto-protected CGI
package Lemonldap::NG::Handler::CGI;
use strict;
......@@ -12,6 +19,10 @@ use Lemonldap::NG::Handler::SharedConf qw(:all);
our $VERSION = '0.2';
## @cmethod Lemonldap::NG::Handler::CGI new(hashRef $args)
# Constructor.
# @param $args hash passed to Lemonldap::NG::Handler::_CGI object
# @return new object
sub new {
my $class = shift;
my $self = $class->SUPER::new() or $class->abort("Unable to build CGI");
......@@ -55,6 +66,11 @@ sub new {
return $self;
}
## @method boolean authenticate()
# Checks if user session is valid.
# Checks Lemonldap::NG cookie and search session in sessions database.
# If nothing is found, redirects the user to the Lemonldap::NG portal.
# @return boolean : true if authentication is good. Exit before else
sub authenticate {
my $self = shift;
my %cookies = fetch CGI::Cookie;
......@@ -81,11 +97,21 @@ sub authenticate {
return 1;
}
## @method boolean authorize()
# Checks if user is authorized to access to the current request.
# Call Lemonldap::NG::Handler::_CGI::grant() function.
# @return boolean : true if user is granted
sub authorize {
my $self = shift;
return $self->_handler->grant( $ENV{REQUEST_URI} );
}
## @method int testUri(string $uri)
# Checks if user is authorized to access to $uri.
# Call Lemonldap::NG::Handler::_CGI::grant() function.
# @param $uri URI or URL to test
# @return int : 1 if user is granted, -1 if virtual host has no configuration,
# 0 if user isn't granted
sub testUri {
my $self = shift;
my $uri = shift;
......@@ -94,15 +120,22 @@ sub testUri {
return $self->_handler->grant( $uri, $host );
}
## @method hashRef user()
# @return hash of user datas
sub user {
return $datas;
}
## @method boolean group(string $group)
# @param $group name of the Lemonldap::NG group to test
# @return boolean : true if user is in this group
sub group {
my ( $self, $group ) = @_;
return ( $datas->{groups} =~ /\b$group\b/ );
}
## @method void goToPortal()
# Redirects the user to the portal and exit.
sub goToPortal {
my $self = shift;
my $tmp = encode_base64( $self->_uri );
......@@ -111,6 +144,9 @@ sub goToPortal {
exit;
}
## @fn string private _uri()
# Builds current URL including "http://" and server name.
# @return URL_string
sub _uri {
return 'http'
. ( $https ? 's' : '' ) . '://'
......@@ -118,31 +154,53 @@ sub _uri {
. $ENV{REQUEST_URI};
}
## @method Lemonldap::NG::Handler::_CGI private _handler()
# Returns the Lemonldap::NG::Handler::_CGI object
sub _handler {
return shift->{_handler};
}
## @class
# Private class used by Lemonldap::NG::Handler::CGI for his internal handler.
package Lemonldap::NG::Handler::_CGI;
use Lemonldap::NG::Handler::SharedConf qw(:locationRules :localStorage);
use base qw(Lemonldap::NG::Handler::SharedConf);
## @method boolean childInit()
# Since this is not a real Apache handler, childs have not to be initialized.
# @return true
sub childInit {1}
## @method boolean purgeCache()
# Since this is not a real Apache handler, it must not purge the cache at starting.
# @return true
sub purgeCache {1}
## @method void lmLog(string $message,string $level)
# Replace lmLog by "print STDERR $message".
# @param $message Message to log
# @param $level error level (debug, info, warning or error)
sub lmLog {
my ( $self, $mess, $level ) = @_;
$mess =~ s/^.*HASH[^:]*:/__PACKAGE__/e;
print STDERR "$mess\n" unless ( $level eq 'debug' );
}
## @method boolean vhostAvailable(string $vhost)
# Checks if $vhost has been declared in configuration
# @param $vhost Virtual Host to test
# @return boolean : true if $vhost is available
sub vhostAvailable {
my ( $self, $vhost ) = @_;
return defined( $defaultCondition->{$vhost} );
}
## @method boolean grant(string $uri, string $vhost)
# Return true if user is granted to access.
# @param $uri URI string
# @param $vhost Optional virtual host (default current virtual host)
sub grant {
my ( $self, $uri, $vhost ) = @_;
$vhost ||= $ENV{SERVER_NAME};
......
## @file
# Perl based proxy used to replace mod_proxy
#
# @copy 2005, 2006, 2007, 2008 Xavier Guimard <x.guimard@free.fr>
## @class
# Perl based proxy used to replace mod_proxy
package Lemonldap::NG::Handler::Proxy;
use strict;
......@@ -18,8 +25,14 @@ BEGIN {
*handler = ( MP() == 2 ) ? \&handler_mp2 : \&handler_mp1;
}
## @method int handler_mp1()
# Launch run() when used under mod_perl version 1
# @return Apache constant
sub handler_mp1 ($$) { shift->run(@_); }
## @method int handler_mp2()
# Launch run() when used under mod_perl version 2
# @return Apache constant
sub handler_mp2 : method {
shift->run(@_);
}
......@@ -40,6 +53,10 @@ our $class;
# disappear.
$UA->requests_redirectable( [] );
## @method int run(Apache2::RequestRec $r)
# Main proxy method.
# Called for Apache response (PerlResponseHandler).
# @return Apache constant
sub run($$) {
( $class, $r ) = @_;
my $url = $r->uri;
......@@ -86,6 +103,9 @@ sub run($$) {
return OK;
}
## @fn void cb_content(string $chunk)
# Send datas received from remote server to the client.
# @param $chunk part of datas returned by HTTP server
sub cb_content {
my $chunk = shift;
unless ($headers_set) {
......@@ -95,6 +115,10 @@ sub cb_content {
$r->print($chunk);
}
## @method void headers(HTTP::Request $response)
# Send headers received from remote server to the client.
# Replace "Location" header.
# @param $response current HTTP response
sub headers {
$class = shift;
my $response = shift;
......
## @file
# Main handler.
#
# @copy 2005, 2006, 2007, 2008 Xavier Guimard <x.guimard@free.fr>
## @class
# Main handler.
package Lemonldap::NG::Handler::SharedConf;
use strict;
......@@ -39,7 +46,10 @@ BEGIN {
# INIT PROCESS
# init is overloaded to call only localInit. globalInit is called later
## @cmethod void init(hashRef $args)
# Constructor.
# init is overloaded to call only localInit. globalInit is called later.
# @param $args hash containing parameters
sub init($$) {
my ( $class, $args ) = @_;
$reloadTime = $args->{reloadTime} || 600;
......@@ -47,7 +57,10 @@ sub init($$) {
$class->localInit($args);
}
# defaultValuesInit : set default values for non-customized variables
## @method void defaultValuesInit(hashRef $args)
# Set default values for non-customized variables
# @param $args hash containing parameters
# @return boolean
sub defaultValuesInit {
my ( $class, $args ) = @_;
......@@ -56,6 +69,9 @@ sub defaultValuesInit {
return $class->SUPER::defaultValuesInit( \%h );
}
## @method void localInit(hashRef $args)
# Load parameters and build the Lemonldap::NG::Common::Conf object.
# @return boolean
sub localInit {
my ( $class, $args ) = @_;
die("$class : unable to build configuration : $Lemonldap::NG::Common::Conf::msg")
......@@ -72,8 +88,12 @@ sub localInit {
# MAIN
## @method int run(Apache2::RequestRec $r)
# Check configuration and launch Lemonldap::NG::Handler::Simple::run().
# Each $reloadTime, the Apache child verify if its configuration is the same
# as the configuration stored in the local storage.
# @param $r Apache2::RequestRec object
# @return Apache constant
sub run($$) {
my ( $class, $r ) = @_;
if ( time() - $lastReload > $reloadTime ) {
......@@ -87,6 +107,13 @@ sub run($$) {
# CONFIGURATION UPDATE
## @method int testConf(boolean $local)
# Test if configuration has changed and launch setConf() if needed.
# If the optional boolean $local is true, remote configuration is not tested:
# only local cached configuration is tested if available. $local is given to
# Lemonldap::NG::Conf::getConf()
# @param $local boolean
# @return Apache constant
sub testConf {
my ( $class, $local ) = @_;
my $conf = $lmConf->getConf( { local => $local } );
......@@ -104,6 +131,10 @@ sub testConf {
OK;
}
## @method int setConf(hashRef $conf)
# Launch globalInit().
# Local parameters have best precedence on configuration parameters.
# @return Apache constant
sub setConf {
my ( $class, $conf ) = @_;
......@@ -118,12 +149,16 @@ sub setConf {
*reload = *refresh;
## @method int refresh(Apache::RequestRec $r)
# Launch testConf() with $local=0, so remote configuration is tested.
# @param $r current request
# @return Apache constant
sub refresh($$) {
my ( $class, $r ) = @_;
$class->lmLog( "$class: request for configuration reload", 'notice' );
$r->handler("perl-script");
if ( $class->testConf(0) == OK ) {
if ( MP() == 2 ) {
if ( MP() == 2 ) {
$r->push_handlers( 'PerlResponseHandler' =>
sub { my $r = shift; $r->content_type('text/plain'); OK } );
}
......
## @file
# Base file for Lemonldap::NG handlers
#
# @copy 2005, 2006, 2007, 2008 Xavier Guimard <x.guimard@free.fr>
## @class
# Base class for Lemonldap::NG handlers
package Lemonldap::NG::Handler::Simple;
use strict;
......@@ -135,18 +142,34 @@ BEGIN {
*logout = ( MP() == 2 ) ? \&logout_mp2 : \&logout_mp1;
}
## @method int handler_mp1()
# Launch run() when used under mod_perl version 1
# @return Apache constant
sub handler_mp1 ($$) { shift->run(@_); }
## @method int handler_mp2()
# Launch run() when used under mod_perl version 2
# @return Apache constant
sub handler_mp2 : method {
shift->run(@_);
}
## @method int logout_mp1()
# Launch unlog() when used under mod_perl version 1
# @return Apache constant
sub logout_mp1 ($$) { shift->unlog(@_); }
## @method int logout_mp2()
# Launch unlog() when used under mod_perl version 2
# @return Apache constant
sub logout_mp2 : method {
shift->unlog(@_);
}
## @method void lmLog(string $mess, string $level)
# Wrapper for Apache log system
# @param $mess message to log
# @param $level string (debug, info, warning or error)
sub lmLog {
my ( $class, $mess, $level ) = @_;
if ( MP() == 2 ) {
......@@ -160,6 +183,10 @@ sub lmLog {
}
}
## @fn void lmSetApacheUser(Apache2::RequestRec $r,string $s)
# Inform Apache for the data to use as user for logs
# @param $r current request
# @param $s string to use
sub lmSetApacheUser {
my ( $r, $s ) = @_;
return unless ($s);
......@@ -171,12 +198,26 @@ sub lmSetApacheUser {
}
}
## @fn string protected regRemoteIp(string $str)
# Replaces $ip by the client IP address in the string
# @param $str string
# @return string
sub regRemoteIp {
my ( $class, $str ) = @_;
$str =~ s/\$datas->\{ip\}/\$apacheRequest->connection->remote_ip/g;
if( MP() == 2 ) {
$str =~ s/\$datas->\{ip\}/\$apacheRequest->connection->remote_ip/g;
}
else {
$str =~ s/\$datas->\{ip\}/\$apacheRequest->remote_ip/g;
}
return $str;
}
## @fn void lmSetHeaderIn(Apache2::RequestRec $r, string $h, string $v)
# Set an HTTP header in the HTTP request.
# @param $r Current request
# @param $h Name of the header
# @param $v Value of the header
sub lmSetHeaderIn {
my ( $r, $h, $v ) = @_;
if ( MP() == 2 ) {
......@@ -187,8 +228,13 @@ sub lmSetHeaderIn {
}
}
## @fn string lmtHeaderIn(Apache2::RequestRec $r, string $h)
# Return an HTTP header value from the HTTP request.
# @param $r Current request
# @param $h Name of the header
# @return Value of the header
sub lmHeaderIn {
my ( $r, $h, $v ) = @_;
my ( $r, $h ) = @_;
if ( MP() == 2 ) {
return $r->headers_in->{$h};
}
......@@ -197,6 +243,11 @@ sub lmHeaderIn {
}
}
## @fn void lmSetErrHeaderOut(Apache2::RequestRec $r, string $h, string $v)
# Set an HTTP header in the HTTP response in error context
# @param $r Current request
# @param $h Name of the header
# @param $v Value of the header
sub lmSetErrHeaderOut {
my ( $r, $h, $v ) = @_;
if ( MP() == 2 ) {
......@@ -207,6 +258,11 @@ sub lmSetErrHeaderOut {
}
}
## @fn void lmSetErrHeaderOut(Apache2::RequestRec $r, string $h, string $v)
# Set an HTTP header in the HTTP response in normal context
# @param $r Current request
# @param $h Name of the header
# @param $v Value of the header
sub lmSetHeaderOut {
my ( $r, $h, $v ) = @_;
if ( MP() == 2 ) {
......@@ -217,6 +273,11 @@ sub lmSetHeaderOut {
}
}
## @fn string lmtHeaderOut(Apache2::RequestRec $r, string $h)
# Return an HTTP header value from the HTTP response.
# @param $r Current request
# @param $h Name of the header
# @return Value of the header
sub lmHeaderOut {
my ( $r, $h, $v ) = @_;
if ( MP() == 2 ) {
......@@ -229,6 +290,8 @@ sub lmHeaderOut {
# Status daemon creation
## @fn void statusProcess()
# Launch the status processus.
sub statusProcess {
require IO::Pipe;
$statusPipe = IO::Pipe->new;
......
package Lemonldap::NG::Portal;
print STDERR
"See Lemonldap::NG::Portal(3) to know which Lemonldap::NG::Portal::* module to use.";
our $VERSION = "0.86";
our @ISA = ('Lemonldap::NG::Portal::SharedConf');
1;
......
......@@ -12,17 +12,17 @@ use Lemonldap::NG::Portal::Simple;
our $VERSION = '0.11';
## @method authInit()
# @return error_code
## @method int authInit()
# @return Lemonldap::NG::Portal constant
sub authInit {
PE_OK;
}
## @method extractFormInfo()
## @method int extractFormInfo()
# Read username return by Apache authentication system.
# By default, authentication is valid if REMOTE_USER environment
# variable is set.
# @return error_code
# @return Lemonldap::NG::Portal constant
sub extractFormInfo {
my $self = shift;
unless ( $self->{user} = $ENV{REMOTE_USER} ) {
......@@ -35,9 +35,9 @@ sub extractFormInfo {
PE_OK;
}
# @method authenticate()
# @method int authenticate()
# Does nothing.
# @return error_code
# @return Lemonldap::NG::Portal constant
sub authenticate {
PE_OK;
}
......
......@@ -13,16 +13,17 @@ use AuthCAS;
our $VERSION = '0.04';
## @method authInit()
# @return error_code
## @method int authInit()
# Does nothing.
# @return Lemonldap::NG::Portal constant
sub authInit {
PE_OK;
}
## @method extractFormInfo()
## @method int extractFormInfo()
# Read username return by CAS authentication system.
# If user isn't authenticated, redirect it to CAS portal.
# @return error_code
# @return Lemonldap::NG::Portal constant
sub extractFormInfo {
my $self = shift;
my $cas = new AuthCAS(
......@@ -46,9 +47,9 @@ sub extractFormInfo {
PE_OK;
}
## @method authenticate()
## @method int authenticate()
# Does nothing.
# @return error_code
# @return Lemonldap::NG::Portal constant
sub authenticate {
PE_OK;
}
......
......@@ -15,8 +15,8 @@ use Lemonldap::NG::Portal::UserDBLDAP;
our $VERSION = '0.2';
use base qw(Lemonldap::NG::Portal::_WebForm);
## @function private ldap()
# @return object Lemonldap::NG::Portal::_LDAP object
## @fn private Lemonldap::NG::Portal::_LDAP ldap()
# @return Lemonldap::NG::Portal::_LDAP object
sub ldap {
my $self = shift;
unless ( ref( $self->{ldap} ) ) {
......@@ -32,9 +32,9 @@ sub ldap {
*_formateFilter = *Lemonldap::NG::Portal::UserDBLDAP::formateFilter;
*_search = *Lemonldap::NG::Portal::UserDBLDAP::search;
# @method authenticate()
## @method int authenticate()
# Authenticate user by LDAP mechanism.
# @return error_code
# @return Lemonldap::NG::Portal constant
sub authenticate {
my $self = shift;
unless ( $self->ldap ) {
......
......@@ -15,9 +15,9 @@ use base qw(Lemonldap::NG::Portal::AuthLDAP);
our $VERSION = '0.11';
## @method authInit()
## @method int authInit()
# Check if SSL environment variables are set.
# @return error_code
# @return Lemonldap::NG::Portal constant
sub authInit {
my $self = shift;
$self->{SSLRequire} = 1 unless ( defined $self->{SSLRequire} );
......@@ -30,12 +30,12 @@ sub authInit {
# Directory.
# So authenticate is overloaded to return only PE_OK.
## @method extractFormInfo()