Commit 5bac01a5 authored by Xavier Guimard's avatar Xavier Guimard

Lemonldap::NG : little documentation for Lemonldap::NG::Handler::Status and perltidy

parent 5ab3a3fd
......@@ -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
......
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__>
......
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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment