SAMLMetadata.pm

package IdPAccountManager::SAMLMetadata;

## Copyright (c) GEANT
## This software was developed by RENATER. The research leading to these results has received funding
## from the European Community¹s Seventh Framework Programme (FP7/2007-2013) under grant agreement nº 238875 (GÉANT).

use strict;

use IdPAccountManager::Tools;
use Conf;

use XML::LibXML;

require Exporter;
my @ISA    = qw(Exporter);
my @EXPORT = qw();

use Carp;

sub new {
    my ($pkg) = shift;
    my %args = @_;

    my $self = {};

    ## Bless SAMLMetadata object
    bless $self, $pkg;

    return $self;
}

## Load metadata
sub load {
    my $self = shift;
    my %in   = @_;

    unless ($in{'federation_metadata_file_path'}) {
        &IdPAccountManager::Tools::do_log('error',
            "Missing parameter 'federation_metadata_file_path'");
        return undef;
    }

    $self->{'federation_metadata_file_path'} =
      $in{'federation_metadata_file_path'};

    unless (-r $self->{'federation_metadata_file_path'}) {
        &IdPAccountManager::Tools::do_log('error',
            "Failed to read $in{'federation_metadata_file_path'} : $!");
        return undef;
    }

    unless ($self->{'federation_metadata_as_xml'} =
        &_get_xml_object($in{'federation_metadata_file_path'}))
    {
        &IdPAccountManager::Tools::do_log('error',
            "Failed to parse file $in{'metadata_file'} : $!");
        return undef;
    }

    my $root = $self->{'federation_metadata_as_xml'}->documentElement();
    unless ($root->nodeName() =~ /EntitiesDescriptor$/) {
        &IdPAccountManager::Tools::do_log(
            'error',
"Root element of file $in{'federation_metadata_file_path'} is of type '%s'; should be 'EntitiesDescriptor'",
            $root->nodeName()
        );
        return undef;
    }

    return 1;
}

## Parse XML structure of metadata to fill a hashref
sub parse {
    my $self    = shift;
    my %options = @_;

    my %parser_args = (
        'metadata_as_xml'    => $self->{'federation_metadata_as_xml'},
        'filter_entity_type' => 'sp'
    );

    if ($options{'filter_entity_id'}) {
        $parser_args{'filter_entity_id'} = $options{'filter_entity_id'};
    }

    $self->{'federation_metadata_as_hashref'} =
      &_parse_saml_metadata(%parser_args);
    unless (defined $self->{'federation_metadata_as_hashref'}) {
        &IdPAccountManager::Tools::do_log('error',
            "Failed to parse federation metadata");
        return undef;
    }

    return 1;
}

## Dumps the SAML metadata content
sub print {
    my $self = shift;
    my $fd = shift || \*STDOUT;

    my $root = $self->{'federation_metadata_as_xml'}->documentElement();
    print $fd $root->toString();

    return 1.;
}

## Internal function
## returns a Lib::XML représenting an XML file
sub _get_xml_object {
    my $metadata_file = shift;
    &IdPAccountManager::Tools::do_log('debug', "");

    unless (-f $metadata_file) {
        &IdPAccountManager::Tools::do_log('error',
            "File $metadata_file not found: $!");
        return undef;
    }

    unless (open FH, $metadata_file) {
        &IdPAccountManager::Tools::do_log('error',
            "Failed to open file $metadata_file: $!");
        return undef;
    }

    my $parser;
    unless ($parser = XML::LibXML->new()) {
        &IdPAccountManager::Tools::do_log('error',
            "Failed to initialize XML parser");
        return undef;
    }

    $parser->line_numbers(1);
    my $doc;

    ## Eval() prevents the parsing from killing the main process
    eval { $doc = $parser->parse_fh(\*FH) };
    if ($@) {
        &IdPAccountManager::Tools::do_log('error',
            "Failed to parse file $metadata_file : $@");
        return undef;
    }

    unless ($doc) {
        &IdPAccountManager::Tools::do_log('error',
            "Failed to parse file $metadata_file : $!");
        return undef;
    }

    return $doc;
}

## Parse a SAML federation metadata file
sub _parse_saml_metadata {
    my %options = @_;

    #&IdPAccountManager::Tools::do_log('trace', "%s", join(',',%options));

 #unless ($options{'filter_entity_type'}) {
 #&IdPAccountManager::Tools::do_log('error', "paramètre entity_type manquant");
 #return undef;
 #}

    my $root = $options{'metadata_as_xml'};

    my @extracted_array;
    foreach my $EntityDescriptor (
        @{ $root->getElementsByLocalName('EntityDescriptor') })
    {

        my $extracted_data = {};

        if ($EntityDescriptor->hasAttributes()) {
            foreach my $attr ($EntityDescriptor->getAttribute('entityID')) {
                $extracted_data->{'entityid'} = $attr;
            }
        }

        next
          if ($options{'filter_entity_id'}
            && ($options{'filter_entity_id'} ne $extracted_data->{'entityid'}));

#&IdPAccountManager::Tools::do_log('trace', "EntityId: %s - Cherche %s", $extracted_data->{'entityid'}, $options{'filter_entity_id'});

        $extracted_data->{'xml_md'} =
          &IdPAccountManager::Tools::escape_xml($EntityDescriptor->toString());

#&IdPAccountManager::Tools::do_log('trace', "EntityId: %s", $extracted_data->{'entityid'});
#&IdPAccountManager::Tools::do_log('trace', "Entity dump: %s", $EntityDescriptor->toString());

        foreach my $child ($EntityDescriptor->childNodes()) {

            ## Ignoringnodes of type XML::LibXML::Text or XML::LibXML::Comment
            next unless (ref($child) =~ /^XML::LibXML::Element/);

            if ($child->nodeName =~ /IDPSSODescriptor$/) {

                $extracted_data->{'type'} = 'idp';

                foreach my $sso (
                    $child->getElementsByLocalName('SingleSignOnService'))
                {

                    ## On ne prend en compte que les endpoints prévus
#next unless ($sso->getAttribute('Binding') && defined $supported_saml_bindings{$sso->getAttribute('Binding')});

                    ## On extrait les infos sur les endpoints
                    push @{ $extracted_data->{'idp_endpoints'} },
                      {
                        'type'     => 'SingleSignOnService',
                        'binding'  => $sso->getAttribute('Binding'),
                        'location' => $sso->getAttribute('Location'),
                      };

                }

                ## Getting domains declared for scoped attributes
                foreach my $scope ($child->getElementsByLocalName('Scope')) {
                    push @{ $extracted_data->{'domain'} },
                      $scope->textContent();
                }

            } elsif ($child->nodeName =~ /SPSSODescriptor$/) {

                $extracted_data->{'type'} = 'sp';

                ## We check the Binding of the ACS that should match "urn:oasis:names:tc:SAML:1.0:profiles:browser-post"
                ## We also check the index to select the ACS that has the lower index
                my ($index_saml1, $index_saml2);
                foreach my $sso (
                    $child->getElementsByLocalName('AssertionConsumerService'))
                {

                    ## Extracting endpoints information
                    push @{ $extracted_data->{'sp_endpoints'} },
                      {
                        'type'     => 'AssertionConsumerService',
                        'binding'  => $sso->getAttribute('Binding'),
                        'location' => $sso->getAttribute('Location'),
                        'index'    => $sso->getAttribute('index'),
                        'isdefault' =>
                          &IdPAccountManager::Tools::boolean2integer(
                            $sso->getAttribute('isDefault')
                          )
                      };

#&IdPAccountManager::Tools::do_log('trace', "Endpoint: type:%s ; binding=%s ; location=%s ; index=%s ; isdefault=%s", 'AssertionConsumerService', $sso->getAttribute('Binding'), $sso->getAttribute('Location'), $sso->getAttribute('index'), $sso->getAttribute('isDefault'));
                }

                foreach my $requestedattribute (
                    $child->getElementsByLocalName('RequestedAttribute'))
                {

                    ## Requested attributes information
                    push @{ $extracted_data->{'requested_attribute'} },
                      {
                        'friendly_name' =>
                          &IdPAccountManager::Tools::encode_utf8(
                            $requestedattribute->getAttribute('FriendlyName')
                          ),
                        'name' => &IdPAccountManager::Tools::encode_utf8(
                            $requestedattribute->getAttribute('Name')
                        ),
                        'is_required' =>
                          &IdPAccountManager::Tools::boolean2integer(
                            $requestedattribute->getAttribute('isRequired')
                          )
                      };
                }

            } elsif ($child->nodeName =~ /Extensions$/) {

#&IdPAccountManager::Tools::do_log('trace', "Extensions for %s", $extracted_data->{'entityid'});
                foreach my $registrationinfo (
                    $child->getElementsByLocalName('RegistrationInfo'))
                {

                    $extracted_data->{'registration_info'}
                      {'registration_authority'} =
                      $registrationinfo->getAttribute('registrationAuthority');
                    $extracted_data->{'registration_info'}
                      {'registration_instant'} =
                      $registrationinfo->getAttribute('registrationInstant');
                    foreach my $registrationpolicy (
                        $registrationinfo->getElementsByLocalName(
                            'RegistrationPolicy')
                      )
                    {
                        if ($registrationpolicy->getAttribute('lang') eq 'en') {
                            $extracted_data->{'registration_info'}
                              {'registration_policy'} =
                              &IdPAccountManager::Tools::encode_utf8(
                                $registrationpolicy->textContent());
                        }
                    }
                }
            } elsif ($child->nodeName =~ /ContactPerson$/) {
                my %contact_details;
                $contact_details{'type'} = $child->getAttribute('contactType');
                if (defined $contact_details{'type'}) {
                    foreach my $contact_child ($child->childNodes()) {
                        $contact_details{ $contact_child->localName } =
                          &IdPAccountManager::Tools::encode_utf8(
                            $contact_child->textContent());
                    }
                    push @{ $extracted_data->{'contacts'} }, \%contact_details;
                }
            }

            foreach
              my $displayname ($child->getElementsByLocalName('DisplayName'))
            {

                $extracted_data->{'display_name'}
                  { $displayname->getAttribute('xml:lang') } =
                  &IdPAccountManager::Tools::encode_utf8(
                    $displayname->textContent());

                ## Set a default displayName in case no English version is provided
                ## However there is no way to determine the native displayName
                ## We take the first one as default
                if (  !$extracted_data->{'default_display_name'}
                    || $displayname->getAttribute('xml:lang'))
                {
                    $extracted_data->{'default_display_name'} =
                      &IdPAccountManager::Tools::encode_utf8(
                        $displayname->textContent());
                }

            }

            foreach
              my $description ($child->getElementsByLocalName('Description'))
            {

                $extracted_data->{'description'}
                  { $description->getAttribute('xml:lang') } =
                  &IdPAccountManager::Tools::encode_utf8(
                    $description->textContent());
            }

            foreach
              my $contact ($child->getElementsByLocalName('ContactPerson'))
            {
                &IdPAccountManager::Tools::do_log('trace', "ContactPerson");

                my %contact_details;
                $contact_details{'type'} =
                  $contact->getAttribute('contactType');
                foreach my $contact_child ($EntityDescriptor->childNodes()) {
                    &IdPAccountManager::Tools::do_log('trace', "Contact : %s",
                        $contact_child->localName);
                    $contact_details{ $contact_child->localName } =
                      &IdPAccountManager::Tools::encode_utf8(
                        $contact_child->textContent());
                }
                push @{ $extracted_data->{'contacts'} }, \%contact_details;
            }

            foreach my $sso (
                $child->getElementsByLocalName('OrganizationDisplayName'))
            {
                $extracted_data->{'organization'} =
                  &IdPAccountManager::Tools::encode_utf8($sso->textContent());
            }

            ## Getting X.509 certificates
            foreach my $cert ($child->getElementsByLocalName('X509Certificate'))
            {
                $extracted_data->{'certificate'} =
                  &IdPAccountManager::Tools::encode_utf8($cert->textContent());
            }
        }

        ## Filter entities based  on type
#&IdPAccountManager::Tools::do_log('trace', "Entity type : %s",  $extracted_data->{'type'});
        next
          if (defined $options{'filter_entity_type'}
            && ($options{'filter_entity_type'} ne $extracted_data->{'type'}));

        ## Merge domains in a single string
        my $domains = join(',', @{ $extracted_data->{'domain'} })
          if ($extracted_data->{'domain'});
        $extracted_data->{'domain'} = $domains;

        #&IdPAccountManager::Tools::do_log('debug', "Scopes : %s", $domains);

        push @extracted_array, $extracted_data;
    }

    return \@extracted_array;
}

1;    # Magic true value required at end of module
__END__

=head1 NAME

SAMLMetadata - loading SAML federation metadata

=head1 SYNOPSIS

    my $federation_metadata = new IdPAccountManager::SAMLMetadata;
    unless ($federation_metadata->load(federation_metadata_file_path => '/tmp/edugain-saml-metadata.xml')) {
        die;
    }
    
    my %args;
    if ($options{'sp_entityid'}) {
        $args{'filter_entity_id'} = $options{'sp_entityid'};
    }

    unless ($federation_metadata->parse(sp_entityid => 'https://test.federation.renater.fr/test/ressource')) {
        die;
    }
        
    ## List SAML entities
    printf "Hashref representing the metadata:\n";
    &IdPAccountManager::Tools::dump_var($federation_metadata->{'federation_metadata_as_hashref'}, 0, \*STDOUT);

=head1 DESCRIPTION

The Test Account manager instanciates test accounts associated to a SAML Identity Provider.
This module parses a SAML2 metadata file.

=head1 SUBROUTINES/METHODS

=over 8

=item C<new ARGS>

Class method. Create a new IdPAccountManager::SAMLMetadata object.
Example:
    
    my $federation_metadata = new IdPAccountManager::SAMLMetadata;

=item C<load ARGS>

Loads the SAML metadata file.

Supported arguments include:

=over 12

=item C<federation_metadata_file_path>

Path of the SAML metadata file.

=back

=item C<parse ARGS>

Parse the SAML metadata file.

Supported arguments include:

=over 12

=item C<filter_entity_id>

EntityID of SAML entities to filter.

=back

=item C<print FD> 

Dumps the content of the SAML metadata to the specified FD file handler (default to STDOUT)

=head1 AUTHOR

Olivier Salaün (olivier.salaun@renater.fr)

=head1 LICENSE

Copyright (c) GEANT
This software was developed by RENATER. The research leading to these results has received funding
from the European Community¹s Seventh Framework Programme (FP7/2007-2013) under grant agreement nº 238875 (GÉANT).