The attached patch adds Nonce and Created whenever they're asked for,
regardless of whether there's going to be a digest. It also contains an
amendment to 11digest.t to confirm that fact.
I also noticed that, if one uses a numeric Created, the encryption ends
up wrong (because the formatted string goes into the element, but the
numeric goes into the salt). So I fixed that and made
12numeric_created.t to check. But even that test has some issues, which
will probably warrant some other solution.
I think this is a pretty straightforward fix, though. (Famous last words)
diff --git a/lib/XML/Compile/WSS.pm b/lib/XML/Compile/WSS.pm
index ee4d4aa..60221e5 100644
--- a/lib/XML/Compile/WSS.pm
+++ b/lib/XML/Compile/WSS.pm
@@ -110,24 +110,28 @@ sub wsseBasicAuth($$;$%)
# The spec says we include "created" and "nonce" nodes if they're present.
my @additional;
- if($type eq UTP11_PDIGEST)
- {
- my $nonce = $opts{nonce} || '';
- if($nonce)
- { my $noncetype = $schema->findName('wsse:Nonce') ;
- my $noncenode = $schema->writer($noncetype, include_namespaces => 0)
- ->($doc, {_ => encode_base64($nonce)});
- push @additional, $noncetype => $noncenode;
- }
-
- my $created = $opts{created} || '';
- if($created)
- { my $createdtype = $schema->findName('wsu:Created' ) ;
- my $cnode = $schema->writer($createdtype, include_namespaces => 0)
- ->($doc, {_ => _datetime($created) } );
- push @additional, $createdtype => $cnode;
- }
+ my $nonce = $opts{nonce} || '';
+ if($nonce)
+ { my $noncetype = $schema->findName('wsse:Nonce') ;
+ my $noncenode = $schema->writer($noncetype, include_namespaces => 0)
+ ->($doc, {_ => encode_base64($nonce)});
+ push @additional, $noncetype => $noncenode;
+ }
+ my $created = $opts{created} || '';
+ if($created)
+ { my $createdtype = $schema->findName('wsu:Created' ) ;
+ # If _datetime changes $created into something different,
+ # _that_ is what's going to need to be put into the
+ # digest (if there's a digest).
+ $created = _datetime($created) ;
+ my $cnode = $schema->writer($createdtype, include_namespaces => 0)
+ ->($doc, {_ => $created } );
+ push @additional, $createdtype => $cnode;
+ }
+
+ if($type eq UTP11_PDIGEST)
+ {
$password = sha1_base64(encode utf8 => "$nonce$created$password").'=';
}
diff --git a/t/11digest.t b/t/11digest.t
index bd3c0b1..1e0c4a1 100644
--- a/t/11digest.t
+++ b/t/11digest.t
@@ -5,7 +5,7 @@
use warnings;
use strict;
-use Test::More tests => 18;
+use Test::More tests => 33;
use MIME::Base64 qw/decode_base64/;
@@ -60,6 +60,25 @@ is( $answer->{body}, $theCorrectAnswer, 'Round-trip to server worked' );
# use Data::Dumper;
# print Dumper $answer;
+{
+ # Ticket 79315 notes that "text" passwords just skip Nonce and
+ # Created. This seems like a reasonable place to check that
+ # (although maybe the filename should change from "digest").
+ my $usernameToken = $wss->wsseBasicAuth($username, $password, UTP11_PTEXT
+ , nonce => $nonce, created => $now
+ , wsu_Id => $usernameId
+ );
+ ok($usernameToken, 'PasswordText returns something sensible');
+
+ my ($answer, $trace) = $getVersion->
+ ( wsse_Security => { %$usernameToken, %$timestampToken }
+ , () # %payload
+ );
+
+ is( $answer->{body}, $theCorrectAnswer, 'Round-trip to server worked' );
+}
+
+
#### HELPERS, for testing only
sub test_server
diff --git a/t/12numeric_created.t b/t/12numeric_created.t
new file mode 100644
index 0000000..29c3ff4
--- /dev/null
+++ b/t/12numeric_created.t
@@ -0,0 +1,74 @@
+#!/usr/bin/env perl
+#
+# Verify that, when "created" is passed as a number in wsseBasicAuth,
+# it gets encrypted the right way.
+#
+# In version 0.90, this was not true.
+#
+
+use strict ;
+use warnings ;
+
+use Digest::SHA1 qw/sha1_base64/;
+use Encode qw/encode/;
+use MIME::Base64 qw/encode_base64 decode_base64/ ;
+
+use Test::More tests => 11 ;
+
+use XML::Compile::WSDL11;
+use XML::Compile::SOAP::WSS;
+use XML::Compile::WSS::Util qw/:utp11/;
+
+my ($username, $password) = qw/username password/;
+
+my $wsdl = XML::Compile::WSDL11->new( 'examples/wsse/example.wsdl');
+my $wss = XML::Compile::SOAP::WSS->new( version => 1.1, schema => $wsdl);
+
+my $now = time() ;
+my $nonce = 'insecure' ;
+
+my $untype = $wss->schema->findName('wsse:UsernameToken');
+my $unreader = $wss->schema->reader($untype) ;
+
+my $usernameToken = $wss->wsseBasicAuth($username, $password, UTP11_PDIGEST
+ , nonce => $nonce, created => $now
+ );
+ok($usernameToken, 'PasswordDigest returns something sensible');
+ok( my $p = $unreader->($usernameToken->{$untype}->toString()), 'UsernameToken is legible' ) ;
+checkEncryption( $p, $nonce, $password ) ;
+
+TODO: {
+ local $TODO = 'Something is amiss when calling wsseBasicAuth twice' ;
+ my $usernameToken = $wss->wsseBasicAuth($username, $password, UTP11_PDIGEST
+ , created => $now
+ );
+ ok($usernameToken, 'PasswordDigest returns something sensible');
+ my $utString = $usernameToken->{$untype}->toString() ;
+ ok( eval { my $p = $unreader->($utString) }, 'UsernameToken is legible' )
+ or do { diag($@) ; diag( "Bad string: $utString" ) } ;
+ diag( "Interpreted to " . Data::Dumper->Dump( [$p], ['p'] ) ) ;
+ checkEncryption( $p, '', $password ) ;
+};
+
+# Verify that, if one unpacks the Nonce and Created from the
+# UsernameToken, the SHA1 goes back together the right way.
+sub checkEncryption {
+ my ($un, $nonce, $password) = @_ ;
+
+ $nonce ||= '' ;
+ if( $nonce ) {
+ my $enc = $un->{wsse_Nonce}->{_} ;
+ ok( $enc, 'Nonce is required and present' ) ;
+ is( decode_base64( $enc ), $nonce, 'Nonce decodes correctly' )
+ }
+ else {
+ ok( ! $un->{wsse_Nonce}, 'Nonce is appropriately absent' ) ;
+ }
+
+ ok( $un->{wsu_Created}->{_}, 'Created is present' )
+ or diag( Data::Dumper->Dump( [$un], ['p'] ) ) ;
+ my $plainPassword = join( '', $nonce, $un->{wsu_Created}->{_}, $password ) ;
+
+ is( sha1_base64(encode( utf8 => $plainPassword )) . '=', $un->{wsse_Password}->{_},
+ 'Password is encrypted correctly' ) ;
+}
