diff options
Diffstat (limited to 'scripts/xml-parse-test.pl')
| -rwxr-xr-x | scripts/xml-parse-test.pl | 157 |
1 files changed, 56 insertions, 101 deletions
diff --git a/scripts/xml-parse-test.pl b/scripts/xml-parse-test.pl index 713359f6..4811177a 100755 --- a/scripts/xml-parse-test.pl +++ b/scripts/xml-parse-test.pl @@ -1,15 +1,6 @@ # $Id$ # # Test of XML::Simple as a tool for encoding and decoding -# -# http://mirin.apnic.net/resourcecerts/wiki/index.php/IR-ISP_Definition - -# CMS wrapper for this (not yet written) would look something like: -# -# openssl smime -sign -nodetach -outform DER -in foo.xml -out foo.cms \ -# -signer foo.cer -inkey foo.key -# -# openssl smime -verify -CApath . -inform DER -in foo.cms -out foo.xml eval 'exec perl -w -S $0 ${1+"$@"}' if 0; @@ -17,6 +8,50 @@ eval 'exec perl -w -S $0 ${1+"$@"}' use strict; use XML::Simple; use Data::Dumper; +use IPC::Open2; + +sub run2 { + my $arg = shift; + my $i; + my $o; + my $pid = open2($o, $i, @_) + or die("Couldn't run @_"); + print($i $arg) + or die("Couldn't write to @_"); + close($i) + or die("Couldn't close @_"); + my @res = <$o>; + waitpid($pid, 0) + or die("Couldn't reap @_"); + return @res; +} + +my $p7b = "-----BEGIN PKCS7-----\n"; +my $p7e = "-----END PKCS7-----\n"; + +sub encode { + my $arg = shift; + my $cer = shift; + my $key = shift; + my @res = run2($arg, qw(openssl smime -sign -nodetach -outform PEM -signer), $cer, q(-inkey), $key); + die("Missing PKCS7 markers") + unless $res[0] eq $p7b && $res[@res-1] eq $p7e; + return join('', @res[1..@res-2]); +} + +sub decode { + my $arg = shift; + my $dir = shift; + my @res = run2($p7b . $arg . $p7e, qw(openssl smime -verify -inform PEM -CApath), $dir); + return join('', @res); +} + +my $xs = XML::Simple->new(KeepRoot => 1, + ForceArray => [qw(list_class)], + KeyAttr => [qw(header)], + NormalizeSpace => 2); + + my @xml = (' <message version="1"> @@ -91,98 +126,18 @@ my @xml = (' [Readable text] </status> </message> -'); - -my $xs = XML::Simple->new(KeepRoot => 1, - ForceArray => [qw(list_class)], - KeyAttr => [qw(header)], - NormalizeSpace => 2); +'); for my $xml (@xml) { - my $x = $xs->XMLin($xml); - my $t = $xs->XMLout($x); - print("\n###\n", $xml, "\n", Dumper($x), "\n", $t); + print("1: ", $xml, "\n"); + print("2: ", Dumper($xs->XMLin($xml)), "\n"); + my $cms = encode($xml, "biz-certs/Alice-EE.cer", "biz-certs/Alice-EE.key"); + print("3: ", $cms, "\n"); + $xml = decode($cms, "biz-certs"); + print("4: ", $xml, "\n"); + print("5: ", Dumper($xs->XMLin($xml)), "\n"); + +# my $x = $xs->XMLin($xml); +# my $t = $xs->XMLout($x); +# print("\n###\n", $xml, "\n", Dumper($x), "\n", $t); } - -__END__ - -# Test of IPC::Open2 - -# CMS wrapper for this (not yet written) would look something like: -# -# openssl smime -sign -nodetach -outform DER -in foo.xml -out foo.cms \ -# -signer foo.cer -inkey foo.key -# -# openssl smime -verify -CApath . -inform DER -in foo.cms -out foo.xml - -eval 'exec perl -w -S $0 ${1+"$@"}' - if 0; - -use strict; -use IPC::Open2; - -my $xml = ' - <message version="1"> - <header sender="sender name" - recipient = "recipient name" - msg_ref="reference" /> - <list_class ca="ca_name" - cert_url="url" - cert_ski="g(ski)" - cert_serial="serial" - cert_aki="g(aki)" - status="keyword" /> - <list_class ca="ca_name" - cert_url="url" - cert_ski="g(ski)" - cert_serial="serial" - cert_aki="g(aki)" - status="keyword" /> - <!-- [repeated for each active class where the ISP has resources] --> - </message> -'; - -sub run2 { - my $arg = shift; - my $i; - my $o; - my $pid = open2($o, $i, @_) - or die("Couldn't run @_"); - print($i $arg) - or die("Couldn't write to @_"); - close($i) - or die("Couldn't close @_"); - my @res = <$o>; - waitpid($pid, 0) - or die("Couldn't reap @_"); - return @res; -} - -my $p7b = "-----BEGIN PKCS7-----\n"; -my $p7e = "-----END PKCS7-----\n"; - -my $dir = "apacheca"; -my $cer = "$dir/ISP4-EE.cer"; -my $key = "$dir/ISP4-EE.key"; - -sub encode { - my $arg = shift; - my @res = run2($arg, qw(openssl smime -sign -nodetach -outform PEM -signer), $cer, q(-inkey), $key); - die("Missing PKCS7 markers") - unless $res[0] eq $p7b && $res[@res-1] eq $p7e; - return join('', @res[1..@res-2]); -} - -sub decode { - my $arg = shift; - my @res = run2($p7b . $arg . $p7e, qw(openssl smime -verify -inform PEM -CApath), $dir); - return join('', @res); -} - -print("1:\n", $xml, "\n"); - -my $cms = encode($xml); - -print("2:\n", $cms, "\n"); - -print("3:\n", decode($cms), "\n"); |