view release on metacpan or  search on metacpan

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

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[ArrayRef[Str]]', is => 'ro', required => 1);

has 'formats' => (
    isa      => 'HashRef[Str]',
    is       => 'ro',
    required => 0,
    default  => sub { {} }
);
has 'default_format' => (isa => 'Str', is => 'ro', required => 0);
has 'debug' => (isa => 'Bool', is => 'ro', required => 0, default => 0);


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

    my $req = GET $args{url};
    my $ua = $args{ua};
    if (!$ua) {
        $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) {
        die(
            sprintf(
                "Error retrieving metadata: %s (%s)\n",
                $res->message, $res->code
            )
        );
    }

    my $xml = $res->decoded_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;

    my $basepath  = '//md:EntityDescriptor/md:IDPSSODescriptor';

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

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

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

    for my $format ($xpath->findnodes("$basepath/md:NameIDFormat")) {
        $format = $format->string_value;
        $format =~ s/^\s+//g;
        $format =~ 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};
        }
    }

    my %certs = ();
    for my $key ($xpath->findnodes("$basepath/md:KeyDescriptor")) {
        my $use = $key->getAttribute('use');
        my $pem = $class->_get_pem_from_keynode($key);
        if (!$use) {
            push(@{$certs{signing}}, $pem);
            push(@{$certs{encryption}}, $pem);
        }
        else {
            push(@{$certs{$use}}, $pem);
        }
    }

    return $class->new(
        entityid => $xpath->findvalue('//md:EntityDescriptor/@entityID'),
        sso_urls => $data->{SSO},
        slo_urls => $data->{SLO} || {},
        art_urls => $data->{Art} || {},
        certs    => \%certs,
        cacert   => $args{cacert},
        debug    => $args{debug},
        $data->{DefaultFormat}
        ? (
            default_format => $data->{DefaultFormat},
            formats        => $data->{NameIDFormat},
            )
        : (),
    );

}

sub _get_pem_from_keynode {
    my $self = shift;
    my $node = shift;

    $node->setNamespace('http://www.w3.org/2000/09/xmldsig#', 'ds');

    my ($text)
        = $node->findvalue("ds:KeyInfo/ds:X509Data/ds:X509Certificate", $node)
        =~ /^\s*(.+?)\s*$/s;

    # rewrap the base64 data from the metadata; it may not
    # be wrapped at 64 characters as PEM requires
    $text =~ s/\n//g;

    my @lines;
    while(length $text > 64) {
        push @lines, substr $text, 0, 64, '';
    }
    push @lines, $text;

    $text = join "\n", @lines;

    return "-----BEGIN CERTIFICATE-----\n$text\n-----END CERTIFICATE-----\n";
}


# BUILDARGS ( hashref of the parameters passed to the constructor )
#
# Called after the object is created to validate the IdP using the cacert
#

around BUILDARGS => sub {
    my $orig = shift;
    my $self = shift;

    my %params = @_;

    if ($params{cacert}) {
        my $ca = Crypt::OpenSSL::Verify->new($params{cacert}, { strict_certs => 0, });

        my %certificates;
        my @errors;
        for my $use (keys %{$params{certs}}) {
            my $certs = $params{certs}{$use};
            for my $pem (@{$certs}) {
                my $cert = Crypt::OpenSSL::X509->new_from_string($pem);
                try {
                    $ca->verify($cert);
                    push(@{$certificates{$use}}, $pem);
                }
                catch { push (@errors, $_); };
            }
        }

        if ( $params{debug} && @errors ) {
            warn "Can't verify IdP cert(s): " . join(", ", @errors);
        }

        $params{certs} = \%certificates;
    }

    return $self->$orig(%params);
};