view release on metacpan or  search on metacpan

lib/XML/Compile/WSS/SignedInfo.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::SignedInfo;{
our $VERSION = '2.04';
}


use warnings;
use strict;

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

use Digest::SHA              ();
use XML::Compile::C14N;
use XML::Compile::Util       qw/type_of_node/;
use XML::Compile::WSS::Util  qw/:wss11 :dsig/;
use XML::Compile::C14N::Util qw/:c14n is_canon_constant/;

# Quite some problems to get canonicalization compatible between
# client and server.  Especially where some xmlns's are optional.
# It may help to enforce some namespaces via $wsdl->prefixFor($ns)
my @default_canon_ns = qw(SOAP-ENV); # qw/wsu/;

# There can only be one c14n rule active, because it would otherwise
# produce a prefix
my $c14n;


sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
sub init($)
{   my ($self, $args) = @_;
    $self->{XCWS_pref} = $args->{prefix_list} || \@default_canon_ns;
    my $wss    = $args->{wss};

    # Immediately try-out the configured digest method.
    my $digest = $self->{XCWS_dig}
               = $args->{digest_method} || DSIG_SHA1;
    try { $self->_get_digester($digest, undef) };
    error __x"digest method {name} is not useable: {err}"
      , name => $digest, err => $@
        if $@;

    my $canon  = $self->{XCWS_can}
               = $args->{canon_method}  || C14N_EXC_NO_COMM;

    $self->{XCWS_c14n} = $args->{c14n} ||= $c14n
      ||= XML::Compile::C14N->new(for => $canon, schema => $wss->schema);

    $self;
}


sub fromConfig(@)
{   my $class = shift;
    $class->new(@_==1 ? %{$_[0]} : @_);
}

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

sub defaultDigestMethod() { shift->{XCWS_dig}  }
sub defaultCanonMethod()  { shift->{XCWS_can}  }
sub defaultPrefixList()   { shift->{XCWS_pref} }
sub c14n()                { shift->{XCWS_c14n} }

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

sub builder($%)
{   my ($self, $wss, %args) = @_;

    my $schema   = $wss->schema;
    my $digest   = $args{digest_method} || $self->defaultDigestMethod;
    my $canon    = $args{canon_method}  || $self->defaultCanonMethod;
    my $preflist = $args{prefix_list}   || $self->defaultPrefixList;

    my $canonic  = $self->_get_canonic($canon, $preflist);
    $schema->prefixFor($canon);  # enforce inclusion of c14n namespace