view release on metacpan or  search on metacpan

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

=head2 Encrypted keys

Although this package does not directly support encrypted keys, it is possible to use encrypted keys by loading and exporting them with the L<Crypt::PK::RSA> and L<Crypt::PK::DSA> packages.

=head1 Constructor options

=cut

=over 4

=item * xml=>'...'

The base xml string to validate or sign. This option is always required.

=cut

has xml=>(
  is=>'ro',
  isa=>Str,
  required=>1,
);

=item * cacert=>'/path/to/your/cacert.pem'

Optional, used to validate X509 certs.

=cut

has cacert=>(
  is=>'rw',
  isa=>sub { my ($f)=@_; croak "cacert must be a readable file" unless defined($f) && -r $f },
  required=>0,
  clearer=>1,
);

=item * nocacheck=>0|1

Turns off ca cert checking.. this may not always be possible!

=cut

has nocacheck=>(
  default=>0,
  is=>'rw',
  isa=>Bool,
);

=item * build_parser=>sub { return XML::LibXML->new() }

Callback that returns a new XML Parser

=cut

has build_parser=>(
  is=>'ro',
  isa=>CodeRef,
  default=>sub { sub { XML::LibXML->new() } },
);

=item * namespaces=>{ ds=>'http://www.w3.org/2000/09/xmldsig#', ec=>'http://www.w3.org/2001/10/xml-exc-c14n#'}

Contains the list of namespaces to set in our XML::LibXML::XPathContext object.

=cut

has namespaces=>(
  is=>'ro',
  isa=>HashRef,
  default=>sub {
    {
      ds=>'http://www.w3.org/2000/09/xmldsig#',
      ec=>'http://www.w3.org/2001/10/xml-exc-c14n#',
      samlp=>"urn:oasis:names:tc:SAML:2.0:protocol",
    }
  },
);

=item * digest_cbs=>{ ... }

Contains the digest callbacks.  The default handlers can be found in %XML::SIG::OO::DIGEST.

=cut

our %DIGEST=(
  'http://www.w3.org/2000/09/xmldsig#sha1'  => sub { my ($self,$content)=@_; $self->_get_digest(sha1 => $content) },
  'http://www.w3.org/2001/04/xmlenc#sha256' => sub { my ($self,$content)=@_; $self->_get_digest(sha256 => $content) },
  'http://www.w3.org/2001/04/xmlenc#sha512' => sub { my ($self,$content)=@_; $self->_get_digest(sha512 => $content) },
  'http://www.w3.org/2001/04/xmldsig-more#sha224' => sub { my ($self,$content)=@_; $self->_get_digest(sha224 => $content) },
  'http://www.w3.org/2001/04/xmldsig-more#sha384' => sub { my ($self,$content)=@_; $self->_get_digest(sha384 => $content) },
  'http://www.w3.org/2001/04/xmldsig-more#sha512' => sub { my ($self,$content)=@_; $self->_get_digest(sha512 => $content) },
  'http://www.w3.org/2001/04/xmldsig-more#sha1024' => sub { my ($self,$content)=@_; $self->_get_digest(sha1024 => $content) },
  'http://www.w3.org/2001/04/xmldsig-more#sha2048' => sub { my ($self,$content)=@_; $self->_get_digest(sha2048=> $content) },
  'http://www.w3.org/2001/04/xmldsig-more#sha3072' => sub { my ($self,$content)=@_; $self->_get_digest(sha3072=> $content) },
  'http://www.w3.org/2001/04/xmldsig-more#sha4096' => sub { my ($self,$content)=@_; $self->_get_digest(sha4096=> $content) },
);

=item * digest_method=>'http://www.w3.org/2000/09/xmldsig#sha1'

Sets the digest method to be used when signing xml

=cut

has digest_method=>(
  isa=>sub { exists $DIGEST{$_[0]} or croak "$_[0] is not a supported digest" },
  is=>'ro',
  default=>'http://www.w3.org/2000/09/xmldsig#sha1',
);

=item * key_type=>'rsa'

The signature method we will use

=cut

has key_type=>(
  isa=>sub { croak "unsuported key type: $_[0]" unless $_[0]=~ /^(?:dsa|rsa|x509)$/s },
  is=>'rw',
  required=>0,
  lazy=>1,
  default=>'x509',
);

has digest_cbs=>(
  isa=>HashRef,
  is=>'ro',
  default=>sub { return { %DIGEST} },
);

sub _get_digest {
  my ($self,$algo, $content) = @_;
  my $digest = Digest::SHA->can("${algo}_base64")->($content);
  while (length($digest) % 4) { $digest .= '='  }
  return $digest;
}

our %TUNE_CERT=(
  'http://www.w3.org/2000/09/xmldsig#dsa-sha1' => sub { _tune_cert(@_,'sha1') },
  'http://www.w3.org/2000/09/xmldsig#rsa-sha1' => sub { _tune_cert(@_,'sha1') },
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha224' => sub { _tune_cert(@_,'sha224') },
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha256' => sub { _tune_cert(@_,'sha256') },
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha384' => sub { _tune_cert(@_,'sha384') },
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha512' => sub { _tune_cert(@_,'sha512') },  
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha1024' => sub { _tune_cert(@_,'sha1024') },  
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha2048' => sub { _tune_cert(@_,'sha2048') },  
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha3072' => sub { _tune_cert(@_,'sha3072') },  
  'http://www.w3.org/2001/04/xmldsig-more#rsa-sha4096' => sub { _tune_cert(@_,'sha4096') },  
);

=item * signature_method=>'http://www.w3.org/2000/09/xmldsig#rsa-sha1'

Sets the signature method.

=cut

has signature_method=>(
  isa=>Str,
  is=>'ro',
  default=>'http://www.w3.org/2000/09/xmldsig#rsa-sha1',
);

sub _tune_cert {
  my ($self,$cert,$alg)=@_;

  my $method="use_${alg}_hash";

  if($cert->can($method)) {
    $cert->$method();
  }
}

=item * tune_cert_cbs=>{ ...}

A collection of callbacks to tune a certificate object for signing

=cut

has tune_cert_cbs=>(
  isa=>HashRef,
  is=>'ro',
  default=>sub {
    return {%TUNE_CERT}
  }
);

=item * mutate_cbs=>{....}

Transform and Canonization callbacks.  The default callbacks are defined in %XML::Sig::OO::MUTATE.

Callbacks are usied in the following context

  $cb->($self,$xpath_element);

=cut

sub _build_canon_coderef {
  my ($method,$comment)=@_;
  return sub {
    my ($self,$x,$node,$nth,$ec14n_inclusive_prefixes)=@_;

    if ($method eq "toStringEC14N")
    {
      return $node->$method($comment, undef, $ec14n_inclusive_prefixes);
    }
    else
    {
      return $node->$method($comment);
    }
  };
}

sub _envelope_transform {
  my ($self,$x,$node,$nth)=@_;

  my $xpath=$self->context($self->xpath_Signature,$nth);
  my ($target)=$x->findnodes($xpath,$node);
  $node->removeChild($target) if defined($target);
  return $node->toString;
}

our %MUTATE=(
  'http://www.w3.org/2000/09/xmldsig#enveloped-signature'=>\&_envelope_transform,
  'http://www.w3.org/TR/2001/REC-xml-c14n-20010315' => _build_canon_coderef('toStringC14N',0),
  'http://www.w3.org/TR/2001/REC-xml-c14n-20010315#WithComments' => _build_canon_coderef('toStringC14N',1),
  'http://www.w3.org/2006/12/xml-c14n11' => _build_canon_coderef('toStringC14N_v1_1',0),
  'http://www.w3.org/2006/12/xml-c14n11#WithComments' => _build_canon_coderef('toStringC14N_v1_1',1),
  'http://www.w3.org/2001/10/xml-exc-c14n#' => _build_canon_coderef('toStringEC14N',0),
  'http://www.w3.org/2001/10/xml-exc-c14n#WithComments' => _build_canon_coderef('toStringEC14N',1),
);

has mutate_cbs=>(
  isa=>HashRef,
  is=>'ro',
  default=>sub { return {%MUTATE} },
);

=back

=head2 Xpaths

The xpaths in this package are not hard coded, each xpath can be defined as an argument to the constructor.  Since xml can contain multiple elements with signatures or multiple id elements to sign, most xpaths are prefixed with the $nth signature

Some cases the xpaths are used in the following context:

  (/xpath)[$nth]

In special cases like finding a list of transforms or which key, signature, or digest:

  (//ds::Signature)[$nth]/xpath

=over 4

=item * xpath_SignatureValue=>//ds:SignatureValue

Xpath used to find the signature value.

=cut

has xpath_SignatureValue=>(
  isa=>Str,
  is=>'ro',
  default=>'//ds:SignatureValue',
);

=item * xpath_SignatureMethod=>'//ds:SignatureMethod/@Algorithm'

Xpath used to find the signature method algorithm.

=cut

has xpath_SignatureMethod=>(
  isa=>Str,
  is=>'ro',
  default=>'//ds:SignatureMethod/@Algorithm',
);

=item * xpath_CanonicalizationMethod=>'//ds:CanonicalizationMethod/@Algorithm'

Xpath used to find the list of canonicalization method(s).

=cut

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

  isa=>Str,
  default=>'/ds:KeyInfo/ds:KeyValue/ds:DSAKeyValue/ds:P',
);

=item * xpath_DSA_Q=>''

Xpath used to find DSA_Q.

=cut

has xpath_DSA_Q=>(
  is=>'ro',
  isa=>Str,
  default=>'/ds:KeyInfo/ds:KeyValue/ds:DSAKeyValue/ds:Q',
);

=item * xpath_DSA_G=>'/ds:KeyInfo/ds:KeyValue/ds:DSAKeyValue/ds:G'

Xpath used to find DSA_G.

=cut

has xpath_DSA_G=>(
  is=>'ro',
  isa=>Str,
  default=>'/ds:KeyInfo/ds:KeyValue/ds:DSAKeyValue/ds:G',
);

=item * xpath_DSA_Y=>'/ds:KeyInfo/ds:KeyValue/ds:DSAKeyValue/ds:Y'

Xpath used to find DSA_Y

=cut 

has xpath_DSA_Y=>(
  is=>'ro',
  isa=>Str,
  default=>'/ds:KeyInfo/ds:KeyValue/ds:DSAKeyValue/ds:Y',
);

=back

=head3 OO Signing Options

The following Signature options can be passed to the constructor object.

=over 4

=item * key_file=>'path/to/my.key'

Key file only used when signing.

=cut

has key_file=>(
  isa=>Str,
  required=>0,
  is=>'ro',
);

=item * envelope_method=>"http://www.w3.org/2000/09/xmldsig#enveloped-signature"

Sets the envelope method; This value most likely is the only valid value.

=cut

has envelope_method=>(
  isa=>Str,
  is=>'ro',
  default=>"http://www.w3.org/2000/09/xmldsig#enveloped-signature",
);

#=item * canon_method=>'http://www.w3.org/2001/10/xml-exc-c14n#'
=item * canon_method=>'http://www.w3.org/TR/2001/REC-xml-c14n-20010315#WithComments'

Sets the canonization method used when signing the code

=cut

has canon_method=>(
  isa=>Str,
  #default=>"http://www.w3.org/2001/10/xml-exc-c14n#",
  default=>"http://www.w3.org/TR/2001/REC-xml-c14n-20010315#WithComments",
  is=>'ro',
);

=item * tag_namespace=>'ds'

Default namespace of the tags being created.  This must be defined in $self->namespaces.

=cut

has tag_namespace=>(
  isa=>Str,
  default=>'ds',
  is=>'ro',
);

=item * sign_cert=>$cert_object

Optional: The Certificate object used to sign xml.  If this option is set it is recomended that you set the "key_type" option as well.

=cut

has sign_cert=>(
  isa=>Object,
  is=>'rw',
  required=>0,
  lazy=>1,
);

=item * cert_file=>'/path/to/cert.pem'

The path that contains the cert file used for signing.

=cut

has cert_file=>(
  isa=>sub {
    my ($file)=@_;
    croak "$file must be defined" unless defined($file);
    croak "$file must be readable" unless -r $file;
  },
  is=>'rw',
  required=>0,
  lazy=>1,
);

=item * cert_string=>undef

This optional argument lets you define the x509 pem text that will be used to generate the x509 portion of the xml.

=cut

has cert_string=>(
  is=>'rw',
  required=>0,
  lazy=>1,
);

=back

=cut

sub BUILD {
  my ($self)=@_;

  # sanity check dsa signature method
  croak 'dsa key types only work with signature_method: http://www.w3.org/2000/09/xmldsig#dsa-sha1'
    if $self->key_type eq 'dsa' && $self->signature_method ne 'http://www.w3.org/2000/09/xmldsig#dsa-sha1';


  croak "namespaces does not contain: ".$self->tag_namespace unless exists $self->namespaces->{$self->tag_namespace};
  croak $self->signature_method." is an unsupported signature method" unless exists $self->tune_cert_cbs->{$self->signature_method};
  if(defined($self->key_file) && !defined($self->sign_cert)) {
    my $result=$self->load_cert_from_file($self->key_file);
    croak $result unless $result;
    my ($key_type,$cert)=@{$result->get_data}{qw(type cert)};
    $self->sign_cert($cert);
    $self->key_type($key_type);
  }
}

=head1 OO Methods

=head2 my $xpath=$self->build_xpath(undef|$xml,{ns=>'url'}|undef);

Creates a new xpath object based on our current object state. 

=cut

sub build_xpath {
  my ($self,$xml,$ns)=@_;
  $xml=$self->xml unless defined($xml);
  $ns=$self->namespaces unless defined($ns);
  my $p=XML::LibXML->new(clean_namespaces=>1);
  my $dom = $p->parse_string( $xml);
  my $x=XML::LibXML::XPathContext->new($dom);
  while(my ($key,$value)=each %{$ns}) {
    $x->registerNs($key,$value);
  }
  return $x;
}

=head2 my $result=$self->validate;

Returns a Data::Result Object.  When true validation passed, when false it contains why validation failed.

A better use case would be this:

  my $result=$self->validate;

  if($result) {
    print "everything checks out\n";
  } else {
    foreach my $chunk (@{$result->get_data}) {
      my ($nth,$signature,$digest)=@{$chunk}{qw(nth signature digest)};

      print "Results for processing chunk $nth\n";
      print "Signature State: ".($signature ? "OK\n" : "Failed, error was $signature\n";
      print "Digest State: ".($digest ? "OK\n" : "Failed, error was $digest\n";
    }
  }

=cut

sub validate {
  my ($self)=@_;

  my $total=$self->build_xpath->findnodes($self->xpath_Signature)->size;