view release on metacpan or  search on metacpan

lib/Net/SAML2/IdP.pm  view on Meta::CPAN

package Net::SAML2::IdP;
use Moose;
use MooseX::Types::URI qw/ Uri /;


use Crypt::OpenSSL::Verify;
use Crypt::OpenSSL::X509;
use HTTP::Request::Common;
use LWP::UserAgent;
use XML::LibXML;
use Net::SAML2::XML::Util qw/ no_comments /;


has 'entityid' => (isa => 'Str',          is => 'ro', required => 1);
has 'cacert'   => (isa => 'Maybe[Str]',   is => 'ro', required => 1);
has 'sso_urls' => (isa => 'HashRef[Str]', is => 'ro', required => 1);
has 'slo_urls' => (isa => 'Maybe[HashRef[Str]]', is => 'ro');
has 'art_urls' => (isa => 'Maybe[HashRef[Str]]', is => 'ro');
has 'certs'    => (isa => 'HashRef[Str]',        is => 'ro', required => 1);
has 'formats'  => (isa => 'HashRef[Str]',        is => 'ro', required => 1);
has 'default_format' => (isa => 'Str', is => 'ro', required => 1);


sub new_from_url {
    my($class, %args) = @_;

    my $req = GET $args{url};
    my $ua  = LWP::UserAgent->new;

    if ( defined $args{ssl_opts} ) {
        require LWP::Protocol::https;
        $ua->ssl_opts( %{$args{ssl_opts}} );
    }

    my $res = $ua->request($req);
    if (! $res->is_success ) {
        my $msg = "no metadata: " . $res->code . ": " . $res->message . "\n";
        die $msg;
    }

    my $xml = $res->content;

    return $class->new_from_xml(xml => $xml, cacert => $args{cacert});
}


sub new_from_xml {
    my($class, %args) = @_;

    my $dom = no_comments($args{xml});

    my $xpath = XML::LibXML::XPathContext->new($dom);
    $xpath->registerNs('md', 'urn:oasis:names:tc:SAML:2.0:metadata');
    $xpath->registerNs('ds', 'http://www.w3.org/2000/09/xmldsig#');

    my $data;

    for my $sso (
        $xpath->findnodes(
            '//md:EntityDescriptor/md:IDPSSODescriptor/md:SingleSignOnService')
        )
    {
        my $binding = $sso->getAttribute('Binding');
        $data->{SSO}->{$binding} = $sso->getAttribute('Location');
    }

    for my $slo (
        $xpath->findnodes(
            '//md:EntityDescriptor/md:IDPSSODescriptor/md:SingleLogoutService')
        )
    {
        my $binding = $slo->getAttribute('Binding');
        $data->{SLO}->{$binding} = $slo->getAttribute('Location');
    }

    for my $art (
        $xpath->findnodes(
            '//md:EntityDescriptor/md:IDPSSODescriptor/md:ArtifactResolutionService')
        )
    {
        my $binding = $art->getAttribute('Binding');
        $data->{Art}->{$binding} = $art->getAttribute('Location');
    }

    for my $format (
        $xpath->findnodes('//md:EntityDescriptor/md:IDPSSODescriptor/md:NameIDFormat'))
    {
        $format = $format->string_value;
        $format =~ s/^\s+|\s+$//g;
        my($short_format)
            = $format =~ /urn:oasis:names:tc:SAML:(?:2.0|1.1):nameid-format:(.*)$/;
        if(defined $short_format) {
            $data->{NameIDFormat}->{$short_format} = $format;
            $data->{DefaultFormat} = $short_format unless exists $data->{DefaultFormat};
        }
    }

    # NameIDFormat is an optional field and not provided in all metadata xml
    # Microsoft in particular does not provide this field
    if(!defined($data->{NameIDFormat})){
        $data->{NameIDFormat}->{unspecified} = 'urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified';
        $data->{DefaultFormat} = 'unspecified' unless exists $data->{DefaultFormat};
    }

    for my $key (
        $xpath->findnodes('//md:EntityDescriptor/md:IDPSSODescriptor/md:KeyDescriptor'))
    {
        my $use = $key->getAttribute('use') || 'signing';

        # We can't select by ds:KeyInfo/ds:X509Data/ds:X509Certificate
        # because of https://rt.cpan.org/Public/Bug/Display.html?id=8784
        my ($text)
            = $key->findvalue("//*[local-name()='X509Certificate']")
            =~ /^\s*(.+?)\s*$/s;