Move read conf calls into Conf/RESTServer (#970)
Xavier Guimard
9 years ago
parent
1983842f79
commit
2118a4242b
@ -0,0 +1,712 @@ |
||||
package Lemonldap::NG::Common::Conf::RESTServer; |
||||
|
||||
use strict; |
||||
use Mouse; |
||||
use Lemonldap::NG::Common::Conf::Constants; |
||||
use Lemonldap::NG::Manager::Constants; |
||||
|
||||
our $VERSION = '2.0.0'; |
||||
|
||||
extends 'Lemonldap::NG::Common::Conf::AccessLib'; |
||||
|
||||
####################### |
||||
# I. PRIVATE METHODS # |
||||
####################### |
||||
|
||||
## @method scalar getConfKey($req, $key) |
||||
# Return key value |
||||
# |
||||
# Return the value of $key key in current configuration. If cfgNum is set to |
||||
# `latest`, get before last configuration number. |
||||
# |
||||
# Errors: set an error in $req->error and return undef if: |
||||
# * query does not have a cfgNum parameter (set by Common/PSGI/Router.pm) |
||||
# * cfgNum is not a number |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param $key Key name |
||||
#@return keyvalue (string, int or hashref) |
||||
sub getConfKey { |
||||
my ( $self, $req, $key, @args ) = @_; |
||||
$self->lmLog( "Search for $key in conf", 'debug' ); |
||||
|
||||
# Verify that cfgNum has been asked |
||||
unless ( defined $req->params('cfgNum') ) { |
||||
$req->error("Missing configuration number"); |
||||
return undef; |
||||
} |
||||
$self->lmLog( "Cfgnum set to " . $req->params('cfgNum'), 'debug' ); |
||||
|
||||
# when 'latest' => replace by last cfgNum |
||||
if ( $req->params('cfgNum') eq 'latest' ) { |
||||
my $tmp = $self->confAcc->lastCfg; |
||||
$req->set_param( 'cfgNum', $tmp ); |
||||
if ($Lemonldap::NG::Common::Conf::msg) { |
||||
$req->error($Lemonldap::NG::Common::Conf::msg); |
||||
return undef; |
||||
} |
||||
} |
||||
elsif ( $req->params('cfgNum') !~ /^\d+$/ ) { |
||||
$req->error("cfgNum must be a number"); |
||||
return undef; |
||||
} |
||||
unless ( |
||||
defined $self->getConfByNum( scalar( $req->params('cfgNum') ), @args ) ) |
||||
{ |
||||
$req->error( "Configuration " |
||||
. $req->params('cfgNum') |
||||
. " is not available (" |
||||
. $Lemonldap::NG::Common::Conf::msg |
||||
. ')' ); |
||||
return undef; |
||||
} |
||||
|
||||
# TODO: insert default values |
||||
# Set an error if key is not defined |
||||
return $self->currentConf->{$key}; |
||||
} |
||||
|
||||
sub getConfByNum { |
||||
my ( $self, $cfgNum, @args ) = @_; |
||||
unless ( %{ $self->currentConf } |
||||
and $cfgNum == $self->currentConf->{cfgNum} ) |
||||
{ |
||||
my $tmp; |
||||
if ( $cfgNum == 0 ) { |
||||
require Lemonldap::NG::Manager::Conf::Zero; |
||||
$tmp = Lemonldap::NG::Manager::Conf::Zero::zeroConf(); |
||||
} |
||||
else { |
||||
$tmp = |
||||
$self->confAcc->getConf( |
||||
{ cfgNum => $cfgNum, raw => 1, noCache => 1, @args } ); |
||||
return undef unless ( $tmp and ref($tmp) and %$tmp ); |
||||
} |
||||
$self->currentConf($tmp); |
||||
} |
||||
return $cfgNum; |
||||
} |
||||
|
||||
######################## |
||||
# II. Display methods # |
||||
######################## |
||||
|
||||
# Values are send depending of the /path/info/. For example, |
||||
# /confs/1/portal to get portal value. |
||||
|
||||
# This section contains several methods: |
||||
# - complex nodes: |
||||
# * complexNodesRoot() call for root queries (no subkeys) to display the list |
||||
# * virtualHosts() |
||||
# * _samlMetaDataNodes() is called by saml(IDP|RP)MetaDataNode |
||||
# * _oidcMetaDataNodes() is called by oidc(OP|RP)MetaDataNodes |
||||
# - other special nodes: |
||||
# * authChoiceModules() |
||||
# * grantSessionRules() |
||||
# * openIdIDPList() (old OpenID) |
||||
# * applicationList() |
||||
# - root: |
||||
# root query (/confs/latest for example) is redirected to metadatas() |
||||
# - other requests: |
||||
# they are managed by getKey() |
||||
# - newRSAKey() returns a new RSA key pair if /confs/newRSAKey is called in a |
||||
# POST request |
||||
# - prx() load a request and return the content (for SAML/OIDC metadatas) |
||||
|
||||
# 31 - Complex subnodes |
||||
# ---------------- |
||||
|
||||
## @method PSGI-JSON-response complexNodesRoot($req, $query, $tpl) |
||||
# Respond to root requests for virtual hosts and SAMLmetadatas |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param $query Configuration root key |
||||
#@param $tpl Javascript template to use (see JS/JSON generator script) |
||||
#@return PSGI JSON response |
||||
sub complexNodesRoot { |
||||
my ( $self, $req, $query, $tpl ) = @_; |
||||
$self->lmLog( "Query for $query template keys", 'debug' ); |
||||
|
||||
my $tmp = $self->getConfKey( $req, $query ); |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
|
||||
my @res; |
||||
if ( ref($tmp) ) { |
||||
foreach my $f ( sort keys %$tmp ) { |
||||
push @res, |
||||
{ |
||||
id => "${tpl}s/$f", |
||||
title => $f, |
||||
type => $tpl, |
||||
template => $tpl |
||||
}; |
||||
} |
||||
} |
||||
return $self->sendJSONresponse( $req, \@res ); |
||||
} |
||||
|
||||
# 311 - Virtual hosts |
||||
# ------------- |
||||
|
||||
## @method PSGI-JSON-response virtualHosts($req, @path) |
||||
# Respond to virtualhosts sub requests |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @path words in path after `virtualhosts` |
||||
#@return PSGI JSON response |
||||
sub virtualHosts { |
||||
my ( $self, $req, @path ) = @_; |
||||
|
||||
return $self->complexNodesRoot( $req, 'locationRules', 'virtualHost' ) |
||||
unless (@path); |
||||
|
||||
my $vh = shift @path; |
||||
my $query; |
||||
unless ( $query = shift @path ) { |
||||
return $self->sendError( $req, |
||||
'Bad request: virtualHost query must ask for a key', 400 ); |
||||
} |
||||
|
||||
# Send setDefault for new vhosts |
||||
return $self->sendError( $req, 'setDefault', 200 ) if ( $vh =~ /^new__/ ); |
||||
|
||||
# Reject unknown vhosts |
||||
return $self->sendError( $req, "Unknown virtualhost ($vh)", 400 ) |
||||
unless ( defined $self->getConfKey( $req, 'locationRules' )->{$vh} ); |
||||
|
||||
if ( $query =~ /^(?:(?:exportedHeader|locationRule)s|post)$/ ) { |
||||
my ( $id, $resp ) = ( 1, [] ); |
||||
my $vhk = eval { $self->getConfKey( $req, $query )->{$vh} } // {}; |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
$self->lmLog( "Query for $vh/$query keys", 'debug' ); |
||||
|
||||
# Keys are ordered except 'default' which must be at the end |
||||
foreach my $r ( |
||||
sort { |
||||
$query eq 'locationRules' |
||||
? ( |
||||
$a eq 'default' |
||||
? 1 |
||||
: ( $b eq 'default' ? -1 : $a cmp $b ) |
||||
) |
||||
: $a cmp $b |
||||
} keys %$vhk |
||||
) |
||||
{ |
||||
my $res = { |
||||
id => "virtualHosts/$vh/$query/" . $id++, |
||||
title => $r, |
||||
data => $vhk->{$r}, |
||||
type => 'keyText', |
||||
}; |
||||
|
||||
# If rule contains a comment, split it |
||||
if ( $query eq 'locationRules' ) { |
||||
$res->{comment} = ''; |
||||
if ( $r =~ s/\(\?#(.*?)\)// ) { |
||||
$res->{title} = $res->{comment} = $1; |
||||
} |
||||
$res->{re} = $r; |
||||
$res->{type} = 'rule'; |
||||
} |
||||
elsif ( $query eq 'post' ) { |
||||
$res->{data} = $vhk->{$r}; |
||||
$res->{type} = 'post'; |
||||
} |
||||
push @$resp, $res; |
||||
} |
||||
return $self->sendJSONresponse( $req, $resp ); |
||||
} |
||||
elsif ( $query =~ /^vhost(?:(?:Aliase|Http)s|Maintenance|Port)$/ ) { |
||||
$self->lmLog( "Query for $vh/$query key", 'debug' ); |
||||
|
||||
# TODO: verify how this is done actually |
||||
my $k1 = $self->getConfKey( $req, 'vhostOptions' ); |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
|
||||
# Default values are set by JS |
||||
my $res = eval { $k1->{$vh}->{$query} } // undef; |
||||
return $self->sendJSONresponse( $req, { value => $res } ); |
||||
} |
||||
else { |
||||
return $self->sendError( $req, "Unknown vhost subkey ($query)", 400 ); |
||||
} |
||||
} |
||||
|
||||
# 312 - SAML |
||||
# ---- |
||||
|
||||
## @method PSGI-JSON-response _samlMetaDataNode($type, $req, @path) |
||||
# Respond to SAML metadata subnodes |
||||
# |
||||
#@param $type `SP` or `IDP` |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @path words in path after `saml{IDP|SP}MetaDataNode` |
||||
#@return PSGI JSON response |
||||
sub _samlMetaDataNodes { |
||||
my ( $self, $type, $req, @path ) = @_; |
||||
|
||||
return $self->complexNodesRoot( $req, "saml${type}MetaDataXML", |
||||
"saml${type}MetaDataNode" ) |
||||
unless (@path); |
||||
my $partner = shift @path; |
||||
my $query = shift @path; |
||||
unless ($query) { |
||||
return $self->sendError( $req, |
||||
"Bad request: saml${type}MetaDataNode query must ask for a key", |
||||
400 ); |
||||
} |
||||
|
||||
# setDefault response for new partners |
||||
return $self->sendError( $req, 'setDefault', 200 ) |
||||
if ( $partner =~ /^new__/ ); |
||||
|
||||
# Reject unknown partners |
||||
return $self->sendError( $req, "Unknown SAML partner ($partner)", 400 ) |
||||
unless ( |
||||
defined eval { |
||||
$self->getConfKey( $req, "saml${type}MetaDataXML" )->{$partner}; |
||||
} |
||||
); |
||||
|
||||
my ( $id, $resp ) = ( 1, [] ); |
||||
|
||||
# Return all exported attributes if asked |
||||
if ( $query =~ /^saml${type}MetaDataExportedAttributes$/ ) { |
||||
my $pk = |
||||
eval { $self->getConfKey( $req, $query )->{$partner} } // {}; |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
foreach my $h ( sort keys %$pk ) { |
||||
push @$resp, |
||||
{ |
||||
id => "saml${type}MetaDataNodes/$partner/$query/" . $id++, |
||||
title => $h, |
||||
data => [ split /;/, $pk->{$h} ], |
||||
type => 'samlAttribute', |
||||
}; |
||||
} |
||||
return $self->sendJSONresponse( $req, $resp ); |
||||
} |
||||
|
||||
# Simple root keys |
||||
elsif ( $query =~ /^saml${type}MetaDataXML$/ ) { |
||||
my $value = |
||||
eval { $self->getConfKey( $req, $query )->{$partner}->{$query}; } |
||||
// undef; |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
return $self->sendJSONresponse( $req, { value => $value } ); |
||||
} |
||||
|
||||
# These regexps are generated by jsongenerator.pl and stored in |
||||
# Lemonldap::NG::Manager::Constants |
||||
elsif ( |
||||
$query =~ { |
||||
IDP => qr/^$samlIDPMetaDataNodeKeys$/o, |
||||
SP => qr/^$samlSPMetaDataNodeKeys$/o |
||||
}->{$type} |
||||
) |
||||
{ |
||||
my $value = eval { |
||||
$self->getConfKey( $req, "saml${type}MetaDataOptions" )->{$partner} |
||||
->{$query}; |
||||
} // undef; |
||||
|
||||
# Note that types "samlService" and "samlAssertion" will be splitted by |
||||
# manager.js in an array |
||||
return $self->sendJSONresponse( $req, { value => $value } ); |
||||
} |
||||
else { |
||||
return $self->sendError( $req, |
||||
"Bad key for saml${type}MetaDataNode ($query)", 400 ); |
||||
} |
||||
} |
||||
|
||||
## @method PSGI-JSON-response samlIDPMetaDataNode($req, @path) |
||||
# Launch _samlMetaDataNode('IDP', @_) |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @path words in path after `samlIDPMetaDataNode` |
||||
#@return PSGI JSON response |
||||
sub samlIDPMetaDataNodes { |
||||
my ( $self, $req, @path ) = @_; |
||||
return $self->_samlMetaDataNodes( 'IDP', $req, @path ); |
||||
} |
||||
|
||||
## @method PSGI-JSON-response samlSPMetaDataNode($req, @path) |
||||
# Launch _samlMetaDataNode('SP', @_) |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @path words in path after `samlSPMetaDataNode` |
||||
#@return PSGI JSON response |
||||
sub samlSPMetaDataNodes { |
||||
my ( $self, $req, @path ) = @_; |
||||
return $self->_samlMetaDataNodes( 'SP', $req, @path ); |
||||
} |
||||
|
||||
# 313 - OpenID-Connect |
||||
# -------------- |
||||
|
||||
## @method PSGI-JSON-response _oidcMetaDataNodes($type, $req, @path) |
||||
# Respond to OpenID-Connect metadata subnodes |
||||
# |
||||
#@param $type `OP` or `RP` |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @path words in path after `oidc{OP|RP}MetaDataNode` |
||||
#@return PSGI JSON response |
||||
sub _oidcMetaDataNodes { |
||||
my ( $self, $type, $req, @path ) = @_; |
||||
|
||||
my $refKey = |
||||
( $type eq 'RP' ? 'oidcRPMetaDataOptions' : 'oidcOPMetaDataJSON' ); |
||||
return $self->complexNodesRoot( $req, $refKey, "oidc${type}MetaDataNode" ) |
||||
unless (@path); |
||||
|
||||
my $partner = shift @path; |
||||
my $query = shift @path; |
||||
unless ($query) { |
||||
return $self->sendError( $req, |
||||
"Bad request: oidc${type}MetaDataNode query must ask for a key", |
||||
400 ); |
||||
} |
||||
|
||||
# setDefault response for new partners |
||||
return $self->sendError( $req, 'setDefault', 200 ) |
||||
if ( $partner =~ /^new__/ ); |
||||
|
||||
# Reject unknown partners |
||||
return $self->sendError( $req, |
||||
"Unknown OpenID-Connect partner ($partner)", 400 ) |
||||
unless ( defined eval { $self->getConfKey( $req, $refKey )->{$partner}; } |
||||
); |
||||
|
||||
my ( $id, $resp ) = ( 1, [] ); |
||||
|
||||
# Return all exported attributes if asked |
||||
if ( $query =~ |
||||
/^(?:oidc${type}MetaDataExportedVars|oidcRPMetaDataOptionsExtraClaims)$/ |
||||
) |
||||
{ |
||||
my $pk = eval { $self->getConfKey( $req, $query )->{$partner} } // {}; |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
foreach my $h ( sort keys %$pk ) { |
||||
push @$resp, |
||||
{ |
||||
id => "oidc${type}MetaDataNodes/$partner/$query/" . $id++, |
||||
title => $h, |
||||
data => $pk->{$h}, |
||||
type => 'keyText', |
||||
}; |
||||
} |
||||
return $self->sendJSONresponse( $req, $resp ); |
||||
} |
||||
|
||||
# Long text types (OP only) |
||||
elsif ( $query =~ /^oidcOPMetaData(?:JSON|JWKS)$/ ) { |
||||
my $value = |
||||
eval { $self->getConfKey( $req, $query )->{$partner}; } // undef; |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
return $self->sendJSONresponse( $req, { value => $value } ); |
||||
} |
||||
|
||||
# Options |
||||
elsif ( |
||||
$query =~ { |
||||
OP => qr/^$oidcOPMetaDataNodeKeys$/o, |
||||
RP => qr/^$oidcRPMetaDataNodeKeys$/o |
||||
}->{$type} |
||||
) |
||||
{ |
||||
my $value = eval { |
||||
$self->getConfKey( $req, "oidc${type}MetaDataOptions" )->{$partner} |
||||
->{$query}; |
||||
} // undef; |
||||
return $self->sendJSONresponse( $req, { value => $value } ); |
||||
} |
||||
else { |
||||
return $self->sendError( $req, |
||||
"Bad key for oidc${type}MetaDataNode ($query)", 400 ); |
||||
} |
||||
} |
||||
|
||||
## @method PSGI-JSON-response oidcOPMetaDataNodes($req, @path) |
||||
# Launch _oidcMetaDataNodes('SP', @_) |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @path words in path after `oidcOPMetaDataNode` |
||||
#@return PSGI JSON response |
||||
sub oidcOPMetaDataNodes { |
||||
my ( $self, $req, @path ) = @_; |
||||
return $self->_oidcMetaDataNodes( 'OP', $req, @path ); |
||||
} |
||||
|
||||
## @method PSGI-JSON-response oidcRPMetaDataNodes($req, @path) |
||||
# Launch _oidcMetaDataNodes('SP', @_) |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @path words in path after `oidcRPMetaDataNode` |
||||
#@return PSGI JSON response |
||||
sub oidcRPMetaDataNodes { |
||||
my ( $self, $req, @path ) = @_; |
||||
return $self->_oidcMetaDataNodes( 'RP', $req, @path ); |
||||
} |
||||
|
||||
# 32 - Other special nodes |
||||
# ------------------- |
||||
|
||||
# 321 - Choice authentication |
||||
|
||||
## @method PSGI-JSON-response authChoiceModules($req,$key) |
||||
# Returns authChoiceModules keys splitted in arrays |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param key optional subkey |
||||
#@return PSGI JSON response |
||||
sub authChoiceModules { |
||||
my ( $self, $req, $key ) = @_; |
||||
my $value = $self->getConfKey( $req, 'authChoiceModules' ); |
||||
unless ($key) { |
||||
my @res; |
||||
foreach my $k ( sort keys %$value ) { |
||||
push @res, |
||||
{ |
||||
id => "authChoiceModules/$k", |
||||
title => "$k", |
||||
data => [ split /;/, $value->{$k} ], |
||||
type => 'authChoice' |
||||
}; |
||||
} |
||||
return $self->sendJSONresponse( $req, \@res ); |
||||
} |
||||
else { |
||||
my $r = $value->{$key} ? [ split( /[;\|]/, $value->{$key} ) ] : []; |
||||
return $self->sendJSONresponse( $req, { value => $r } ); |
||||
} |
||||
} |
||||
|
||||
# 322 - Rules to grant sessions |
||||
|
||||
## @method PSGI-JSON-response grantSessionRules($req) |
||||
# Split grantSessionRules key=>value into 3 elements |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@return PSGI JSON response |
||||
sub grantSessionRules { |
||||
my ( $self, $req, $key ) = @_; |
||||
return $self->sendError( 'Subkeys forbidden for grantSessionRules', 400 ) |
||||
if ($key); |
||||
my $value = $self->getConfKey( $req, 'grantSessionRules' ); |
||||
my @res; |
||||
|
||||
sub _sort { |
||||
my $A = ( $a =~ /^.*?##(.*)$/ )[0]; |
||||
my $B = ( $b =~ /^.*?##(.*)$/ )[0]; |
||||
return !$A ? 1 : !$B ? -1 : $A cmp $B; |
||||
} |
||||
my $id = 0; |
||||
foreach my $k ( sort _sort keys %$value ) { |
||||
my $r = $k; |
||||
my $c = ( $r =~ s/^(.*)?##(.*)$/$1/ ? $2 : '' ); |
||||
$id++; |
||||
push @res, |
||||
{ |
||||
id => "grantSessionRules/$id", |
||||
title => $c || $r, |
||||
re => $r, |
||||
comment => $c, |
||||
data => $value->{$k}, |
||||
type => 'grant' |
||||
}; |
||||
} |
||||
return $self->sendJSONresponse( $req, \@res ); |
||||
} |
||||
|
||||
# 323 - (old)OpenID IDP black/white list |
||||
|
||||
##method PSGI-JSON-response openIdIDPList($req) |
||||
# Split openIdIDPList parameter into 2 elements |
||||
sub openIdIDPList { |
||||
my ( $self, $req, $key ) = @_; |
||||
return $self->sendError( 'Subkeys forbidden for openIdIDPList', 400 ) |
||||
if ($key); |
||||
my $value = $self->getConfKey( $req, 'openIdIDPList' ); |
||||
$value //= '0;'; |
||||
my ( $type, $v ) = split /;/, $value; |
||||
$v //= ''; |
||||
return $self->sendJSONresponse( $req, { value => [ $type, $v ] } ); |
||||
} |
||||
|
||||
# 324 - Application for menu |
||||
# -------------------- |
||||
|
||||
## @method PSGI-JSON-response applicationList($req, @other) |
||||
# Return the full menu tree |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param @other words in path after `applicationList` |
||||
#@return PSGI JSON response |
||||
sub applicationList { |
||||
my ( $self, $req, @other ) = @_; |
||||
return $self->sendError( $req, |
||||
'There is no subkey for applicationList', 400 ) |
||||
if (@other); |
||||
my $apps = $self->getConfKey( $req, 'applicationList' ); |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
$apps = {} unless ( ref($apps) eq 'HASH' ); |
||||
my $json = $self->_scanCatsAndApps( $apps, 'applicationList' ); |
||||
return $self->sendJSONresponse( $req, $json ); |
||||
} |
||||
|
||||
## @method arrayRef _scanCatsAndApps($apps) |
||||
# Recursive method used to build categories & applications menu |
||||
# |
||||
#@param $apps HashRef pointing to a subnode of catAndApps conf tree |
||||
#@return arrayRef |
||||
sub _scanCatsAndApps { |
||||
my ( $self, $apps, $baseId ) = @_; |
||||
my @res; |
||||
|
||||
foreach my $cat ( grep { not /^(?:catname|type)$/ } sort keys %$apps ) { |
||||
my $item = { id => "$baseId/$cat" }; |
||||
if ( $apps->{$cat}->{type} eq 'category' ) { |
||||
$item->{title} = $apps->{$cat}->{catname}; |
||||
$item->{type} = 'menuCat'; |
||||
$item->{nodes} = |
||||
$self->_scanCatsAndApps( $apps->{$cat}, "$baseId/$cat" ); |
||||
} |
||||
else { |
||||
$item->{title} = $apps->{$cat}->{options}->{name}; |
||||
$item->{type} = $apps->{$cat}->{type} = 'menuApp'; |
||||
foreach my $o ( |
||||
grep { not /^name$/ } |
||||
keys %{ $apps->{$cat}->{options} } |
||||
) |
||||
{ |
||||
$item->{data}->{$o} = $apps->{$cat}->{options}->{$o}; |
||||
} |
||||
} |
||||
push @res, $item; |
||||
} |
||||
return \@res; |
||||
} |
||||
|
||||
# 33 - Root queries |
||||
# ----------- |
||||
|
||||
## @method PSGI-JSON-response metadatas($req) |
||||
# Respond to `/conf/:cfgNum` requests by sending configuration metadatas |
||||
# |
||||
# NB: if `full=1` is set in the query, configuration is returned directly in |
||||
# JSON |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@return PSGI JSON response |
||||
sub metadatas { |
||||
my ( $self, $req ) = @_; |
||||
if ( $req->params('full') and $req->params('full') !~ NO ) { |
||||
my $c = $self->getConfKey( $req, 'cfgNum' ); |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
$self->userNotice( 'User ' |
||||
. $self->userId($req) |
||||
. ' ask for full configuration ' |
||||
. $c ); |
||||
return $self->sendJSONresponse( |
||||
$req, |
||||
$self->currentConf, |
||||
forceJSON => 1, |
||||
headers => [ |
||||
'Content-Disposition' => "Attachment; filename=lmConf-$c.json" |
||||
], |
||||
); |
||||
} |
||||
else { |
||||
my $res = {}; |
||||
$res->{cfgNum} = $self->getConfKey( $req, 'cfgNum' ); |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
return $self->sendError( $req, "Configuration without cfgNum", 500 ) |
||||
unless ( defined $res->{cfgNum} ); |
||||
foreach my $key (qw(cfgAuthor cfgDate cfgAuthorIP cfgLog)) { |
||||
$res->{$key} = $self->getConfKey( $req, $key ); |
||||
} |
||||
|
||||
# Find next and previous conf |
||||
my @a = $self->confAcc->available; |
||||
my $id = -1; |
||||
my ($ind) = map { $id++; $_ == $res->{cfgNum} ? ($id) : () } @a; |
||||
if ($ind) { $res->{prev} = $a[ $ind - 1 ]; } |
||||
if ( $ind and $ind < $#a ) { $res->{next} = $a[ $ind + 1 ]; } |
||||
$self->userNotice( 'User ' |
||||
. $self->userId($req) |
||||
. ' ask for configuration metadatas (' |
||||
. $res->{cfgNum} |
||||
. ')' ); |
||||
return $self->sendJSONresponse( $req, $res ); |
||||
} |
||||
} |
||||
|
||||
# 34 - Other values |
||||
# ------------ |
||||
|
||||
## @method PSGI-JSON-response getKey($req, $key, $subkey) |
||||
# Return the value of a root key of current configuration |
||||
# |
||||
#@param $req Lemonldap::NG::Common::PSGI::Request |
||||
#@param $key Name of key requested |
||||
#@param $subkey Subkey for hash values |
||||
#@return PSGI JSON response |
||||
sub getKey { |
||||
my ( $self, $req, $key, $subkey ) = @_; |
||||
unless ($key) { |
||||
return $self->metadatas($req); |
||||
} |
||||
$self->userInfo( 'User ' . $self->userId($req) . " asks for key $key" ); |
||||
my $value = $self->getConfKey( $req, $key ); |
||||
return $self->sendError( $req, undef, 400 ) if ( $req->error ); |
||||
|
||||
# When "hash" |
||||
if ( $key =~ qr/^$simpleHashKeys$/o ) { |
||||
return $self->sendError( $req, 'setDefault', 200 ) |
||||
unless defined($value); |
||||
|
||||
# If a hash key is asked return its value |
||||
if ($subkey) { |
||||
return $self->sendJSONresponse( $req, |
||||
{ value => $value->{$subkey} // undef, } ); |
||||
} |
||||
|
||||
# else return the list of keys |
||||
my @res; |
||||
foreach my $k ( sort keys %$value ) { |
||||
push @res, |
||||
{ |
||||
id => "$key/$k", |
||||
title => "$k", |
||||
data => $value->{$k}, |
||||
type => 'keyText' |
||||
}; |
||||
} |
||||
return $self->sendJSONresponse( $req, \@res ); |
||||
} |
||||
elsif ( $key =~ qr/^$doubleHashKeys$/o ) { |
||||
my @res; |
||||
if ( defined $value ) { |
||||
foreach my $host ( sort keys %$value ) { |
||||
my @tmp; |
||||
foreach my $k ( sort keys %{ $value->{$host} } ) { |
||||
push @tmp, { k => $k, v => $value->{$host}->{$k} }; |
||||
} |
||||
push @res, { k => $host, h => \@tmp }; |
||||
} |
||||
} |
||||
return $self->sendJSONresponse( $req, { value => \@res } ); |
||||
} |
||||
|
||||
# When scalar |
||||
return $self->sendError( $req, "Key $key is not a hash", 400 ) |
||||
if ($subkey); |
||||
return $self->sendError( $req, 'setDefault', 200 ) unless defined($value); |
||||
return $self->sendJSONresponse( $req, { value => $value } ); |
||||
|
||||
# TODO authParam key |
||||
} |
||||
|
||||
1; |
||||
Loading…
Reference in new issue