Lemonldap::NG : little documentation for Lemonldap::NG::Handler::Status and perltidy
This commit is contained in:
parent
5ab3a3fdfe
commit
5bac01a55f
|
@ -2,8 +2,9 @@ lemonldap-ng (0.9.2) unstable; urgency=low
|
|||
|
||||
* New css in manager
|
||||
* cleaning Handler code
|
||||
* Status system for Lemonldap::NG::Handler
|
||||
|
||||
-- Xavier Guimard <x.guimard@free.fr> Tue, 06 May 2008 06:58:04 +0200
|
||||
-- Xavier Guimard <x.guimard@free.fr> Fri, 09 May 2008 22:10:37 +0200
|
||||
|
||||
lemonldap-ng (0.9.1) unstable; urgency=low
|
||||
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
Revision history for Perl extension Lemonldap::NG::Handler.
|
||||
|
||||
0.87 Tue may 6 7:04:45 2008
|
||||
- Remove Apache2::compta dependency
|
||||
0.87 Tue may 9 22:32:44 2008
|
||||
- Remove Apache2::compat dependency
|
||||
- New status module
|
||||
|
||||
0.86 Mon apr 7 14:52:30 2008
|
||||
- logout bug : logout_sso target was not running (Closes: #308856 /
|
||||
|
|
|
@ -18,5 +18,7 @@ __PACKAGE__->init ( {
|
|||
},
|
||||
|
||||
https => 0,
|
||||
# Uncomment this to activate status module
|
||||
# status => 1,
|
||||
} );
|
||||
|
||||
1;
|
||||
|
|
|
@ -18,7 +18,9 @@ __PACKAGE__->init(
|
|||
dirName => '__CONFDIR__',
|
||||
},
|
||||
|
||||
https => 0,
|
||||
https => 0,
|
||||
# Uncomment this to activate status module
|
||||
# status => 1,
|
||||
}
|
||||
);
|
||||
|
||||
|
@ -34,3 +36,4 @@ sub logForbidden {
|
|||
. shift,
|
||||
);
|
||||
}
|
||||
1;
|
||||
|
|
|
@ -10,6 +10,14 @@
|
|||
PerlHeaderParserHandler My::Package->refresh
|
||||
</Location>
|
||||
|
||||
# Uncomment this to activate status module
|
||||
#<Location /status>
|
||||
# Order deny,allow
|
||||
# Deny from all
|
||||
# Allow from 127.0.0.0/8
|
||||
# PerlHeaderParserHandler My::Package->status
|
||||
#</Location>
|
||||
|
||||
# Just to make example running (index.pl display authenticated user)
|
||||
DocumentRoot __DIR__
|
||||
<Directory __DIR__>
|
||||
|
|
|
@ -1,30 +1,38 @@
|
|||
PerlOptions +GlobalRequest
|
||||
<VirtualHost 127.0.0.3:*>
|
||||
|
||||
ServerName test.example.com
|
||||
PerlRequire __DIR__/handler/MyHandler.pm
|
||||
PerlHeaderParserHandler My::Package
|
||||
<Location /reload>
|
||||
Order deny,allow
|
||||
Deny from all
|
||||
Allow from 127.0.0.0/8
|
||||
PerlHeaderParserHandler My::Package->refresh
|
||||
</Location>
|
||||
ServerName test.example.com
|
||||
PerlRequire __DIR__/handler/MyHandler.pm
|
||||
PerlHeaderParserHandler My::Package
|
||||
<Location /reload>
|
||||
Order deny,allow
|
||||
Deny from all
|
||||
Allow from 127.0.0.0/8
|
||||
PerlHeaderParserHandler My::Package->refresh
|
||||
</Location>
|
||||
|
||||
# Just to make example running (index.pl display authenticated user)
|
||||
DocumentRoot __DIR__
|
||||
<Directory __DIR__>
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
Options +ExecCGI
|
||||
</Directory>
|
||||
<Files *.pl>
|
||||
SetHandler perl-script
|
||||
PerlResponseHandler ModPerl::Registry
|
||||
</Files>
|
||||
# Uncomment this to activate status module
|
||||
#<Location /status>
|
||||
# Order deny,allow
|
||||
# Deny from all
|
||||
# Allow from 127.0.0.0/8
|
||||
# PerlHeaderParserHandler My::Package->status
|
||||
#</Location>
|
||||
|
||||
<IfModule mod_dir.c>
|
||||
DirectoryIndex index.pl index.html
|
||||
</IfModule>
|
||||
# Just to make example running (index.pl display authenticated user)
|
||||
DocumentRoot __DIR__
|
||||
<Directory __DIR__>
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
Options +ExecCGI
|
||||
</Directory>
|
||||
<Files *.pl>
|
||||
SetHandler perl-script
|
||||
PerlResponseHandler ModPerl::Registry
|
||||
</Files>
|
||||
|
||||
<IfModule mod_dir.c>
|
||||
DirectoryIndex index.pl index.html
|
||||
</IfModule>
|
||||
|
||||
</VirtualHost>
|
||||
|
|
|
@ -34,8 +34,10 @@ Create your own package (example using a central configuration database):
|
|||
type => "DBI",
|
||||
dbiChain => "DBI:mysql:database=lemondb;host=$hostname",
|
||||
dbiUser => "lemonldap",
|
||||
dbiPassword => "password",
|
||||
dbiPassword => "password",
|
||||
}
|
||||
# Uncomment this to activate status module
|
||||
# status => 1,
|
||||
} );
|
||||
|
||||
=head2 Configure Apache
|
||||
|
@ -68,8 +70,18 @@ You can also unprotect an URI
|
|||
PerlHeaderParserHandler My::Package->unprotect
|
||||
</Files>
|
||||
|
||||
To display the status page, add something like this :
|
||||
|
||||
<Location /status>
|
||||
Order deny,allow
|
||||
Allow from 10.1.1.0/24
|
||||
Deny from all
|
||||
PerlHeaderParserHandler My::Package->status
|
||||
</Location>
|
||||
|
||||
If your application has a "logout" URL, you can configure it directly in Apache
|
||||
configuration file (or in the manager interface) :
|
||||
configuration file (or in the manager interface). THIS IS DEPRECATED, use the
|
||||
manager :
|
||||
|
||||
<Location /logout>
|
||||
PerlHeaderParserHandler My::Package->logout
|
||||
|
|
|
@ -269,7 +269,7 @@ sub localInit($$) {
|
|||
require IO::Pipe;
|
||||
$statusPipe = IO::Pipe->new;
|
||||
$statusOut = IO::Pipe->new;
|
||||
if(my $pid = fork()) {
|
||||
if ( my $pid = fork() ) {
|
||||
$statusPipe->writer();
|
||||
$statusOut->reader();
|
||||
$statusPipe->autoflush(1);
|
||||
|
@ -277,15 +277,18 @@ sub localInit($$) {
|
|||
else {
|
||||
$statusPipe->reader();
|
||||
$statusOut->writer();
|
||||
my $fdin = $statusPipe->fileno;
|
||||
my $fdin = $statusPipe->fileno;
|
||||
my $fdout = $statusOut->fileno;
|
||||
open STDIN, "<&$fdin";
|
||||
|
||||
#open STDOUT, '>/tmp/log';
|
||||
open STDOUT, ">&$fdout";
|
||||
exec 'perl','-MLemonldap::NG::Handler::Status',
|
||||
'-e',
|
||||
'&Lemonldap::NG::Handler::Status::run('.$localStorage.','
|
||||
. Data::Dumper->new([$localStorageOptions])->Terse(1)->Dump.');';
|
||||
exec 'perl', '-MLemonldap::NG::Handler::Status',
|
||||
'-e',
|
||||
'&Lemonldap::NG::Handler::Status::run('
|
||||
. $localStorage . ','
|
||||
. Data::Dumper->new( [$localStorageOptions] )->Terse(1)->Dump
|
||||
. ');';
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -488,10 +491,12 @@ sub grant {
|
|||
sub forbidden {
|
||||
my $class = shift;
|
||||
if ( $datas->{_logout} ) {
|
||||
print $statusPipe $datas->{$whatToTrace} . " => $_[0] LOGOUT\n" if($statusPipe);
|
||||
print $statusPipe $datas->{$whatToTrace} . " => $_[0] LOGOUT\n"
|
||||
if ($statusPipe);
|
||||
return $class->goToPortal( $datas->{_logout}, 'logout=1' );
|
||||
}
|
||||
print $statusPipe $datas->{$whatToTrace} . " => $_[0] REJECT\n" if($statusPipe);
|
||||
print $statusPipe $datas->{$whatToTrace} . " => $_[0] REJECT\n"
|
||||
if ($statusPipe);
|
||||
$class->logForbidden(@_);
|
||||
return FORBIDDEN;
|
||||
}
|
||||
|
@ -571,7 +576,9 @@ sub run ($$) {
|
|||
my $id;
|
||||
unless ( $id = $class->fetchId ) {
|
||||
$class->lmLog( "$class: No cookie found", 'info' );
|
||||
print $statusPipe $apacheRequest->connection->remote_ip . " => $uri REDIRECT\n" if($statusPipe);
|
||||
print $statusPipe $apacheRequest->connection->remote_ip
|
||||
. " => $uri REDIRECT\n"
|
||||
if ($statusPipe);
|
||||
return $class->goToPortal($uri);
|
||||
}
|
||||
|
||||
|
@ -591,7 +598,9 @@ sub run ($$) {
|
|||
# The cookie isn't yet available
|
||||
$class->lmLog( "The cookie $id isn't yet available: $@",
|
||||
'info' );
|
||||
print $statusPipe $apacheRequest->connection->remote_ip . " => $uri REDIRECT\n" if($statusPipe);
|
||||
print $statusPipe $apacheRequest->connection->remote_ip
|
||||
. " => $uri REDIRECT\n"
|
||||
if ($statusPipe);
|
||||
return $class->goToPortal($uri);
|
||||
}
|
||||
$datas->{$_} = $h{$_} foreach ( keys %h );
|
||||
|
@ -610,7 +619,7 @@ sub run ($$) {
|
|||
|
||||
# AUTHORIZATION
|
||||
return $class->forbidden($uri) unless ( $class->grant($uri) );
|
||||
print $statusPipe $datas->{$whatToTrace} . " => $uri OK\n" if($statusPipe);
|
||||
print $statusPipe $datas->{$whatToTrace} . " => $uri OK\n" if ($statusPipe);
|
||||
$class->lmLog(
|
||||
"User "
|
||||
. $datas->{$whatToTrace}
|
||||
|
@ -691,26 +700,42 @@ sub redirectFilter {
|
|||
}
|
||||
while ( $f->read( my $buffer, 1024 ) ) {
|
||||
}
|
||||
print $statusPipe $datas->{$whatToTrace} . " => filter REDIRECT\n" if($statusPipe);
|
||||
print $statusPipe $datas->{$whatToTrace} . " => filter REDIRECT\n"
|
||||
if ($statusPipe);
|
||||
return REDIRECT;
|
||||
}
|
||||
|
||||
sub status($$) {
|
||||
my ( $class, $r ) = @_;
|
||||
$class->lmLog( "$class: request for status", 'debug' );
|
||||
return SERVER_ERROR unless( $statusPipe and $statusOut );
|
||||
return SERVER_ERROR unless ( $statusPipe and $statusOut );
|
||||
$r->handler("perl-script");
|
||||
print $statusPipe "STATUS\n";
|
||||
my $buf;
|
||||
while(<$statusOut>) {
|
||||
last if(/^$/);
|
||||
while (<$statusOut>) {
|
||||
last if (/^END$/);
|
||||
$buf .= $_;
|
||||
}
|
||||
if ( MP() == 2 ) {
|
||||
$r->push_handlers( 'PerlResponseHandler' => sub { my $r = shift; $r->content_type('text/plain'); $r->print($buf); OK } );
|
||||
$r->push_handlers(
|
||||
'PerlResponseHandler' => sub {
|
||||
my $r = shift;
|
||||
$r->content_type('text/plain');
|
||||
$r->print($buf);
|
||||
OK;
|
||||
}
|
||||
);
|
||||
}
|
||||
else {
|
||||
$r->push_handlers( 'PerlHandler' => sub { my $r = shift; $r->content_type('text/plain'); $r->send_http_header; $r->print($buf); OK });
|
||||
$r->push_handlers(
|
||||
'PerlHandler' => sub {
|
||||
my $r = shift;
|
||||
$r->content_type('text/plain');
|
||||
$r->send_http_header;
|
||||
$r->print($buf);
|
||||
OK;
|
||||
}
|
||||
);
|
||||
}
|
||||
return OK;
|
||||
}
|
||||
|
|
|
@ -5,32 +5,105 @@ use strict;
|
|||
our $status = {};
|
||||
|
||||
sub run {
|
||||
my( $localStorage, $localStorageOptions ) = ( shift, shift );
|
||||
#STDOUT->autoflush(1);
|
||||
my ( $localStorage, $localStorageOptions ) = ( shift, shift );
|
||||
my $refLocalStorage;
|
||||
eval "use $localStorage; \$refLocalStorage = new $localStorage(\$localStorageOptions);";
|
||||
die($@) if($@);
|
||||
$|=1;
|
||||
while(<STDIN>) {
|
||||
if(/^(\S+)\s+=>\s+(\S+)\s+(OK|REJECT|REDIRECT|LOGOUT)$/) {
|
||||
my($user,$uri,$code) = ($1,$2,$3);
|
||||
$status->{user}->{$user}->{$code}++;
|
||||
$uri =~ s/^(.*?)\?.*$/$1/;
|
||||
$status->{uri}->{$uri}->{$code}++;
|
||||
}
|
||||
elsif(/^STATUS$/) {
|
||||
#print Dumper($status);
|
||||
my $c;
|
||||
while( my($user,$v) = each( %{ $status->{user} } ) ) {
|
||||
foreach(keys %$v) {
|
||||
$c->{$_} += $v->{$_};
|
||||
}
|
||||
}
|
||||
use Data::Dumper; print Dumper($c);
|
||||
my @t = $refLocalStorage->get_keys($localStorageOptions->{namespace});
|
||||
print "Local Cache : " . @t . " objects\n";
|
||||
print "\n";
|
||||
}
|
||||
die($@) if ($@);
|
||||
$| = 1;
|
||||
while (<STDIN>) {
|
||||
if (/^(\S+)\s+=>\s+(\S+)\s+(OK|REJECT|REDIRECT|LOGOUT)$/) {
|
||||
my ( $user, $uri, $code ) = ( $1, $2, $3 );
|
||||
$status->{user}->{$user}->{$code}++;
|
||||
$uri =~ s/^(.*?)\?.*$/$1/;
|
||||
$status->{uri}->{$uri}->{$code}++;
|
||||
}
|
||||
elsif (/^STATUS$/) {
|
||||
my $c;
|
||||
while ( my ( $user, $v ) = each( %{ $status->{user} } ) ) {
|
||||
foreach ( keys %$v ) {
|
||||
$c->{$_} += $v->{$_};
|
||||
}
|
||||
}
|
||||
# DEVEL
|
||||
use Data::Dumper;
|
||||
print Dumper($c);
|
||||
my @t = $refLocalStorage->get_keys( $localStorageOptions->{namespace} );
|
||||
print "Local Cache : " . @t . " objects\n";
|
||||
print "END\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Lemonldap::NG::Handler::Status - Perl extension to add a mod_status like system for L<Lemonldap::NG::Handler>
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head2 Create your Apache module
|
||||
|
||||
Create your own package (example using a central configuration database):
|
||||
|
||||
package My::Package;
|
||||
use Lemonldap::NG::Handler::SharedConf;
|
||||
@ISA = qw(Lemonldap::NG::Handler::SharedConf);
|
||||
|
||||
__PACKAGE__->init ( {
|
||||
# Activate status feature
|
||||
status => 1,
|
||||
# Local storage used for sessions and configuration
|
||||
localStorage => "Cache::DBFile",
|
||||
localStorageOptions => {...},
|
||||
# How to get my configuration
|
||||
configStorage => {
|
||||
type => "DBI",
|
||||
dbiChain => "DBI:mysql:database=lemondb;host=$hostname",
|
||||
dbiUser => "lemonldap",
|
||||
dbiPassword => "password",
|
||||
}
|
||||
# ... See Lemonldap::N::Handler
|
||||
} );
|
||||
|
||||
=head2 Configure Apache
|
||||
|
||||
Call your package in /apache-dir/conf/httpd.conf:
|
||||
|
||||
# Load your package
|
||||
PerlRequire /My/File
|
||||
# Normal Protection
|
||||
PerlHeaderParserHandler My::Package
|
||||
|
||||
# Status page
|
||||
<Location /status>
|
||||
Order deny,allow
|
||||
Allow from 10.1.1.0/24
|
||||
Deny from all
|
||||
PerlHeaderParserHandler My::Package->status
|
||||
</Location>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Lemonldap::NG::Handler::Status adds a mod_status like feature to display
|
||||
Lemonldap::NG::Handler activity on a protected server. It can so be used by
|
||||
L<mrtg> or directly browsed by your browser.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Manager>,
|
||||
L<http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Xavier Guimard, E<lt>guimard@E<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2008 by Xavier Guimard
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.8 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
=cut
|
||||
|
|
|
@ -196,7 +196,7 @@ sub process {
|
|||
# $self->_debug("parameter : $_ = " . $self->param($_)) ;
|
||||
# }
|
||||
# while(my($k,$v) = each(%ENV)) {
|
||||
# $self->_debug("env : $k = $v") ;
|
||||
# $self->_debug("env : $k = $v") ;
|
||||
# }
|
||||
|
||||
#--------
|
||||
|
@ -315,7 +315,7 @@ sub process {
|
|||
# choisi pour récup les infos du user (sera par défaut en ldap).
|
||||
#
|
||||
# TODO :
|
||||
# * Faire de cette fonction un override de setSessionInfo avec par défaut
|
||||
# * Faire de cette fonction un override de setSessionInfo avec par défaut
|
||||
# le comportement de l'ancienne version et si dans la conf recup
|
||||
# attribut par wsf... recup en wsf2.0.
|
||||
#
|
||||
|
@ -326,10 +326,10 @@ sub setSessionInfo {
|
|||
|
||||
# Si configuration fixée à WSF
|
||||
# Alors
|
||||
# Traitement de récupération des informations par WSF
|
||||
# Traitement de récupération des informations par WSF
|
||||
# Sinon
|
||||
# Traitement de récupération des informations en appelant la fonction
|
||||
# SUPER::setSessionInfo.
|
||||
# Traitement de récupération des informations en appelant la fonction
|
||||
# SUPER::setSessionInfo.
|
||||
|
||||
# $self->{sessionInfo}->{dn} = "cn=tutu,ou=people,dc=example,dc=com" ;
|
||||
# $self->{sessionInfo}->{cn} = "tutu" ;
|
||||
|
@ -866,9 +866,9 @@ sub libertySignOn {
|
|||
#===============================================================================
|
||||
#
|
||||
# Two cases :
|
||||
# * Portal or applications requiere singleLogout -> SP request ;
|
||||
# * IDP requiere singleLogout -> IDP request with $ENV{'QUERY_STRING'}
|
||||
# specified.
|
||||
# * Portal or applications requiere singleLogout -> SP request ;
|
||||
# * IDP requiere singleLogout -> IDP request with $ENV{'QUERY_STRING'}
|
||||
# specified.
|
||||
#
|
||||
# This function one optional parameter that specifies if the portal is called
|
||||
# through a SOAP call.
|
||||
|
|
Loading…
Reference in New Issue