view release on metacpan or  search on metacpan

t/32-xsw-defenses.t  view on Meta::CPAN

    my $aud    = $p{audience} // 'http://sp.test';
    my $recip  = $p{recipient} // 'http://sp.test/saml/post';

    return <<"XML";
<saml:Assertion xmlns:saml="urn:oasis:names:tc:SAML:2.0:assertion"
                ID="$id" Version="2.0" IssueInstant="$now">
  <saml:Issuer>$issuer</saml:Issuer>
  <saml:Subject>
    <saml:NameID Format="urn:oasis:names:tc:SAML:1.1:nameid-format:emailAddress">$nameid</saml:NameID>
    <saml:SubjectConfirmation Method="urn:oasis:names:tc:SAML:2.0:cm:bearer">
      <saml:SubjectConfirmationData InResponseTo="_req_$$" NotOnOrAfter="$exp" Recipient="$recip"/>
    </saml:SubjectConfirmation>
  </saml:Subject>
  <saml:Conditions NotBefore="$now" NotOnOrAfter="$exp">
    <saml:AudienceRestriction>
      <saml:Audience>$aud</saml:Audience>
    </saml:AudienceRestriction>
  </saml:Conditions>
  <saml:AuthnStatement AuthnInstant="$now" SessionIndex="_sess_$$">
    <saml:AuthnContext>
      <saml:AuthnContextClassRef>urn:oasis:names:tc:SAML:2.0:ac:classes:Password</saml:AuthnContextClassRef>
    </saml:AuthnContext>
  </saml:AuthnStatement>
  <saml:AttributeStatement>
    <saml:Attribute Name="role">
      <saml:AttributeValue>user</saml:AttributeValue>
    </saml:Attribute>
  </saml:AttributeStatement>
</saml:Assertion>
XML
}

# Wrap a (possibly-signed) Assertion XML in a Response wrapper.
sub wrap_in_response {
    my %p = @_;
    my $inner = $p{inner};
    my $resp_id = "_resp_$$" . "_" . int(rand(1e9));
    my $now = strftime("%Y-%m-%dT%H:%M:%SZ", gmtime());
    my $dest = $p{destination} // 'http://sp.test/saml/post';
    return <<"XML";
<samlp:Response xmlns:samlp="urn:oasis:names:tc:SAML:2.0:protocol"
                xmlns:saml="urn:oasis:names:tc:SAML:2.0:assertion"
                ID="$resp_id" Version="2.0" IssueInstant="$now"
                Destination="$dest">
  <saml:Issuer>http://idp.test/idp</saml:Issuer>
  <samlp:Status>
    <samlp:StatusCode Value="urn:oasis:names:tc:SAML:2.0:status:Success"/>
  </samlp:Status>
$inner
</samlp:Response>
XML
}

my $signer = XML::Sig->new({
    x509               => 1,
    key                => $idp_key,
    cert               => $idp_crt,
    no_xml_declaration => 1,
});

# Helper: sign and post-process so the <dsig:Signature> sits right
# after <saml:Issuer> within the signed element - the position the
# SAML 2.0 schema (AssertionType, StatusResponseType) requires.
# XML::Sig appends the signature as the last child, which is valid
# per W3C XML-DSig but rejected by strict schema-validating SPs.
#
# This is regex-based and only moves the Signature element verbatim
# (no parsing/reserialization). Internal whitespace of SignedInfo
# is untouched, so digest and signature math both remain valid.
sub sign_schema_compliant {
    my ($s, $xml) = @_;
    my $signed = $s->sign($xml);
    my ($sig) = $signed =~ m{(<(?:ds|dsig):Signature\b.*?</(?:ds|dsig):Signature>)}s;
    return $signed unless $sig;
    # Move the Signature element ONLY - no surrounding whitespace -
    # so the canonical form of the signed element (after enveloped-
    # signature transform strips the Signature) is byte-identical to
    # what XML::Sig digested. Any added whitespace would change the
    # text-node structure and break digest validation.
    $signed =~ s{\Q$sig\E}{}s;
    $signed =~ s{(</saml:Issuer>)}{$1$sig}s;
    return $signed;
}

# ============================================================
# Sanity: a legitimately-signed Response + Assertion parses
# ============================================================
{
    my $assertion_xml = make_assertion(nameid => 'lowuser@victim.com');
    my $signed = sign_schema_compliant($signer, $assertion_xml);
    my $response = wrap_in_response(inner => $signed);

    my $a = eval {
        Net::SAML2::Protocol::Assertion->new_from_xml(
            xml    => $response,
            cacert => $idp_crt,
        );
    };
    ok($a, 'sanity: legit signed assertion parses') or diag $@;
    is($a && $a->nameid, 'lowuser@victim.com', 'sanity: nameid extracted');
}

# ============================================================
# Test 1: math gate catches a corrupted SignatureValue
# ============================================================
{
    my $assertion_xml = make_assertion(nameid => 'lowuser@victim.com');
    my $signed = sign_schema_compliant($signer, $assertion_xml);
    my $response = wrap_in_response(inner => $signed);

    # Corrupt the first base64 char of the SignatureValue so the signature
    # math must fail. Deterministic: flip the captured char to a
    # guaranteed-different value (A<->B), regardless of what it is, and
    # tolerate optional whitespace/newline after the opening tag. The
    # previous version set a fixed char ('A') which was a no-op when the
    # original char already equalled it, making the test flaky.
    (my $corrupted = $response) =~ s{
        (<(?:ds|dsig)?:?SignatureValue[^>]*>\s*) ([A-Za-z0-9+/])
    }{
        $1 . ($2 eq 'A' ? 'B' : 'A')
    }ex;
    isnt($corrupted, $response, 'corruption regex made a change');

    throws_ok(
        sub {
            Net::SAML2::Protocol::Assertion->new_from_xml(
                xml    => $corrupted,
                cacert => $idp_crt,
            );
        },
        qr/XML signature verification failed/,
        'XML signature verification failed croaks on corrupted SignatureValue'
    );
}

# ============================================================
# Test 2: defensive croak on XSW1 duplicate-ID
# ============================================================
{
    my $legit_id = "_legit_id_dup_test";
    my $assertion_xml = make_assertion(id => $legit_id, nameid => 'lowuser@victim.com');
    my $signed = sign_schema_compliant($signer, $assertion_xml);

    # Inject a SECOND <saml:Assertion> with the SAME ID, AFTER the signed
    # one (so XML::Sig's _get_node still picks the legit one for digest).
    my $duplicate = qq{<saml:Assertion xmlns:saml="urn:oasis:names:tc:SAML:2.0:assertion" ID="$legit_id"><saml:Issuer>x</saml:Issuer></saml:Assertion>};
    my $payload = $signed . $duplicate;
    my $response = wrap_in_response(inner => $payload);

    throws_ok(
        sub {
            Net::SAML2::Protocol::Assertion->new_from_xml(
                xml    => $response,
                cacert => $idp_crt,
            );
        },
        qr/XSW guard|ambiguous|XML signature verification failed/,
        'duplicate-ID document is rejected (either XSW guard or upstream XML::Sig fail)'
    );
}

# ============================================================
# Test 3: XSW different-ID wrapping is defended
#
# Attacker constructs a Response containing a fresh attacker
# Assertion (different ID, NameID="admin@victim.com") prepended
# in document order, followed by the legitimately-signed Assertion
# (NameID="lowuser@victim.com"). Without the XSW anchor, document-
# order extraction would pick the attacker's element. With it,
# extraction is anchored at the signed Assertion's subtree.
# ============================================================
{
    my $legit_id = "_legit_" . int(rand(1e9));
    my $legit_xml = make_assertion(id => $legit_id, nameid => 'lowuser@victim.com');
    my $signed_legit = sign_schema_compliant($signer, $legit_xml);

    # Attacker's modified Assertion - no signature, NameID escalated.
    my $atk_id = "_attacker_" . int(rand(1e9));