view release on metacpan or  search on metacpan

lib/XML/Compile/WSS/Signature.pm  view on Meta::CPAN

# Copyrights 2012-2025 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution XML-Compile-WSS-Signature.
# Meta-POD processed with OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package XML::Compile::WSS::Signature;{
our $VERSION = '2.04';
}

use base 'XML::Compile::WSS';

use warnings;
use strict;

use Log::Report 'xml-compile-wss-sig';

use XML::Compile::WSS::Util     qw/:wss11 :wsm10 :dsig :xtp10/;
use XML::Compile::WSS::SecToken ();
use XML::Compile::WSS::Sign     ();
use XML::Compile::WSS::KeyInfo  ();
use XML::Compile::WSS::SignedInfo ();

use XML::Compile::C14N::Util    qw/:c14n/;
use XML::Compile::C14N          ();

use Digest          ();
use XML::LibXML     ();
use File::Basename  qw/dirname/;
use File::Glob      qw/bsd_glob/;
use Scalar::Util    qw/blessed/;

my %prefixes =
  ( # ds=DSIG_NS already registered in ::WSS
    dsig11 => DSIG11_NS
  , dsp    => DSP_NS
  , dsigm  => DSIG_MORE_NS
  , xenc   => XENC_NS
  );

#use Data::Dumper;
#$Data::Dumper::Indent    = 1;
#$Data::Dumper::Quotekeys = 0;


sub init($)
{   my ($self, $args) = @_;
    my $wss_v = $args->{wss_version} ||= '1.1';

    $self->SUPER::init($args);

    my $signer  = delete $args->{signer} || {};
    blessed $signer || ref $signer
        or $signer  = +{ sign_method => $signer };           # pre 2.00

    $signer->{private_key} ||= delete $args->{private_key};  # pre 2.00
    $self->{XCWS_signer}   =
        XML::Compile::WSS::Sign->fromConfig(%$signer, wss => $self);

    my $si      = delete $args->{signed_info} || {};
    $si->{$_} ||= delete $args->{$_}
        for qw/digest_method cannon_method prefix_list/;     # pre 2.00

    $self->{XCWS_siginfo}  =
        XML::Compile::WSS::SignedInfo->fromConfig(%$si, wss => $self);

    my $ki      = delete $args->{key_info} || {};
    $ki->{publish_token} ||= delete $args->{publish_token};  # pre 2.00

    $self->{XCWS_keyinfo}  =
        XML::Compile::WSS::KeyInfo->fromConfig(%$ki, wss => $self);

    if(my $subsig = delete $args->{signature})
    {   $subsig->{sign_types} ||= [ 'wsse:SignatureType' ];
        $subsig->{sign_put}   ||= $args->{sign_put};
        $self->{XCWS_subsig} = (ref $self)
          ->new(wss_version => $wss_v, schema => $self->schema, %$subsig);
    }

    $self->{XCWS_token}    = $args->{token};
    $self->{XCWS_config}   = $args;  # the left-overs are for me
    $self;
}

#-----------------------------


sub keyInfo()    {shift->{XCWS_keyinfo}}
sub signedInfo() {shift->{XCWS_siginfo}}
sub signer()     {shift->{XCWS_signer}}

#-----------------------------


sub token()       {shift->{XCWS_token}}
sub remoteToken() {shift->{XCWS_rem_token}}

lib/XML/Compile/WSS/Signature.pm  view on Meta::CPAN

              # Above two lines do add a xmlns:wsu per Id.
          }

          push @elems_to_sign, $xml;
          $xml;
        }
      );

    my $sign_put  = $config->{sign_put}  or panic;
    my $sign_when = $config->{sign_when} || $sign_put;

    my $enveloped = grep $sign_put eq $_, @sign_types;
    if($enveloped)
    {   # The Signature element is required in the enveloped element,
        # but can only be created after the element has been produced.  This
        # is a chicken-egg situation.  Gladly, XML::Compile does not check
        # the kind of node which get's produced, so we can put in an empty
        # text-node which gets ignored.
        $schema->addHook
          ( action => 'WRITER', type => 'ds:SignatureType'
          , replace => sub { $_[0]->createTextNode('') }
          );
    }

    my $add_signature = $self->builder(enveloped => $enveloped);

    my $container;
    $schema->addHook
      ( action => 'WRITER'
      , type   => $sign_put
      , after  => sub {
          my ($doc, $xml) = @_;
#warn "Located signature container";
#         $schema->prefixFor(WSU_10);
          $container = $xml;
        }
      );

    $schema->addHook
      ( action => 'WRITER'
      , type   => $sign_when
      , after  => sub {
          my ($doc, $xml) = @_;
#warn "Creating signature";
          $add_signature->($doc, \@elems_to_sign, $container);
          @elems_to_sign = ();
          $xml;
        }
      );

    $self;
}

sub loadSchemas($$)
{   my ($self, $schema, $version) = @_;
    return if $schema->{XCWS_sig_loaded}++;

    $self->SUPER::loadSchemas($schema, $version);

    my $xsddir = dirname __FILE__;
    trace "loading wss-dsig schemas from $xsddir/(dsig|encr)/*.xsd";

    my @xsds   =
      ( bsd_glob("$xsddir/dsig/*.xsd")
      , bsd_glob("$xsddir/encr/*.xsd")
      );

    $schema->addPrefixes(\%prefixes);
    my $prefixes = join ',', sort keys %prefixes;
    $schema->addKeyRewrite("PREFIXED($prefixes)");

    $schema->importDefinitions(\@xsds);
    $schema;
}

1;