SAMLMetadata.pm

package IdPAccountManager::SAMLMetadata;

use strict;
use warnings;

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

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;
    ENTITY: foreach my $EntityDescriptor (
        @{ $self->{doc}->getElementsByLocalName('EntityDescriptor') })
    {

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

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

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

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

            if ($child->localname() eq 'IDPSSODescriptor') {
                next ENTITY if $args{type} && $args{type} ne 'idp';

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

                foreach my $sso (
                    $child->getChildrenByLocalName('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') {
                next ENTITY if $args{type} && $args{type} ne 'sp';

                $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->getChildrenByLocalName('AssertionConsumerService')
                ) {

                    ## Extracting endpoints information
                    push @{ $data->{sp_endpoints} }, {
                        type     => 'AssertionConsumerService',
                        binding  => $sso->getAttribute('Binding'),
                        location => $sso->getAttribute('Location'),
                        index    => $sso->getAttribute('index'),
                        isdefault => _boolean2integer(
                            $sso->getAttribute('isDefault')
                        )
                    };

                }

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

                    ## Requested attributes information
                    push @{ $data->{requested_attribute} }, {
                        friendly_name => $attribute->getAttribute('FriendlyName'),
                        name          => $attribute->getAttribute('Name'),
                        is_required   => _boolean2integer(
                            $attribute->getAttribute('isRequired')
                        )
                    };
                }

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

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

                    $data->{registration_info}->{registration_authority} =
                      $registrationinfo->getAttribute('registrationAuthority');
                    $data->{registration_info}->{registration_instant} =
                      $registrationinfo->getAttribute('registrationInstant');
                    foreach my $policy (
                        $registrationinfo->getChildrenByLocalName(
                            'RegistrationPolicy')
                    ) {
                        my $lang = $policy->getAttribute('lang');
                        next unless $lang && $lang eq 'en';
                        $data->{registration_info}->{registration_policy} =
                            $policy->textContent();
                    }
                }
            } elsif ($child->localname() eq 'ContactPerson') {
                my $details;
                $details->{type} = $child->getAttribute('contactType');
                if (defined $details->{type}) {
                    foreach my $contact_child ($child->childNodes()) {
                        next unless $contact_child->nodeType() == XML_ELEMENT_NODE;
                        my $key   = $contact_child->localname();
                        my $value = $contact_child->textContent();
                        $value =~ s/^mailto:// if $key eq 'EmailAddress';
                        $details->{$key} = $value;
                    }
                    push @{ $data->{contacts} }, $details;
                }
            } elsif ($child->localname() eq 'Organization') {
                $data->{name}         = _get_default_value(
                    $child, 'OrganizationName'
                );
                $data->{display_name} = _get_default_value(
                    $child, 'OrganizationDisplayName'
                );
            }

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

        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();
}

sub _boolean2integer {
    return
        ! defined $_[0]  ? undef :
        $_[0] eq 'true'  ?     1 :
        $_[0] eq 'false' ?     0 :
        undef;
}


sub _get_default_value {
    my ($node, $child_name) = @_;

    my %names;
    $names{ $_->getAttribute('xml:lang') } = $_->textContent()
        foreach $node->getChildrenByLocalName($child_name);

    return $names{en} ? $names{en} : (values %names)[0];
}

1;
__END__

=head1 NAME

SAMLMetadata - loading SAML federation metadata

=head1 SYNOPSIS

    # instanciate metadata object
    my $metadata = IdPAccountManager::SAMLMetadata->new(
        file => '/tmp/edugain-saml-metadata.xml'
    );

    # extract metadata for a single SAML entity
    my $entities = $metadata->parse(id => $id);

=head1 DESCRIPTION

This class parses a SAML2 metadata file.

=head1 CLASS METHODS

=over

=item new()

Create a new IdPAccountManager::SAMLMetadata object.

Supported arguments include:

=over

=item I<file>: metadata file path

=back

=back

=head1 INSTANCE METHODS

=over

=item parse()

Parse the SAML metadata file.

Supported arguments include:

=over

=item I<id>: keep only entity with matching ID

=item I<type>: keep only entity with matching type

=back

=back