SAMLMetadata.pm

package IdPAccountManager::SAMLMetadata;

use strict;
use warnings;

use English qw(-no_match_vars);
use XML::LibXML qw(:libxml);

use IdPAccountManager::Tools;

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

    die "missing argument 'file'" unless defined $args{file};
    die "non-existing file $args{file}" unless -f $args{file};
    die "non-readable file $args{file}" unless -r $args{file};

    my $doc;
    eval { $doc = XML::LibXML->load_xml(location => $args{file}); };
    die "Failed to parse file: $EVAL_ERROR" if $EVAL_ERROR;

    my $root = $doc->documentElement();
    my $type = $root->nodeName();

    die "incorrect root element type '$type' for file $args{file}, should be
        'EntitiesDescriptor'" unless $type =~ /EntitiesDescriptor$/;

    my $self = {
        file => $args{file},
        doc  => $doc
    };

    bless $self, $pkg;

    return $self;
}

## Parse XML structure of metadata to fill a hashref
sub parse {
    my ($self, %args) = @_;

    my @array;
    foreach my $EntityDescriptor (
        @{ $self->{doc}->getElementsByLocalName('EntityDescriptor') })
    {

        my $id = $EntityDescriptor->getAttribute('entityID');
        next if $args{entity_id} && $args{entity_id} ne $id;

        my $data = {
            entityid => $id
        };

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

            ## Ignoringnodes of type XML::LibXML::Text or XML::LibXML::Comment
            next unless $child->nodeType() == XML_ELEMENT_NODE;

            if ($child->localname() eq 'IDPSSODescriptor') {

                $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 @{ $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 @{ $data->{domain} }, $scope->textContent();
                }

            } elsif ($child->localname() eq 'SPSSODescriptor') {

                $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 @{ $data->{sp_endpoints} }, {
                        type     => 'AssertionConsumerService',
                        binding  => $sso->getAttribute('Binding'),
                        location => $sso->getAttribute('Location'),
                        index    => $sso->getAttribute('index'),
                        isdefault => IdPAccountManager::Tools::boolean2integer(
                            $sso->getAttribute('isDefault')
                        )
                    };

                }

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

                    ## Requested attributes information
                    push @{ $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->localname() eq 'Extensions') {

                foreach my $registrationinfo (
                    $child->getElementsByLocalName('RegistrationInfo'))
                {

                    $data->{registration_info}
                      {registration_authority} =
                      $registrationinfo->getAttribute('registrationAuthority');
                    $data->{registration_info}
                      {registration_instant} =
                      $registrationinfo->getAttribute('registrationInstant');
                    foreach my $registrationpolicy (
                        $registrationinfo->getElementsByLocalName(
                            'RegistrationPolicy')
                      )
                    {
                        if ($registrationpolicy->getAttribute('lang') eq 'en') {
                            $data->{registration_info}
                              {registration_policy} =
                              IdPAccountManager::Tools::encode_utf8(
                                $registrationpolicy->textContent());
                        }
                    }
                }
            } elsif ($child->localname() eq '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 @{ $data->{contacts} }, \%contact_details;
                }
            }

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

                $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 (  !$data->{default_display_name}
                    || $displayname->getAttribute('xml:lang'))
                {
                    $data->{default_display_name} =
                      IdPAccountManager::Tools::encode_utf8(
                        $displayname->textContent());
                }

            }

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

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

            foreach
              my $contact ($child->getElementsByLocalName('ContactPerson'))
            {

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

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

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

        ## Filter entities based  on type
        next
          if (defined $args{filter_entity_type}
            && ($args{filter_entity_type} ne $data->{type}));

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

        push @array, $data;
    }

    return \@array;
}

## Dumps the SAML metadata content
sub print {
    my ($self, $fd) = @_;
    $fd = \*STDOUT unless $fd;

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

1;
__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)