view release on metacpan or  search on metacpan

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

=head1 NAME

XML::Sig::OO - Modern XML Signatured validation

=head1 SYNOPSIS

  use XML::Sig::OO;

  # Sign our xml
  my $s=new XML::Sig::OO(
    xml=>'<?xml version="1.0" standalone="yes"?><data><test ID="A" /><test ID="B" /></data>',
    key_file=>'rsa_key.pem'
    cert_file=>'cert.pem',
  );
  my $result=$s->sign;
  die "Failed to sign the xml, error was: $result" unless $result;

  my $xml=$result->get_data;
  # Example checking a signature
  my $v=new XML::Sig::OO(xml=>$xml);

  # validate our xml
  my $result=$v->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");
    }
  }

=head1 DESCRIPTION

L<XML::Sig::OO> is a project to create a stand alone perl module that does a good job creating and validating xml signatures.  At its core  This module is written around libxml2 better known as L<XML::LibXML>.

=head1 Multiple signatures and keys

In the case of signing multiple //@ID elements, it is possible to sign each chunk with a different key, in fact you can even use completly different key types.

  use Modern::Perl;
  use XML::Sig::OO;
  use File::Spec;
  use FindBin qw($Bin);
  use Crypt::OpenSSL::DSA;
  use Crypt::OpenSSL::RSA;

  # create our signign object
  my $s=new XML::Sig::OO(
    xml=>'<?xml version="1.0" standalone="yes"?><data><test ID="A" /><test ID="B" /></data>',
  );

  my $x=$s->build_xpath;

  # sign our first xml chunk with our rsa key!
  my $rsa_str=join '',IO::File->new(File::Spec->catfile($Bin,'x509_key.pem'))->getlines;
  my $rsa=Crypt::OpenSSL::RSA->new_private_key($rsa_str);
  $rsa->use_pkcs1_padding();
  my $cert_str=join '',IO::File->new(File::Spec->catfile($Bin,'x509_cert.pem'))->getlines;
  $s->sign_cert($rsa);
  $s->key_type('rsa');
  $s->cert_string($cert_str);
  my $result=$s->sign_chunk($x,1);
  die $result unless $result;

  # Sign our 2nd chunk with our dsa key
  my $dsa = Crypt::OpenSSL::DSA->read_priv_key(File::Spec->catfile($Bin,'dsa_priv.pem'));
  $s->cert_string(undef);
  $s->sign_cert($dsa);
  $s->key_type('dsa');
  $result=$s->sign_chunk($x,2);
  die $result unless $result;

  my ($node)=$x->findnodes($s->xpath_Root);
  my $xml=$node->toString;

  print "Our Signed XML IS: \n",$xml,"\n";
  # Example checking a signature
  my $v=new XML::Sig::OO(xml=>$xml);

  $result=$v->validate;
  die $result unless $result;

  print "Our signed and xml passes validation\n";

=head2 Working with Net::SAML2

L<Net::SAML2> has many problems when it comes to signature validation of xml strings.  This section documents how to use this module in place of the Net::SAML2 built ins.

  use Net::SAML2::Protocol::Assertion;
  use XML::Sig::OO;
  use MIME::Base64;

  # Lets assume we have a post binding response
  my $saml_response=.....

  my $xml=decode_base64($saml_response);

  my $v=XML::Sig::OO->new(xml=>$xml,cacert=>'idp_cert.pem');
  my $result=$v->validate;
  die $result unless $result;

  # we can now use the asertion knowing it was from our idp
  my $assertion=Net::SAML2::Protocol::Assertion->new_from_xml(xml=>$xml)

=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=>'...'

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

=head2 my $result=$self->load_cert_from_file($filename)

Returns a Data::Result structure, when true it contains a hasref with the following elements:

  type: 'dsa|rsa|x509'
  cert: $cert_object

=cut

sub load_cert_from_file {
  my ($self,$file)=@_;
  return new_false Data::Result("file is not defined") unless defined($file);
  return new_false Data::Result("cannot read: $file") unless -r $file;

  my $io=IO::File->new($file,'r');
  return new_false Data::Result("Cannot open $file, error was $!") unless $io;
  my $text=join '',$io->getlines;
  return $self->detect_cert($text);
}

=head2 my $result=$self->detect_cert($text)

Returns a Data::Result object, when true it contains the following hashref

  type: 'dsa|rsa|x509'
  cert: $cert_object

=cut

sub detect_cert {
  my ($self,$text)=@_;
  if ($text =~ m/BEGIN ([DR]SA) PRIVATE KEY/s ) {

    if($1 eq 'RSA') {
      return $self->load_rsa_string($text);
    } else {
      return $self->load_dsa_string($text);
    }

  } elsif ( $text =~ m/BEGIN PRIVATE KEY/ ) {
    return $self->load_rsa_string($text); 
  } elsif ($text =~ m/BEGIN CERTIFICATE/) {
    return $self->load_x509_string($text);
  } else {
    return new_false Data::Result("Unsupported key type");
  }
}

=head2 my $result=$self->load_rsa_string($string)

Returns a Data::Result object, when true it contains the following hashref:

  type: 'rsa'
  cert: $cert_object

=cut

sub load_rsa_string {
  my ($self,$str)=@_;
  my $rsaKey = Crypt::OpenSSL::RSA->new_private_key( $str );
  return new_false Data::Result("Failed to parse rsa key") unless $rsaKey;
  #$rsaKey->use_pkcs1_padding();
  return new_true Data::Result({cert=>$rsaKey,type=>'rsa'});
}

=head2 my $result=$self->load_x509_string($string)

Returns a Data::Result object, when true it contains the following hashref:

  type: 'x509'
  cert: $cert_object

=cut

sub load_x509_string {
  my ($self,$str)=@_;
  my $x509Key = Crypt::OpenSSL::X509->new_from_string( $str );
  return new_false Data::Result("Failed to parse x509 cert") unless $x509Key;
  return new_true Data::Result({cert=>$x509Key,type=>'x509'});
}

=head2 my $result=$self->load_dsa_string($string)

Returns a Data::Result object, when true it contains the following hashref:

  type: 'dsa'
  cert: $cert_object

=cut

sub load_dsa_string {
  my ($self,$str)=@_;
  my $dsa_key = Crypt::OpenSSL::DSA->read_priv_key_str( $str );
  return new_false("Failed to parse dsa key") unless $dsa_key;
  return new_true Data::Result({cert=>$dsa_key,type=>'dsa'});
}

=head2 my $result=$self->get_xml_to_sign($xpath_object,$nth)

Returns a Data::Result object, when true it contains the xml object to sign.

=cut

sub get_xml_to_sign {
  my ($self,$x,$nth)=@_;
  my $xpath=$self->context($self->xpath_ToSign,$nth);
  my ($node)=$x->findnodes($xpath);

  return new_false Data::Result("Failed to find xml to sign in xpath: $xpath") unless defined($node);
  return new_true Data::Result($node);
}

=head2 my $result=$self->get_signer_id($xpath_object,$nth)

Returns a Data::Result object, when true it contains the id value

=cut

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