Commit 40d2c706 authored by Xavier Guimard's avatar Xavier Guimard

New target 'tidy' in Makefile

parent b5e24077
......@@ -592,3 +592,7 @@ default-diff:
@$(DIFF) lemonldap-ng-manager/example/index.pl $(LMPREFIX)/htdocs/manager/index.pl ||true
@$(DIFF) lemonldap-ng-manager/example/sessions.pl $(LMPREFIX)/htdocs/manager/sessions.pl ||true
tidy: clean
find lemon*/ -type f -name '*.pm' -exec perltidy -b {} \;
find lemon*/ -name '*.bak' -delete
package Lemonldap::NG::Common;
our $VERSION='0.95';
our $VERSION = '0.95';
use strict;
......
......@@ -194,12 +194,12 @@ sub get_key_from_all_sessions() {
my $r = $self->_soapCall( "get_key_from_all_sessions", $args );
my $res;
if ($r) {
foreach my $k ( keys %$r ) {
my $tmp = &$data( $r->{$k}, $k );
$res->{$k} = $tmp if ( defined($tmp) );
foreach my $k ( keys %$r ) {
my $tmp = &$data( $r->{$k}, $k );
$res->{$k} = $tmp if ( defined($tmp) );
}
}
}
}
else {
return $self->_soapCall( "get_key_from_all_sessions", $args, $data );
}
......
......@@ -127,8 +127,10 @@ sub soapTest {
# If non form encoded datas are posted, we call SOAP Services
if ( $ENV{HTTP_SOAPACTION} ) {
require Lemonldap::NG::Common::CGI::SOAPServer; #link protected dispatcher
require Lemonldap::NG::Common::CGI::SOAPService; #link protected soapService
require
Lemonldap::NG::Common::CGI::SOAPServer; #link protected dispatcher
require
Lemonldap::NG::Common::CGI::SOAPService; #link protected soapService
my @func = (
ref($soapFunctions) ? @$soapFunctions : split /\s+/,
$soapFunctions
......
......@@ -15,9 +15,9 @@ our $VERSION = '0.2';
# @param @func authorizated methods
# @return Lemonldap::NG::Common::CGI::SOAPService object
sub new {
my($class, $obj, @func) = @_;
s/.*::// foreach(@func);
return bless {obj=>$obj,func=>\@func}, $class;
my ( $class, $obj, @func ) = @_;
s/.*::// foreach (@func);
return bless { obj => $obj, func => \@func }, $class;
}
## @method datas AUTOLOAD()
......@@ -29,14 +29,14 @@ sub new {
sub AUTOLOAD {
my $self = shift;
$AUTOLOAD =~ s/.*:://;
if(grep {$_ eq $AUTOLOAD} @{$self->{func}}){
if ( grep { $_ eq $AUTOLOAD } @{ $self->{func} } ) {
my $tmp = $self->{obj}->$AUTOLOAD(@_);
unless(ref($tmp) and ref($tmp) eq 'SOAP::Data') {
unless ( ref($tmp) and ref($tmp) eq 'SOAP::Data' ) {
$tmp = SOAP::Data->name( result => $tmp );
}
return $tmp;
}
elsif($AUTOLOAD ne 'DESTROY') {
elsif ( $AUTOLOAD ne 'DESTROY' ) {
die "$AUTOLOAD is not an authorizated function";
}
1;
......
......@@ -9,7 +9,7 @@ package Lemonldap::NG::Common::Conf;
use strict;
no strict 'refs';
use Lemonldap::NG::Common::Conf::Constants; #inherits
use Lemonldap::NG::Common::Conf::Constants; #inherits
use Lemonldap::NG::Common::Crypto
; #link protected cipher Object "cypher" in configuration hash
use Regexp::Assemble;
......
......@@ -3,7 +3,7 @@ package Lemonldap::NG::Common::Conf::CDBI;
use strict;
use DBI;
require Storable;
use Lemonldap::NG::Common::Conf::Constants; #inherits
use Lemonldap::NG::Common::Conf::Constants; #inherits
our $VERSION = 0.1;
......@@ -84,7 +84,8 @@ sub store {
$fields =~ s/'/''/gs;
my $tmp =
$self->_dbh->do( "insert into "
. $self->{dbiTable} . " (cfgNum,data) values ($cfgNum,'$fields')");
. $self->{dbiTable}
. " (cfgNum,data) values ($cfgNum,'$fields')" );
unless ($tmp) {
$self->logError;
return UNKNOWN_ERROR;
......@@ -107,9 +108,10 @@ sub load {
return 0;
}
my $r;
eval { $r = Storable::thaw($row->[1]); } ;
eval { $r = Storable::thaw( $row->[1] ); };
if ($@) {
$Lemonldap::NG::Common::Conf::msg = "Bad stored data in conf database: $@";
$Lemonldap::NG::Common::Conf::msg =
"Bad stored data in conf database: $@";
return 0;
}
return $r;
......
package Lemonldap::NG::Common::Conf::File;
use strict;
use Lemonldap::NG::Common::Conf::Constants; #inherits
use Lemonldap::NG::Common::Conf::Constants; #inherits
use Lemonldap::NG::Common::Conf::Serializer;
our $VERSION = 0.23;
......@@ -74,8 +74,8 @@ sub store {
$self->unlock;
return UNKNOWN_ERROR;
}
foreach my $k (sort keys %$fields) {
print FILE "$k\n\t$fields->{$k}\n\n";
foreach my $k ( sort keys %$fields ) {
print FILE "$k\n\t$fields->{$k}\n\n";
}
close FILE;
umask($mask);
......
......@@ -13,7 +13,7 @@ use Lemonldap::NG::Common::Conf::Serializer;
our $VERSION = 0.02;
BEGIN {
*Lemonldap::NG::Common::Conf::ldap = \&ldap;
*Lemonldap::NG::Common::Conf::ldap = \&ldap;
}
sub prereq {
......@@ -56,7 +56,7 @@ sub lastCfg {
sub ldap {
my $self = shift;
return $self->{ldap} if($self->{ldap});
return $self->{ldap} if ( $self->{ldap} );
# Parse servers configuration
my $useTls = 0;
......@@ -106,16 +106,19 @@ sub ldap {
}
sub lock {
# No lock for LDAP
return 1;
}
sub isLocked {
# No lock for LDAP
return 0;
}
sub unlock {
# No lock for LDAP
return 1;
}
......
......@@ -119,7 +119,7 @@ sub load {
while ( @row = $sth->fetchrow_array ) {
$res->{ $row[1] } = $row[2];
}
unless($res) {
unless ($res) {
$Lemonldap::NG::Common::Conf::msg .= "No configuration $cfgNum found";
return 0;
}
......
......@@ -218,7 +218,7 @@ sub toXML {
# Return this object in configuration string format.
# @return string
sub toConf {
my $self = shift;
my $self = shift;
my $fields = $self->toHash();
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Varname = "data";
......@@ -233,11 +233,10 @@ sub toConf {
# Return this object in configuration hash format.
# @return hashref
sub toHash {
my $self = shift;
my $self = shift;
my $fields = ();
foreach (keys %$self)
{
$fields->{$_} = $self->{$_};
foreach ( keys %$self ) {
$fields->{$_} = $self->{$_};
}
return $fields;
}
......
......@@ -10,7 +10,7 @@ our $VERSION = 0.21;
BEGIN {
*Lemonldap::NG::Common::Conf::_soapCall = \&_soapCall;
*Lemonldap::NG::Common::Conf::_connect = \&_connect;
*Lemonldap::NG::Common::Conf::_connect = \&_connect;
sub SOAP::Transport::HTTP::Client::get_basic_credentials {
return $Lemonldap::NG::Common::Conf::SOAP::username =>
......
......@@ -3,14 +3,14 @@ package Lemonldap::NG::Common::Conf::Serializer;
use Data::Dumper;
BEGIN {
*Lemonldap::NG::Common::Conf::serialize = \&serialize;
*Lemonldap::NG::Common::Conf::serialize = \&serialize;
*Lemonldap::NG::Common::Conf::unserialize = \&unserialize;
}
sub serialize {
my ( $self, $conf ) = @_;
my $fields;
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Varname = "data";
while ( my ( $k, $v ) = each(%$conf) ) {
next if ( $k =~ /^(?:reVHosts|cipher)$/ );
......
......@@ -66,7 +66,7 @@ sub decrypt {
$msg = '';
# Obscure Perl re bug...
$tmp .="\0";
$tmp .= "\0";
$tmp =~ s/\0*$//;
return $tmp;
}
......
......@@ -23,7 +23,7 @@ our $functions = [qw(&checkLogonHours &checkDate)];
# @param $default_access optional what result to return for users without logons hours
# @return 1 if access allowed, 0 else
sub checkLogonHours {
my ($logon_hours, $syntax, $time_correction, $default_access) = @_;
my ( $logon_hours, $syntax, $time_correction, $default_access ) = @_;
# Active Directory - logonHours: $attr_src_syntax = octetstring
# Samba - sambaLogonHours: ???
......@@ -39,29 +39,31 @@ sub checkLogonHours {
# Begin with sunday at 0h00
my $base2_logon_hours;
if ( $syntax eq "octetstring" ) {
$base2_logon_hours = unpack ("B*", $logon_hours);
$base2_logon_hours = unpack( "B*", $logon_hours );
}
if ( $syntax eq "hexadecimal" ) {
# Remove white spaces
$logon_hours =~ s/ //g;
$base2_logon_hours = unpack ("B*", pack ("H*", $logon_hours));
$base2_logon_hours = unpack( "B*", pack( "H*", $logon_hours ) );
}
# Get the present day and hour
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
gmtime(time);
# Get the hour position
my $hourpos = $wday*24 + $hour;
my $hourpos = $wday * 24 + $hour;
# Use time_correction
if ($time_correction) {
my ($sign, $time) = ($time_correction =~ /([+|-]?)(\d+)/);
if ($sign =~ /-/) { $hourpos -= $time; }
else { $hourpos += $time; }
my ( $sign, $time ) = ( $time_correction =~ /([+|-]?)(\d+)/ );
if ( $sign =~ /-/ ) { $hourpos -= $time; }
else { $hourpos += $time; }
}
# Get the corresponding byte
return substr($base2_logon_hours, $hourpos, 1);
return substr( $base2_logon_hours, $hourpos, 1 );
}
## @function boolean checkDate(string start, string end, boolean default_access)
......@@ -71,15 +73,15 @@ sub checkLogonHours {
# @param $default_access optional what result to return for users without start or end start
# @return 1 if access allowed, 0 else
sub checkDate {
my ($start, $end, $default_access) = @_;
my ( $start, $end, $default_access ) = @_;
# Get date in string
$start = substr($start, 0, 14);
$end = substr($end, 0, 14);
$start = substr( $start, 0, 14 );
$end = substr( $end, 0, 14 );
# Default access if no value
$default_access ||= "0";
return $default_access unless ($start or $end);
return $default_access unless ( $start or $end );
# If no start, set start to 0
$start ||= 0;
......@@ -88,22 +90,22 @@ sub checkDate {
$end ||= 999999999999999;
# Get the present day and hour
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
gmtime(time);
$year += 1900;
$mon += 1;
$mon = "0".$mon if ($mon<10);
$mday = "0".$mday if ($mday<10);
$hour = "0".$hour if ($hour<10);
$min = "0".$min if ($min<10);
$sec = "0".$sec if ($sec<10);
$mon += 1;
$mon = "0" . $mon if ( $mon < 10 );
$mday = "0" . $mday if ( $mday < 10 );
$hour = "0" . $hour if ( $hour < 10 );
$min = "0" . $min if ( $min < 10 );
$sec = "0" . $sec if ( $sec < 10 );
my $date = $year.$mon.$mday.$hour.$min.$sec;
my $date = $year . $mon . $mday . $hour . $min . $sec;
return 1 if ( ($date >= $start) and ($date <= $end) );
return 1 if ( ( $date >= $start ) and ( $date <= $end ) );
return 0;
}
1;
__END__
......
......@@ -7,11 +7,11 @@ __PACKAGE__->init(
# ACCESS TO CONFIGURATION
# By default, Lemonldap::NG uses the default lemonldap-ng.ini file to know
# where to find is configuration
# (generaly /etc/lemonldap-ng/lemonldap-ng.ini)
# You can specify by yourself this file :
#configStorage => { confFile => '/path/to/my/file' },
# By default, Lemonldap::NG uses the default lemonldap-ng.ini file to know
# where to find is configuration
# (generaly /etc/lemonldap-ng/lemonldap-ng.ini)
# You can specify by yourself this file :
#configStorage => { confFile => '/path/to/my/file' },
# You can also specify directly the configuration
# (see Lemonldap::NG::Handler::SharedConf(3))
......
......@@ -20,11 +20,11 @@ __PACKAGE__->init(
# ACCESS TO CONFIGURATION
# By default, Lemonldap::NG uses the default lemonldap-ng.ini file to know
# where to find is configuration
# (generaly /etc/lemonldap-ng/lemonldap-ng.ini)
# You can specify by yourself this file :
#configStorage => { confFile => '/path/to/my/file' },
# By default, Lemonldap::NG uses the default lemonldap-ng.ini file to know
# where to find is configuration
# (generaly /etc/lemonldap-ng/lemonldap-ng.ini)
# You can specify by yourself this file :
#configStorage => { confFile => '/path/to/my/file' },
# You can also specify directly the configuration
# (see Lemonldap::NG::Handler::SharedConf(3))
......
......@@ -25,7 +25,7 @@ our $VERSION = '0.4';
# @return new object
sub new {
my $class = shift;
my $self = $class->SUPER::new() or $class->abort("Unable to build CGI");
my $self = $class->SUPER::new() or $class->abort("Unable to build CGI");
$Lemonldap::NG::Handler::_CGI::_cgi = $self;
unless ($Lemonldap::NG::Handler::_CGI::cookieName) {
Lemonldap::NG::Handler::_CGI->init(@_);
......@@ -216,9 +216,9 @@ sub grant {
$vhost ||= $ENV{SERVER_NAME};
$apacheRequest = Lemonldap::NG::Apache::Request->new(
{
uri => $uri,
hostname => $vhost,
args => '',
uri => $uri,
hostname => $vhost,
args => '',
}
);
for ( my $i = 0 ; $i < $locationCount->{$vhost} ; $i++ ) {
......@@ -240,7 +240,7 @@ package Lemonldap::NG::Apache::Request;
sub new {
my $class = shift;
my $self = shift;
my $self = shift;
return bless $self, $class;
}
......
......@@ -19,11 +19,12 @@ use strict;
use Lemonldap::NG::Handler::Simple qw(:all);
use Lemonldap::NG::Handler::Vhost;
use Lemonldap::NG::Common::Conf; #link protected lmConf
use Lemonldap::NG::Common::Conf::Constants; #inherits
use Lemonldap::NG::Common::Conf; #link protected lmConf
use Lemonldap::NG::Common::Conf::Constants; #inherits
use Cache::Cache qw($EXPIRES_NEVER);
use base qw(Lemonldap::NG::Handler::Vhost Lemonldap::NG::Handler::Simple);
#parameter reloadTime Time in second between 2 configuration check (600)
our $VERSION = '0.72';
......@@ -62,6 +63,7 @@ BEGIN {
# @param $args hash containing parameters
sub init($$) {
my ( $class, $args ) = splice @_;
# TODO reloadTime in defaultValuesInit ?
$reloadTime = $args->{reloadTime} || 600;
$class->localInit($args);
......@@ -91,8 +93,8 @@ sub localInit {
Lemonldap::NG::Common::Conf->new( $args->{configStorage} ) );
# Get local configuration parameters
my $localconf = $lmConf->getLocalConf( HANDLERSECTION );
if ( $localconf ) {
my $localconf = $lmConf->getLocalConf(HANDLERSECTION);
if ($localconf) {
$args->{$_} ||= $localconf->{$_} foreach ( keys %$localconf );
}
......
......@@ -9,7 +9,7 @@ use Data::Dumper;
#inherits Cache::Cache
our $VERSION = "0.21";
our $VERSION = "0.21";
our $status = {};
our $activity = [];
......@@ -142,86 +142,86 @@ sub run {
}
else {
# Total requests
print "<h2>Total</h2>\n<div id=\"total\"><pre>\n";
print sprintf( "%-30s : \%6d (%.02f / mn)\n",
$_, $c->{$_}, $c->{$_} / $mn )
foreach ( sort keys %$c );
print "\n</pre></div>\n";
# Average
print "<h2>Average for last " . MN_COUNT
. " minutes</h2>\n<div id=\"average\"><pre>\n";
print sprintf( "%-30s : %6s / mn\n", $_, $m->{$_} )
foreach ( sort keys %$m );
print "\n</pre></div>\n";
# Users connected
print "<div id=\"users\"><p>\nTotal users : $u\n</p></div>\n";
# Local cache
my @t =
# Total requests
print "<h2>Total</h2>\n<div id=\"total\"><pre>\n";
print sprintf( "%-30s : \%6d (%.02f / mn)\n",
$_, $c->{$_}, $c->{$_} / $mn )
foreach ( sort keys %$c );
print "\n</pre></div>\n";
# Average
print "<h2>Average for last " . MN_COUNT
. " minutes</h2>\n<div id=\"average\"><pre>\n";
print sprintf( "%-30s : %6s / mn\n", $_, $m->{$_} )
foreach ( sort keys %$m );
print "\n</pre></div>\n";
# Users connected
print "<div id=\"users\"><p>\nTotal users : $u\n</p></div>\n";
# Local cache
my @t =
$refLocalStorage->get_keys(
$localStorageOptions->{namespace} );
print "<div id=\"cache\"><p>\nLocal Cache : " . @t
. " objects\n</p></div>\n";
print "<div id=\"cache\"><p>\nLocal Cache : " . @t
. " objects\n</p></div>\n";
# Uptime
print "<div id=\"up\"><p>\nServer up for : "
. &timeUp($mn)
. "\n</p></div>\n";
# Top uri
if ( $args->{top} ) {
print "<hr/>\n";
# Top uri
if ( $args->{top} ) {
print "<hr/>\n";
$args->{categories} ||=
'REJECT,PORTAL_FIRSTACCESS,LOGOUT,OK';
# Vhost activity
print
# Vhost activity
print
"<h2>Virtual Host activity</h2>\n<div id=\"vhost\"><pre>\n";
foreach (
sort { $count->{vhost}->{$b} <=> $count->{vhost}->{$a} }
keys %{ $count->{vhost} }
)
{
foreach (
sort { $count->{vhost}->{$b} <=> $count->{vhost}->{$a} }
keys %{ $count->{vhost} }
)
{
print
sprintf( "%-40s : %6d\n", $_, $count->{vhost}->{$_} );
}
print "\n</pre></div>\n";
# General
print "<h2>Top used URI</h2>\n<div id=\"uri\"><pre>\n";
my $i = 0;
foreach (
sort { $count->{uri}->{$b} <=> $count->{uri}->{$a} }
keys %{ $count->{uri} }
)
{
last if ( $i == $args->{top} );
last unless ( $count->{uri}->{$_} );
$i++;
}
print "\n</pre></div>\n";
# General
print "<h2>Top used URI</h2>\n<div id=\"uri\"><pre>\n";
my $i = 0;
foreach (
sort { $count->{uri}->{$b} <=> $count->{uri}->{$a} }
keys %{ $count->{uri} }
)
{
last if ( $i == $args->{top} );
last unless ( $count->{uri}->{$_} );
$i++;
print
sprintf( "%-80s : %6d\n", $_, $count->{uri}->{$_} );
}
print "\n</pre></div>\n";
}
print "\n</pre></div>\n";
# Top by category
print
"<table class=\"topByCat\"><tr><th style=\"width:20%\">Code</th><th>Top</th></tr>\n";
foreach my $cat ( split /,/, $args->{categories} ) {
# Top by category
print
"<table class=\"topByCat\"><tr><th style=\"width:20%\">Code</th><th>Top</th></tr>\n";
foreach my $cat ( split /,/, $args->{categories} ) {
print
"<tr><td>$cat</td><td nowrap>\n<div id=\"$cat\">\n";
topByCat( $cat, $args->{top} );
print "</div>\n</td></tr>";
topByCat( $cat, $args->{top} );
print "</div>\n</td></tr>";
}
print "</table>\n";
}
print "</table>\n";
}
&end;
&end;
}
}
}
}
}
## @rfn private string timeUp(int d)
......
......@@ -7,31 +7,33 @@ use Digest::MD5;
our $VERSION = '0.11';
open S, '/etc/lemonldap-ng/sympa.secret' or die "Unable to open /etc/lemonldap-ng/sympa.secret";
our $sympaSecret = join('',<S>);
open S, '/etc/lemonldap-ng/sympa.secret'
or die "Unable to open /etc/lemonldap-ng/sympa.secret";
our $sympaSecret = join( '', <S> );
close S;
$sympaSecret =~ s/[\r\n]//g;
sub run {
my $class = shift;
my $r = $_[0];
my $ret = $class->SUPER::run(@_);
my $class = shift;
my $r = $_[0];
my $ret = $class->SUPER::run(@_);
# Building Sympa cookie
my $tmp = new Digest::MD5;
$tmp->reset;
$tmp->add($datas->{mail}.$sympaSecret);
my $str = "sympauser=$datas->{mail}:".substr(unpack("H*",$tmp->digest), -8);
my $tmp = new Digest::MD5;
$tmp->reset;
$tmp->add( $datas->{mail} . $sympaSecret );
my $str =
"sympauser=$datas->{mail}:" . substr( unpack( "H*", $tmp->digest ), -8 );
# Get cookie header, removing Sympa cookie if exists (avoid security
# problems) and set the new value
$tmp = lmHeaderIn( $r, 'Cookie' );
$tmp = lmHeaderIn( $r, 'Cookie' );
$tmp =~ s/\bsympauser=[^,;]*[,;]?//;
$tmp .= $tmp ? ";$str" : $str;
lmSetHeaderIn( $r, 'Cookie' => $tmp );
$tmp .= $tmp ? ";$str" : $str;
lmSetHeaderIn( $r, 'Cookie' => $tmp );
# Return SUPER::run() result
return $ret;
return $ret;
}
1;
......
......@@ -5,7 +5,7 @@
# This class adds virtual host support for Lemonldap::NG handlers.
package Lemonldap::NG::Handler::Vhost;
use Lemonldap::NG::Handler::Simple qw(:locationRules :headers); #inherits
use Lemonldap::NG::Handler::Simple qw(:locationRules :headers); #inherits
use strict;
use MIME::Base64;