Commit ef0cca88 authored by Xavier Guimard's avatar Xavier Guimard

LEMONLDAP::NG : new features:

                - 'apply changes' button in Manager used to reload configuration
                  in handlers (by calling reload sub via HTTP)
                - i18n module in portal (for displaying errors)
                - lock in DBI configuration system (NOT YET TESTED)


git-svn-id: svn://svn.forge.objectweb.org/svnroot/lemonldap/trunk@55 1dbb9719-a921-0410-b57f-c3a383c2c641
parent 8507614c
......@@ -20,7 +20,7 @@ described below.
1 - INSTALLATION
================
Lenmonldap::NG is a different project than Lemonldap and contains all you need
Lemonldap::NG is a different project than Lemonldap and contains all you need
to use and administer it. So softwares, like Lemonldap webmin module, may not
work with Lemonldap::NG.
......
......@@ -95,9 +95,6 @@ sub headers {
my $response = shift;
my $tmp = $response->header('Content-Type');
$r->content_type($tmp) if ($tmp);
# Modif demandée par mail
#$r->content_type( $response->header('Content-Type') );
$r->status( $response->code );
$r->status_line( join ' ', $response->code, $response->message );
......
Revision history for Perl extension Lemonldap::NG::Manager.
0.45 Sat Mar 3 9:26:08 2007
- New error system when uploading conf
- Verification if configuration has changed before saving
- New feature: "apply configuration"
0.44 Sat Feb 24 16:32:34 2007
- Adding SOAP support to access to configuration
......
......@@ -53,10 +53,12 @@ lib/Lemonldap/NG/Manager/_HTML.pm
lib/Lemonldap/NG/Manager/_i18n.pm
lib/Lemonldap/NG/Manager/Base.pm
lib/Lemonldap/NG/Manager/Conf.pm
lib/Lemonldap/NG/Manager/Conf/Constants.pm
lib/Lemonldap/NG/Manager/Conf/DBI.pm
lib/Lemonldap/NG/Manager/Conf/File.pm
lib/Lemonldap/NG/Manager/Conf/SOAP.pm
lib/Lemonldap/NG/Manager/Help.pm
lib/Lemonldap/NG/Manager/Restricted.pm
lib/Lemonldap/NG/Manager/SOAPServer.pm
Makefile.PL
MANIFEST
......
......@@ -5,10 +5,11 @@ WriteMakefile(
NAME => 'Lemonldap::NG::Manager',
VERSION_FROM => 'lib/Lemonldap/NG/Manager.pm', # finds $VERSION
PREREQ_PM => {
'DBI' => 0,
'CGI' => 3.08,
'Storable' => 0,
'XML::Simple' => 0
'DBI' => 0,
'CGI' => 3.08,
'Storable' => 0,
'XML::Simple' => 0,
'LWP::UserAgent' => 0,
}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/Lemonldap/NG/Manager.pm', # retrieve abstract from module
......
......@@ -20,7 +20,7 @@ described below.
1 - INSTALLATION
================
Lenmonldap::NG is a different project than Lemonldap and contains all you need
Lemonldap::NG is a different project than Lemonldap and contains all you need
to use and administer it. So softwares, like Lemonldap webmin module, may not
work with Lemonldap::NG.
......
......@@ -9,6 +9,7 @@ use Lemonldap::NG::Manager::Conf;
use Lemonldap::NG::Manager::_HTML;
require Lemonldap::NG::Manager::_i18n;
require Lemonldap::NG::Manager::Help;
use LWP::UserAgent;
our @ISA = qw(Lemonldap::NG::Manager::Base);
......@@ -32,6 +33,9 @@ sub new {
unless ( -r $self->{jsFile} ) {
print STDERR qq#Unable to read $self->{jsFile}. You have to set "jsFile" parameter to /path/to/lemonldap-ng-manager.js\n#;
}
unless ( __PACKAGE__->can('ldapServer') ) {
Lemonldap::NG::Manager::_i18n::import( $ENV{HTTP_ACCEPT_LANGUAGE} );
}
if ( $self->param('lmQuery') ) {
my $tmp = "print_" . $self->param('lmQuery');
$self->$tmp;
......@@ -51,7 +55,9 @@ sub new {
# Subroutines to make all the work
sub doall {
my $self = shift;
print $self->header_public;
# When using header_public here, Firefox does not load configuration
# sometimes. Where is the bug ?
print $self->header;
print $self->start_html;
print $self->main;
print $self->end_html;
......@@ -77,7 +83,9 @@ sub print_libjs {
sub print_lmjs {
my $self = shift;
print $self->header_public( $ENV{SCRIPT_FILENAME},
# TODO: replace this
# print $self->header_public( $ENV{SCRIPT_FILENAME},
print $self->header(
-type => 'text/javascript' );
$self->javascript;
}
......@@ -96,9 +104,6 @@ sub print_help {
# Configuration download subroutines
sub print_conf {
my $self = shift;
unless ( __PACKAGE__->can('ldapServer') ) {
Lemonldap::NG::Manager::_i18n::import( $ENV{HTTP_ACCEPT_LANGUAGE} );
}
print $self->header( -type => "text/xml", '-Cache-Control' => 'private' );
$self->printXmlConf;
exit;
......@@ -112,6 +117,17 @@ sub default {
}
sub printXmlConf {
my $self = shift;
print XMLout(
$self->buildTree,
#XMLDecl => "<?xml version='1.0' encoding='iso-8859-1'?>",
RootName => 'tree',
KeyAttr => { item => 'id', username => 'name' },
NoIndent => 1
);
}
sub buildTree {
my $self = shift;
my $config = $self->config->getConf();
$config = $self->default unless ($config);
......@@ -151,8 +167,9 @@ sub printXmlConf {
},
groups => { text => &txt_userGroups, },
virtualHosts => {
text => &txt_virtualHosts,
open => 1,
text => &txt_virtualHosts,
open => 1,
select => 1,
},
},
},
......@@ -265,15 +282,7 @@ sub printXmlConf {
$macros->{$macro} = $self->xmlField( 'both', $expr, $macro );
}
}
print XMLout(
$tree,
#XMLDecl => "<?xml version='1.0' encoding='iso-8859-1'?>",
RootName => 'tree',
KeyAttr => { item => 'id', username => 'name' },
NoIndent => 1
);
return $tree;
}
sub xmlField {
......@@ -309,10 +318,14 @@ sub upload {
my ( $self, $tree ) = @_;
$tree = XMLin($$tree);
my $config = {};
# Load config number
($config->{cfgNum}) = ($tree->{text} =~ /(\d+)$/);
# Load groups
while ( my ( $g, $h ) = each( %{ $tree->{groups} } ) ) {
next unless ( ref($h) );
$config->{groups}->{ $h->{text} } = $h->{value};
}
# Load virtualHosts
while ( my ( $vh, $h ) = each( %{ $tree->{virtualHosts} } ) ) {
next unless ( ref($h) );
my $lr;
......@@ -330,6 +343,7 @@ sub upload {
$config->{exportedHeaders}->{$vh}->{ $h->{text} } = $h->{value};
}
}
# General parameters
$config->{cookieName} = $tree->{generalParameters}->{cookieName}->{value};
$config->{domain} = $tree->{generalParameters}->{domain}->{value};
$config->{globalStorage} = $tree->{generalParameters}->{sessionStorage}->{globalStorage}->{value};
......@@ -361,6 +375,51 @@ sub upload {
return $self->config->saveConf($config);
}
# Apply subroutines
# TODO: Credentials in applyConfFile
sub print_apply {
my $self = shift;
print $self->header( -type => "text/html" );
unless(-r $self->{applyConfFile} ) {
print "<h3>".&txt_canNotReadApplyConfFile."</h3>";
return;
}
print '<h3>' . &txt_result . ' : </h3><ul>';
open F, $self->{applyConfFile};
my $ua = new LWP::UserAgent( requests_redirectable => [] );
$ua->timeout(10);
while(<F>) {
local $| = 1;
# pass blank lines and comments
next if(/^$/ or /^\s*#/);
chomp;
s/\r//;
# each line must be like:
# host http(s)://vhost/request/
my( $host, $request ) = (/^\s*([^\s]+)\s+([^\s]+)$/);
unless( $host and $request ) {
print "<li> ".&txt_invalidLine.": $_</li>";
next;
}
my ( $method, $vhost, $uri ) = ( $request =~ /^(https?):\/\/([^\/]+)(.*)$/ );
unless($vhost) {
$vhost = $host;
$uri = $request;
}
print "<li>$host ... ";
my $r = HTTP::Request->new( 'GET', "$method://$host$uri", HTTP::Headers->new( Host => $vhost ) );#, {Host => $vhost} );
my $response = $ua->request( $r );
if ( $response->code != 200 ) {
print join( ' ', &txt_error, ":", $response->code, $response->message, "</li>");
}
else {
print "OK</li>";
}
}
print "</ul><p>" . &txt_changesAppliedLater . "</p>";
}
# Internal subroutines
sub _dir {
my $d = $ENV{SCRIPT_FILENAME};
......@@ -461,6 +520,15 @@ error logs.
=item * B<jsFile> (optional): the path to the file C<lemonldap-ng-manager.js>.
It is required only if this file is not in the same directory than your script.
=item * B<applyConfFile> (optional): the path to a file containing parameters
to make configuration reloaded by handlers. See C<reload> function in
L<Lemonldap::NG::Handler>. The configuration file must contains lines like:
# Comments if wanted
host http://virtual-host/reload-path
When this parameter is set, an "apply" button is added to the manager menu.
=back
=item * B<doall>: subroutine that provide headers and the full html code. Il
......
......@@ -26,8 +26,7 @@ sub header_public {
my $year = $5;
my $cm = $2;
# TODO
if ( my $ref = $ENV{TODO_HTTP_IF_MODIFIED_SINCE} ) {
if ( my $ref = $ENV{HTTP_IF_MODIFIED_SINCE} ) {
my %month = (
jan => 0,
feb => 1,
......@@ -54,7 +53,7 @@ sub header_public {
}
return $self->SUPER::header(
'-Last-Modified' => $hd,
'-Cache-Control' => 'public',
'-Cache-Control' => 'public; must-revalidate',
@_
);
}
......
......@@ -3,8 +3,9 @@ package Lemonldap::NG::Manager::Conf;
use strict;
use Storable qw(thaw freeze);
use MIME::Base64;
use Lemonldap::NG::Manager::Conf::Constants;
our $VERSION = 0.41;
our $VERSION = 0.42;
our @ISA;
sub new {
......@@ -36,6 +37,9 @@ sub new {
sub saveConf {
my ( $self, $conf ) = @_;
# If configuration was modified, return an error
return CONFIG_WAS_CHANGED if( $conf->{cfgNum} != $self->lastCfg or $self->isLocked );
$self->lock or return DATABASE_LOCKED;
my $fields;
while ( my ( $k, $v ) = each(%$conf) ) {
if ( ref($v) ) {
......
package Lemonldap::NG::Manager::Conf::Constants;
use strict;
use Exporter 'import';
our @ISA = qw(Exporter);
our $VERSION = '0.1';
# CONSTANTS
use constant CONFIG_WAS_CHANGED => -1;
use constant UNKNOWN_ERROR => -2;
use constant DATABASE_LOCKED => -3;
our %EXPORT_TAGS = ( 'all' => [ qw(
CONFIG_WAS_CHANGED
UNKNOWN_ERROR
DATABASE_LOCKED
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
1;
__END__
......@@ -4,8 +4,9 @@ use strict;
use DBI;
use Storable qw(freeze thaw);
use MIME::Base64;
use Lemonldap::NG::Manager::Conf::Constants;
our $VERSION = 0.1;
our $VERSION = 0.12;
sub prereq {
my $self = shift;
......@@ -21,9 +22,8 @@ sub prereq {
sub available {
my $self = shift;
$self->_connect;
my $sth =
$self->{dbh}->prepare(
$self->dbh->prepare(
"SELECT cfgNum from " . $self->{dbiTable} . " order by cfgNum" );
$sth->execute();
my @conf;
......@@ -36,49 +36,82 @@ sub available {
sub lastCfg {
my $self = shift;
my @row =
$self->{dbh}
->selectrow_array( "SELECT max(cfgNum) from " . $self->{dbiTable} );
$self->dbh->selectrow_array( "SELECT max(cfgNum) from " . $self->{dbiTable} );
return $row[0];
}
sub _connect {
sub dbh {
my $self = shift;
$self->{dbh} = DBI->connect_cached(
$self->{dbiTable} ||= "lmconfig";
return $self->{dbh} ||= DBI->connect_cached(
$self->{dbiChain}, $self->{dbiUser},
$self->{dbiPassword}, { RaiseError => 1 }
);
$self->{dbiTable} ||= "lmconfig";
}
# TODO: test lock
sub lock {
my $self = shift;
my $sth = $self->dbh->prepare_cached(q{SELECT GET_LOCK(?, 5)}, {}, 1);
$sth->execute('lmconf');
my @row = $sth->fetchrow_array;
return $row[0] || 0;
}
sub isLocked {
my $self = shift;
my $sth = $self->dbh->prepare_cached(q{SELECT IS_FREE_LOCK(?)}, {}, 1);
$sth->execute('lmconf');
my @row = $sth->fetchrow_array;
return $row[0] ? 0 : 1;
}
sub unlock {
my $self = shift;
my $sth = $self->dbh->prepare_cached(q{SELECT RELEASE_LOCK(?)}, {}, 1);
$sth->execute('lmconf');
my @row = $sth->fetchrow_array;
return $row[0] || 0;
}
sub store {
my ( $self, $fields ) = @_;
$self->_connect;
my $tmp =
$self->{dbh}->do( "insert into "
$self->dbh->do( "insert into "
. $self->{dbiTable} . " ("
. join( ",", keys(%$fields) )
. ") values ("
. join( ",", values(%$fields) )
. ")" );
unless ($tmp) {
print STDERR "Database error: " . $self->{dbh}->errstr . "\n";
return 0;
$self->logError;
return UNKNOWN_ERROR;
}
unless( $self->unlock ) {
$self->logError;
return UNKNOWN_ERROR;
}
return $fields->{cfgNum};
}
sub load {
my ( $self, $cfgNum, $fields ) = @_;
$self->_connect;
$fields = join( /,/, @$fields ) || '*';
my $row =
$self->{dbh}->selectrow_hashref(
$self->dbh->selectrow_hashref(
"SELECT $fields from " . $self->{dbiTable} . " WHERE cfgNum=$cfgNum" );
unless ($row) {
print STDERR "Database error: " . $self->{dbh}->errstr . "\n";
$self->logError;
return 0;
}
return $row;
}
sub logError {
my $self = shift;
print STDERR "Database error: " . $self->dbh->errstr . "\n";
}
1;
__END__
package Lemonldap::NG::Manager::Conf::File;
use strict;
use Lemonldap::NG::Manager::Conf::Constants;
our $VERSION = 0.1;
our $VERSION = 0.12;
sub prereq {
my $self = shift;
......@@ -32,13 +33,32 @@ sub lastCfg {
return $avail[$#avail];
}
# TODO: LOCK
sub lock {
return 1;
}
sub isLocked {
return 0;
}
sub unlock {
return 1;
}
sub store {
my ( $self, $fields ) = @_;
open FILE, '>' . $self->{dirName} . "/lmConf-" . $fields->{cfgNum};
unless( open FILE, '>' . $self->{dirName} . "/lmConf-" . $fields->{cfgNum} ) {
print STDERR "Open file failed: $!";
$self->unlock;
return UNKNOWN_ERROR;
}
while ( my ( $k, $v ) = each(%$fields) ) {
print FILE "$k\n\t$v\n\n";
}
close FILE;
$self->unlock;
return $fields->{cfgNum};
}
......
......@@ -41,6 +41,22 @@ sub lastCfg {
return $self->_soapCall( 'lastCfg', @_ );
}
sub lock {
my $self = shift;
return $self->_soapCall( 'lock', @_ );
}
# unlock is not needed here since real unlock is called by store
#sub unlock {
# my $self = shift;
# return $self->_soapCall( 'unlock', @_ );
#}
sub isLocked {
my $self = shift;
return $self->_soapCall( 'isLocked', @_ );
}
sub store {
my $self = shift;
return $self->_soapCall( 'store', @_ );
......
package Lemonldap::NG::Manager::Restricted;
use strict;
use Lemonldap::NG::Manager;
use Lemonldap::NG::Manager::Conf::Constants;
our @ISA=qw(Lemonldap::NG::Manager);
our $VERSION = "0.01";
sub new {
my ( $class, $args ) = @_;
my $self = $class->SUPER::new($args);
unless( $self->{read} ) {
print STDERR qq#Warning, "read" parameter is not set, nothing will be displayed\n#;
}
return $self;
}
sub buildTree {
my $self = shift;
my $tree = $self->SUPER::buildTree();
# TODO: purge tree
delete $tree->{item}->{item}->{groups};
delete $tree->{item}->{item}->{generalParameters};
return $tree;
}
# TODO: restrict upload
sub upload {
UNKNOWN_ERROR;
}
1;
__END__
=head1 NAME
Lemonldap::NG::Manager::Restricted - Experimental restricted version of
Lemonldap::NG::Manager
=head1 SYNOPSIS
use Lemonldap::NG::Manager::Restrited;
my $h=new Lemonldap::NG::Manager::Restricted (
{
configStorage=>{
type=>'File',
dirName=>"/tmp/",
},
dhtmlXTreeImageLocation=> "/devel/img/",
# uncomment this only if lemonldap-ng-manager.js is not in the same
# directory than your script.
# jsFile => /path/to/lemonldap-ng-manager.js,
}
) or die "Unable to start, see Apache logs";
$h->doall();
=head1 DESCRIPTION
This module is in development. It will be usable to restrict access to
configuration for example only to a single virtual host.
=head1 SEE ALSO
L<Lemonldap::NG::Manager>
=head1 AUTHOR
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2007 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.
......@@ -6,7 +6,9 @@ package Lemonldap::NG::Manager::_HTML;
use AutoLoader qw(AUTOLOAD);
require Lemonldap::NG::Manager::_i18n;
our $VERSION = '0.13';
use Lemonldap::NG::Manager::Conf::Constants;
our $VERSION = '0.22';
1;
__END__
......@@ -73,10 +75,13 @@ sub javascript {
my %text;
foreach(qw(newVirtualHost newMacro newGroup newVar newGSOpt saveConf
deleteNode locationRules unableToSave confSaved saveFailure
newRule newHeader httpHeaders)) {
newRule newHeader httpHeaders waitingResult unknownError
configurationWasChanged configLoaded warningConfNotApplied
applyConf )) {
$text{$_} = &{"txt_$_"};
$text{$_} =~s/'/\\'/g;
}
print <<EOT;
print qq#
var s3,s32;
window.onload=function(){
var w=X.clientWidth()-12;
......@@ -86,11 +91,13 @@ window.onload=function(){
s3=new xSplitter('idSplitter3',0,0,w,h,true,4,w/4,w/8,true,4,null,s32);
X.addEventListener(window,'resize',win_onresize,false);
document.body.style.cursor='wait';
document.getElementById('help').innerHTML='<h3>$text{waitingResult}</h3>';
tree=new dhtmlXTreeObject(document.getElementById('treeBox'),"100%","100%",0);
tree.setImagePath("$self->{dhtmlXTreeImageLocation}");
tree.setXMLAutoLoading("$ENV{SCRIPT_NAME}?lmQuery=conf");
tree.loadXML("$ENV{SCRIPT_NAME}?lmQuery=conf");
tree.setOnClickHandler(onNodeSelect);
document.getElementById('help').innerHTML='<h3>$text{configLoaded}</h3>';
window.setTimeout("document.body.style.cursor='auto'",1000);
};
......@@ -171,6 +178,11 @@ function onNodeSelect(nodeId) {
}
if(tree.getUserData(nodeId,"modif")=='both') but+=button('$text{deleteNode}','deleteNode',nodeId);
but+=button('$text{saveConf}','saveConf');
#;
if( $self->{applyConfFile} ) {
print "but+=button('$text{applyConf}','applyConf');";
}
print qq#
document.getElementById('buttons').innerHTML = but;
}
......@@ -194,7 +206,7 @@ function button(text,func,nodeId){
function insertNewChild(a,b,c) {
tree.insertNewChild(a,b,c);
tree.setItemColor(b,"#000000","#0000FF");
tree.setItemColor(b,"\#000000","\#0000FF");
}
function newVirtualHost() {
......@@ -280,13 +292,18 @@ function saveConf(){
var r=xhr_object.responseText;
if(r>0) {
tree.setItemText('root','Configuration '+r);
document.getElementById('help').innerHTML='<h3>$text{confSaved} : '+r+'</h3>';
document.getElementById('help').innerHTML='<h3>$text{confSaved} : '+r+'</h3>$text{warningConfNotApplied}';
}
else {
document.getElementById('help').innerHTML='<h3>$text{saveFailure}</h3>';
else if(r<0) {
var txt='<h3>$text{saveFailure}: ';
if(r==#.CONFIG_WAS_CHANGED.qq#) {
txt+='$text{configurationWasChanged}';
}
document.getElementById('help').innerHTML=txt+'</h3>';
}
else document.getElementById('help').innerHTML='<h3>$text{unknownError}</h3>';
}
else document.getElementById('help').innerHTML='<h3>$text{saveFailure}</h3>';
else document.getElementById('help').innerHTML='<h3>$text{waitingResult}</h3>';
}
xhr_object.send(h);
}
......@@ -308,11 +325,19 @@ function tree2txt(id){
return r;
}
function applyConf(){
xhr_object.open('GET', "$ENV{SCRIPT_NAME}?lmQuery=apply",true);
xhr_object.onreadystatechange = function() {
if(xhr_object.readyState == 4) document.getElementById('help').innerHTML=xhr_object.responseText;
}
xhr_object.send(null);
}
function ec(s){
if((!s) || s=='') return s;
return s.replace(/>/g,'&gt;').replace(/</g,'&lt;');
}
EOT
#;
}
sub start_html {
......
......@@ -2,7 +2,7 @@ package Lemonldap::NG::Manager::_i18n;
use AutoLoader qw(AUTOLOAD);
use UNIVERSAL qw(can);
our $VERSION = '0.11';
our $VERSION = '0.2';
sub import {
my ($caller_package) = caller;
......@@ -34,80 +34,103 @@ __END__
sub fr {
return {
configuration => 'Configuration',
exportedVars => 'Attributs LDAP &agrave; exporter',
generalParameters => 'Param&egrave;tres g&eacute;n&eacute;raux',
ldapParameters => 'Param&egrave;tres LDAP',
sessionStorage => 'Stockage des sessions',
globalStorageOptions => 'Param&egrave;tres du module Apache::Session',
authParams => "Param&egrave;tres d'authentification",