view release on metacpan or  search on metacpan

lib/Lemonldap/NG/Common/Conf/RESTServer.pm  view on Meta::CPAN

    }
    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', @_)
#

lib/Lemonldap/NG/Common/Conf/RESTServer.pm  view on Meta::CPAN

#
#@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' );