You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
397 lines
12 KiB
397 lines
12 KiB
package Lemonldap::NG::Manager::Build;
|
|
|
|
use strict;
|
|
use Mouse;
|
|
use Lemonldap::NG::Manager::Build::Attributes;
|
|
use Lemonldap::NG::Manager::Build::Tree;
|
|
use Lemonldap::NG::Manager::Build::CTrees;
|
|
use Data::Dumper;
|
|
use Regexp::Assemble;
|
|
use JSON;
|
|
use Getopt::Std;
|
|
use IO::String;
|
|
|
|
has structFile => ( isa => 'Str', is => 'ro', required => 1 );
|
|
has confTreeFile => ( isa => 'Str', is => 'ro', required => 1 );
|
|
has managerConstantsFile => ( isa => 'Str', is => 'ro', required => 1 );
|
|
has managerAttributesFile => ( isa => 'Str', is => 'ro', required => 1 );
|
|
has defaultValuesFile => ( isa => 'Str', is => 'ro', required => 1 );
|
|
|
|
my @managerAttrKeys = qw(keyTest type test msgFail default);
|
|
my $format = 'Creating %-69s: ';
|
|
my $reIgnoreKeys = qr/^$/;
|
|
|
|
my @angularScopeVars;
|
|
my @cnodesKeys;
|
|
my %cnodesRe;
|
|
my @ignoreKeys;
|
|
my $ignoreKeys;
|
|
my $mainTree;
|
|
my @sessionTypes;
|
|
my @simpleHashKeys;
|
|
|
|
my $attributes = Lemonldap::NG::Manager::Build::Attributes::attributes();
|
|
my $jsonEnc = JSON->new()->allow_nonref;
|
|
$jsonEnc->canonical(1);
|
|
|
|
$Data::Dumper::Sortkeys = sub {
|
|
my ($hash) = @_;
|
|
return [
|
|
( defined $hash->{id} ? ('id') : () ),
|
|
( defined $hash->{title} ? ( 'title', ) : () ),
|
|
(
|
|
grep { /^(?:id|title)$/ ? 0 : 1 }
|
|
sort {
|
|
return 1
|
|
if ( $a =~ /node/ and $b !~ /node/ );
|
|
return -1 if ( $b =~ /node/ );
|
|
lc($a) cmp lc($b);
|
|
} keys %$hash
|
|
)
|
|
];
|
|
};
|
|
|
|
sub run {
|
|
my $self = shift;
|
|
$self = __PACKAGE__->new(@_) unless ref $self;
|
|
|
|
# 1. confTree.js
|
|
printf STDERR $format, $self->confTreeFile;
|
|
$mainTree = Lemonldap::NG::Manager::Build::CTrees::cTrees();
|
|
|
|
my $script =
|
|
'function templates(tpl,key){'
|
|
. 'var ind;'
|
|
. 'var scalarTemplate=function(r){'
|
|
. 'return{'
|
|
. '"id":tpl+"s/"+(ind++),'
|
|
. '"title":r,'
|
|
. '"get":tpl+"s/"+key+"/"+r};};'
|
|
. 'switch(tpl){';
|
|
|
|
# To build confTree.js, each special node is scanned from
|
|
# Lemonldap::NG::Manager::Build::CTrees
|
|
foreach my $node ( sort keys %$mainTree ) {
|
|
@cnodesKeys = ();
|
|
my $jsonTree = [];
|
|
$self->scanTree( $mainTree->{$node}, $jsonTree, '__KEY__', '' );
|
|
my $tmp = $jsonEnc->encode($jsonTree);
|
|
$tmp =~ s!"__KEY__!tpl+"s/"+key+"/"+"!mg;
|
|
$tmp =~ s/"(true|false)"/$1/sg;
|
|
$tmp =~ s/:\s*"(\d+)"\s*(["\}])/:$1$2/sg;
|
|
$script .= "case'$node':return$tmp;";
|
|
|
|
# Second step, Manager/Constants.pm file will contain datas issued from
|
|
# this scan
|
|
my $ra = Regexp::Assemble->new;
|
|
|
|
# Build $oidcOPMetaDataNodeKeys, $samlSPMetaDataNodeKeys,...
|
|
foreach my $r (@cnodesKeys) {
|
|
$ra->add($r);
|
|
}
|
|
$cnodesRe{$node} = $ra->as_string;
|
|
|
|
push @ignoreKeys, $node;
|
|
}
|
|
$script .= 'default:return [];}}';
|
|
open F, ">", $self->confTreeFile or die $!;
|
|
print F $script;
|
|
close F;
|
|
print STDERR "done\n";
|
|
my $ra = Regexp::Assemble->new;
|
|
foreach my $re (@ignoreKeys) {
|
|
$ra->add($re);
|
|
}
|
|
$ignoreKeys = $ra->as_string;
|
|
$reIgnoreKeys = $ra->re;
|
|
|
|
# 2. struct.json
|
|
printf STDERR $format, $self->structFile;
|
|
$mainTree = Lemonldap::NG::Manager::Build::Tree::tree();
|
|
my $jsonTree = [];
|
|
$self->scanTree( $mainTree, $jsonTree, '', '' );
|
|
$script = 'function setScopeVars(scope){';
|
|
foreach my $v (@angularScopeVars) {
|
|
$script .= "scope.$v->[0]=scope$v->[1];scope.getKey(scope.$v->[0]);";
|
|
}
|
|
$script .= '}';
|
|
open F, ">>", $self->confTreeFile || die $!;
|
|
print F $script;
|
|
close F;
|
|
open F, ">", $self->structFile || die $!;
|
|
my $tmp = $jsonEnc->encode($jsonTree);
|
|
$tmp =~ s/"(true|false)"/$1/sg;
|
|
$tmp =~ s/:\s*"(\d+)"\s*(["\}])/:$1$2/sg;
|
|
print F $tmp;
|
|
close F;
|
|
print STDERR "done\n";
|
|
$tmp = undef;
|
|
|
|
printf STDERR $format, $self->managerConstantsFile;
|
|
my $sessionTypes = join( "', '", @sessionTypes );
|
|
|
|
open F, ">", $self->managerConstantsFile or die($!);
|
|
my $exportedVars =
|
|
'$'
|
|
. join( 'Keys $', 'simpleHash', 'specialNode', sort keys %cnodesRe )
|
|
. 'Keys $specialNodeHash @sessionTypes';
|
|
print F <<EOF;
|
|
# This file is generated by $0. Don't modify it by hand
|
|
package Lemonldap::NG::Manager::Constants;
|
|
|
|
use strict;
|
|
use Exporter 'import';
|
|
use base qw(Exporter);
|
|
|
|
our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';
|
|
|
|
our %EXPORT_TAGS = ( 'all' => [qw($exportedVars)] );
|
|
our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } );
|
|
our \@EXPORT = ( \@{ \$EXPORT_TAGS{'all'} } );
|
|
|
|
our \$specialNodeHash = {
|
|
virtualHosts => [qw(exportedHeaders locationRules post vhostOptions)],
|
|
samlIDPMetaDataNodes => [qw(samlIDPMetaDataXML samlIDPMetaDataExportedAttributes samlIDPMetaDataOptions)],
|
|
samlSPMetaDataNodes => [qw(samlSPMetaDataXML samlSPMetaDataExportedAttributes samlSPMetaDataOptions)],
|
|
oidcOPMetaDataNodes => [qw(oidcOPMetaDataJSON oidcOPMetaDataJWKS oidcOPMetaDataOptions oidcOPMetaDataExportedVars)],
|
|
oidcRPMetaDataNodes => [qw(oidcRPMetaDataOptions oidcRPMetaDataExportedVars)],
|
|
};
|
|
|
|
our \@sessionTypes = ( '$sessionTypes' );
|
|
|
|
EOF
|
|
|
|
$ra = Regexp::Assemble->new;
|
|
foreach (@simpleHashKeys) {
|
|
$ra->add($_);
|
|
}
|
|
print F "our \$simpleHashKeys = '" . $ra->as_string . "';\n"
|
|
. "our \$specialNodeKeys = '${ignoreKeys}s';\n";
|
|
foreach ( sort keys %cnodesRe ) {
|
|
print F "our \$${_}Keys = '$cnodesRe{$_}';\n";
|
|
}
|
|
|
|
print F "\n1;\n";
|
|
close F;
|
|
print STDERR "done\n";
|
|
|
|
printf STDERR $format, $self->defaultValuesFile;
|
|
my $defaultValues = {
|
|
map {
|
|
defined $attributes->{$_}->{default}
|
|
? ( $_ => $attributes->{$_}->{default} )
|
|
: ()
|
|
} keys(%$attributes)
|
|
};
|
|
my $defaultAttr = Dumper($defaultValues);
|
|
$defaultAttr =~ s/^\$VAR1\s*=/sub defaultValues {\n return/;
|
|
$defaultAttr = "# This file is generated by $0. Don't modify it by hand
|
|
package Lemonldap::NG::Common::Conf::DefaultValues;
|
|
|
|
our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';
|
|
|
|
$defaultAttr}
|
|
|
|
1;
|
|
";
|
|
|
|
my $dst;
|
|
|
|
eval {
|
|
require Perl::Tidy;
|
|
Perl::Tidy::perltidy(
|
|
source => IO::String->new($defaultAttr),
|
|
destination => \$dst
|
|
);
|
|
};
|
|
$dst = $defaultAttr if ($@);
|
|
|
|
open( F, ">", $self->defaultValuesFile ) or die($!);
|
|
print F $dst;
|
|
close F;
|
|
print STDERR "done\n";
|
|
|
|
printf STDERR $format, $self->managerAttributesFile;
|
|
my $managerAttr = {
|
|
map {
|
|
my @r;
|
|
foreach my $f (@managerAttrKeys) {
|
|
push @r, $f, $attributes->{$_}->{$f}
|
|
if ( defined $attributes->{$_}->{$f} );
|
|
}
|
|
( $_ => {@r} );
|
|
} keys(%$attributes)
|
|
};
|
|
$managerAttr = Dumper($managerAttr);
|
|
$managerAttr =~ s/^\$VAR1\s*=/sub attributes {\n return/;
|
|
my $managerTypes =
|
|
Dumper( Lemonldap::NG::Manager::Build::Attributes::types() );
|
|
$managerTypes =~ s/^\$VAR1\s*=/sub types {\n return/;
|
|
$managerAttr = "# This file is generated by $0. Don't modify it by hand
|
|
package Lemonldap::NG::Manager::Attributes;
|
|
|
|
our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';
|
|
|
|
$managerTypes}
|
|
|
|
$managerAttr}
|
|
|
|
";
|
|
eval {
|
|
Perl::Tidy::perltidy(
|
|
source => IO::String->new($managerAttr),
|
|
destination => \$dst
|
|
);
|
|
};
|
|
$dst = $managerAttr if ($@);
|
|
|
|
open( F, ">", $self->managerAttributesFile ) or die($!);
|
|
print F $dst;
|
|
close F;
|
|
print STDERR "done\n";
|
|
}
|
|
|
|
sub scanTree {
|
|
my ( $self, $tree, $json, $prefix, $path ) = splice @_;
|
|
unless ( ref($tree) eq 'ARRAY' ) {
|
|
die 'Not an array';
|
|
}
|
|
$prefix //= '';
|
|
my $ord = -1;
|
|
my $nodeName = $path ? '_nodes' : 'data';
|
|
foreach my $leaf (@$tree) {
|
|
$ord++;
|
|
my $jleaf = {};
|
|
|
|
# Grouped leaf
|
|
if ( ref($leaf) and $leaf->{group} ) {
|
|
die "'form' is required when using 'group'"
|
|
unless ( $leaf->{form} );
|
|
push @$json,
|
|
{
|
|
id => "$prefix$leaf->{title}",
|
|
title => $leaf->{title},
|
|
type => $leaf->{form},
|
|
get => $leaf->{group}
|
|
};
|
|
}
|
|
|
|
# Subnode
|
|
elsif ( ref($leaf) ) {
|
|
$jleaf->{title} = $jleaf->{id} = $leaf->{title};
|
|
$jleaf->{type} = $leaf->{form} if ( $leaf->{form} );
|
|
foreach my $n (qw(nodes nodes_cond)) {
|
|
if ( $leaf->{$n} ) {
|
|
$jleaf->{"_$n"} = [];
|
|
$self->scanTree( $leaf->{$n}, $jleaf->{"_$n"}, $prefix,
|
|
"$path.$nodeName\[$ord\]" );
|
|
if ( $n eq 'nodes_cond' ) {
|
|
foreach my $sn ( @{ $jleaf->{"_$n"} } ) {
|
|
$sn->{show} = 'false';
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$jleaf->{help} = $leaf->{help} if ( $leaf->{help} );
|
|
$jleaf->{_nodes_filter} = $leaf->{nodes_filter}
|
|
if ( $leaf->{nodes_filter} );
|
|
push @$json, $jleaf;
|
|
}
|
|
|
|
# Leaf
|
|
else {
|
|
# Get data type and build tree
|
|
#
|
|
# Types : PerlModule bool boolOrExpr catAndAppList file hostname int
|
|
# keyTextContainer lmAttrOrMacro longtext openidServerList pcre
|
|
# rulesContainer samlAssertion samlAttributeContainer samlService
|
|
# select text trool url virtualHostContainer word
|
|
# password
|
|
|
|
if ( $leaf =~ s/^\*// ) {
|
|
push @angularScopeVars, [ $leaf, "$path._nodes[$ord]" ];
|
|
}
|
|
push @sessionTypes, $1
|
|
if ( $leaf =~ /^(.*)(?<!notification)StorageOptions$/ );
|
|
my $attr = $attributes->{$leaf} or die("Missing attribute $leaf");
|
|
$jleaf = { id => "$prefix$leaf", title => $leaf };
|
|
unless ( $attr->{type} ) {
|
|
print STDERR "Fatal: no type: $leaf\n";
|
|
exit;
|
|
}
|
|
|
|
# TODO: change this
|
|
$attr->{type} =~
|
|
s/^(?:url|word|pcre|lmAttrOrMacro|hostname|PerlModule)$/text/;
|
|
$jleaf->{type} = $attr->{type} if ( $attr->{type} ne 'text' );
|
|
foreach my $w (qw(default select get template)) {
|
|
$jleaf->{$w} = $attr->{$w} if ( defined $attr->{$w} );
|
|
}
|
|
if ( $jleaf->{default} and ref( $jleaf->{default} ) ) {
|
|
$jleaf->{default} = [];
|
|
my $type = $attr->{type};
|
|
$type =~ s/Container//;
|
|
foreach my $k ( sort keys( %{ $attr->{default} } ) ) {
|
|
push @{ $jleaf->{default} },
|
|
{
|
|
id => "$prefix$leaf/$k",
|
|
title => $k,
|
|
type => $type,
|
|
data => $attr->{default}->{$k},
|
|
(
|
|
$type eq 'rule'
|
|
? ( re => $k )
|
|
: ()
|
|
),
|
|
};
|
|
}
|
|
}
|
|
if ($prefix) {
|
|
push @cnodesKeys, $leaf;
|
|
}
|
|
if ( $attr->{type} =~ /^(?:catAndAppList|\w+Container)$/ ) {
|
|
$jleaf->{cnodes} = $prefix . $leaf;
|
|
unless ( $prefix or $leaf =~ $reIgnoreKeys ) {
|
|
push @simpleHashKeys, $leaf;
|
|
}
|
|
|
|
#if ( $opts{f} ) {
|
|
# my $js = getData( $prefix . $leaf );
|
|
#}
|
|
}
|
|
else {
|
|
#if ( $opts{f} ) {
|
|
# my $file = $jleaf->{get} // $jleaf->{title};
|
|
# my $js = getData($file);
|
|
# $jleaf->{get} = $file = $file . ".json";
|
|
# open F, ">app/confs/$opts{f}/$file"
|
|
# or die $!;
|
|
# print F $js;
|
|
# close F;
|
|
#}
|
|
if ( $prefix and !$jleaf->{get} ) {
|
|
$jleaf->{get} = $prefix . $jleaf->{title};
|
|
}
|
|
}
|
|
push @$json, $jleaf;
|
|
}
|
|
}
|
|
}
|
|
|
|
__END__
|
|
sub getData {
|
|
die $opts{f} unless $opts{f} =~ /^\d+$/;
|
|
my $k = shift;
|
|
my $q = "/confs/$opts{f}/$k";
|
|
return $run->(
|
|
{
|
|
HTTP_ACCEPT => 'application/json',
|
|
PATH_INFO => $q,
|
|
QUERY_STRING => '',
|
|
REQUEST_URI => $q,
|
|
REQUEST_METHOD => 'GET',
|
|
}
|
|
)->[2]->[0];
|
|
}
|
|
|
|
1;
|
|
|