XML-Sig

 view release on metacpan or  search on metacpan

lib/XML/Sig.pm  view on Meta::CPAN

use strict;
use warnings;

package XML::Sig;
our $VERSION = '0.70';

use Encode;
use Try::Tiny;
# ABSTRACT: XML::Sig - A toolkit to help sign and verify XML Digital Signatures

# use 'our' on v5.6.0
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);

$DEBUG = 0;

use base qw(Class::Accessor);
XML::Sig->mk_accessors(qw(key));


use Digest::SHA qw(sha1 sha224 sha256 sha384 sha512 hmac_sha1 hmac_sha256 hmac_sha384 hmac_sha512);
use Crypt::Digest::RIPEMD160 qw/ripemd160/;
use XML::LibXML;
use MIME::Base64;
use Carp;


use constant TRANSFORM_ENV_SIG           => 'http://www.w3.org/2000/09/xmldsig#enveloped-signature';
use constant TRANSFORM_C14N              => 'http://www.w3.org/TR/2001/REC-xml-c14n-20010315';
use constant TRANSFORM_C14N_COMMENTS     => 'http://www.w3.org/TR/2001/REC-xml-c14n-20010315#WithComments';
use constant TRANSFORM_C14N_V1_1         => 'http://www.w3.org/TR/2008/REC-xml-c14n11-20080502';
use constant TRANSFORM_C14N_V1_1_COMMENTS => 'http://www.w3.org/TR/2008/REC-xml-c14n11-20080502#WithComments';
use constant TRANSFORM_EXC_C14N          => 'http://www.w3.org/2001/10/xml-exc-c14n#';
use constant TRANSFORM_EXC_C14N_COMMENTS => 'http://www.w3.org/2001/10/xml-exc-c14n#WithComments';

sub DESTROY { }

$| = 1;  # autoflush




sub new {
    my $class = shift;
    my $params = shift;
    my $self = {};
    foreach my $prop ( qw/ key cert cert_text ns id_attr/ ) {
        if ( exists $params->{ $prop } ) {
            $self->{ $prop } = $params->{ $prop };
        }
#        else {
#            confess "You need to provide the $prop parameter!";
#        }
    }
    bless $self, $class;
    $self->{ 'x509' } = exists $params->{ x509 } ? 1 : 0;
    if ( exists $params->{ key_name } ) {
        $self->{ key_name } = $params->{ key_name };
    }
    if ( exists $params->{ 'key' } ) {
        $self->_load_key( $params->{ 'key' } );
    }
    if ( exists $params->{ 'cert' } ) {
        $self->_load_cert_file( $params->{ 'cert' } );
    }
    if ( exists $params->{ 'cert_text' } ) {
        $self->_load_cert_text( $params->{ 'cert_text' } );
    }
    if ( exists $params->{ 'hmac_key' } ) {
        $self->_load_hmac_key_info;
    }

    if ( exists $params->{ sig_hash } && grep { $_ eq $params->{ sig_hash } } ('sha224', 'sha256', 'sha384', 'sha512', 'ripemd160'))
    {
        $self->{ sig_hash } = $params->{ sig_hash };
    }
    else {
        $self->{ sig_hash } = 'sha256';
    }

    if ( exists $params->{ digest_hash } && grep { $_ eq $params->{ digest_hash } } ('sha1', 'sha224', 'sha256', 'sha384','sha512', 'ripemd160'))
    {
        $self->{ digest_hash } = $params->{ digest_hash };
    }
    else {
        $self->{ digest_hash } = 'sha256';
    }

    if (defined $self->{ key_type } && XML::Sig::check_dsa_version() && $self->{ key_type } eq 'dsa') {
        my $sig_size = $self->{ key_obj }->get_sig_size();

        # The key size dictates the sig size
        if ( $sig_size eq 48 ) {    # 1024-bit key
            $self->{ sig_hash } = 'sha1';
        } else {                    # 2048-bit or 3072-bit key
            $self->{ sig_hash } = 'sha256';
        }
    }

    if ( exists $params->{ no_xml_declaration } && $params->{ no_xml_declaration } == 1 ) {
        $self->{ no_xml_declaration } = 1;
    } else {
        $self->{ no_xml_declaration } = 0;
    }

    if ( !defined $self->{ key_type } && exists $params->{ hmac_key } ) {
        $self->{ hmac_key } = $params->{ hmac_key };
        $self->{ key_type } = 'hmac';
    }

    return $self;
}


sub sign {
    my $self = shift;
    my ($xml) = @_;

    die "You cannot sign XML without a private key." unless $self->key || $self->{ hmac_key };

    local $XML::LibXML::skipXMLDeclaration = $self->{ no_xml_declaration };

    my $dom = $self->_load_xml($xml);

    $self->{ parser } = XML::LibXML::XPathContext->new($dom);
    $self->{ parser }->registerNs('dsig', 'http://www.w3.org/2000/09/xmldsig#');
    $self->{ parser }->registerNs('ec', 'http://www.w3.org/2001/10/xml-exc-c14n#');
    $self->{ parser }->registerNs('saml', 'urn:oasis:names:tc:SAML:2.0:assertion');
    if ($self->{ns}) {
        foreach (keys %{$self->{ns}}) {
            $self->{ parser }->registerNs($_, $self->{ns}{$_});
        }
    }

    print ("Signing XML\n") if $DEBUG;

    my @ids_to_sign = $self->_get_ids_to_sign();

    foreach my $signid (@ids_to_sign) {

        print ("Signing ID $signid\n") if $DEBUG;

        # Temporarily create the Signature XML from the part
        # TODO: ths section needs a rewrite to create the xml in
        # a better way.

        # Create a Reference xml fragment including digest section
        my $digest_xml    = $self->_reference_xml( $signid, "REPLACE DIGEST " . $signid );

        # Create a SignedInfo xml fragment including digest section
        my $signed_info   = $self->_signedinfo_xml( $digest_xml );

        # Create a Signature xml fragment including SignedInfo section
        my $signature_xml = $self->_signature_xml( $signed_info, 'REPLACE SIGNATURE ' . $signid );

        print ("Sign ID: $signid\n") if $DEBUG;

        # Get the XML note to sign base on the ID
        my $xml = $self->_get_xml_to_sign($signid);

        # Canonicalize the XML to http://www.w3.org/2001/10/xml-exc-c14n#
        # TODO Change the Canonicalization method in the xml fragment from _signedinfo_xml
        #    <dsig:Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
        #    <dsig:Transform Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#"/>
        my $xml_canon        = $xml->toStringEC14N();

        if(my $ref = Digest::SHA->can($self->{ digest_hash })) {
            $self->{digest_method} = $ref;
        }
        elsif ( $ref = Crypt::Digest::RIPEMD160->can($self->{ digest_hash }))  {
            $self->{digest_method} = $ref;
        }
        else {
            die("Can't handle $self->{ digest_hash }");
        }

        # Calculate the digest of the XML being signed
        my $bin_digest    = $self->{digest_method}->( Encode::encode_utf8( $xml_canon ));
        my $digest        = encode_base64( $bin_digest, '' );
        print ("   Digest: $digest\n") if $DEBUG;

        # Display the ID of the XML being signed for debugging
        my $reference = $signid; #$self->{parser}->findvalue('//@ID', $xml);
        print ("   Reference URI: $reference\n") if $DEBUG;

        local $XML::LibXML::skipXMLDeclaration = $self->{ no_xml_declaration };

        my $signature_dom = $self->_load_xml($signature_xml);

        my $xpath = XML::LibXML::XPathContext->new($signature_dom);
        $xpath->registerNs('dsig', 'http://www.w3.org/2000/09/xmldsig#');
        $xpath->registerNs('ec', 'http://www.w3.org/2001/10/xml-exc-c14n#');

        # Canonicalize the SignedInfo to http://www.w3.org/TR/2001/REC-xml-c14n-20010315#WithComments
        # TODO Change the Canonicalization method in the xml fragment from _signedinfo_xml

        my ($signature_node) = $xpath->findnodes(
            '/dsig:Signature', $signature_xml);
        my ($signed_info_node) = $xpath->findnodes(
            '/dsig:Signature/dsig:SignedInfo',$signature_xml);

        # Add the digest value to the Signed info
        my ($digest_value_node) = $xpath->findnodes(
            '/dsig:Signature/dsig:SignedInfo/dsig:Reference/dsig:DigestValue', $signature_xml);
        $digest_value_node->removeChildNodes();
        $digest_value_node->appendText($digest);

        # At this point the SignedInfo includes the information
        # to allow us to use the _canonicalize_xml with the $signature_node
        my $signed_info_canon = $self->_canonicalize_xml($signed_info_node, $signature_node);

        # Calculate the signature of the Canonical Form of SignedInfo
        my $signature;
        if ($self->{key_type} eq 'dsa') {
            $signature = encode_base64( $self->_calc_dsa_signature( $signed_info_canon ), "\n" );
        } elsif ($self->{key_type} eq 'ecdsa') {
            $signature = encode_base64( $self->_calc_ecdsa_signature( $signed_info_canon ), "\n" );
        } elsif ($self->{key_type} eq 'rsa') {
            $signature = encode_base64( $self->_calc_rsa_signature( $signed_info_canon ), "\n" );
        } else {
            if ( defined $self->{ hmac_key } ) {
                $signature = encode_base64( $self->_calc_hmac_signature( $signed_info_canon ), "\n" );
            } else {
                die "No Signature signing method provided";
            }
        }

        # Add the Signature to the SignatureValue
        my ($signature_value_node) = $xpath->findnodes(
            '/dsig:Signature/dsig:SignatureValue', $signature_xml);
        $signature_value_node->removeChildNodes();
        $signature_value_node->appendText($signature);

        my $set = $xpath->findnodes('dsig:Signature');

        my $node = $set->get_node(1)->cloneNode( 1 );

        my $root = $dom->findnodes("//*[\@ID=\'$signid\']");

        my $loc = $root->shift();
        $loc->addChild($node);

        print ("\n\n\n SignatureValue:\n" . $signature_value_node . "\n\n\n") if $DEBUG;
    }

    return $dom->toString;
}


sub verify {
    my $self = shift;
    delete $self->{signer_cert};
    my $xml = shift;

    my $dom = $self->_load_xml($xml);

    $self->{ parser } = XML::LibXML::XPathContext->new($dom);
    $self->{ parser }->registerNs('dsig', 'http://www.w3.org/2000/09/xmldsig#');
    $self->{ parser }->registerNs('ec', 'http://www.w3.org/2001/10/xml-exc-c14n#');
    $self->{ parser }->registerNs('saml', 'urn:oasis:names:tc:SAML:2.0:assertion');
    $self->{ parser }->registerNs('ecdsa', 'http://www.w3.org/2001/04/xmldsig-more#');

    my $signature_nodeset = $self->{ parser }->findnodes('//dsig:Signature');

    my $key_to_verify;
    if ($self->{id_attr}) {
        if ($self->{ns}) {
            foreach (keys %{$self->{ns}}) {
                $self->{ parser }->registerNs($_, $self->{ns}{$_});
            }
        }
        $key_to_verify = $self->_get_ids_to_sign();
    }

    my $numsigs = $signature_nodeset->size();
    print ("NodeSet Size: $numsigs\n") if $DEBUG;

    die 'XML::Sig - XML does not include any signatures' if $numsigs <= 0;
    # Loop through each Signature in the document checking each
    my $i;
    while (my $signature_node = $signature_nodeset->shift()) {
        $i++;
        print ("\nSignature $i\n") if $DEBUG;

        # Get SignedInfo Reference ID
        my $reference = $self->{ parser }->findvalue(
            'dsig:SignedInfo/dsig:Reference/@URI', $signature_node);
        $reference =~ s/#//g;

        print("   Reference URI: $reference\n") if $DEBUG;

        if ($key_to_verify && $key_to_verify ne $reference) {
            print ("Skipping reference URI: $reference, does not match required option\n") if $DEBUG;
            next;
        }

        # The reference ID must point to something in the document
        # if not disregard it and look for another signature
        # TODO check to ensure that if there is only a single reference
        # like this it won't accidentally validate
        if (! $self->{ parser }->findvalue('//*[@ID=\''. $reference . '\']')) {
            print ("   Signature reference $reference is not signing anything in this xml\n") if $DEBUG;
            if ($numsigs <= 1) {
                return 0;
            }
            else {
                next;
            }
        }

        # Get SignedInfo DigestMethod Algorithim
        my $digest_method = $self->{ parser }->findvalue(
                'dsig:SignedInfo/dsig:Reference/dsig:DigestMethod/@Algorithm', $signature_node);
        $digest_method =~ s/^.*[#]//;
        print ("   Digest Method: $digest_method\n") if $DEBUG;

        # Get the DigestValue used to verify Canonical XML
        # Note that the digest may have embedded newlines in the XML
        # Decode the base64 and encode it with no newlines
        my $refdigest = encode_base64(decode_base64(_trim($self->{ parser }->findvalue(
                'dsig:SignedInfo/dsig:Reference/dsig:DigestValue', $signature_node))), "");
        print ("   Digest Value: $refdigest\n") if $DEBUG;

        # Get the SignatureValue used to verify the SignedInfo
        my $signature = _trim($self->{ parser }->findvalue('dsig:SignatureValue', $signature_node));
        print ("   Signature: $signature\n") if $DEBUG;

        # Get SignatureMethod Algorithim
        my $signature_method = $self->{ parser }->findvalue(
                'dsig:SignedInfo/dsig:SignatureMethod/@Algorithm', $signature_node);
        $signature_method =~ s/^.*[#]//;
        $signature_method =~ s/^rsa-//;
        $signature_method =~ s/^dsa-//;
        $signature_method =~ s/^ecdsa-//;
        $signature_method =~ s/^hmac-//;

        $self->{ sig_hash } = $signature_method;
        print ("   SignatureMethod: $signature_method\n") if $DEBUG;

        # Get the SignedInfo and obtain its Canonical form
        my ($signed_info) = $self->{ parser }->findnodes('dsig:SignedInfo', $signature_node);
        my $signed_info_canon = $self->_canonicalize_xml($signed_info, $signature_node);

        print "$signed_info_canon\n" if $DEBUG;

        if(my $ref = Digest::SHA->can($signature_method)) {
            $self->{sig_method} = $ref;
        }
        elsif ( $ref = Crypt::Digest::RIPEMD160->can( $signature_method ))  {
            $self->{sig_method} = $ref;
        }
        else {
            die("Can't handle $signature_method");
        }

        if(my $ref = Digest::SHA->can($digest_method)) {
            $self->{digest_method} = $ref;
        }
        elsif ( $ref = Crypt::Digest::RIPEMD160->can( $digest_method ))  {
            $self->{digest_method} = $ref;
        }
        else {
            die("Can't handle $digest_method");
        }

        # If a cert was provided to XML::Sig->new() use it to
        # verify the SignedInfo signature
        if (defined $self->{cert_obj}) {
            # use the provided cert to verify
            unless ($self->_verify_x509_cert($self->{cert_obj},$signed_info_canon,$signature)) {
                print STDERR "not verified by x509\n";
                return 0;
            }
        }
        elsif (!defined $self->{cert_obj} && defined $self->{ hmac_key }) {
            # use the provided cert to verify
            unless ($self->_verify_hmac($signed_info_canon,$signature)) {
                print "not verified by hmac-" . $self->{ sig_hash }, "\n" if $DEBUG;
                return 0;
            }
        }
        # Extract the XML provided certificate and use it to
        # verify the SignedInfo signature
        else {
            # extract the certficate or key from the document
            my %verify_dispatch = (
                'X509Data' => '_verify_x509',
                'RSAKeyValue' => '_verify_rsa',
                'DSAKeyValue' => '_verify_dsa',
                'ECDSAKeyValue' => '_verify_ecdsa',
            );
            my $keyinfo_nodeset;
            foreach my $key_info_sig_type ( qw/X509Data RSAKeyValue DSAKeyValue ECDSAKeyValue/ ) {
                if ( $key_info_sig_type eq 'X509Data' ) {
                    $keyinfo_nodeset = $self->{ parser }->find(
                            "dsig:KeyInfo/dsig:$key_info_sig_type", $signature_node);
                    #print ("   keyinfo_nodeset X509Data: $keyinfo_nodeset\n") if $DEBUG;
                } else {
                    $keyinfo_nodeset = $self->{ parser }->find(
                            "dsig:KeyInfo/dsig:KeyValue/dsig:$key_info_sig_type", $signature_node);
                    #print ("   keyinfo_nodeset [DR]SAKeyValue: $keyinfo_nodeset\n") if $DEBUG;
                }
                if ( $keyinfo_nodeset->size ) {
                    my $verify_method = $verify_dispatch{$key_info_sig_type};
                    print ("   Verify Method: $verify_method\n") if $DEBUG;
                    if ( ! $self->$verify_method($keyinfo_nodeset->get_node(0),
                            $signed_info_canon, $signature) ) {
                        print ("keyinfo_nodeset->get_node: " . $keyinfo_nodeset->get_node(0) . "\n") if $DEBUG;
                        print STDERR "Failed to verify using $verify_method\n";
                        return 0;
                    } else {
                        print ("Success Verifying\n") if $DEBUG;
                    }
                    last;
                }
            }
            die "Unrecognized key type or no KeyInfo in document" unless (
                $keyinfo_nodeset && $keyinfo_nodeset->size > 0);
        }

        # Signature of SignedInfo was verified above now obtain the
        # Canonical form of the XML and verify the DigestValue of the XML

        # Remove the Signature from the signed XML
        my $signed_xml = $self->_get_signed_xml( $signature_node );
        $signed_xml->removeChild( $signature_node );

        # Obtain the Canonical form of the XML
        my $canonical = $self->_transform($signed_xml, $signature_node);

        # Add the $signature_node back to the $signed_xml to allow other
        # signatures to be validated if they exist
        $signed_xml->addChild( $signature_node );

        print ( "    Canonical XML:  " . $canonical ."\n") if $DEBUG;

        # Obtain the DigestValue of the Canonical XML
        my $digest = $self->{digest_method}->(Encode::encode_utf8($canonical));

        print ( "    Reference Digest:  " . _trim($refdigest) ."\n") if $DEBUG;

        print ( "    Calculated Digest: ". _trim(encode_base64($digest, '')) ."\n") if $DEBUG;

        # Return 0 - fail verification on the first XML signature that fails
        return 0 unless ($refdigest eq _trim(encode_base64($digest, '')));

        print ( "Signature $i Valid\n") if $DEBUG;
    }

    return 1;
}


sub signer_cert {
    my $self = shift;
    return $self->{signer_cert};
}

##
## _get_ids_to_sign()

lib/XML/Sig.pm  view on Meta::CPAN

## Nodes first.
##
sub _get_ids_to_sign {
    my $self = shift;

    if ($self->{id_attr}) {
        my $nodes = $self->{parser}->findnodes($self->{id_attr});
        if ($nodes->size == 0) {
            die "Unable to find an attribute node with $self->{id_attr}";
        }
        my $node = $nodes->get_node(1);
        return $node->getAttribute('ID');

    }

    my $nodes = $self->{parser}->findnodes('//@ID');
    return $nodes->reverse->map(
        sub {
            my $val = $_->getValue;
            defined($val) && length($val) && $val;
        }
    );
}

##
## _get_xml_to_sign()
##
## Arguments:
##    $id:     string ID of the Node for the XML to retrieve
##
## Returns: XML NodeSet to sign
##
## Find the XML node with the ID = $id and return the
## XML NodeSet
##
sub _get_xml_to_sign {
    my $self = shift;
    my $id = shift;
    die "You cannot sign an XML document without identifying the element to sign with an ID attribute" unless $id;

    my $xpath = "//*[\@ID='$id']";
    my ($node) = $self->_get_node( $xpath );
    return $node;
}

##
## _get_signed_xml($context)
##
## Arguments:
##    $context:     string XML NodeSet used as context
##
## Returns: XML NodeSet for with ID equal to the URI
##
## Find the XML node with the ID = $URI and return the
## XML NodeSet
##
sub _get_signed_xml {
    my $self = shift;
    my ($context) = @_;

    my $id = $self->{parser}->findvalue('./dsig:SignedInfo/dsig:Reference/@URI', $context);
    $id =~ s/^#//;
    print ("    Signed XML id: $id\n") if $DEBUG;

    $self->{'sign_id'} = $id;
    my $xpath = "//*[\@ID='$id']";
    return $self->_get_node( $xpath, $context );
}

##
## _transform($xml, $context)
##
## Arguments:
##    $xml:     string XML NodeSet
##    $context: string XML Context
##
## Returns: string  Transformed XML
##
## Canonicalizes/Transforms xml based on the Transforms
## from the SignedInfo.
##
sub _transform {
    my $self = shift;
    my ($xml, $context) = @_;

    $context->setNamespace( 'http://www.w3.org/2000/09/xmldsig#', 'dsig' );
    my $transforms = $self->{parser}->find(
        'dsig:SignedInfo/dsig:Reference/dsig:Transforms/dsig:Transform',
        $context
    );

    print "_transform\n" if $DEBUG;
    foreach my $node ($transforms->get_nodelist) {
        my $alg = $node->getAttribute('Algorithm');

        print "    Algorithm: $alg\n" if $DEBUG;
        if ($alg eq TRANSFORM_ENV_SIG) {
            # TODO the xml being passed here currently has the
            # Signature removed.  May be better to do it all here
            next;
        }
        elsif ($alg eq TRANSFORM_C14N) {
            print "        toStringC14N" if $DEBUG;
            $xml = $xml->toStringC14N();
        }
        elsif ($alg eq TRANSFORM_C14N_COMMENTS) {
            print "        toStringC14N(1)" if $DEBUG;
            $xml = $xml->toStringC14N(1);
        }
        elsif ($alg eq TRANSFORM_EXC_C14N) {
            my @prefixlist = $self->_find_prefixlist($node);
            print "        toStringEC14N(0, '', @prefixlist)\n" if $DEBUG;
            $xml = $xml->toStringEC14N(0, '', \@prefixlist);
        }
        elsif ($alg eq TRANSFORM_EXC_C14N_COMMENTS) {
            my @prefixlist = $self->_find_prefixlist($node);
            print "        toStringEC14N(1, '', @prefixlist)\n" if $DEBUG;
            $xml = $xml->toStringEC14N(1, '', \@prefixlist);
        }
        else {
            die "Unsupported transform: $alg";
        }
    }
    return $xml;
}

##
## _find_prefixlist($node)
##
## Arguments:
##    $node:    string XML NodeSet
##
## Returns: ARRAY of prefix lists
##
## Generate an array of prefix lists defined in InclusiveNamespaces
##
sub _find_prefixlist {
    my $self = shift;
    my ($node) = @_;
    my @children = $node->getChildrenByLocalName('InclusiveNamespaces');

    my $prefixlist = '';
    foreach my $child (@children) {
        if ($child) {
            $prefixlist .= $child->getAttribute('PrefixList');
        }
        $prefixlist .= ' ';
    }
    return split / /, $prefixlist;
}

##
## _verify_rsa($context,$canonical,$sig)
##
## Arguments:
##    $context:     string XML Context to use
##    $canonical:   string Canonical XML to verify
##    $sig:         string Base64 encode of RSA Signature
##
## Returns: integer (1 True, 0 False) if signature is valid
##
## Verify the RSA signature of Canonical XML
##
sub _verify_rsa {
    my $self = shift;
    my ($context,$canonical,$sig) = @_;

    eval {
        require Crypt::PK::RSA;
    };
    confess "Crypt::PK::RSA needs to be installed so
                that we can handle X509 certificates" if $@;
    # Generate Public Key from XML
    my $mod = _trim($self->{parser}->findvalue('dsig:Modulus', $context));
    my $modBin = decode_base64( $mod );
    my $exp = _trim($self->{parser}->findvalue('dsig:Exponent', $context));
    my $expBin = decode_base64( $exp );
    my $n = unpack("H*", $modBin);
    my $e = unpack("H*", $expBin);

    my $pk = Crypt::PK::RSA->new();
    my $rsa_pub = $pk->import_key({N => $n, e => $e});
    # Decode signature and verify
    my $bin_signature = decode_base64($sig);

    return 1 if ($rsa_pub->verify_message( $bin_signature, $canonical, $self->{ sig_hash }, "v1.5"));
    return 0;
}

##
## _clean_x509($cert)
##
## Arguments:
##    $cert:     string Certificate in base64 from XML
##
## Returns: string  Certificate in Valid PEM format
##
## Reformats Certifcate string into PEM format 64 characters
## with proper header and footer
##
sub _clean_x509 {
    my $self = shift;
    my ($cert) = @_;

    $cert = $cert->value() if(ref $cert);
    chomp($cert);

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

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

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

    $cert = "-----BEGIN CERTIFICATE-----\n" . $cert . "\n-----END CERTIFICATE-----\n";
    return $cert;
}

##
## _verify_x509($context,$canonical,$sig)
##
## Arguments:
##    $context:     string XML Context to use
##    $canonical:   string Canonical XML to verify
##    $sig:         string Base64 encode of RSA Signature
##
## Returns: integer (1 True, 0 False) if signature is valid
##
## Verify the RSA signature of Canonical XML using an X509
##
sub _verify_x509 {
    my $self = shift;
    my ($context,$canonical,$sig) = @_;

    eval {
        require Crypt::OpenSSL::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: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);
}

##
## _verify_x509_cert($cert,$canonical,$sig)
##
## Arguments:
##    $cert:        string X509 Certificate
##    $canonical:   string Canonical XML to verify
##    $sig:         string Base64 encode of [EC|R]SA Signature
##
## Returns: integer (1 True, 0 False) if signature is valid
##
## Verify the X509 signature of Canonical XML
##
sub _verify_x509_cert {
    my $self = shift;
    my ($cert, $canonical, $sig) = @_;

    # Decode signature and verify
    my $bin_signature = decode_base64($sig);

    if ($cert->key_alg_name eq 'id-ecPublicKey') {
        eval {require Crypt::PK::ECC; CryptX->VERSION('0.036'); 1}
        or confess "Crypt::PK::ECC 0.036+ needs to be installed so
             that we can handle ECDSA signatures";
        my $ecdsa_pub = Crypt::PK::ECC->new(\$cert->pubkey);

        my $ecdsa_hash = $self->{rsa_hash};

        # Signature is stored as the concatenation of r and s.
        # verify_message_rfc7518 expects that format
        if ($ecdsa_pub->verify_message_rfc7518( $bin_signature, $canonical, uc($self->{sig_hash}) )) {
            $self->{signer_cert} = $cert;
            return 1;
        }
    }
    elsif ($cert->key_alg_name eq 'dsaEncryption') {
        confess "Crypt::OpenSSL::DSA >= 0.20 needs to be installed so
                    that we can handle DSA X509 certificates" if ! $self->check_dsa_version();

        my $dsa_pub  = Crypt::OpenSSL::DSA->read_pub_key_str( $cert->pubkey );
        my $sig_size = ($dsa_pub->get_sig_size - 8)/2;
        #my ($r, $s) = unpack('a20a20', $bin_signature);
        my $unpk = "a" . $sig_size . "a" . $sig_size;
        my ($r, $s) = unpack($unpk, $bin_signature);

        # Create a new Signature Object from r and s
        my $sigobj = Crypt::OpenSSL::DSA::Signature->new();
        $sigobj->set_r($r);
        $sigobj->set_s($s);

        if ($dsa_pub->do_verify($self->{sig_method}->($canonical), $sigobj)) {
            $self->{signer_cert} = $cert;

lib/XML/Sig.pm  view on Meta::CPAN

##
## Returns: croak if unable to load Crypt::OpenSSL::DSA
##
## Verify that Crypt::OpenSSL::DSA is installed
##
sub _assert_dsa_installed {
    my $self = shift;
    try {
        require Crypt::OpenSSL::DSA;
    } catch {
        croak "Crypt::OpenSSL::DSA is not installed";
    };
}

##
## check_dsa_version
##
## Arguments:
##
## Returns: integer (1 True, 0 False) if Correct version of Crypt::OpenSSL::DSA is installed
##
## Verify the required Crypt::OpenSSL::DSA is installed
##
sub check_dsa_version {
    my $self = shift;
    my $ver;
    try {
        XML::Sig::_assert_dsa_installed;
        $ver = Crypt::OpenSSL::DSA->VERSION;
    } catch {
        return 0;
    };

    if ( (!defined $ver) || (version->parse($ver) lt version->parse('0.20')) ){
        return 0;
    }
    return 1;
}

##
## _verify_dsa($context,$canonical,$sig)
##
## Arguments:
##    $context:     string XML Context to use
##    $canonical:   string Canonical XML to verify
##    $sig:         string Base64 encode 40 byte string of r and s
##
## Returns: integer (1 True, 0 False) if signature is valid
##
## Verify the DSA signature of Canonical XML
##
sub _verify_dsa {
    my $self = shift;
    my ($context,$canonical,$sig) = @_;


    confess "Crypt::OpenSSL::DSA >= 0.20 needs to be installed so
                    that we can handle DSA signatures" if ! $self->check_dsa_version();

    # Generate Public Key from XML
    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);
    $dsa_pub->set_g($g);
    $dsa_pub->set_pub_key($y);

    # Decode signature and verify
    my $bin_signature = decode_base64($sig);

    # https://www.w3.org/TR/2002/REC-xmldsig-core-20020212/#sec-SignatureAlg
    # The output of the DSA algorithm consists of a pair of integers
    # The signature value consists of the base64 encoding of the
    # concatenation of r and s in that order ($r . $s)
    # Binary Signature is stored as a concatenation of r and s
    my $sig_size = ($dsa_pub->get_sig_size - 8)/2;
    my $unpk = "a" . $sig_size . "a" . $sig_size;
    my ($r, $s) = unpack($unpk, $bin_signature);

    # Create a new Signature Object from r and s
    my $sigobj = Crypt::OpenSSL::DSA::Signature->new();
    $sigobj->set_r($r);
    $sigobj->set_s($s);

    # DSA signatures are limited to a message body of 20 characters, so a sha1 digest is taken
    return 1 if ($dsa_pub->do_verify( $self->{sig_method}->($canonical),  $sigobj ));
    return 0;
}

##
## _verify_ecdsa($context,$canonical,$sig)
##
## Arguments:
##    $context:     string XML Context to use
##    $canonical:   string Canonical XML to verify
##    $sig:         string Base64 encoded
##
## Returns: integer (1 True, 0 False) if signature is valid
##
## Verify the ECDSA signature of Canonical XML
##
sub _verify_ecdsa {
    my $self = shift;
    my ($context,$canonical,$sig) = @_;

    eval {require Crypt::PK::ECC; CryptX->VERSION('0.036'); 1}
    or confess "Crypt::PK::ECC 0.036+ needs to be installed so
             that we can handle ECDSA signatures";
    # Generate Public Key from XML
    my $oid = _trim($self->{parser}->findvalue('.//dsig:NamedCurve/@URN', $context));

    use URI ();
    my $u1 = URI->new($oid);
    $oid = $u1->nss;

    my %curve_name = (
        '1.2.840.10045.3.1.1'   => 'secp192r1',
        '1.3.132.0.33'          => 'secp224r1',
        '1.2.840.10045.3.1.7'   => 'secp256r1',
        '1.3.132.0.34'          => 'secp384r1',
        '1.3.132.0.35'          => 'secp521r1',
        '1.3.36.3.3.2.8.1.1.1'  => 'brainpoolP160r1',
        '1.3.36.3.3.2.8.1.1.3'  => 'brainpoolP192r1',
        '1.3.36.3.3.2.8.1.1.5'  => 'brainpoolP224r1',
        '1.3.36.3.3.2.8.1.1.7'  => 'brainpoolP256r1',
        '1.3.36.3.3.2.8.1.1.9'  => 'brainpoolP320r1',
        '1.3.36.3.3.2.8.1.1.11' => 'brainpoolP384r1',
        '1.3.36.3.3.2.8.1.1.13' => 'brainpoolP512r1',
    );

    my $x = $self->{parser}->findvalue('.//dsig:PublicKey/dsig:X/@Value', $context);
    my $y = $self->{parser}->findvalue('.//dsig:PublicKey/dsig:Y/@Value', $context);

    my $ecdsa_pub = Crypt::PK::ECC->new();

    $ecdsa_pub->import_key({
        kty => "EC",
        curve_name => $curve_name{ $oid },
        pub_x   => $x,
        pub_y   => $y,
    });

    my $bin_signature = decode_base64($sig);

    # verify_message_rfc7518 is used to verify signature stored as a
    # concatenation of integers r and s
    return 1 if ($ecdsa_pub->verify_message_rfc7518(
                    $bin_signature,
                    $canonical,
                    uc($self->{sig_hash}))
                );
    return 0;
}

##
## _verify_hmac($canonical, $sig)
##
## Arguments:
##    $canonical:   string Canonical XML to verify
##    $sig:         string Base64 encode of HMAC Signature
##
## Returns: integer (1 True, 0 False) if signature is valid
##
## Verify the HMAC signature of Canonical XML
##
sub _verify_hmac {
    my $self = shift;
    my ($canonical, $sig) = @_;

    # Decode signature and verify
    my $bin_signature = decode_base64($sig);
    use Crypt::Mac::HMAC qw( hmac );
    if ( defined $self->{ hmac_key } ) {
        print ("    Verifying SignedInfo using hmac-", $self->{ sig_hash }, "\n") if $DEBUG;
        if ( my $ref = Digest::SHA->can('hmac_' . $self->{ sig_hash }) ) {
            if ($bin_signature eq $self->_calc_hmac_signature( $canonical )) {
                return 1;
            }
            else {
                return 0;
            }
        }
        elsif ( $ref = Crypt::Digest::RIPEMD160->can($self->{ sig_hash })) {
            if ($bin_signature eq $self->_calc_hmac_signature( $canonical )) {
                return 1;
            }
            else {
                return 0;
            }
        }
        else {
            die("Can't handle $self->{ sig_hash }");

lib/XML/Sig.pm  view on Meta::CPAN

    my $nodeset;
    if ($context) {
         $nodeset = $self->{parser}->find($xpath, $context);
    } else {
         $nodeset = $self->{parser}->find($xpath);
    }
    foreach my $node ($nodeset->get_nodelist) {
        return $node;
    }
}

##
## _trim($string)
##
## Arguments:
##    $string:      string String to remove whitespace
##
## Returns: string  Trimmed String
##
## Trim the whitespace from the begining and end of the string
##
sub _trim {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

##
## _load_ecdsa_key($key_text)
##
## Arguments:
##    $key_text:    string ECDSA Private Key as String
##
## Returns: nothing
##
## Populate:
##   self->{KeyInfo}
##   self->{key_obj}
##   self->{key_type}
##
sub _load_ecdsa_key {
    my $self = shift;
    my $key_text = shift;

    eval {require Crypt::PK::ECC; CryptX->VERSION('0.036'); 1}
    or confess "Crypt::PK::ECC 0.036+ needs to be installed so
             that we can handle ECDSA signatures";

    my $ecdsa_key = Crypt::PK::ECC->new(\$key_text);

    if ( $ecdsa_key ) {
        $self->{ key_obj } = $ecdsa_key;

        my $key_hash    = $ecdsa_key->key2hash;

        my $oid         = $key_hash->{ curve_oid };
        my $x           = $key_hash->{ pub_x };
        my $y           = $key_hash->{ pub_y };

        $self->{KeyInfo} = "<dsig:KeyInfo>
                             <dsig:KeyValue>
                                <dsig:ECDSAKeyValue>
                                    <dsig:DomainParameters>
                                        <dsig:NamedCurve URN=\"urn:oid:$oid\" />
                                    </dsig:DomainParameters>
                                    <dsig:PublicKey>
                                        <dsig:X Value=\"$x\" />
                                        <dsig:Y Value=\"$y\" />
                                    </dsig:PublicKey>
                                </dsig:ECDSAKeyValue>
                             </dsig:KeyValue>
                            </dsig:KeyInfo>";
        $self->{key_type} = 'ecdsa';
    }
    else {
        confess "did not get a new Crypt::PK::ECC object";
    }
}

##
## _load_dsa_key($key_text)
##
## Arguments:
##    $key_text:    string DSA Private Key as String
##
## Returns: nothing
##
## Populate:
##   self->{KeyInfo}
##   self->{key_obj}
##   self->{key_type}
##
sub _load_dsa_key {
    my $self = shift;
    my $key_text = shift;

    confess "Crypt::OpenSSL::DSA >= 0.20 needs to be installed so that we can handle DSA keys."
        if ! $self->check_dsa_version();

    my $dsa_key = Crypt::OpenSSL::DSA->read_priv_key_str( $key_text );

    if ( $dsa_key ) {
        $self->{ key_obj } = $dsa_key;
        my $g = encode_base64( $dsa_key->get_g(), '' );
        my $p = encode_base64( $dsa_key->get_p(), '' );
        my $q = encode_base64( $dsa_key->get_q(), '' );
        my $y = encode_base64( $dsa_key->get_pub_key(), '' );

        $self->{KeyInfo} = "<dsig:KeyInfo>
                             <dsig:KeyValue>
                              <dsig:DSAKeyValue>
                               <dsig:P>$p</dsig:P>
                               <dsig:Q>$q</dsig:Q>
                               <dsig:G>$g</dsig:G>
                               <dsig:Y>$y</dsig:Y>
                              </dsig:DSAKeyValue>
                             </dsig:KeyValue>
                            </dsig:KeyInfo>";
        $self->{key_type} = 'dsa';
    }
    else {
        confess "did not get a new Crypt::PK::RSA object";
    }
}

##
## _load_rsa_key($key_text)
##
## Arguments:
##    $key_text:    string RSA Private Key as String
##
## Returns: nothing
##
## Populate:
##   self->{KeyInfo}
##   self->{key_obj}
##   self->{key_type}
##
sub _load_rsa_key {
    my $self = shift;
    my ($key_text) = @_;

    eval {
        require Crypt::PK::RSA;
    };
    confess "Crypt::PK::RSA needs to be installed so that we can handle RSA keys." if $@;

    my $pk = Crypt::PK::RSA->new();
    my $rsaKey = $pk->import_key(\$key_text);

    if ( $rsaKey ) {
        $self->{ key_obj }  = $rsaKey;
        $self->{ key_type } = 'rsa';

        if (!$self->{ x509 }) {
            my $key_params = $rsaKey->key2hash;
            my $exp = encode_base64(pack("H*", $key_params->{e}), '');
            my $mod = encode_base64(pack("H*", $key_params->{N}), '');
            $self->{KeyInfo} = "<dsig:KeyInfo>
                                 <dsig:KeyValue>
                                  <dsig:RSAKeyValue>
                                   <dsig:Modulus>$mod</dsig:Modulus>
                                   <dsig:Exponent>$exp</dsig:Exponent>
                                  </dsig:RSAKeyValue>
                                 </dsig:KeyValue>
                                </dsig:KeyInfo>";
        }
    }
    else {
        confess "did not get a new Crypt::PK::RSA object";
    }
}

##
## _load_hmac_key_info()
##
## Arguments:
##    none
##
## Returns: nothing
##
## Populate:
##   self->{KeyInfo}
##
sub _load_hmac_key_info {
    my $self = shift;

    if (! defined $self->{ key_name }) {
        return;
    }

    $self->{KeyInfo} = qq{<dsig:KeyInfo><dsig:KeyName>$self->{key_name}</dsig:KeyName></dsig:KeyInfo>};
}

##
## _load_x509_key($key_text)
##
## Arguments:
##    $key_text:    string RSA Private Key as String
##
## Returns: nothing
##
## Populate:
##   self->{key_obj}
##   self->{key_type}
##
sub _load_x509_key {
    my $self = shift;
    my $key_text = shift;

    eval {
        require Crypt::OpenSSL::X509;
    };
    confess "Crypt::OpenSSL::X509 needs to be installed so that we
            can handle X509 Certificates." if $@;

    my $x509Key = Crypt::OpenSSL::X509->new_private_key( $key_text );

    if ( $x509Key ) {
        $x509Key->use_pkcs1_oaep_padding();
        $self->{ key_obj } = $x509Key;
        $self->{key_type} = 'x509';
    }
    else {
        confess "did not get a new Crypt::OpenSSL::X509 object";
    }
}

##
## _load_cert_file()
##
## Arguments: none
##
## Returns: nothing
##
## Read the file name from $self->{ cert } and
## Populate:
##   self->{key_obj}
##   $self->{KeyInfo}
##
sub _load_cert_file {
    my $self = shift;

    eval {
        require Crypt::OpenSSL::X509;
    };

    confess "Crypt::OpenSSL::X509 needs to be installed so that we can handle X509 certs." if $@;

    my $file = $self->{ cert };
    if ( open my $CERT, '<', "$file" ) {
        my $text = '';
        local $/ = undef;
        $text = <$CERT>;
        close $CERT;

        my $cert = Crypt::OpenSSL::X509->new_from_string($text);
        if ( $cert ) {
            $self->{ cert_obj } = $cert;
            my $cert_text = $cert->as_string;
            $cert_text =~ s/-----[^-]*-----//gm;
            $self->{KeyInfo} = "<dsig:KeyInfo><dsig:X509Data><dsig:X509Certificate>\n"._trim($cert_text)."\n</dsig:X509Certificate></dsig:X509Data></dsig:KeyInfo>";
        }
        else {
            confess "Could not load certificate from $file";
        }
    }
    else {
        confess "Could not find certificate file $file";
    }

    return;
}

##
## _load_cert_text()
##
## Arguments: none
##
## Returns: nothing
##
## Read the certificate from $self->{ cert_text } and
## Populate:
##   self->{key_obj}
##   $self->{KeyInfo}
##
sub _load_cert_text {
    my $self = shift;

    eval {
        require Crypt::OpenSSL::X509;
    };

    confess "Crypt::OpenSSL::X509 needs to be installed so that we can handle X509 certs." if $@;

    my $text = $self->{ cert_text };
    my $cert = Crypt::OpenSSL::X509->new_from_string($text);
    if ( $cert ) {
        $self->{ cert_obj } = $cert;
        my $cert_text = $cert->as_string;
        $cert_text =~ s/-----[^-]*-----//gm;
        $self->{KeyInfo} = "<dsig:KeyInfo><dsig:X509Data><dsig:X509Certificate>\n"._trim($cert_text)."\n</dsig:X509Certificate></dsig:X509Data></dsig:KeyInfo>";
    }
    else {
            confess "Could not load certificate from given text.";
    }

    return;
}

##
## _load_key($file)
##
## Arguments: $self->{ key }
##
## Returns: nothing
##
## Load the key and process it acording to its headers
##
sub _load_key {
    my $self = shift;
    my $file = $self->{ key };

    if ( open my $KEY, '<', "$file" ) {
        my $text = '';
        local $/ = undef;
        $text = <$KEY>;
        close $KEY;

        if ( $text =~ m/BEGIN ([DR]SA) PRIVATE KEY/ ) {
            my $key_used = $1;

            if ( $key_used eq 'RSA' ) {
                $self->_load_rsa_key( $text );
            }
            else {
                $self->_load_dsa_key( $text );
            }

            return 1;
        } elsif ( $text =~ m/BEGIN EC PRIVATE KEY/ ) {
            $self->_load_ecdsa_key( $text );
        } elsif ( $text =~ m/BEGIN PRIVATE KEY/ ) {
            $self->_load_rsa_key( $text );
        } elsif ($text =~ m/BEGIN CERTIFICATE/) {
            $self->_load_x509_key( $text );
        }
        else {
            confess "Could not detect type of key $file.";
        }
    }
    else {
        confess "Could not load key $file: $!";
    }

    return;
}

##
## _signature_xml($signed_info,$signature_value)
##
## Arguments:
##   $signed_info:      string XML String Fragment
##   $signature_value   String Base64 Signature Value
##
## Returns: string      XML fragment
##
## Create a XML string of the Signature
##
sub _signature_xml {
    my $self = shift;
    my ($signed_info,$signature_value) = @_;

    return qq{<dsig:Signature xmlns:dsig="http://www.w3.org/2000/09/xmldsig#">
            $signed_info
            <dsig:SignatureValue>$signature_value</dsig:SignatureValue>
            $self->{KeyInfo}
        </dsig:Signature>};
}

##
## _signedinfo_xml($digest_xml)
##
## Arguments:
##   $digest_xml        string XML String Fragment
##
## Returns: string      XML fragment
##
## Create a XML string of the SignedInfo
##
sub _signedinfo_xml {
    my $self = shift;
    my ($digest_xml) = @_;

    my $algorithm;
    if (! defined $self->{key_type} && defined $self->{ hmac_key } ) {
        $self->{key_type} = 'hmac';
    }

    if ( $self->{ sig_hash } eq 'sha1' && $self->{key_type} ne 'ecdsa' ) {
        $algorithm = "http://www.w3.org/2000/09/xmldsig#$self->{key_type}-$self->{ sig_hash }";
    }
    elsif ( $self->{key_type} eq 'ecdsa' ) {
        if ( $self->{ sig_hash } eq 'ripemd160' || $self->{ sig_hash } eq  'whirlpool' ) {
            $algorithm = "http://www.w3.org/2007/05/xmldsig-more#$self->{key_type}-$self->{ sig_hash }";
        }
        else {
            $algorithm = "http://www.w3.org/2001/04/xmldsig-more#$self->{key_type}-$self->{ sig_hash }";
        }
    }
    elsif ( $self->{ key_type } eq 'dsa' && $self->{ sig_hash } eq 'sha256') {
        $algorithm = "http://www.w3.org/2009/xmldsig11#$self->{key_type}-$self->{ sig_hash }";
    }
    else {
        $algorithm = "http://www.w3.org/2001/04/xmldsig-more#$self->{key_type}-$self->{ sig_hash }";
    }

    #return qq{<dsig:SignedInfo xmlns:dsig="http://www.w3.org/2000/09/xmldsig#">
    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/2001/10/xml-exc-c14n#" />
                <dsig:SignatureMethod Algorithm="$algorithm" />
                $digest_xml
            </dsig:SignedInfo>};
}

##
## _reference_xml($id)
##
## Arguments:
##   $id        string XML ID related to the URI
##   $digest    string Base64 encoded digest
##
## Returns: string      XML fragment
##
## Create a XML string of the Reference
##
sub _reference_xml {
    my $self = shift;
    my $id = shift;
    my ($digest) = @_;

    my $algorithm;
    if ( $self->{ digest_hash } eq 'sha1') {
        $algorithm = "http://www.w3.org/2000/09/xmldsig#$self->{ digest_hash }";
    }
    elsif (($self->{ digest_hash } eq 'sha224') || ($self->{ digest_hash } eq 'sha384')) {
        $algorithm = "http://www.w3.org/2001/04/xmldsig-more#$self->{ digest_hash }";
    }
    else {
        $algorithm = "http://www.w3.org/2001/04/xmlenc#$self->{ digest_hash }";
    }

    return qq{<dsig:Reference URI="#$id">
                        <dsig:Transforms>
                            <dsig:Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
                            <dsig:Transform Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#"/>
                        </dsig:Transforms>
                        <dsig:DigestMethod Algorithm="$algorithm" />
                        <dsig:DigestValue>$digest</dsig:DigestValue>
                    </dsig:Reference>};
}


##
## _canonicalize_xml($xml, $context)
##
## Arguments:
##    $xml:     string XML NodeSet
##    $context: string XML Context
##
## Returns: string  Canonical XML
##
## Canonicalizes xml based on the CanonicalizationMethod
## from the SignedInfo.
##
sub _canonicalize_xml {
    my $self = shift;
    my ($xml, $context) = @_;

    print ("_canonicalize_xml:\n") if $DEBUG;
    my $canon_method = $self->{ parser }->findnodes(
                'dsig:SignedInfo/dsig:CanonicalizationMethod', $context
    );

    foreach my $node ($canon_method->get_nodelist) {
        my $alg = $node->getAttribute('Algorithm');

        print ("    Canon Method: $alg\n") if $DEBUG;
        if ($alg eq TRANSFORM_C14N) {
           print ("        toStringC14N\n") if $DEBUG;
           $xml = $xml->toStringC14N();
        }
        elsif ($alg eq TRANSFORM_C14N_COMMENTS) {
            print ("        toStringC14N_Comments\n") if $DEBUG;
            $xml = $xml->toStringC14N(1);
        }
        elsif ($alg eq TRANSFORM_C14N_V1_1) {
           print ("        toStringC14N_v1_1\n") if $DEBUG;
           $xml = $xml->toStringC14N_v1_1();
        }
        elsif ($alg eq TRANSFORM_C14N_V1_1_COMMENTS) {
            print ("        toStringC14N_v1_1_Comments\n") if $DEBUG;
            $xml = $xml->toStringC14N_v1_1(1);
        }
        elsif ($alg eq TRANSFORM_EXC_C14N) {
            print ("        toStringEC14N\n") if $DEBUG;
            $xml = $xml->toStringEC14N();
        }
        elsif ($alg eq TRANSFORM_EXC_C14N_COMMENTS) {
            print ("        toStringEC14N_Comments\n") if $DEBUG;
            $xml = $xml->toStringEC14N(1);
        }
        else {
            die "Unsupported transform: $alg";
        }
    }
    return $xml;
}

##
## _calc_dsa_signature($signed_info_canon)
##
## Arguments:
##    $canonical:     string Canonical XML
##
## Returns: string  Signature
##
## Calculates signature based on the method and hash
##
sub _calc_dsa_signature {
    my $self                = shift;
    my $signed_info_canon   = shift;

    print ("    Signing SignedInfo using DSA key type\n") if $DEBUG;
    if(my $ref = Digest::SHA->can($self->{ sig_hash })) {
        $self->{sig_method} = $ref;
    }
    elsif ( $ref = Crypt::Digest::RIPEMD160->can($self->{ sig_hash }))  {
        $self->{sig_method} = $ref;
    }
    else {
        die("Can't handle $self->{ sig_hash }");
    }

    # DSA 1024-bit only permits the signing of 20 bytes or less, hence the sha1
    # DSA 2048-bit only permits the signing sha256
    my $bin_signature = $self->{key_obj}->do_sign( $self->{ sig_method }($signed_info_canon) );

    # https://www.w3.org/TR/2002/REC-xmldsig-core-20020212/#sec-SignatureAlg
    # The output of the DSA algorithm consists of a pair of integers
    # The signature value consists of the base64 encoding of the
    # concatenation of r and s in that order ($r . $s)
    my $r = $bin_signature->get_r;
    my $s = $bin_signature->get_s;

    my $sig_size = ($self->{key_obj}->get_sig_size - 8) * 8;
    my $rs = _zero_fill_buffer($sig_size);
    _concat_dsa_sig_r_s(\$rs, $r, $s, $sig_size);

    return $rs;

}

##
## _calc_ecdsa_signature($signed_info_canon)
##
## Arguments:
##    $canonical:     string Canonical XML
##
## Returns: string  Signature
##
## Calculates signature based on the method and hash
##
sub _calc_ecdsa_signature {
    my $self                = shift;
    my $signed_info_canon   = shift;

    print ("    Signing SignedInfo using ECDSA key type\n") if $DEBUG;

    my $bin_signature = $self->{key_obj}->sign_message_rfc7518(
        $signed_info_canon, uc($self->{sig_hash})
    );
    # The output of the ECDSA algorithm consists of a pair of integers
    # The signature value consists of the base64 encoding of the
    # concatenation of r and s in that order ($r . $s).  In this
    # case sign_message_rfc7518 produces that
    return $bin_signature;
}

##
## _calc_rsa_signature($signed_info_canon)
##
## Arguments:
##    $canonical:     string Canonical XML
##
## Returns: string  Signature
##
## Calculates signature based on the method and hash
##
sub _calc_rsa_signature {
    my $self                = shift;
    my $signed_info_canon   = shift;

    print ("    Signing SignedInfo using RSA key type\n") if $DEBUG;
    my $bin_signature = $self->{key_obj}->sign_message( $signed_info_canon, $self->{sig_hash}, 'v1.5' );

    return $bin_signature;
}

lib/XML/Sig.pm  view on Meta::CPAN


Verify the required Crypt::OpenSSL::DSA is installed

Arguments: none

Returns: integer (1 True, 0 False) if a valid version of
Crypt::OpenSSL::DSA is installed

=head1 ABOUT DIGITAL SIGNATURES

Just as one might want to send an email message that is cryptographically signed
in order to give the recipient the means to independently verify who sent the email,
one might also want to sign an XML document. This is especially true in the
scenario where an XML document is received in an otherwise unauthenticated
context, e.g. SAML.

However XML provides a challenge that email does not. In XML, two documents can be
byte-wise inequivalent, and semanticaly equivalent at the same time. For example:

    <?xml version="1.0"?>
    <foo>
      <bar />
    </foo>

    And:

    <?xml version="1.0"?>
    <foo>
      <bar></bar>
    </foo>

Each of these document express the same thing, or in other words they "mean"
the same thing. However if you were to strictly sign the raw text of these
documents, they would each produce different signatures.

XML Signatures on the other hand will produce the same signature for each of
the documents above. Therefore an XML document can be written and rewritten by
different parties and still be able to have someone at the end of the line
verify a signature the document may contain.

There is a specially subscribed methodology for how this process should be
executed and involves transforming the XML into its canonical form so a
signature can be reliably inserted or extracted for verification. This
module implements that process.

=head2 EXAMPLE SIGNATURE

Below is a sample XML signature to give you some sense of what they look like.
First let's look at the original XML document, prior to being signed:

  <?xml version="1.0"?>
  <foo ID="abc">
    <bar>123</bar>
  </foo>

Now, let's insert a signature:

  <?xml version="1.0"?>
  <foo ID="abc">
    <bar>123</bar>
    <Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
      <SignedInfo xmlns="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#">
        <CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315#WithComments" />
        <SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" />
        <Reference URI="#abc">
          <Transforms>
            <Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
          </Transforms>
          <DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" />
          <DigestValue>9kpmrvv3peVJpNSTRycrV+jeHVY=</DigestValue>
        </Reference>
      </SignedInfo>
      <SignatureValue>
        HXUBnMgPJf//j4ihaWnaylNwAR5AzDFY83HljFIlLmTqX1w1C72ZTuRObvYve8TNEbVsQlTQkj4R
        hiY0pgIMQUb75GLYFtc+f0YmBZf5rCWY3NWzo432D3ogAvpEzYXEQPmicWe2QozQhybaz9/wrYki
        XiXY+57fqCkf7aT8Bb6G+fn7Aj8gnZFLkmKxwCdyGsIZOIZdQ8MWpeQrifxBR0d8W1Zm6ix21WNv
        ONt575h7VxLKw8BDhNPS0p8CS3hOnSk29stpiDMCHFPxAwrbKVL1kGDLaLZn1q8nNRmH8oFxG15l
        UmS3JXDZAss8gZhU7g9T4XllCqjrAvzPLOFdeQ==
      </SignatureValue>
      <KeyInfo>
        <KeyValue>
          <RSAKeyValue>
            <Modulus>
              1b+m37u3Xyawh2ArV8txLei251p03CXbkVuWaJu9C8eHy1pu87bcthi+T5WdlCPKD7KGtkKn9vq
              i4BJBZcG/Y10e8KWVlXDLg9gibN5hb0Agae3i1cCJTqqnQ0Ka8w1XABtbxTimS1B0aO1zYW6d+U
              Yl0xIeAOPsGMfWeu1NgLChZQton1/NrJsKwzMaQy1VI8m4gUleit9Z8mbz9bNMshdgYEZ9oC4bH
              n/SnA4FvQl1fjWyTpzL/aWF/bEzS6Qd8IBk7yhcWRJAGdXTWtwiX4mXb4h/2sdrSNvyOsd/shCf
              OSMsf0TX+OdlbH079AsxOwoUjlzjuKdCiFPdU6yAJw==
            </Modulus>
            <Exponent>Iw==</Exponent>
          </RSAKeyValue>
        </KeyValue>
      </KeyInfo>
    </Signature>
  </foo>

=head1 SEE ALSO

L<http://www.w3.org/TR/xmldsig-core/>

=head1 VERSION CONTROL

L<https://github.com/perl-net-saml2/perl-XML-Sig>

=head1 AUTHORS and CREDITS

Author: Byrne Reese <byrne@majordojo.com>

Thanks to Manni Heumann who wrote Google::SAML::Response from
which this module borrows heavily in order to create digital
signatures.

Net::SAML2 embedded version amended by Chris Andrews <chris@nodnol.org>.

Maintainer: Timothy Legge <timlegge@cpan.org>

=head1 AUTHOR

Timothy Legge <timlegge@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2026 by Byrne Reese, Chris Andrews and Others; in detail:

  Copyright 2009       Byrne, Michael Hendricks
            2010       Chris Andrews
            2011       Chris Andrews, Oskari Okko Ojala
            2012       Chris Andrews, Peter Marschall
            2015       Mike Wisener
            2016       Jeff Fearn
            2017       Mike Wisener, xmikew
            2019-2021  Timothy Legge
            2022-2023  Timothy Legge, Wesley Schwengle
            2025-2026  Timothy Legge


This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__

}



( run in 0.651 second using v1.01-cache-2.11-cpan-71847e10f99 )