430 lines
12 KiB
Perl
430 lines
12 KiB
Perl
##@file
|
|
# SAML Metadata object for Lemonldap::NG
|
|
|
|
##@class
|
|
# SAML Metadata object for Lemonldap::NG
|
|
package Lemonldap::NG::Common::Conf::SAML::Metadata;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Crypt::OpenSSL::RSA;
|
|
use Crypt::OpenSSL::X509;
|
|
use Data::Dumper;
|
|
use HTML::Template;
|
|
use MIME::Base64;
|
|
use XML::Simple;
|
|
use Safe;
|
|
use Encode;
|
|
|
|
our $VERSION = '1.0.0';
|
|
|
|
## @cmethod Lemonldap::NG::Common::Conf::SAML::Metadata new(hashRef args)
|
|
# Class constructor.
|
|
# @param args hash reference
|
|
# @return Lemonldap::NG::Common::Conf::SAML::Metadata object
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = bless {}, $class;
|
|
if ( ref( $_[0] ) ) {
|
|
%$self = %{ $_[0] };
|
|
}
|
|
elsif ( defined @_ && $#_ % 2 == 1 ) {
|
|
%$self = @_;
|
|
}
|
|
return $self;
|
|
}
|
|
|
|
## @method public boolean initiliazeFromConf(string s)
|
|
# Initialize this object from configuration string.
|
|
# @param $s Configuration string.
|
|
# @return boolean
|
|
sub initializeFromConf {
|
|
my $self = shift;
|
|
my $string = shift;
|
|
|
|
$string =~ s/'/'/g;
|
|
my $data = eval $string;
|
|
|
|
return $self->initializeFromConfHash($data);
|
|
}
|
|
|
|
## @method public boolean initiliazeFromConfHash(hash h)
|
|
# Initialize this object from configuration hash element.
|
|
# @param $h Configuration hash element.
|
|
# @return boolean
|
|
sub initializeFromConfHash {
|
|
my $self = shift;
|
|
my $hash = shift;
|
|
|
|
return 0 unless $hash;
|
|
|
|
while ( my ( $k, $v ) = each(%$hash) ) {
|
|
$self->{$k} = $v;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
## @method public boolean initializeFromFile(string file)
|
|
# Initialize this object from XML file.
|
|
# @param $file Filename
|
|
# @return boolean
|
|
sub initializeFromFile {
|
|
my $self = shift;
|
|
my $file = shift;
|
|
my $xml = $self->_loadFile($file);
|
|
if ( !$xml ) {
|
|
return 0;
|
|
}
|
|
return $self->initializeFromXML($xml);
|
|
}
|
|
|
|
## @method public boolean initializeFromXML(string string)
|
|
# Initialize this object from configuration XML string.
|
|
# @param $string Configuration XML string.
|
|
# @return boolean
|
|
sub initializeFromXML {
|
|
my $self = shift;
|
|
my $string = shift;
|
|
|
|
# Remove spaces
|
|
$string =~ s/[\n\r\s]+/ /g;
|
|
$string =~ s/> </></g;
|
|
|
|
# New XML::Simple object
|
|
my $xs = XML::Simple->new( ForceContent => 1, ForceArray => 1 );
|
|
my $data = $xs->XMLin($string);
|
|
|
|
# Store data in Metadata object
|
|
if ($data) {
|
|
while ( my ( $k, $v ) = each( %{$data} ) ) {
|
|
$self->{$k} = $v;
|
|
}
|
|
return 1;
|
|
}
|
|
return 0;
|
|
|
|
}
|
|
|
|
## @method public string serviceToXML
|
|
# Return all SAML parameters in well formated XML format, corresponding to
|
|
# SAML 2 description.
|
|
# @return string
|
|
sub serviceToXML {
|
|
my ( $self, $file, $conf ) = splice @_;
|
|
|
|
my $template = HTML::Template->new(
|
|
filename => "$file",
|
|
die_on_bad_params => 0,
|
|
cache => 0,
|
|
);
|
|
|
|
# Automatic parameters
|
|
my @param_auto = qw(
|
|
samlEntityID
|
|
samlOrganizationName
|
|
samlOrganizationDisplayName
|
|
samlOrganizationURL
|
|
);
|
|
|
|
foreach (@param_auto) {
|
|
$template->param( $_, $self->getValue( $_, $conf ) );
|
|
}
|
|
|
|
# Boolean parameters
|
|
my @param_boolean = qw(
|
|
samlSPSSODescriptorAuthnRequestsSigned
|
|
samlSPSSODescriptorWantAssertionsSigned
|
|
samlIDPSSODescriptorWantAuthnRequestsSigned
|
|
);
|
|
|
|
foreach (@param_boolean) {
|
|
$template->param( $_, $self->getValue( $_, $conf ) ? 'true' : 'false' );
|
|
}
|
|
|
|
# Format public keys
|
|
my @param_keys = qw(
|
|
samlServicePublicKeySig
|
|
samlServicePublicKeyEnc
|
|
);
|
|
|
|
foreach (@param_keys) {
|
|
my $str = '';
|
|
my $val = $self->getValue( $_, $conf );
|
|
|
|
# A default value for samlServicePublicKeyEnc parameter
|
|
if ( $_ =~ /samlServicePublicKeyEnc/ ) {
|
|
unless ( $val && length $val gt 0 ) {
|
|
$val = $conf->{samlServicePublicKeySig};
|
|
}
|
|
}
|
|
|
|
# Generate XML
|
|
if ( defined $val && length $val gt 0 ) {
|
|
|
|
# Public Key ?
|
|
if ( $val =~ /^-----BEGIN PUBLIC KEY-----/
|
|
and my $rsa_pub = Crypt::OpenSSL::RSA->new_public_key($val) )
|
|
{
|
|
my @params = $rsa_pub->get_key_parameters();
|
|
my $mod = encode_base64( $params[0]->to_bin() );
|
|
my $exp = encode_base64( $params[1]->to_bin() );
|
|
$str =
|
|
'<ds:KeyValue>' . "\n\t"
|
|
. '<RSAKeyValue xmlns="http://www.w3.org/2000/09/xmldsig#">'
|
|
. "\n\t\t"
|
|
. '<Modulus>'
|
|
. $mod
|
|
. '</Modulus>'
|
|
. "\n\t\t"
|
|
. '<Exponent>'
|
|
. $exp
|
|
. '</Exponent>' . "\n\t"
|
|
. '</RSAKeyValue>' . "\n"
|
|
. '</ds:KeyValue>';
|
|
}
|
|
|
|
# Certificate ?
|
|
if ( $val =~ /^-----BEGIN CERTIFICATE-----/
|
|
and my $certificate =
|
|
Crypt::OpenSSL::X509->new_from_string($val) )
|
|
{
|
|
$certificate = $certificate->as_string();
|
|
$certificate =~ s/^-----BEGIN CERTIFICATE-----\n?//g;
|
|
$certificate =~ s/\n?-----END CERTIFICATE-----$//g;
|
|
$str =
|
|
'<ds:X509Data>' . "\n\t"
|
|
. '<ds:X509Certificate>' . "\n\t"
|
|
. $certificate
|
|
. '</ds:X509Certificate>' . "\n"
|
|
. '</ds:X509Data>';
|
|
}
|
|
}
|
|
$template->param( $_, $str );
|
|
}
|
|
|
|
# Rebuilded parameters for SAML services
|
|
# A samlService value is formated like the following:
|
|
# "binding;location;responseLocation"
|
|
# The last value, responseLocation, is optional.
|
|
my @param_service = qw(
|
|
samlSPSSODescriptorSingleLogoutServiceHTTPRedirect
|
|
samlSPSSODescriptorSingleLogoutServiceHTTPPost
|
|
samlSPSSODescriptorSingleLogoutServiceSOAP
|
|
samlIDPSSODescriptorSingleSignOnServiceHTTPRedirect
|
|
samlIDPSSODescriptorSingleSignOnServiceHTTPPost
|
|
samlIDPSSODescriptorSingleSignOnServiceHTTPArtifact
|
|
samlIDPSSODescriptorSingleSignOnServiceSOAP
|
|
samlIDPSSODescriptorSingleLogoutServiceHTTPRedirect
|
|
samlIDPSSODescriptorSingleLogoutServiceHTTPPost
|
|
samlIDPSSODescriptorSingleLogoutServiceSOAP
|
|
samlAttributeAuthorityDescriptorAttributeServiceSOAP
|
|
);
|
|
|
|
foreach (@param_service) {
|
|
my @_tab = split( /;/, $self->getValue( $_, $conf ) );
|
|
$template->param( $_ . 'Binding', $_tab[0] );
|
|
$template->param( $_ . 'Location', $_tab[1] );
|
|
$template->param( $_ . 'ResponseLocation', $_tab[2] );
|
|
}
|
|
|
|
# Rebuilded parameters for SAML assertions
|
|
# A samlAssertion value is formated like the following:
|
|
# "default;index;binding;location"
|
|
my @param_assertion = qw(
|
|
samlSPSSODescriptorAssertionConsumerServiceHTTPArtifact
|
|
samlSPSSODescriptorAssertionConsumerServiceHTTPPost
|
|
samlSPSSODescriptorArtifactResolutionServiceArtifact
|
|
samlIDPSSODescriptorArtifactResolutionServiceArtifact
|
|
);
|
|
|
|
foreach (@param_assertion) {
|
|
my @_tab = split( /;/, $self->getValue( $_, $conf ) );
|
|
$template->param( $_ . 'Default', $_tab[0] ? 'true' : 'false' );
|
|
$template->param( $_ . 'Index', $_tab[1] );
|
|
$template->param( $_ . 'Binding', $_tab[2] );
|
|
$template->param( $_ . 'Location', $_tab[3] );
|
|
}
|
|
|
|
# Return the XML metadata.
|
|
return $template->output;
|
|
}
|
|
|
|
## @method public string toXML
|
|
# Return this object in XML format.
|
|
# @return string
|
|
sub toXML {
|
|
my $self = shift;
|
|
|
|
# Use XML::Simple to Dump Perl Hash in XML format
|
|
my $xs = XML::Simple->new( RootName => "md:EntityDescriptor" );
|
|
|
|
# Force xmlns:md key
|
|
$self->{"xmlns:md"} = "urn:oasis:names:tc:SAML:2.0:metadata"
|
|
unless defined $self->{"xmlns:md"};
|
|
|
|
# Serialize XML
|
|
my $xml = $xs->XMLout($self);
|
|
|
|
# Force UTF-8 encoding
|
|
my $xml_utf8 = encode( "utf8", $xml );
|
|
|
|
# XML schema requires Exponent after Modulus in KeyInfo
|
|
$xml_utf8 =~
|
|
s#<Exponent>(.+)</Exponent>\s*<Modulus>(.+)</Modulus>#<Modulus>$2</Modulus>\n<Exponent>$1</Exponent>#mg;
|
|
|
|
return $xml_utf8;
|
|
}
|
|
|
|
## @method public string toConf ()
|
|
# Return this object in configuration string format.
|
|
# @return string
|
|
sub toConf {
|
|
my $self = shift;
|
|
my $fields = $self->toHash();
|
|
local $Data::Dumper::Indent = 0;
|
|
local $Data::Dumper::Varname = "data";
|
|
my $data = Dumper($fields);
|
|
$data =~ s/^\s*(.*?)\s*$/$1/;
|
|
$data =~ s/'/'/g;
|
|
$data =~ s/^\$data[0-9]*\s*=\s*({?\s*.+\s*}?)/$1/g;
|
|
return $data;
|
|
}
|
|
|
|
## @method public string toHash ()
|
|
# Return this object in configuration hash format.
|
|
# @return hashref
|
|
sub toHash {
|
|
my $self = shift;
|
|
my $fields = ();
|
|
foreach ( keys %$self ) {
|
|
$fields->{$_} = $self->{$_};
|
|
}
|
|
return $fields;
|
|
}
|
|
|
|
## @method public hashref toStruct ()
|
|
# Return this object to be display into the Manager.
|
|
# NOT USED FOR THE MOMENT.
|
|
# @return hashref
|
|
sub toStruct {
|
|
my $self = shift;
|
|
my $struct = ();
|
|
foreach ( keys %$self ) {
|
|
$struct->{$_} = $self->{$_};
|
|
}
|
|
return $self->_toStruct( '', $struct );
|
|
}
|
|
|
|
## @method private hashref _toStruct (string path, hashref node)
|
|
# Return a preformated structure to be stored into Manager structure.
|
|
# NOT USED FOR THE MOMENT.
|
|
# @param $path The path of the node.
|
|
# @param $node The current node into the hashref tree.
|
|
# @return hashref A structure to be inserted into Manager structure.
|
|
sub _toStruct {
|
|
my $self = shift;
|
|
my $path = shift;
|
|
my $node = shift;
|
|
if ( ref $node ) {
|
|
my $struct = {
|
|
_nodes => [],
|
|
_help => 'default'
|
|
};
|
|
my @nodes = ();
|
|
my $tmpnode;
|
|
if ( ref $node eq 'ARRAY' ) {
|
|
|
|
# More than one value for the same key
|
|
# Build a hash with indices
|
|
my $i = 0;
|
|
foreach (@$node) {
|
|
$tmpnode->{$i} = $node->[$i];
|
|
}
|
|
}
|
|
else {
|
|
$tmpnode = $node;
|
|
}
|
|
foreach ( keys %$tmpnode ) {
|
|
|
|
if ( $_ =~ /^xmlns/ ) {
|
|
next;
|
|
}
|
|
my $key = $path . ' ' . $_;
|
|
$key =~ s/^ +//g;
|
|
my $data;
|
|
|
|
$data = $self->_toStruct( $key, $tmpnode->{$_} );
|
|
if ($data) {
|
|
$struct->{$key} = $data;
|
|
push @nodes, 'n:' . $key;
|
|
}
|
|
else {
|
|
$struct->{$key} = 'text:/' . $_;
|
|
push @nodes, $key;
|
|
}
|
|
}
|
|
$struct->{_nodes} = \@nodes;
|
|
return $struct;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
## @method public static boolean load(array files)
|
|
# Return an array of Metadata object.
|
|
# @param @files Array of filenames
|
|
# @return array of Metadata objects
|
|
sub load {
|
|
my @files = splice @_;
|
|
my @metadatas = ();
|
|
foreach (@files) {
|
|
my $metadata = new Lemonldap::NG::Common::Conf::SAML::Metadata();
|
|
if ( $metadata->initializeFromFile($_) ) {
|
|
push @metadatas, $metadata;
|
|
}
|
|
}
|
|
return @metadatas;
|
|
}
|
|
|
|
## @method private hashref _loadFile(string file)
|
|
# Load XML file as a XML string.
|
|
# @param $file Filename
|
|
# @return string
|
|
sub _loadFile {
|
|
my $self = shift;
|
|
my $file = shift;
|
|
local $/ = undef;
|
|
open FILE, $file
|
|
or die "Couldn't open file: $!";
|
|
my $string = <FILE>;
|
|
close FILE;
|
|
return $string;
|
|
}
|
|
|
|
#@method string getValue(string key, hashref conf)
|
|
# Get the value for a metadata configuration key
|
|
# Replace #PORTAL# macro
|
|
# @param key Configuration key
|
|
# @param conf Configuration hash ref
|
|
# @return value
|
|
sub getValue {
|
|
my ( $self, $key, $conf ) = splice @_;
|
|
|
|
# Get portal value
|
|
my $portal = $conf->{portal} || "http://auth.example.com";
|
|
$portal =~ s/\/$//;
|
|
|
|
# Try to get value for the given key in configuraiton
|
|
my $value = $conf->{$key};
|
|
return unless defined $value;
|
|
|
|
# Replace #PORTAL# macro
|
|
$value =~ s/#PORTAL#/$portal/g;
|
|
|
|
# Return value
|
|
return $value;
|
|
}
|
|
|
|
1;
|
|
|