700 lines
17 KiB
Perl
700 lines
17 KiB
Perl
use File::Copy;
|
||
use XML::Simple;
|
||
use File::Copy;
|
||
use File::Basename;
|
||
|
||
my $PREFIX = (-e '/etc/debian_version') ? '/usr/share/webmin/' : '../';
|
||
|
||
do ( $PREFIX . 'web-lib.pl' );
|
||
|
||
#do './httpd-lib.pl';
|
||
&init_config();
|
||
|
||
###################################################################
|
||
#
|
||
|
||
sub getStyle {
|
||
if ($_[0] =~ /map/i) {
|
||
$_[1] = 0;
|
||
return "conf_style";
|
||
}
|
||
if ($_[0] =~ /lectro/i) {
|
||
$_[1] = 1;
|
||
return "simpage";
|
||
}
|
||
if ($_[0] =~ /golf/i) {
|
||
$_[1] = 2;
|
||
return "golf_style";
|
||
}
|
||
}
|
||
|
||
sub Nerror
|
||
{
|
||
print "Content-type: text/html\n";
|
||
print "\n";
|
||
print "<h3>","motif : ",@_,"</h3>\n";
|
||
print "<hr>\n";
|
||
exit;
|
||
}
|
||
|
||
|
||
########################################################################
|
||
#
|
||
|
||
sub isValidXML { # return 1 == OK
|
||
my $namef = $_[0]; # 0 == fichier inexsitant
|
||
# -1 == XML invalide
|
||
|
||
if( !-e $namef ){
|
||
return 0;
|
||
}
|
||
|
||
my $pxml = XMLin( $namef, "ForceArray" => "1" );
|
||
|
||
if( ! %{$pxml} ) {
|
||
return -1;
|
||
}
|
||
|
||
return 1;
|
||
}
|
||
|
||
################################################################################################
|
||
# GENERATION DES FICHIERS DE CONF APACHE
|
||
#
|
||
sub GenerateConfigFiles {
|
||
my $confile = $_[0];
|
||
my $pxml = XMLin( $confile, "ForceArray" => "1" );
|
||
my $path = $config{'httpd_conf'};
|
||
|
||
if( !length($path) ){ ## pas de path pour conf.d dans les params du module !!!
|
||
return $text{'lab_error_12'};
|
||
}
|
||
|
||
## completer si necessaire le path avec le / de fin
|
||
my @lpath = split(//, $path );
|
||
if( $lpath[ @lpath - 1 ] ne '/' ){
|
||
$path .= '/';
|
||
}
|
||
|
||
## tester l existance du path vers conf.d
|
||
if( ! -e $path ){
|
||
return $text{'lab_error_13'};
|
||
}
|
||
|
||
my %kk = ( 'Portal' => 'portal' ,
|
||
'BasePub' => 'basepub' ,
|
||
'BasePriv' => 'basepriv' ,
|
||
'EnableLWPProxy' => 'enablelwpproxy' ,
|
||
'Organization' => 'organization' ,
|
||
'AppliCode' => 'applicode' ,
|
||
'DisableAccessControl' => 'disableaccesscontrol',
|
||
'StopCookie' => 'stopcookie' ,
|
||
'ChaseRedirect' => 'chaseredirect' ,
|
||
'ProxyExt' => 'proxyext' ,
|
||
'ProxyPatterns' => 'proxypatterns' ,
|
||
'MultiHoming' => 'multihoming' ,
|
||
'LWPTimeout' => 'lwptimeout' ,
|
||
'SoftControl' => 'softcontrol' ,
|
||
'Header' => 'header' ,
|
||
'Allow' => 'allow' ,
|
||
'PolicyPlugIn' => 'policyplugin' ,
|
||
'RewritePlugIn' => 'rewriteplugin' ,
|
||
'HeaderPlugIn' => 'headerplugin' ,
|
||
'BackendPlugIn' => 'backendplugin'
|
||
);
|
||
|
||
my @igk = keys( %kk );
|
||
|
||
## recup ts les noms de domaines
|
||
my @doms = keys( %{ $pxml->{'domain'} } );
|
||
|
||
## BIG LOOP
|
||
##-----------
|
||
my $nbgen = 0;
|
||
|
||
for( @doms ){
|
||
# domaine
|
||
my $dom = $_;
|
||
|
||
# recup ts les handlers d un domaine
|
||
my @hands = keys( %{ $pxml->{'domain'}->{ $dom }->{ 'handler' } } );
|
||
for( @hands ){
|
||
|
||
my $hand = $_;
|
||
|
||
my $typHand = $pxml->{'domain'}->{ $dom }->{ 'handler' }->{ $hand }->{ 'MultiHomer' };
|
||
|
||
if( $typHand eq 'CombinedType' ){
|
||
next;
|
||
}
|
||
|
||
# contruct file name
|
||
my $fname = $path . $hand . '.conf';
|
||
# create file (erase if exists)
|
||
open( F, ">$fname" ) || return( $text{ 'lab_error_14' } . $fname );
|
||
$nbgen++;
|
||
# recup keys and values for the handler
|
||
my %hand = %{ $pxml->{'domain'}->{ $dom }->{ 'handler' }->{ $hand } };
|
||
|
||
## by name or by IPAdress ???
|
||
my $type = $hand{'VirtualHost'};
|
||
|
||
if( !$type ){
|
||
print( F "<virtualhost *:80>\n" );
|
||
} else {
|
||
if( $type eq 'byIPAdress' ){
|
||
my $ip = $hand{'IPAdress'};
|
||
print( F "<virtualhost $ip>\n" );
|
||
} else {
|
||
print( F "<virtualhost *:80>\n" );
|
||
}
|
||
}
|
||
|
||
## ServerName
|
||
my $basePub = $hand{ 'BasePub' };
|
||
if( $basePub ){
|
||
my ($sn) = $basePub =~ /\/\/(.*)$/ ;
|
||
print( F " ServerName \t\t$sn\n" );
|
||
}
|
||
|
||
## constant
|
||
print( F " perltranshandler \tLemonldap::Handlers::Generic4a2\n\n" );
|
||
|
||
## all PerlSetVar
|
||
##----------------
|
||
for( @igk ){
|
||
my $ka = $_;
|
||
|
||
if( exists($hand{ $ka }) ){
|
||
my $val = $hand{ $ka };
|
||
if( $val ){
|
||
my $pl = $kk{ $ka };
|
||
my $tab = length( $pl ) > 16 ? "\t" : "\t\t";
|
||
print( F " PerlSetVar $pl $tab $val\n" );
|
||
}
|
||
}
|
||
}
|
||
## close virtualhost
|
||
print( F "</virtualhost>\n" );
|
||
close( F );
|
||
}
|
||
}
|
||
return( "$nbgen ''Apache config files'' generated in $path" );
|
||
}
|
||
|
||
################################################################################################
|
||
# GENERATION DES FICHIERS DE CONF APACHE WITH TEMPLATES
|
||
#
|
||
|
||
sub GenerateConfigFilesWT {
|
||
my $confile = $_[0];
|
||
my $confgenTT = $_[1];
|
||
my $pxml = XMLin( $confile, "ForceArray" => "1" );
|
||
my $path = $config{'httpd_conf'};
|
||
|
||
if( !length($path) ){ ## pas de path pour conf.d dans les params du module !!!
|
||
return $text{'lab_error_12'};
|
||
}
|
||
|
||
## completer si necessaire le path avec le / de fin
|
||
my @lpath = split(//, $path );
|
||
if( $lpath[ @lpath - 1 ] ne '/' ){
|
||
$path .= '/';
|
||
}
|
||
|
||
## tester l existance du path vers conf.d
|
||
if( ! -e $path ){
|
||
return $text{'lab_error_13'};
|
||
}
|
||
|
||
## recup ts les noms de domaines
|
||
my @doms = keys( %{ $pxml->{'domain'} } );
|
||
|
||
## BIG LOOP
|
||
##-----------
|
||
my $nbgen = 0;
|
||
|
||
my $TT = Template->new( OUTPUT_PATH => $path );
|
||
|
||
for( @doms ){
|
||
# domaine
|
||
my $dom = $_;
|
||
|
||
# recup ts les handlers d un domaine
|
||
my @hands = keys( %{ $pxml->{'domain'}->{ $dom }->{ 'handler' } } );
|
||
for( @hands ){
|
||
|
||
my $hand = $_;
|
||
|
||
my $typHand = $pxml->{'domain'}->{ $dom }->{ 'handler' }->{ $hand }->{ 'MultiHomer' };
|
||
|
||
if( $typHand eq 'CombinedType' ){
|
||
next;
|
||
}
|
||
|
||
# contruct file name
|
||
my $fname = $hand . '.conf';
|
||
$nbgen++;
|
||
# recup keys and values for the handler
|
||
my %hhand = %{ $pxml->{'domain'}->{ $dom }->{ 'handler' }->{ $hand } };
|
||
|
||
## by name or by IPAdress ???
|
||
my $type = $hhand{'VirtualHost'};
|
||
if( !$type ){
|
||
$type = 'byName';
|
||
}
|
||
## ServerName
|
||
my $basePub = $hhand{ 'BasePub' };
|
||
|
||
my $sn = 'servername';
|
||
if( $basePub ){
|
||
($sn) = $basePub =~ /\/\/(.*)$/ ;
|
||
}
|
||
|
||
for( keys( %hhand ) ){
|
||
if( !length( $hhand{ $_ } ) ){
|
||
delete( $hhand{ $_ } );
|
||
}
|
||
}
|
||
|
||
delete $hhand{'IPAdress'};
|
||
delete $hhand{'MultiHomer'};
|
||
delete $hhand{'VirtualHost'};
|
||
|
||
my $vars= { type => $type ,
|
||
serverName => $sn ,
|
||
handler => \%hhand
|
||
};
|
||
|
||
$TT->process( $confgenTT, $vars, $fname );
|
||
|
||
}
|
||
}
|
||
|
||
return( "$nbgen ''Apache config files'' generated in $path" );
|
||
}
|
||
|
||
|
||
########################################################################
|
||
# retourne une H table correspondant <20> une page complete dans le XML
|
||
|
||
sub getXmlPage {
|
||
my $page = $_[0];
|
||
my $pxml = XMLin( "guiconfig.xml", "ForceArray" => "1" );
|
||
return($pxml->{page}->{$page});
|
||
}
|
||
|
||
########################################################################
|
||
# RETOURNE TOUT LE XML D UN FICHIER
|
||
|
||
sub getXML {
|
||
my $confile = $_[0];
|
||
my $base = basename( $confile );
|
||
my $workfile = './templates/' . $base;
|
||
|
||
if( ! -e $workfile ){
|
||
system("cp -p $confile $workfile");
|
||
}
|
||
|
||
my $pxml = XMLin( $workfile, "ForceArray" => "1" );
|
||
UpdateOldXml( $pxml, $confile );
|
||
return( $pxml );
|
||
}
|
||
|
||
########################################################################
|
||
# RETOURNE 1 si le fichier de travail est plus recent que le fichier
|
||
# en production
|
||
|
||
sub IsXMLModified {
|
||
my $confile = $_[0];
|
||
my $base = basename( $confile );
|
||
my $workfile = './templates/' . $base;
|
||
|
||
my $prodmt = (stat($confile))[ 9 ];
|
||
my $workmt = (stat($workfile))[ 9 ];
|
||
|
||
return ( $workmt > $prodmt ? 1 : 0 );
|
||
}
|
||
|
||
########################################################################
|
||
# Met <20> niveau les fichiers XML avec le param MultiHomer ( type de Handler )
|
||
|
||
sub UpdateOldXml {
|
||
my $xmlemon = $_[0];
|
||
my $confile = $_[1];
|
||
my $chapter = getChapterXML( $xmlemon, "domain" );
|
||
|
||
my @kdom = keys( %{$chapter} );
|
||
my $flagREWRITE = 0;
|
||
|
||
for( @kdom ){
|
||
my $dom = $_;
|
||
my $hdom = $chapter->{ $dom }->{ 'handler' };
|
||
if( $hdom ){
|
||
my @khand = keys( %{$hdom} );
|
||
for( @khand ){
|
||
my $hand = $_;
|
||
my $typeh = $chapter->{ $dom }->{ 'handler' }->{ $hand }->{ 'MultiHomer' };
|
||
if( !$typeh ){
|
||
my $multi = $chapter->{ $dom }->{ 'handler' }->{ $hand }->{ 'MultiHoming' };
|
||
if( $multi ){
|
||
$chapter->{ $dom }->{ 'handler' }->{ $hand }->{ 'MultiHomer' } = 'MultiHomingType';
|
||
} else {
|
||
my $combi = $chapter->{ $dom }->{ 'handler' }->{ $hand }->{ 'MotifOut' };
|
||
if( $combi ){
|
||
$chapter->{ $dom }->{ 'handler' }->{ $hand }->{ 'MultiHomer' } = 'CombinedType';
|
||
} else {
|
||
$chapter->{ $dom }->{ 'handler' }->{ $hand }->{ 'MultiHomer' } = 'GenericType';
|
||
}
|
||
}
|
||
$flagREWRITE = 1;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
if( $flagREWRITE ){
|
||
&writeXML( $xmlemon, $confile );
|
||
}
|
||
}
|
||
|
||
########################################################################
|
||
# donne le numero de sequence "bak#" pour sauvegardes auto lors des modifs
|
||
|
||
sub getNumBakSequence {
|
||
my $confile = $_[0];
|
||
my $numbk = $_[1];
|
||
|
||
my $surch = $confile . '.bak?';
|
||
|
||
my @list = glob( $surch );
|
||
|
||
my $numseq = @list;
|
||
if( $numseq < $numbk ){
|
||
return $numseq;
|
||
}
|
||
|
||
my %h;
|
||
my @tabdt;
|
||
|
||
for( @list ){
|
||
my $dt = (stat($_))[9];
|
||
$h{ $dt } = $_;
|
||
push( @tabdt, $dt );
|
||
}
|
||
|
||
@tabdt = sort( @tabdt );
|
||
|
||
my $last = substr($h{ $tabdt[0] }, -1, 1 );
|
||
return $last;
|
||
}
|
||
|
||
|
||
########################################################################
|
||
# copie le fichier WORK sur le fichier de PROD
|
||
|
||
sub ApplyXMLModifs {
|
||
my $confile = $_[0];
|
||
my $base = basename( $confile );
|
||
my $workfile = './templates/' . $base;
|
||
|
||
my $numseq = getNumBakSequence( $confile, 3 );
|
||
my $backf = $confile . '.bak' . $numseq;
|
||
copy( $confile, $backf );
|
||
|
||
my $status = system("cp -p $workfile $confile");
|
||
return $status;
|
||
}
|
||
|
||
########################################################################
|
||
# copie le fichier de PROD sur le fichier WORK
|
||
|
||
sub DiscardXMLModifs {
|
||
my $confile = $_[0];
|
||
my $base = basename( $confile );
|
||
my $workfile = './templates/' . $base;
|
||
|
||
my $status = system("cp -p $confile $workfile");
|
||
return $status;
|
||
}
|
||
########################################################################
|
||
# retourne un tableau de dates de modif des fichiers BAKx du conf
|
||
|
||
sub GetNumXmlConfMod {
|
||
my $confile = $_[0];
|
||
|
||
my $surch = $confile . '.bak?';
|
||
my @list = glob( $surch );
|
||
|
||
my $tabdt;
|
||
for( @list ){
|
||
my $dt = (stat($_))[9];
|
||
my $str = localtime($dt);
|
||
push( @{$tabdt}, $str );
|
||
}
|
||
@{$tabdt} = sort( @{$tabdt} );
|
||
return $tabdt;
|
||
}
|
||
|
||
########################################################################
|
||
# ECRIT UN PXML DANS UN FICHIER XML apr<70>s en avoir fait une copie "bak"
|
||
|
||
sub writeXML {
|
||
my $pxml = $_[0];
|
||
my $namef = $_[1];
|
||
|
||
my $base = basename( $namef );
|
||
$namef = './templates/' . $base;
|
||
|
||
my $backf = $namef.'.bak';
|
||
my $rootN = $_[2] || "lemonldapconfig";
|
||
|
||
# copie du fichier
|
||
if( !copy( $namef, $backf )){
|
||
## ????
|
||
}
|
||
|
||
open( $fout, ">$namef" ) || Nerror( $! );
|
||
|
||
XMLout( $pxml, OutputFile => $fout,
|
||
AttrIndent => 1,
|
||
RootName => $rootN,
|
||
KeyAttr => { session =>'id',
|
||
cache =>'id',
|
||
handler =>'id',
|
||
application =>'id',
|
||
domain =>'id',
|
||
cluster =>'id',
|
||
node => 'id',
|
||
} );
|
||
close( $fout );
|
||
}
|
||
|
||
########################################################################
|
||
# RETOURNE UN CHAPITRE DANS LE XML PASSE EN PARAM
|
||
|
||
sub getChapterXML {
|
||
my $pxml = $_[0];
|
||
my $nam = $_[1];
|
||
my $mod = $_[2];
|
||
if( !$mod ){
|
||
return( $pxml->{$nam} );
|
||
} else {
|
||
return( $pxml->{$nam}->{ $mod } );
|
||
}
|
||
}
|
||
|
||
########################################################################
|
||
# retourne une H table correspondant <20> un composant tabulations
|
||
|
||
sub getTab {
|
||
my $tab = $_[0];
|
||
|
||
my @k = keys( %{$tab->{tab}} );
|
||
@k = sort( @k );
|
||
|
||
my @tablo;
|
||
for(my $i=0; $i< @k; $i++){
|
||
$tablo[ $i ] = $tab->{tab}->{ $k[$i] };
|
||
}
|
||
|
||
return(\@tablo);
|
||
}
|
||
|
||
########################################################################
|
||
# comme son nom l indique
|
||
|
||
sub keyToVal {
|
||
my $h = $_[0];
|
||
|
||
my @k = keys( %{$h} );
|
||
@k = sort( @k );
|
||
my @tab;
|
||
my $firstL = $k[ 0 ];
|
||
|
||
for( @k ){
|
||
my %hs;
|
||
$hs{ "idValue" } = $_;
|
||
$hs{ "labOption" } = $_;
|
||
push( @tab, \%hs );
|
||
}
|
||
$_[1] = \@tab;
|
||
return $firstL;
|
||
}
|
||
|
||
#---------------------------------------------------------------------
|
||
# CONTROLE DE L'APARTENANCE D'UN HANDLER COMBINED A UN MULTI-HOMING
|
||
# POUR AUTORISATION DE CHANGEMENT DE TYPE OU SUPPRESSION
|
||
#---------------------------------------------------------------------
|
||
|
||
sub OkToChange {
|
||
my $allHandlersChapters = $_[0];
|
||
my $selectedHand = $_[1];
|
||
|
||
my @auxall = keys( %{ $allHandlersChapters } );
|
||
for( @auxall ){
|
||
my $loc = $_;
|
||
my $str = $allHandlersChapters->{ $loc }->{ 'MultiHoming' };
|
||
my @tabH = split( /,/, $str );
|
||
for( @tabH ){
|
||
if( $selectedHand eq $_ ){
|
||
$_[2] = 'ERROR: ' . $selectedHand . ' ' . $text{lab_error_2} . ' ' . $loc;
|
||
return 0;
|
||
}
|
||
}
|
||
}
|
||
|
||
$_[2] = 0;
|
||
return 1;
|
||
}
|
||
|
||
########################################################################
|
||
# retourne tous les composants graph. d'une page (apr<70>s les tabs)
|
||
|
||
sub getAllComposants {
|
||
my $comps = $_[0];
|
||
|
||
my @k = keys( %{$comps->{comp}} );
|
||
@k = sort( @k );
|
||
|
||
my @tablo;
|
||
for(my $i=0; $i< @k; $i++){
|
||
$tablo[ $i ] = $comps->{comp}->{ $k[$i] };
|
||
}
|
||
return(\@tablo);
|
||
}
|
||
|
||
########################################################################
|
||
# retourne une ref sur une valeur d un composant
|
||
|
||
sub getRefValueInCompo {
|
||
my $composs = $_[0];
|
||
my $idcompo = $_[1]; #"LastModified"
|
||
|
||
for( @{$composs} ){
|
||
my $h = $_;
|
||
if( $h->{ id_input } eq $idcompo ){
|
||
return( $h );
|
||
}
|
||
}
|
||
|
||
return( undef );
|
||
}
|
||
|
||
########################################################################
|
||
# supprime le caract<63>re % en d<>but et fin de chaine
|
||
|
||
sub dePourCent {
|
||
my $line = $_[0];
|
||
$line =~ s/%(.+)%/$1/;
|
||
return( $line );
|
||
}
|
||
|
||
########################################################################
|
||
# teste la pr<70>sence du caract<63>re % en d<>but et fin de chaine
|
||
|
||
sub isPourCented {
|
||
my $line = $_[0];
|
||
|
||
my $newline = $line =~ /^%.+%$/;
|
||
return $newline;
|
||
}
|
||
|
||
########################################################################
|
||
# remplace une variable %xxxx% par le texte EN /FR
|
||
|
||
sub polyGlotTab {
|
||
my @tabular = @{$_[0]};
|
||
my %text = %{$_[1]};
|
||
|
||
for(@tabular) { # 0,1 ,2
|
||
my $hash = $_;
|
||
for(keys %{$hash} ) {
|
||
if( isPourCented( $hash->{$_} ) ){
|
||
$hash->{$_} = $text{ dePourCent( $hash->{$_} ) };
|
||
}
|
||
}
|
||
}
|
||
return( \@tabular );
|
||
}
|
||
|
||
###################################################################
|
||
# remplace les attributs link dans une URL
|
||
|
||
sub ajustLink {
|
||
my @tabular = @{$_[0]};
|
||
my $mode = $_[1];
|
||
my $style = $_[2];
|
||
|
||
my $dom = $_[3];
|
||
|
||
for(@tabular) { # 0,1 ,2
|
||
my $hash = $_;
|
||
$hash->{link} =~ s/\$mode/$mode/;
|
||
$hash->{link} =~ s/\$_style/$style/;
|
||
if( $dom ){
|
||
$hash->{link} =~ s/\$dom/$dom/;
|
||
}
|
||
}
|
||
return( \@tabular );
|
||
}
|
||
|
||
########################################################################
|
||
# crochets certifies // substitue les valeurs def et hid par defaut
|
||
|
||
sub TransformVars {
|
||
my @composs = @{$_[0]};
|
||
my $chapter = $_[1];
|
||
my @tabk = keys(%{$chapter});
|
||
my $clebase = $tabk[0];
|
||
|
||
for( @composs ){
|
||
my $comp = $_;
|
||
|
||
for( keys(%{$comp} )) {
|
||
my $k = $_;
|
||
if( $comp->{ $k } =~ /^\$def(.+)/ ||
|
||
$comp->{ $k } =~ /^\$hid(.+)/ ){
|
||
my $cle = $1;
|
||
if( $cle eq "id" ) {
|
||
$comp->{ $k } = $clebase;
|
||
} else {
|
||
if( $chapter->{ $clebase }->{ $cle } ){
|
||
$comp->{ $k } = $chapter->{ $clebase }->{ $cle };
|
||
} else {
|
||
$comp->{ $k } = "";
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
###################################################################
|
||
#
|
||
sub IsApacheRunning {
|
||
if( !($config{'pid_file'}) ) {
|
||
return 0;
|
||
}
|
||
if( -e $config{'pid_file'} ){
|
||
return 1;
|
||
}
|
||
return 0;
|
||
}
|
||
|
||
|
||
###################################################################
|
||
# RAZ du fichier de conf XML en recopiant le fichier template_conf.xml
|
||
|
||
sub restoreXMLFile() {
|
||
copy( "./templates/template_conf.xml", $_[0] );
|
||
}
|
||
|
||
###################################################################
|
||
#
|
||
|
||
1;
|
||
|
||
# C FINI !!! ooops PERL FINI !!!!
|
||
###################################################################
|
||
|