Lemonldap-NG-Common/lib/Lemonldap/NG/Common/Conf/RESTServer.pm
package Lemonldap::NG::Common::Conf::RESTServer;
use strict;
use JSON 'from_json';
use Mouse;
use Lemonldap::NG::Common::Conf::Constants;
use Lemonldap::NG::Common::Conf::ReConstants;
our $VERSION = '2.22.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->logger->debug("Search for $key in conf");
# Verify that cfgNum has been asked
unless ( defined $req->params('cfgNum') ) {
$req->error("Missing configuration number");
return undef;
}
$self->logger->debug( "Cfgnum set to " . $req->params('cfgNum') );
# when 'latest' => replace by last cfgNum
if ( $req->params('cfgNum') eq 'latest' ) {
my $tmp = $self->confAcc->lastCfg;
$req->set_param( 'cfgNum', $tmp );
unless ($tmp) {
$req->error($Lemonldap::NG::Common::Conf::msg)
if ($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 %{ $self->currentConf }
and $cfgNum == $self->currentConf->{cfgNum} )
{
my $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 metadata()
# - 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 metadata)
# 31 - Complex subnodes
# ----------------
## @method PSGI-JSON-response complexNodesRoot($req, $query, $tpl)
# Respond to root requests for virtual hosts and SAMLmetadata
#
#@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->logger->debug("Query for $query template keys");
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->sendJSONresponse( $req, { error => 'setDefault' } )
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->logger->debug("Query for $vh/$query keys");
# 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 or an AuthLevel, split them
if ( $query eq 'locationRules' ) {
$res->{comment} = '';
$res->{level} = '';
$res->{level} = $1 if ( $r =~ s/\(\?#AuthnLevel=(-?\d+)\)// );
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 =~ qr/^$virtualHostKeys$/o ) {
$self->logger->debug("Query for $vh/$query key");
# 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->sendJSONresponse( $req, { error => 'setDefault' } )
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 );
}
elsif ( $query eq "samlSPMetaDataMacros" ) {
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 => $pk->{$h},
type => 'keyText',
};
}
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 } );
}
# Metadata URL
elsif ( $query =~ /^saml${type}MetaDataURL$/ ) {
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::Common::Conf::ReConstants
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->sendJSONresponse( $req, { error => 'setDefault' } )
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, [] );
# Handle RP Attributes
if ( $query eq "oidcRPMetaDataExportedVars" ) {
my $pk = eval { $self->getConfKey( $req, $query )->{$partner} } // {};
return $self->sendError( $req, undef, 400 ) if ( $req->error );
foreach my $h ( sort keys %$pk ) {
# Set default values for type and array
my $data = [ split /;/, $pk->{$h} ];
unless ( $data->[1] ) {
$data->[1] = "string";
}
unless ( $data->[2] ) {
$data->[2] = "auto";
}
push @$resp,
{
id => "oidc${type}MetaDataNodes/$partner/$query/" . $id++,
title => $h,
data => $data,
type => 'oidcAttribute',
};
}
return $self->sendJSONresponse( $req, $resp );
}
# Return all exported attributes if asked
elsif ( $query =~
/^(?:oidc${type}MetaDataExportedVars|oidcRPMetaDataOptionsExtraClaims|oidcRPMetaDataMacros|oidcRPMetaDataScopeRules)$/
)
{
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 );
}
# 314 - CAS
# ---
sub _casMetaDataNodes {
my ( $self, $type, $req, @path ) = @_;
my $refKey =
( $type eq 'App' ? 'casAppMetaDataOptions' : 'casSrvMetaDataOptions' );
return $self->complexNodesRoot( $req, $refKey, "cas${type}MetaDataNode" )
unless (@path);
my $partner = shift @path;
my $query = shift @path;
unless ($query) {
return $self->sendError( $req,
"Bad request: cas${type}MetaDataNode query must ask for a key",
400 );
}
# setDefault response for new partners
return $self->sendJSONresponse( $req, { error => 'setDefault' } )
if ( $partner =~ /^new__/ );
# Reject unknown partners
return $self->sendError( $req, "Unknown CAS partner ($partner)", 400 )
unless ( defined eval { $self->getConfKey( $req, $refKey )->{$partner}; }
);
my ( $id, $resp ) = ( 1, [] );
# Return all exported attributes if asked
if ( $query =~
/^(?:cas${type}MetaDataExportedVars|casSrvMetaDataOptionsProxiedServices|casAppMetaDataMacros)$/
)
{
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 => "cas${type}MetaDataNodes/$partner/$query/" . $id++,
title => $h,
data => $pk->{$h},
type => 'keyText',
};
}
return $self->sendJSONresponse( $req, $resp );
}
# Options
if (
$query =~ {
App => qr/^$casAppMetaDataNodeKeys$/o,
Srv => qr/^$casSrvMetaDataNodeKeys$/o
}->{$type}
)
{
my $value = eval {
$self->getConfKey( $req, "cas${type}MetaDataOptions" )->{$partner}
->{$query};
} // undef;
return $self->sendJSONresponse( $req, { value => $value } );
}
else {
return $self->sendError( $req,
"Bad key for cas${type}MetaDataNode ($query)", 400 );
}
}
sub casSrvMetaDataNodes {
my ( $self, $req, @path ) = @_;
return $self->_casMetaDataNodes( 'Srv', $req, @path );
}
sub casAppMetaDataNodes {
my ( $self, $req, @path ) = @_;
return $self->_casMetaDataNodes( 'App', $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 ) {
my $data = [ split /;\s*/, $value->{$k} ];
if ( $data->[5] ) {
my $over;
eval { $over = from_json( $data->[5] ) };
if ($@) {
$self->logger->error(
"Bad value in choice over parameters, deleted ($@)");
}
else {
$data->[5] = [ map { [ $_, $over->{$_} ] } keys %{$over} ];
}
}
push @res,
{
id => "authChoiceModules/$k",
title => "$k",
data => $data,
type => 'authChoice'
};
}
return $self->sendJSONresponse( $req, \@res );
}
else {
my $r = $value->{$key} ? [ split( /;\s*/, $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( $req, '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( $req, '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 (
sort {
( $apps->{$a}->{order} || 0 ) <=> ( $apps->{$b}->{order} || 0 )
or $a cmp $b
}
grep { not /^(?:catname|type|order)$/ } 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;
}
# 325 - Combination modules
# Returns raw value, just transform "over" key
sub combModules {
my ( $self, $req, $key ) = @_;
return $self->sendError( $req, 'Subkeys forbidden for combModules', 400 )
if ($key);
my $val = $self->getConfKey( $req, 'combModules' ) // {};
my $res = [];
foreach my $mod ( keys %$val ) {
my $tmp;
$tmp->{title} = $mod;
$tmp->{id} = "combModules/$mod";
$tmp->{type} = 'cmbModule';
$tmp->{data}->{$_} = $val->{$mod}->{$_} foreach (qw(type for));
my $over = $val->{$mod}->{over} // {};
$tmp->{data}->{over} = [ map { [ $_, $over->{$_} ] } keys %$over ];
push @$res, $tmp;
}
return $self->sendJSONresponse( $req, $res );
}
sub sfExtra {
my ( $self, $req, $key ) = @_;
return $self->sendError( $req, 'Subkeys forbidden for sfExtra', 400 )
if ($key);
my $val = $self->getConfKey( $req, 'sfExtra' ) // {};
my $res = [];
foreach my $mod ( keys %$val ) {
my $tmp;
$tmp->{title} = $mod;
$tmp->{id} = "sfExtra/$mod";
$tmp->{type} = 'sfExtra';
$tmp->{data}->{$_} = $val->{$mod}->{$_}
foreach (qw(type rule regrule logo level label));
$tmp->{data}->{register} = $val->{$mod}->{register} ? \1 : \0;
my $over = $val->{$mod}->{over} // {};
$tmp->{data}->{over} = [ map { [ $_, $over->{$_} ] } keys %$over ];
push @$res, $tmp;
}
return $self->sendJSONresponse( $req, $res );
}
## Keys
sub keyNodes {
my ( $self, $req, @path ) = @_;
{
local $" = ",";
$self->logger->debug("Keynode @path");
}
return $self->complexNodesRoot( $req, "keys", "keyNode" ) unless (@path);
my $keyId = shift @path;
my $query = shift @path;
unless ($query) {
return $self->sendError( $req,
"Bad request: keyNodes query must ask for a key", 400 );
}
# setDefault response for new keyIds
return $self->sendError( $req, 'setDefault', 200 )
if ( $keyId =~ /^new__/ );
# Reject unknown keyIds
return $self->sendError( $req, "Unknown key ID ($keyId)", 400 )
unless ( defined eval { $self->getConfKey( $req, 'keys' )->{$keyId}; } );
my ( $id, $resp ) = ( 1, [] );
my $value =
eval { $self->getConfKey( $req, "keys" )->{$keyId}->{$query}; } // undef;
return $self->sendJSONresponse( $req, { value => $value } );
}
# 33 - Root queries
# -----------
## @method PSGI-JSON-response metadata($req)
# Respond to `/conf/:cfgNum` requests by sending configuration metadata
#
# 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 metadata {
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 );
if ( my $userid = $self->_userId($req) ) {
$self->auditLog(
$req,
message => (
'User ' . $userid . ' ask for full configuration ' . $c
),
code => "CONFIG_DOWNLOADED",
user => $userid,
cfgNum => $c
);
}
else {
$self->auditLog(
$req,
message => "REST request to get full configuration $c",
code => "CONFIG_DOWNLOADED",
cfgNum => $c
);
}
return $self->sendJSONresponse(
$req,
$self->currentConf,
pretty => 1,
headers => [
'Content-Disposition' => "Attachment; filename=lmConf-$c.json"
],
);
}
elsif ( my $oidc = $req->params('oidcMetadata')
or $req->params('samlMetadata') )
{
my $c = $self->getConfKey( $req, 'cfgNum' );
my $type = $oidc ? 'OIDC' : 'SAML';
return $self->sendError( $req, undef, 400 ) if ( $req->error );
if ( $self->can('userId') ) {
$self->userLogger->notice( 'User '
. $self->userId($req)
. " ask for $type metadata "
. $c );
}
else {
$self->logger->info("REST request to get $type metadata $c");
}
if ($oidc) {
require Lemonldap::NG::Common::OpenIDConnect::Metadata;
my $path = $self->currentConf->{issuerDBOpenIDConnectPath};
$path =~ s#^.*?(\w+).*?$#$1/#;
return $self->sendJSONresponse(
$req,
Lemonldap::NG::Common::OpenIDConnect::Metadata->metadataDoc(
$self->currentConf->{oidcServiceMetaDataIssuer}
|| $self->p->portal,
$self->currentConf,
$path,
),
pretty => 1,
headers => [
'content-Type' => 'application/json',
'Content-Disposition' =>
"Attachment; filename=openid-configuration.json"
],
);
}
else {
require Lemonldap::NG::Common::Conf::SAML::Metadata;
if ( my $metadata =
Lemonldap::NG::Common::Conf::SAML::Metadata->new() )
{
my $s =
$metadata->serviceToXML(
{ %{ $self->currentConf }, portal => $self->p->portal },
'all' );
return [
200,
[
'Content-Type' => 'application/xml',
'Content-Length' => length($s),
],
[$s]
];
}
return $self->p->sendError( $req, 'Unable to build Metadata', 500 );
}
}
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 cfgVersion)) {
$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 ( defined $ind and $ind < $#a ) {
$res->{next} = $a[ $ind + 1 ];
}
if ( my $userid = $self->_userId($req) ) {
$self->auditLog(
$req,
code => "CONFIG_GET_METADATA",
user => $userid,
cfgNum => $res->{cfgNum},
message => (
'User '
. $userid
. ' ask for configuration metadata ('
. $res->{cfgNum} . ')'
)
);
}
else {
$self->auditLog(
$req,
code => "CONFIG_GET_METADATA",
cfgNum => $res->{cfgNum},
message =>
"REST request to get configuration metadata ($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->metadata($req);
}
if ( my $userid = $self->_userId($req) ) {
$self->auditLog(
$req,
code => "CONFIG_GET_KEY",
message => ( 'User ' . $userid . " asks for key $key" ),
user => $userid,
key => $key,
);
}
else {
$self->auditLog(
$req,
code => "CONFIG_GET_KEY",
message => ("REST request to get configuration key $key"),
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->sendJSONresponse( $req, { error => 'setDefault' } )
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;
$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->sendJSONresponse( $req, { error => 'setDefault' } )
unless defined($value);
return $self->sendJSONresponse( $req, { value => $value } );
# TODO authParam key
}
sub _userId {
my ( $self, $req ) = @_;
if ( $self->can('p') and $self->p->can('userId') ) {
return $self->p->userId($req);
}
return;
}
1;