1014 lines
33 KiB
Perl
1014 lines
33 KiB
Perl
## @file
|
|
# Lemonldap::NG Management interface
|
|
|
|
## @class
|
|
# Lemonldap::NG Management interface
|
|
package Lemonldap::NG::Manager;
|
|
|
|
use strict;
|
|
|
|
use XML::Simple;
|
|
|
|
use Lemonldap::NG::Common::CGI;
|
|
use Lemonldap::NG::Common::Conf; #link protected conf Configuration
|
|
use Lemonldap::NG::Manager::_HTML; #inherits
|
|
require Lemonldap::NG::Manager::_Response; #inherits
|
|
require Lemonldap::NG::Manager::_i18n; #inherits
|
|
require Lemonldap::NG::Manager::Help; #inherits
|
|
use Lemonldap::NG::Common::Conf::Constants; #inherits
|
|
use Lemonldap::NG::Common::Safelib; #link protected msafe Safe object
|
|
use LWP::UserAgent;
|
|
use Safe;
|
|
use MIME::Base64;
|
|
|
|
#inherits Lemonldap::NG::Handler::CGI
|
|
|
|
use base qw(Lemonldap::NG::Common::CGI);
|
|
our @ISA;
|
|
|
|
our $VERSION = '0.91';
|
|
|
|
# Secure jail
|
|
our $msafe;
|
|
|
|
##@method private object msafe()
|
|
# Provide the security jail.
|
|
#@return Safe object
|
|
sub msafe {
|
|
my $self = shift;
|
|
return $msafe if ($msafe);
|
|
$msafe = new Safe;
|
|
my @t =
|
|
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
|
|
foreach (@t) {
|
|
s/^.*:://;
|
|
next if ( $self->can($_) );
|
|
eval "sub $_ {1}";
|
|
$self->lmLog( $@, 'error' ) if ($@);
|
|
}
|
|
$msafe->share_from( 'main', ['%ENV'] );
|
|
$msafe->share_from( 'Lemonldap::NG::Common::Safelib',
|
|
$Lemonldap::NG::Common::Safelib::functions );
|
|
$msafe->share( '&encode_base64', @t );
|
|
return $msafe;
|
|
}
|
|
|
|
## @cmethod Lemonldap::NG::Manager new(hashref args)
|
|
# Constructor.
|
|
# @param $args hash reference containing parameters
|
|
sub new {
|
|
my ( $class, $args ) = @_;
|
|
my $self;
|
|
if ( $args->{protection} ) {
|
|
require Lemonldap::NG::Handler::CGI;
|
|
unshift @ISA, "Lemonldap::NG::Handler::CGI";
|
|
$self = $class->SUPER::new($args);
|
|
}
|
|
else {
|
|
$self = $class->SUPER::new();
|
|
}
|
|
unless ($args) {
|
|
$self->abort( "Unable to start",
|
|
"parameters are required, I can't start so" );
|
|
}
|
|
%$self = ( %$self, %$args );
|
|
foreach (qw(dhtmlXTreeImageLocation)) {
|
|
unless ( $self->{$_} ) {
|
|
$self->abort( "Unable to start",
|
|
qq/The "$_" parameter is required/ );
|
|
}
|
|
}
|
|
$self->{jsFile} ||= $self->_dir . "lemonldap-ng-manager.js";
|
|
unless ( -r $self->{jsFile} ) {
|
|
$self->abort(
|
|
qq#Unable to read $self->{jsFile}. You have to set "jsFile" parameter to /path/to/lemonldap-ng-manager.js#
|
|
);
|
|
}
|
|
$self->{pageTitle} ||= "LemonLDAP::NG Administration";
|
|
$self->{textareaW} ||= 50;
|
|
$self->{textareaH} ||= 5;
|
|
$self->{inputSize} ||= 30;
|
|
unless ( __PACKAGE__->can('ldapServer') ) {
|
|
Lemonldap::NG::Manager::_i18n::import( $self->{language}
|
|
|| $ENV{HTTP_ACCEPT_LANGUAGE} );
|
|
}
|
|
if ( $self->param('lmQuery') ) {
|
|
my $tmp = "print_" . $self->param('lmQuery');
|
|
$self->$tmp;
|
|
}
|
|
else {
|
|
my $datas;
|
|
if ( $datas = $self->param('POSTDATA') ) {
|
|
$self->print_upload( \$datas );
|
|
}
|
|
else {
|
|
return $self;
|
|
}
|
|
}
|
|
exit;
|
|
}
|
|
|
|
## @method void doall()
|
|
# Launch :
|
|
# - Lemonldap::NG::Manager::_HTML::start_html()
|
|
# - Lemonldap::NG::Manager::_HTML::main()
|
|
# - CGI::end_html()
|
|
sub doall {
|
|
my $self = shift;
|
|
|
|
print $self->header( -type => 'text/html; charset=utf8' );
|
|
|
|
# Test if we have to use specific CSS
|
|
if ( defined $self->{cssFile} ) {
|
|
print $self->start_html(
|
|
-style => $self->{cssFile},
|
|
-title => $self->{pageTitle},
|
|
);
|
|
}
|
|
else {
|
|
print $self->start_html( -title => $self->{pageTitle}, );
|
|
}
|
|
print $self->main;
|
|
print $self->end_html;
|
|
}
|
|
|
|
## @method void print_css()
|
|
# Print HTTP headers using header_public() and call
|
|
# Lemonldap::NG::Manager::_HTML::css()
|
|
sub print_css {
|
|
my $self = shift;
|
|
print $self->header_public( $ENV{SCRIPT_FILENAME}, -type => 'text/css' );
|
|
$self->css;
|
|
}
|
|
|
|
## @method void print_libjs()
|
|
# Print HTTP headers using header_public() and display $self->{jsFile}
|
|
# javascript file.
|
|
sub print_libjs {
|
|
my $self = shift;
|
|
print $self->header_public( $self->{jsFile},
|
|
-type => 'application/x-javascript' );
|
|
open F, $self->{jsFile};
|
|
while (<F>) {
|
|
print;
|
|
}
|
|
close F;
|
|
}
|
|
|
|
## @method void print_lmjs()
|
|
# Print HTTP headers using header_public() and call
|
|
# Lemonldap::NG::Manager::_HTML::javascript()
|
|
sub print_lmjs {
|
|
my $self = shift;
|
|
print $self->header_public( $ENV{SCRIPT_FILENAME},
|
|
-type => 'text/javascript; charset=utf8' );
|
|
$self->javascript;
|
|
}
|
|
|
|
## @method void print_help()
|
|
# AJAX method that display help chapter.
|
|
# Print HTTP headers using header_public() and display asked help chapter.
|
|
sub print_help {
|
|
my $self = shift;
|
|
print $self->header_public( $ENV{SCRIPT_FILENAME},
|
|
-type => 'text/html; charset=utf8' );
|
|
Lemonldap::NG::Manager::Help::import( $self->{language}
|
|
|| $ENV{HTTP_ACCEPT_LANGUAGE} )
|
|
unless ( $self->can('help_groups') );
|
|
my $chap = $self->param('help');
|
|
eval { no strict "refs"; &{"help_$chap"} };
|
|
}
|
|
|
|
## @method void print_delete()
|
|
# Print HTTP headers and call Lemonldap::NG::Common::Conf::delete()
|
|
sub print_delete {
|
|
my $self = shift;
|
|
print $self->header( -type => 'text/html; charset=utf8' );
|
|
Lemonldap::NG::Manager::Help::import( $self->{language}
|
|
|| $ENV{HTTP_ACCEPT_LANGUAGE} )
|
|
unless ( $self->can('help_groups') );
|
|
if ( $self->config->delete( $self->param('cfgNum') ) ) {
|
|
print &txt_configurationDeleted;
|
|
}
|
|
else {
|
|
print &txt_configurationNotDeleted;
|
|
}
|
|
exit;
|
|
}
|
|
|
|
## @method void print_conf()
|
|
# Print HTTP headers using header_public() and call printXmlConf()
|
|
sub print_conf {
|
|
my $self = shift;
|
|
print $self->header(
|
|
-type => "text/xml; charset=utf8",
|
|
'-Cache-Control' => 'private'
|
|
);
|
|
$self->printXmlConf( { cfgNum => $self->param('cfgNum'), noCache => 1 } );
|
|
exit;
|
|
}
|
|
|
|
## @fn protected hashref default()
|
|
# Build a minimum configuration if no configuration is available.
|
|
# @return Lemonldap::NG configuration hash reference.
|
|
sub default {
|
|
return {
|
|
cfgNum => 0,
|
|
ldapBase => "dc=example,dc=com",
|
|
};
|
|
}
|
|
|
|
## @method protected string printXmlConf(array p)
|
|
# Call buildTree() then XML::Simple::XMLout to build the XML datas used by
|
|
# javascript library to display the tree.
|
|
# @param @p parameters given to buildTree()
|
|
# @return XML string
|
|
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,
|
|
NoSort => 0,
|
|
XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>',
|
|
);
|
|
}
|
|
|
|
## @method protected hashRef buildTree(array p)
|
|
# Transform Lemonldap::NG configuration into a tree that javascript library can
|
|
# understand.
|
|
# @param @p parameters given to Lemonldap::NG::Common::Conf::getConf()
|
|
# @return hash reference to the javascript tree structure
|
|
sub buildTree {
|
|
my $self = shift;
|
|
my $config = $self->config->getConf(@_);
|
|
$config = $self->default unless ( $config and $config->{cfgNum} );
|
|
my $indice = 1;
|
|
my $tree = {
|
|
id => '0',
|
|
item => {
|
|
id => 'root',
|
|
open => 1,
|
|
text => &txt_configuration . " $config->{cfgNum}",
|
|
item => {
|
|
generalParameters => {
|
|
text => &txt_generalParameters,
|
|
item => {
|
|
exportedVars => {
|
|
text => &txt_exportedVars,
|
|
item => {},
|
|
},
|
|
macros => { text => &txt_macros, },
|
|
ldapParameters => {
|
|
text => &txt_ldapParameters,
|
|
item => {},
|
|
},
|
|
sessionStorage => {
|
|
text => &txt_sessionStorage,
|
|
item => {
|
|
globalStorageOptions =>
|
|
{ text => &txt_globalStorageOptions, }
|
|
},
|
|
},
|
|
authParams => {
|
|
text => &txt_authParams,
|
|
item => {},
|
|
},
|
|
},
|
|
},
|
|
groups => { text => &txt_userGroups, },
|
|
virtualHosts => {
|
|
text => &txt_virtualHosts,
|
|
open => 1,
|
|
select => 1,
|
|
},
|
|
},
|
|
},
|
|
};
|
|
my $generalParameters = $tree->{item}->{item}->{generalParameters}->{item};
|
|
my $exportedVars =
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{exportedVars}
|
|
->{item};
|
|
my $ldapParameters =
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{ldapParameters}
|
|
->{item};
|
|
my $sessionStorage =
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
|
->{item};
|
|
my $globalStorageOptions =
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
|
->{item}->{globalStorageOptions}->{item};
|
|
my $authParams =
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{authParams}->{item};
|
|
$authParams->{authentication} =
|
|
$self->xmlField( "value", $config->{authentication} || 'ldap',
|
|
&txt_authenticationType, );
|
|
$authParams->{portal} =
|
|
$self->xmlField( "value", $config->{portal} || 'http://portal/',
|
|
&txt_portal );
|
|
$authParams->{securedCookie} =
|
|
$self->xmlField( "value", $config->{securedCookie} || 0,
|
|
&txt_securedCookie );
|
|
$generalParameters->{whatToTrace} =
|
|
$self->xmlField( "value", $config->{whatToTrace} || '$uid',
|
|
&txt_whatToTrace );
|
|
|
|
$generalParameters->{domain} =
|
|
$self->xmlField( "value", $config->{domain} || 'example.com', &txt_domain,
|
|
);
|
|
$generalParameters->{cookieName} =
|
|
$self->xmlField( "value", $config->{cookieName} || 'lemonldap',
|
|
&txt_cookieName, );
|
|
$generalParameters->{timeout} =
|
|
$self->xmlField( "value", $config->{timeout} || 7200,
|
|
&txt_sessionTimeout, );
|
|
|
|
$sessionStorage->{globalStorage} =
|
|
$self->xmlField( "value",
|
|
$config->{globalStorage} || 'Apache::Session::File',
|
|
&txt_apacheSessionModule, );
|
|
|
|
$ldapParameters->{ldapServer} =
|
|
$self->xmlField( "value", $config->{ldapServer} || 'localhost',
|
|
&txt_ldapServer, );
|
|
$ldapParameters->{ldapPort} =
|
|
$self->xmlField( "value", $config->{ldapPort} || 389, &txt_ldapPort, );
|
|
$ldapParameters->{ldapBase} =
|
|
$self->xmlField( "value", $config->{ldapBase} || ' ', &txt_ldapBase, );
|
|
$ldapParameters->{managerDn} =
|
|
$self->xmlField( "value", $config->{managerDn} || ' ', &txt_managerDn, );
|
|
$ldapParameters->{managerPassword} =
|
|
$self->xmlField( "value", $config->{managerPassword} || ' ',
|
|
&txt_managerPassword, );
|
|
|
|
if ( $config->{exportedVars} ) {
|
|
foreach my $n ( sort keys %{ $config->{exportedVars} } ) {
|
|
$exportedVars->{ sprintf( "ev_%010d", $indice ) } =
|
|
$self->xmlField( "both", $config->{exportedVars}->{$n}, $n );
|
|
$indice++;
|
|
}
|
|
}
|
|
else {
|
|
foreach (qw(cn mail uid)) {
|
|
$exportedVars->{ sprintf( "ev_%010d", $indice ) } =
|
|
$self->xmlField( 'both', $_, $_ );
|
|
$indice++;
|
|
}
|
|
}
|
|
|
|
if ( $config->{globalStorageOptions}
|
|
and %{ $config->{globalStorageOptions} } )
|
|
{
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
|
->{item}->{globalStorageOptions}->{item} = {};
|
|
$globalStorageOptions =
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
|
->{item}->{globalStorageOptions}->{item};
|
|
foreach my $n ( sort keys %{ $config->{globalStorageOptions} } ) {
|
|
$globalStorageOptions->{ sprintf( "go_%010d", $indice ) } =
|
|
$self->xmlField( "both", $config->{globalStorageOptions}->{$n},
|
|
$n );
|
|
$indice++;
|
|
}
|
|
}
|
|
|
|
if ( $config->{locationRules} and %{ $config->{locationRules} } ) {
|
|
$tree->{item}->{item}->{virtualHosts}->{item} = {};
|
|
my $virtualHost = $tree->{item}->{item}->{virtualHosts}->{item};
|
|
|
|
# TODO: split locationRules into 2 arrays
|
|
foreach my $host ( sort keys %{ $config->{locationRules} } ) {
|
|
my $rules = $config->{locationRules}->{$host};
|
|
my $vh_id = sprintf( "vh_%010d", $indice );
|
|
$indice++;
|
|
$virtualHost->{$vh_id} = $self->xmlField( "text", 'i', $host );
|
|
my ( $ih, $ir ) =
|
|
( "exportedHeaders_$indice", "locationRules_$indice" );
|
|
$virtualHost->{$vh_id}->{item} = {
|
|
"$ih" => { text => &txt_httpHeaders, },
|
|
"$ir" => { text => &txt_locationRules, },
|
|
};
|
|
foreach my $reg ( sort keys %$rules ) {
|
|
my $type = ( $reg eq 'default' ) ? 'value' : 'both';
|
|
$virtualHost->{$vh_id}->{item}->{$ir}->{item}
|
|
->{ sprintf( "r_%010d", $indice ) } =
|
|
$self->xmlField( $type, $rules->{$reg}, $reg );
|
|
$indice++;
|
|
}
|
|
my $headers = $config->{exportedHeaders}->{$host};
|
|
foreach my $h ( sort keys %$headers ) {
|
|
$virtualHost->{$vh_id}->{item}->{$ih}->{item}
|
|
->{ sprintf( "h_%010d", $indice ) } =
|
|
$self->xmlField( "both", $headers->{$h}, $h );
|
|
$indice++;
|
|
}
|
|
}
|
|
}
|
|
if ( $config->{groups} and %{ $config->{groups} } ) {
|
|
$tree->{item}->{item}->{groups}->{item} = {};
|
|
my $groups = $tree->{item}->{item}->{groups}->{item};
|
|
foreach my $group ( sort keys %{ $config->{groups} } ) {
|
|
$groups->{ sprintf( "g_%010d", $indice ) } =
|
|
$self->xmlField( 'both', $config->{groups}->{$group}, $group );
|
|
$indice++;
|
|
}
|
|
}
|
|
if ( $config->{macros} and %{ $config->{macros} } ) {
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{macros}->{item} =
|
|
{};
|
|
my $macros =
|
|
$tree->{item}->{item}->{generalParameters}->{item}->{macros}->{item};
|
|
foreach my $macro ( sort keys %{ $config->{macros} } ) {
|
|
$macros->{"m_$indice"} =
|
|
$self->xmlField( 'both', $config->{macros}->{$macro}, $macro );
|
|
$indice++;
|
|
}
|
|
}
|
|
return $tree;
|
|
}
|
|
|
|
## @method protected hashref xmlField(string type, string value, string text)
|
|
# Little method used by buildTree to build javascript tree nodes.
|
|
# @param $type type of field (key and value can be both modified or not)
|
|
# @param $value value of the node
|
|
# @param $text text to display for the node
|
|
sub xmlField {
|
|
my ( $self, $type, $value, $text ) = @_;
|
|
$value =~ s/"/\"/g;
|
|
$text =~ s/"/\"/g;
|
|
return {
|
|
text => $text,
|
|
aCol => "#000000",
|
|
sCol => "#0000FF",
|
|
userdata => [
|
|
{ name => 'value', content => $value },
|
|
{ name => 'modif', content => $type },
|
|
],
|
|
};
|
|
}
|
|
|
|
# Upload subroutines
|
|
## @method void print_upload(string datas)
|
|
# Print HTTP headers, and call upload() to store the new configuration.
|
|
# Then call Lemonldap::NG::Manager::_Response::send() to display the response
|
|
# @param $datas new configuration in javascript XML format
|
|
sub print_upload {
|
|
my $self = shift;
|
|
my $datas = shift;
|
|
print $self->header( -type => "text/javascript; charset=utf8" );
|
|
my $r = Lemonldap::NG::Manager::_Response->new();
|
|
my $tmp = $self->upload( $datas, $r );
|
|
if ( $tmp == 0 ) {
|
|
$r->message( &txt_unknownError, &txt_checkLogs );
|
|
}
|
|
elsif ( $tmp > 0 ) {
|
|
$r->setConfiguration($tmp);
|
|
$r->message( &txt_confSaved . " $tmp", &txt_warningConfNotApplied );
|
|
}
|
|
elsif ( $tmp == CONFIG_WAS_CHANGED ) {
|
|
$r->message( &txt_saveFailure, &txt_configurationWasChanged );
|
|
}
|
|
elsif ( $tmp == SYNTAX_ERROR ) {
|
|
$r->message( &txt_saveFailure, &txt_syntaxError );
|
|
}
|
|
$r->send;
|
|
}
|
|
|
|
## @method protected int upload(string tree, Lemonldap::NG::Manager::_Response response)
|
|
# Transform $tree in a hash reference using tree2conf(), verify it using
|
|
# checkConf() then save configuration using saveConf()
|
|
# @param $tree configuration in XML format
|
|
# @param $response response object
|
|
# @return error code
|
|
sub upload {
|
|
my ( $self, $tree, $response ) = @_;
|
|
my $config = $self->tree2conf( $tree, $response );
|
|
return SYNTAX_ERROR unless ( $self->checkConf( $config, $response ) );
|
|
return $self->config->saveConf($config);
|
|
}
|
|
|
|
## @method protected hashref tree2conf(string tree, Lemonldap::NG::Manager::_Response response)
|
|
# Transform $tree into a Lemonldap::NG configuration hash reference.
|
|
# @param $tree configuration in XML format
|
|
# @param $response response object
|
|
# @return $tree transformed in hash reference
|
|
sub tree2conf {
|
|
my ( $self, $tree, $response ) = @_;
|
|
$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 ( $k, $h ) = each( %{ $tree->{virtualHosts} } ) ) {
|
|
next unless ( ref($h) );
|
|
my $lr;
|
|
my $eh;
|
|
foreach ( keys(%$h) ) {
|
|
$lr = $h->{$_} if ( $_ =~ /locationRules/ );
|
|
$eh = $h->{$_} if ( $_ =~ /exportedHeaders/ );
|
|
}
|
|
my $vh = $h->{text};
|
|
|
|
# TODO: split locationRules into 2 arrays
|
|
LR: foreach my $r ( values(%$lr) ) {
|
|
next LR unless ( ref($r) );
|
|
$config->{locationRules}->{$vh}->{ $r->{text} } = $r->{value};
|
|
}
|
|
EH: foreach my $h ( values(%$eh) ) {
|
|
next EH unless ( ref($h) );
|
|
$config->{exportedHeaders}->{$vh}->{ $h->{text} } = $h->{value};
|
|
}
|
|
}
|
|
|
|
# General parameters
|
|
$config->{cookieName} = $tree->{generalParameters}->{cookieName}->{value};
|
|
$config->{timeout} = $tree->{generalParameters}->{timeout}->{value};
|
|
$config->{whatToTrace} = $tree->{generalParameters}->{whatToTrace}->{value};
|
|
$config->{domain} = $tree->{generalParameters}->{domain}->{value};
|
|
$config->{globalStorage} =
|
|
$tree->{generalParameters}->{sessionStorage}->{globalStorage}->{value};
|
|
while (
|
|
my ( $v, $h ) = each(
|
|
%{
|
|
$tree->{generalParameters}->{sessionStorage}
|
|
->{globalStorageOptions}
|
|
}
|
|
)
|
|
)
|
|
{
|
|
next unless ( ref($h) );
|
|
$config->{globalStorageOptions}->{ $h->{text} } = $h->{value};
|
|
}
|
|
while ( my ( $v, $h ) = each( %{ $tree->{generalParameters}->{macros} } ) )
|
|
{
|
|
next unless ( ref($h) );
|
|
$config->{macros}->{ $h->{text} } = $h->{value};
|
|
}
|
|
foreach (qw(ldapBase ldapPort ldapServer managerDn managerPassword)) {
|
|
$config->{$_} =
|
|
$tree->{generalParameters}->{ldapParameters}->{$_}->{value};
|
|
$config->{$_} = '' if ( ref( $config->{$_} ) );
|
|
$config->{$_} =~ s/^\s*(.*?)\s*/$1/;
|
|
}
|
|
foreach (qw(authentication portal securedCookie)) {
|
|
$config->{$_} = $tree->{generalParameters}->{authParams}->{$_}->{value};
|
|
$config->{$_} = '' if ( ref( $config->{$_} ) );
|
|
$config->{$_} =~ s/^\s*(.*?)\s*/$1/;
|
|
}
|
|
while ( my ( $v, $h ) =
|
|
each( %{ $tree->{generalParameters}->{exportedVars} } ) )
|
|
{
|
|
next unless ( ref($h) );
|
|
$config->{exportedVars}->{ $h->{text} } = $h->{value};
|
|
}
|
|
return $config;
|
|
}
|
|
|
|
## @method protected boolean checkConf(hashref config,Lemonldap::NG::Manager::_Response response)
|
|
# Try to find faults in new uploaded configuration.
|
|
# @param $config Lemonldap::NG configuration hash reference
|
|
# @param $response response object
|
|
sub checkConf {
|
|
my $self = shift;
|
|
my $config = shift;
|
|
my $response = shift;
|
|
my $expr = '';
|
|
my $result = 1;
|
|
my $assign = qr/(?<=[^=<!>\?])=(?![=~])/;
|
|
|
|
# Check cookie name
|
|
unless ( $config->{cookieName} =~ /^[a-zA-Z]\w*$/ ) {
|
|
$result = 0;
|
|
$response->error(
|
|
'"' . $config->{cookieName} . '" ' . &txt_isNotAValidCookieName );
|
|
}
|
|
|
|
# Check session timeout
|
|
unless ( $config->{timeout} =~ /^\d+$/ ) {
|
|
$result = 0;
|
|
$response->error( '"' . $config->{timeout} . '" ' . &txt_isNotANumber );
|
|
}
|
|
|
|
# Check domain name
|
|
unless ( $config->{domain} =~
|
|
/^(?=^.{1,254}$)\.?(?:(?!\d+\.)[\w\-]{1,63}\.?)+(?:[a-zA-Z]{2,})$/ )
|
|
{
|
|
$result = 0;
|
|
$response->error(
|
|
'"' . $config->{domain} . '" ' . &txt_isNotAValidCookieName );
|
|
}
|
|
|
|
# Customized variables
|
|
foreach ( @{ $self->{customVars} } ) {
|
|
$expr .= "my \$$_ = '1';";
|
|
}
|
|
|
|
# Load variables
|
|
foreach ( keys %{ $config->{exportedVars} } ) {
|
|
|
|
# Reserved words
|
|
if ( $_ eq 'groups' or $_ !~ /^\w+$/ ) {
|
|
$response->error( "\"$_\" " . &txt_isNotAValidAttributeName );
|
|
$result = 0;
|
|
}
|
|
if ( $config->{exportedVars}->{$_} !~ /^\w+$/ ) {
|
|
$response->error( "\"$config->{exportedVars}->{$_}\" "
|
|
. &txt_isNotAValidLDAPAttributeName );
|
|
$result = 0;
|
|
}
|
|
$expr .= "my \$$_ = '1';";
|
|
}
|
|
|
|
# Load and check macros
|
|
$self->msafe->reval($expr);
|
|
if ($@) {
|
|
$result = 0;
|
|
$response->error( &txt_unknownErrorInVars . " ($@)" );
|
|
}
|
|
while ( my ( $k, $v ) = each( %{ $config->{macros} } ) ) {
|
|
|
|
# Syntax
|
|
if ( $k eq 'groups' or $k !~ /^[a-zA-Z]\w*$/ ) {
|
|
$response->error( "\"$k\" " . &txt_isNotAValidMacroName );
|
|
$result = 0;
|
|
}
|
|
|
|
# "=" may be a fault ("==")
|
|
if ( $v =~ $assign ) {
|
|
$response->warning(
|
|
&txt_macro . " $k " . &txt_containsAnAssignment );
|
|
}
|
|
|
|
# Test macro values;
|
|
$expr .= "my \$$k = $v;";
|
|
$self->msafe->reval($expr);
|
|
if ($@) {
|
|
$response->error(
|
|
&txt_macro . " $k : " . &txt_syntaxError . " : $@" );
|
|
$result = 0;
|
|
}
|
|
}
|
|
|
|
# TODO: check module name
|
|
# Check whatToTrace
|
|
unless ( $config->{whatToTrace} =~ /^\$?[a-zA-Z]\w*$/ ) {
|
|
$response->error(&txt_invalidWhatToTrace);
|
|
$result = 0;
|
|
}
|
|
|
|
# Test groups
|
|
$expr .= 'my $groups;';
|
|
while ( my ( $k, $v ) = each( %{ $config->{groups} } ) ) {
|
|
|
|
# Name syntax
|
|
if ( $k !~ /^[\w-]+$/ ) {
|
|
$response->error( "\"$k\" " . &txt_isNotAValidGroupName );
|
|
$result = 0;
|
|
}
|
|
|
|
# "=" may be a fault (but not "==")
|
|
if ( $v =~ $assign ) {
|
|
$response->warning(
|
|
&txt_group . " $k " . &txt_containsAnAssignment );
|
|
}
|
|
|
|
# Test boolean expression
|
|
$self->msafe->reval( $expr . "\$groups = '$k' if($v);" );
|
|
if ($@) {
|
|
$response->error( &txt_group . " $k " . &txt_syntaxError );
|
|
$result = 0;
|
|
}
|
|
}
|
|
|
|
# Test rules
|
|
while ( my ( $vh, $rules ) = each( %{ $config->{locationRules} } ) ) {
|
|
|
|
# Virtual host name has to be a fully qualified name or an IP address (CDA)
|
|
unless ( $vh =~
|
|
/^(?:(?=^.{1,254}$)(?:(?!\d+\.)[\w\-]{1,63}\.?)+(?:[a-zA-Z]{2,})|(?:\d{1,3}\.){3}\d{1,3})$/
|
|
)
|
|
{
|
|
$response->error( "\"$vh\" " . &txt_isNotAValidVirtualHostName );
|
|
$result = 0;
|
|
}
|
|
while ( my ( $reg, $v ) = each( %{$rules} ) ) {
|
|
|
|
# Test regular expressions
|
|
unless ( $reg eq 'default' ) {
|
|
$reg =~ s/#/\\#/g;
|
|
$self->msafe->reval( $expr . "my \$r = qr#$reg#;" );
|
|
if ($@) {
|
|
$response->error(
|
|
&txt_rule . " $vh -> \"$reg\" : " . &txt_syntaxError );
|
|
$result = 0;
|
|
}
|
|
}
|
|
|
|
# Test boolean expressions
|
|
unless ( $v =~ /^(?:accept$|deny$|logout)/ ) {
|
|
|
|
# "=" may be a fault (but not "==")
|
|
if ( $v =~ $assign ) {
|
|
$response->warning( &txt_rule
|
|
. " $vh -> \"$reg\" : "
|
|
. &txt_containsAnAssignment );
|
|
}
|
|
|
|
$self->msafe->reval( $expr . "my \$r=1 if($v);" );
|
|
if ($@) {
|
|
$response->error(
|
|
&txt_rule . " $vh -> \"$reg\" : " . &txt_syntaxError );
|
|
$result = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Test exported headers
|
|
while ( my ( $vh, $headers ) = each( %{ $config->{exportedHeaders} } ) ) {
|
|
|
|
# Virtual host name has to be a fully qualified name or an IP address (CDA)
|
|
unless ( $vh =~
|
|
/^(?:(?=^.{1,254}$)(?:(?!\d+\.)[\w\-]{1,63}\.?)+(?:[a-zA-Z]{2,})|(?:\d{1,3}\.){3}\d{1,3})$/
|
|
)
|
|
{
|
|
$response->error( "\"$vh\" " . &txt_isNotAValidVirtualHostName );
|
|
$result = 0;
|
|
}
|
|
while ( my ( $header, $v ) = each( %{$headers} ) ) {
|
|
|
|
# Header name syntax
|
|
unless ( $header =~ /^[\w][-\w]*$/ ) {
|
|
$response->error(
|
|
"\"$header\" ($vh) " . &txt_isNotAValidHTTPHeaderName );
|
|
$result = 0;
|
|
}
|
|
|
|
# "=" may be a fault ("==")
|
|
if ( $v =~ $assign ) {
|
|
$response->warning( &txt_header
|
|
. " $vh -> $header "
|
|
. &txt_containsAnAssignment );
|
|
}
|
|
|
|
# Perl expression
|
|
$self->msafe->reval( $expr . "my \$r = $v;" );
|
|
if ($@) {
|
|
$response->error(
|
|
&txt_header . " $vh -> $header " . &txt_syntaxError );
|
|
$result = 0;
|
|
}
|
|
}
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
# Apply subroutines
|
|
# TODO: Credentials in applyConfFile
|
|
|
|
## @method void print_apply()
|
|
# Call all Lemonldap::NG handlers declared in $self->{applyConfFile} file to
|
|
# ask them to reload Lemonldap::NG configuration.
|
|
sub print_apply {
|
|
my $self = shift;
|
|
print $self->header( -type => "text/html; charset=utf8" );
|
|
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 ) );
|
|
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>";
|
|
}
|
|
|
|
## @fn private string _dir()
|
|
# Return the path to the manager script
|
|
sub _dir {
|
|
my $d = $ENV{SCRIPT_FILENAME};
|
|
$d =~ s/[^\/]*$//;
|
|
return $d;
|
|
}
|
|
|
|
## @method Lemonldap::NG::Common::Conf config()
|
|
# Return Lemonldap::NG::Common::Conf object if exists else, build it.
|
|
# @return Lemonldap::NG::Common::Conf object
|
|
sub config {
|
|
my $self = shift;
|
|
return $self->{_config} if $self->{_config};
|
|
$self->{_config} =
|
|
Lemonldap::NG::Common::Conf->new( $self->{configStorage} );
|
|
unless ( $self->{_config} ) {
|
|
$self->abort( "Unable to start",
|
|
"Configuration not loaded\n" . $Lemonldap::NG::Common::Conf::msg );
|
|
}
|
|
return $self->{_config};
|
|
}
|
|
|
|
# Those sub are loaded en demand. With &header_public, they are not loaded each
|
|
# time.
|
|
*css = *Lemonldap::NG::Manager::_HTML::css;
|
|
*javascript = *Lemonldap::NG::Manager::_HTML::javascript;
|
|
*main = *Lemonldap::NG::Manager::_HTML::main;
|
|
*start_html = *Lemonldap::NG::Manager::_HTML::start_html;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Lemonldap::NG::Manager - Perl extension for managing Lemonldap::NG Web-SSO
|
|
system.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Lemonldap::NG::Manager;
|
|
my $h=new Lemonldap::NG::Manager(
|
|
{
|
|
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";
|
|
# Simple
|
|
$h->doall();
|
|
|
|
You can also peersonalize the HTML code instead of using C<doall()>:
|
|
|
|
print $self->header_public( $ENV{SCRIPT_FILENAME} );
|
|
print $self->start_html ( # See CGI(3) for more about start_html
|
|
-style => "/location/to/my.css",
|
|
-title => "Example.com SSO configuration",
|
|
);
|
|
# optional HTML code for the top of the page
|
|
print "<img src=...";
|
|
print $self->main;
|
|
# optional HTML code for the footer of the page
|
|
print "<img src=...";
|
|
|
|
print $self->end_html;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Lemonldap::NG::Manager provides a web interface to manage Lemonldap::NG Web-SSO
|
|
system.
|
|
|
|
=head2 SUBROUTINES
|
|
|
|
=over
|
|
|
|
=item * B<new> (constructor): new instanciates the manager object. It takes the
|
|
following arguments:
|
|
|
|
=over
|
|
|
|
=item * B<configStorage> (required): a hash reference to the description of the
|
|
configuration database system. the key 'type' must be set. Example:
|
|
|
|
configStorage => {
|
|
type => "DBI",
|
|
dbiChain => "DBI:mysql:database=session;host=1.2.3.4",
|
|
dbiUser => "lemonldap-ng",
|
|
dbiPassword => "pass",
|
|
}
|
|
|
|
See L<Lemonldap::Manager::NG::Common::Conf::File> or
|
|
L<Lemonldap::Manager::NG::Common::Conf::DBI> to know which keys are required.
|
|
|
|
=item * B<dhtmlXTreeImageLocation> (required): the location of the directory
|
|
containing dhtmlXTree images (provided in example/imgs). If this parameter
|
|
isn't correct, the tree will not appear and you will have sone error in Apache
|
|
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
|
|
simply calls C<header_public>, C<start_html>, C<main> and C<end_html> in this
|
|
order.
|
|
|
|
=item * B<header>: print HTTP headers. See L<CGI> for more.
|
|
|
|
=item * B<header_public>: print HTTP headers and manage the
|
|
C<If-Modified-Since> HTTP header. If it match to the age of the file passed
|
|
in first argument, it returns C<HTTP 304 Not Modified> end exit. Else, it
|
|
calls C<header> with the other arguments. By default, all elements of the
|
|
manager use this mecanism except the configuration itself.
|
|
|
|
=item * B<start_html>: subroutine that print the HTML headers. you can add
|
|
parameters to it; example;
|
|
|
|
print start_html(-title => 'My SSO configuration',
|
|
-author => 'fred@capricorn.org',
|
|
-target => '_blank',
|
|
-meta => {'keywords'=>'pharaoh secret mummy',
|
|
'copyright' => 'copyright 1996 King Tut'},
|
|
-style => {'src'=>'/styles/style1.css'},
|
|
-BGCOLOR => 'blue');
|
|
|
|
See start_html description in L<CGI> for more. Bee carefull with C<-style>
|
|
argument. You have to call it like the example above or simply like this:
|
|
-style=> '/styles/style1.css',
|
|
All other forms will not work.
|
|
|
|
=item * B<main>: il produce the main HTML code needed to build the
|
|
configuration interface.
|
|
|
|
=item * B<end_html>: close the HTML code by writing C<'E<lt>/bodyE<gt>E<lt>/htmlE<gt>'>
|
|
|
|
=back
|
|
|
|
Other subroutines manage the produce of CSS, Javascripts and of course the
|
|
configuration tree (called with AJAX).
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Portal>, L<CGI>,
|
|
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation
|
|
|
|
=head1 AUTHOR
|
|
|
|
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
=head1 BUG REPORT
|
|
|
|
Use OW2 system to report bug or ask for features:
|
|
L<http://forge.objectweb.org/tracker/?group_id=274>
|
|
|
|
=head1 DOWNLOAD
|
|
|
|
Lemonldap::NG is available at
|
|
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
Copyright (C) 2006-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.
|
|
|
|
=cut
|
|
|