Shibboleth compatibility and small documentation improvements

lib/Net/SAML2.pm

@@ -25,8 +25,9 @@ Net::SAML2 - SAML bindings and protocol implementation
         )->as_xml;
 
         my $redirect = Net::SAML2::Binding::Redirect->new(
-                key => 'sign-nopw-cert.pem',
-                url => $sso_url,
+                key   => 'sign-nopw-cert.pem',
+                url   => $sso_url,
+                param => 'SAMLRequest',
         );
 
         my $url = $redirect->sign($authnreq);

lib/Net/SAML2/Binding/Redirect.pm

@@ -13,6 +13,7 @@ Net::SAML2::Binding::Redirect
     key => 'sign-nopw-cert.pem',
     url => $sso_url,
     param => 'SAMLRequest',
+    cert => 'path/to/cert.ca',
   );
 
   my $url = $redirect->sign($authnreq);

lib/Net/SAML2/IdP.pm

@@ -33,7 +33,7 @@ Constructor
 has 'entityid'       => (isa => Str, is => 'ro', required => 1);
 has 'cacert'         => (isa => Str, is => 'ro', required => 1);
 has 'sso_urls'       => (isa => HashRef[Str], is => 'ro', required => 1);
-has 'slo_urls'       => (isa => HashRef[Str], is => 'ro', required => 1);
+has 'slo_urls'       => (isa => 'HashRef[Str]|Undef', is => 'ro', required => 0);
 has 'art_urls'       => (isa => HashRef[Str], is => 'ro', required => 1);
 has 'certs'          => (isa => HashRef[Str], is => 'ro', required => 1);
 has 'formats'        => (isa => HashRef[Str], is => 'ro', required => 1);
@@ -101,7 +101,7 @@ sub new_from_xml {
     }
 
     for my $key ($xpath->findnodes('//md:EntityDescriptor/md:IDPSSODescriptor/md:KeyDescriptor')) {
-        my $use = $key->getAttribute('use');
+        my $use = $key->getAttribute('use') || 'signing';
         my ($text) = $key->findvalue('ds:KeyInfo/ds:X509Data/ds:X509Certificate') =~ /^\s*(.+?)\s*$/s;
 
         # rewrap the base64 data from the metadata; it may not

lib/Net/SAML2/Protocol/Assertion.pm

@@ -46,7 +46,7 @@ sub new_from_xml {
 
     my $attributes = {};
     for my $node ($xpath->findnodes('//saml:Assertion/saml:AttributeStatement/saml:Attribute')) {
-        my @values = $node->findnodes('saml:AttributeValue');
+        my @values = $xpath->findnodes('saml:AttributeValue', $node);
         $attributes->{$node->getAttribute('Name')} = [
             map { $_->string_value } @values
         ];

lib/Net/SAML2/Protocol/AuthnRequest.pm

@@ -16,6 +16,8 @@ Net::SAML2::Protocol::AuthnRequest - SAML2 AuthnRequest object
     issueinstant => DateTime->now,
     issuer       => $self->{id},
     destination  => $destination,
+    nameid_format => 'urn:oasis:names:tc:SAML:2.0:nameid-format:persistent', # or 'urn:oasis:names:tc:SAML:2.0:nameid-format:transient',
+    forceAuthn   => 1,
   );
 
 =head1 METHODS
@@ -35,7 +37,9 @@ Arguments:
 
 has 'issuer'        => (isa => Uri, is => 'ro', required => 1, coerce => 1);
 has 'destination'   => (isa => Uri, is => 'ro', required => 1, coerce => 1);
-has 'nameid_format' => (isa => NonEmptySimpleStr, is => 'ro', required => 1);
+has 'nameid_format' => (isa => NonEmptySimpleStr, is => 'ro', required => 1, default => 'urn:oasis:names:tc:SAML:2.0:nameid-format:persistent');
+has 'providername'  => (is => 'rw', required => 0, default => 'ProviderName');
+has 'forceAuthn'    => (is => 'rw', required => 0, default => 0);
 
 =head2 as_xml()
 
@@ -53,22 +57,24 @@ sub as_xml {
     $x->xml(
         $x->AuthnRequest(
             $samlp,
-            { Destination => $self->destination,
-              ID => $self->id,
-              IssueInstant => $self->issue_instant,
-              ProviderName => "My SP's human readable name.",
-              Version => '2.0' },
+            { Destination => $self->destination(),
+              ID => $self->id(),
+              IssueInstant => $self->issue_instant(),
+              ProviderName => $self->providername(),
+              Version => '2.0',
+              ForceAuthn => $self->forceAuthn(),
+            },
             $x->Issuer(
                 $saml,
                 $self->issuer,
             ),
             $x->NameIDPolicy(
                 $samlp,
                 { AllowCreate => '1',
-                  Format => $self->nameid_format },
-            )
+                  Format => $self->nameid_format() },
+            ),
         )
     );
 }
 
-__PACKAGE__->meta->make_immutable;
+1;

lib/Net/SAML2/XML/Sig.pm

@@ -114,57 +114,80 @@ sub verify {
 
     $self->{ parser } = XML::XPath->new( xml => $xml );
     $self->{ parser }->set_namespace('dsig', 'http://www.w3.org/2000/09/xmldsig#');
+    $self->{ parser }->set_namespace('ec', 'http://www.w3.org/2001/10/xml-exc-c14n#');
 
-    my $signature = _trim($self->{parser}->findvalue('//dsig:Signature/dsig:SignatureValue'));
-    my $signed_info_node = $self->_get_node('//dsig:Signature/dsig:SignedInfo');
+    my $signature_nodeset = $self->{parser}->findnodes('//dsig:Signature');
 
-    my $signature_node = $self->_get_node('//dsig:Signature');
-    my $ns;
-    if (defined $signature_node && ref $signature_node) {
+    while (my $signature_node = $signature_nodeset->shift()) {
+
+        my $value = $self->{parser}->findvalue('dsig:SignatureValue', $signature_node);
+
+        my $signature = _trim($self->{parser}->findvalue('dsig:SignatureValue', $signature_node));
+        my $signed_info_node = $self->_get_node('dsig:SignedInfo', $signature_node);
+
+        my $ns;
+        if (defined $signature_node && ref $signature_node) {
             $ns = $signature_node->getNamespaces->[0];
             $self->{dsig_prefix} = ($ns->getPrefix eq '#default') ? '' : $ns->getPrefix;
-    }
-    else {
+        }
+        else {
             die "no Signature node?";
-    }
+        }
 
-    if (scalar @{ $signed_info_node->getNamespaces } == 0) {
-        $signed_info_node->appendNamespace($ns);
-    }
+        if (scalar @{ $signed_info_node->getNamespaces } == 0) {
+            $signed_info_node->appendNamespace($ns);
+        }
 
-    my $signed_info = XML::XPath::XMLParser::as_string($signed_info_node);
-    my $signed_info_canon = $self->_canonicalize_xml( $signed_info );
+        my $signed_info = XML::XPath::XMLParser::as_string($signed_info_node);
+        my $signed_info_canon = $self->_canonicalize_xml( $signed_info );
 
-    if (defined $self->{cert_obj}) {
+        if (defined $self->{cert_obj}) {
             # use the provided cert to verify
-            return 0 unless $self->_verify_x509_cert($self->{cert_obj},$signed_info_canon,$signature);
-    }
-    else {
+            unless ($self->_verify_x509_cert($self->{cert_obj},$signed_info_canon,$signature)) {
+                print STDERR "not verified by x509\n";
+                return 0;
+            }
+        }
+        else {
             # extract the certficate or key from the document
-            my $keyinfo_node;
-            if ($keyinfo_node = $self->{parser}->find('//dsig:Signature/dsig:KeyInfo/dsig:X509Data')) {
-                    return 0 unless $self->_verify_x509($keyinfo_node,$signed_info_canon,$signature);
-            } 
-            elsif ($keyinfo_node = $self->{parser}->find('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:RSAKeyValue')) {
-                    return 0 unless $self->_verify_rsa($keyinfo_node,$signed_info_canon,$signature);
+            my $keyinfo_nodeset;
+            if ($keyinfo_nodeset = $self->{parser}->findnodes('dsig:KeyInfo/dsig:X509Data', $signature_node)) {
+                my $keyinfo_node = $keyinfo_nodeset->shift();
+                unless ($self->_verify_x509($keyinfo_node,$signed_info_canon,$signature)) {
+                    print STDERR "not verified by x509\n";
+                    return 0;
+                }
+            }
+            elsif ($keyinfo_nodeset = $self->{parser}->find('dsig:KeyInfo/dsig:KeyValue/dsig:RSAKeyValue', $signature_node)) {
+                my $keyinfo_node = $keyinfo_nodeset->shift();
+                unless ($self->_verify_rsa($keyinfo_node,$signed_info_canon,$signature)) {
+                    print STDERR "not verified by rsa\n";
+                    return 0;
+                }
             }
-            elsif ($keyinfo_node = $self->{parser}->find('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:DSAKeyValue')) {
-                    return 0 unless $self->_verify_dsa($keyinfo_node,$signed_info_canon,$signature);
+            elsif ($keyinfo_nodeset = $self->{parser}->find('dsig:KeyInfo/dsig:KeyValue/dsig:DSAKeyValue', $signature_node)) {
+                my $keyinfo_node = $keyinfo_nodeset->shift();
+                unless ($self->_verify_dsa($keyinfo_node,$signed_info_canon,$signature)) {
+                    print STDERR "not verified by dsa\n";
+                    return 0;
+                }
             }
             else {
-                    die "Unrecognized key type or no KeyInfo in document";
+                die "Unrecognized key type or no KeyInfo in document";
             }
-    }
+        }
 
-    my $digest_method = $self->{parser}->findvalue('//dsig:Signature/dsig:SignedInfo/dsig:Reference/dsig:DigestMethod/@Algorithm');
-    my $digest = _trim($self->{parser}->findvalue('//dsig:Signature/dsig:SignedInfo/dsig:Reference/dsig:DigestValue'));
+        my $digest_method = $self->{parser}->findvalue('dsig:Reference/dsig:DigestMethod/@Algorithm', $signed_info_node);
+        my $refdigest     = _trim($self->{parser}->findvalue('dsig:Reference/dsig:DigestValue', $signed_info_node));
 
-    my $signed_xml    = $self->_get_signed_xml();
-    my $canonical     = $self->_transform( $signed_xml );
-    my $digest_bin    = sha1( $canonical ); 
+        my $signed_xml    = $self->_get_signed_xml( $signature_node );
+        my $canonical     = $self->_transform( $signed_xml, $signature_node );
+        my $digest        = encode_base64(_trim(sha1( $canonical )), '');
 
-    return 1 if ($digest eq _trim(encode_base64($digest_bin)));
-    return 0;
+        return 0 unless ($digest eq $refdigest);
+    }
+
+    return 1;
 }
 
 sub signer_cert {
@@ -183,7 +206,8 @@ sub _get_xml_to_sign {
 
 sub _get_signed_xml {
     my $self = shift;
-    my $id = $self->{parser}->findvalue('//dsig:Signature/dsig:SignedInfo/dsig:Reference/@URI');
+    my ($context) = @_;
+    my $id = $self->{parser}->findvalue('dsig:SignedInfo/dsig:Reference/@URI', $context);
     $id =~ s/^#//;
     $self->{'sign_id'} = $id;
     my $xpath = "//*[\@ID='$id']";
@@ -192,25 +216,49 @@ sub _get_signed_xml {
 
 sub _transform {
     my $self = shift;
-    my ($xml) = @_;
-    foreach my $node ($self->{parser}->find('//dsig:Transform/@Algorithm')->get_nodelist) {
-        my $alg = $node->getNodeValue;
-        if ($alg eq TRANSFORM_ENV_SIG) { $xml = $self->_transform_env_sig($xml); }
-        elsif ($alg eq TRANSFORM_EXC_C14N) { $xml = $self->_canonicalize_xml($xml,0); }
-        elsif ($alg eq TRANSFORM_EXC_C14N_COMMENTS) { $xml = $self->_canonicalize_xml($xml,1); }
-        else { die "Unsupported transform: $alg"; }
+    my ($xml, $context) = @_;
+
+    my $transforms = $self->{parser}->find(
+        'dsig:SignedInfo/dsig:Reference/dsig:Transforms/dsig:Transform', 
+        $context
+    );
+
+    foreach my $node ($transforms->get_nodelist) {
+        my $alg = $node->getAttribute('Algorithm');
+
+        if ($alg eq TRANSFORM_ENV_SIG) {
+            $xml = $self->_transform_env_sig($xml);
+        }
+        elsif ($alg eq TRANSFORM_EXC_C14N) {
+            my $prefixlist = $self->_find_prefixlist($node);
+            $xml = $self->_canonicalize_xml($xml, 0, $prefixlist);
+        }
+        elsif ($alg eq TRANSFORM_EXC_C14N_COMMENTS) {
+            my $prefixlist = $self->_find_prefixlist($node);
+            $xml = $self->_canonicalize_xml($xml, 1, $prefixlist);
+        }
+        else {
+            die "Unsupported transform: $alg";
+        }
     }
     return $xml;
 }
 
+sub _find_prefixlist {
+    my $self = shift;
+    my ($node) = @_;
+    my $prefixlist = $self->{parser}->findvalue('ec:InclusiveNamespaces/@PrefixList', $node);
+    return $prefixlist;
+}
+
 sub _verify_rsa {
     my $self = shift;
     my ($context,$canonical,$sig) = @_;
 
     # Generate Public Key from XML
-    my $mod = _trim($self->{parser}->findvalue('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:RSAKeyValue/dsig:Modulus'));
+    my $mod = _trim($self->{parser}->findvalue('dsig:Modulus', $context));
     my $modBin = decode_base64( $mod );
-    my $exp = _trim($self->{parser}->findvalue('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:RSAKeyValue/dsig:Exponent'));
+    my $exp = _trim($self->{parser}->findvalue('dsig:Exponent', $context));
     my $expBin = decode_base64( $exp );
     my $n = Crypt::OpenSSL::Bignum->new_from_bin($modBin);
     my $e = Crypt::OpenSSL::Bignum->new_from_bin($expBin);
@@ -239,12 +287,12 @@ sub _verify_x509 {
     confess "Crypt::OpenSSL::X509 needs to be installed so that we can handle X509 certificates" if $@;
 
     # Generate Public Key from XML
-    my $certificate = _trim($self->{parser}->findvalue('//dsig:Signature/dsig:KeyInfo/dsig:X509Data/dsig:X509Certificate'));
+    my $certificate = _trim($self->{parser}->findvalue('dsig:X509Certificate', $context));
 
     # This is added because the X509 parser requires it for self-identification
     $certificate = $self->_clean_x509($certificate);
-
     my $cert = Crypt::OpenSSL::X509->new_from_string($certificate);
+
     return $self->_verify_x509_cert($cert, $canonical, $sig);
 }
 
@@ -279,10 +327,10 @@ sub _verify_dsa {
     };
 
     # Generate Public Key from XML
-    my $p = decode_base64(_trim($self->{parser}->findvalue('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:DSAKeyValue/dsig:P')));
-    my $q = decode_base64(_trim($self->{parser}->findvalue('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:DSAKeyValue/dsig:Q')));
-    my $g = decode_base64(_trim($self->{parser}->findvalue('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:DSAKeyValue/dsig:G')));
-    my $y = decode_base64(_trim($self->{parser}->findvalue('//dsig:Signature/dsig:KeyInfo/dsig:KeyValue/dsig:DSAKeyValue/dsig:Y')));
+    my $p = decode_base64(_trim($self->{parser}->findvalue('dsig:P', $context)));
+    my $q = decode_base64(_trim($self->{parser}->findvalue('dsig:Q', $context)));
+    my $g = decode_base64(_trim($self->{parser}->findvalue('dsig:G', $context)));
+    my $y = decode_base64(_trim($self->{parser}->findvalue('dsig:Y', $context)));
     my $dsa_pub = Crypt::OpenSSL::DSA->new();
     $dsa_pub->set_p($p);
     $dsa_pub->set_q($q);
@@ -298,8 +346,13 @@ sub _verify_dsa {
 
 sub _get_node {
     my $self = shift;
-    my ($xpath) = @_;
-    my $nodeset = $self->{parser}->find($xpath);
+    my ($xpath, $context) = @_;
+    my $nodeset;
+    if ($context) {
+         $nodeset = $self->{parser}->find($xpath, $context);
+    } else {
+         $nodeset = $self->{parser}->find($xpath);
+    }
     foreach my $node ($nodeset->get_nodelist) {
         return $node; 
     }
@@ -317,7 +370,11 @@ sub _transform_env_sig {
     if (defined $self->{dsig_prefix} && length $self->{dsig_prefix}) {
         $prefix = $self->{dsig_prefix} . ':';
     }
-    $str =~ s/(<${prefix}Signature(.*?)>(.*?)\<\/${prefix}Signature>)//igs;
+    # This removes the first Signature tag from the XML - even if there is another XML tree with another Signature inside and that comes first.
+    # TODO: Remove the outermost Signature only.
+
+    $str =~ s/(<${prefix}Signature(.*?)>(.*?)\<\/${prefix}Signature>)//is;
+
     return $str;
 }
 
@@ -537,7 +594,7 @@ sub _signedinfo_xml {
     my $self = shift;
     my ($digest_xml) = @_;
 
-    return qq{<dsig:SignedInfo xmlns:dsig="http://www.w3.org/2000/09/xmldsig#" xmlns:samlp="urn:oasis:names:tc:SAML:2.0:protocol" xmlns:xenc="http://www.w3.org/2001/04/xmlenc#">
+    return qq{<dsig:SignedInfo xmlns:dsig="http://www.w3.org/2000/09/xmldsig#" xmlns:xenc="http://www.w3.org/2001/04/xmlenc#">
                 <dsig:CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315#WithComments" />
                 <dsig:SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#$self->{key_type}-sha1" />
                 $digest_xml
@@ -560,18 +617,26 @@ sub _reference_xml {
 
 sub _canonicalize_xml {
     my $self = shift;
-    my ($xml,$comments) = @_;
+    my ($xml,$comments,$prefixlist) = @_;
     $comments = 0 unless $comments;
+    $prefixlist = '' unless $prefixlist;
 
     if ( $self->{canonicalizer} eq 'XML::Canonical' ) {
         require XML::Canonical;
+
+        # TODO - pass prefixlist in here if X::C supports it
+
         my $xmlcanon = XML::Canonical->new( comments => $comments );
         return $xmlcanon->canonicalize_string( $xml );
     }
     elsif ( $self->{ canonicalizer } eq 'XML::CanonicalizeXML' ) {
         require XML::CanonicalizeXML;
         my $xpath = '<XPath>(//. | //@* | //namespace::*)</XPath>';
-        return XML::CanonicalizeXML::canonicalize( $xml, $xpath, [], 1, $comments );
+
+        # adjust prefixlist from attribute for XML::CanonicalizeXML's format
+        $prefixlist =~ s/ /,/g;
+
+        return XML::CanonicalizeXML::canonicalize( $xml, $xpath, $prefixlist, 1, $comments );
     }
     else {
         confess "Unknown XML canonicalizer module.";