diff options
Diffstat (limited to 'scripts/encode-test.pl')
| -rwxr-xr-x | scripts/encode-test.pl | 207 |
1 files changed, 207 insertions, 0 deletions
diff --git a/scripts/encode-test.pl b/scripts/encode-test.pl new file mode 100755 index 00000000..ae82435e --- /dev/null +++ b/scripts/encode-test.pl @@ -0,0 +1,207 @@ +# $Id$ +# +# Test of XML::Simple as a tool for encoding and decoding + +eval 'exec perl -w -S $0 ${1+"$@"}' + if 0; + +use strict; +use XML::Simple; +use Data::Dumper; +use IPC::Open2; + +my %opt; + +if (0) { + use Getopt::Long; + my $usage = "Use The Source, Luke"; + die($usage) + unless GetOptions(\%opt, qw(encode! decode! schema=s key=s cert=s dir=s)) + and $opt{encode} + $opt{decode} == 1; + die($usage) + if $opt{encode} and !$opt{cert} || !$opt{key}; + die($usage) + if $opt{decode} and !$opt{schema} || !$opt{dir}; +} else { + $opt{dir} = "biz-certs"; + $opt{cert} = "biz-certs/Alice-EE.cer"; + $opt{key} = "biz-certs/Alice-EE.key"; + $opt{schema} = "up-down-medium-schema.rng"; +} + +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 @_"); + local $/; + my $res = <$o>; + waitpid($pid, 0) + or die("Couldn't reap @_"); + return $res; +} + +sub encode { + my $arg = shift; + my $cer = shift; + my $key = shift; + return run2($arg, qw(openssl smime -sign -nodetach -outform PEM -signer), $cer, q(-inkey), $key); +} + +sub decode { + my $arg = shift; + my $dir = shift; + return run2($arg, qw(openssl smime -verify -inform PEM -CApath), $dir); +} + +sub relaxng { + my $xml = shift; + my $schema = shift; + open(F, "| xmllint --relaxng $schema - 2>&1") or die; + print(F $xml) or die; + return close(F); +} + +my $xs = XML::Simple->new(KeepRoot => 1, + ForceArray => [qw(list_class)], + KeyAttr => [qw(header)], + NormalizeSpace => 2); + + + +my @xml = ('<?xml version="1.0" encoding="UTF-8"?> +<message xmlns="http://www.apnic.net/specs/rescerts/up-down/" + version="1" + sender="sender name" + recipient="recipient name" + msg_ref="42" + type="error_response"> + <status>2001</status> + <last_msg_processed>17</last_msg_processed> + <description xml:lang="en-US">[Readable text]</description> +</message> +','<?xml version="1.0" encoding="UTF-8"?> +<message xmlns="http://www.apnic.net/specs/rescerts/up-down/" + version="1" + sender="sender name" + recipient="recipient name" + msg_ref="42" type="issue"> + <request class_name="class name" + req_resource_set_as="" + req_resource_set_ipv4="10.0.0.44/32" + req_resource_set_ipv6="dead:beef::/32"> + deadbeef + </request> +</message> +','<?xml version="1.0" encoding="UTF-8"?> +<message xmlns="http://www.apnic.net/specs/rescerts/up-down/" + version="1" + sender="sender name" + recipient="recipient name" + msg_ref="1" + type="issue_response"> + <class class_name="class name" + cert_url="url" + cert_ski="g(ski)" + resource_set_as="22,42,44444-5555555" + resource_set_ipv4="10.0.0.44-10.3.0.44,10.6.0.2/32" + resource_set_ipv6="dead:beef::/128"> + <certificate cert_url="url" + cert_ski="g(ski)" + cert_aki="g(aki)" + cert_serial="1" + resource_set_as="14-17" + resource_set_ipv4="128.224.1.136/22" + resource_set_ipv6="0:0::/22" + req_resource_set_as="" + req_resource_set_ipv4="10.0.0.77/16,127.0.0.1/8" + req_resource_set_ipv6="dead:beef::/16" + status="match"> + deadbeef + </certificate> + <issuer>deadbeef</issuer> + </class> +</message> +','<?xml version="1.0" encoding="UTF-8"?> +<message xmlns="http://www.apnic.net/specs/rescerts/up-down/" + version="1" + sender="sender name" + recipient="recipient name" + msg_ref="42" + type="list"/> +','<?xml version="1.0" encoding="UTF-8"?> +<message xmlns="http://www.apnic.net/specs/rescerts/up-down/" + version="1" + sender="sender name" + recipient="recipient name" + msg_ref="42" + type="list_response"> + <class class_name="class name" + cert_url="url" + cert_ski="g(ski)" + resource_set_as="1,2,4,6,16-32" + resource_set_ipv4="128.224.1.1-128.22.4.32" + resource_set_ipv6="" + suggested_sia_head="rsync://wombat.example/fnord/"> + <certificate cert_url="url" + cert_ski="g(ski)" + cert_aki="g(aki)" + cert_serial="1" + resource_set_as="" + resource_set_ipv4="" + resource_set_ipv6="" + req_resource_set_as="" + req_resource_set_ipv4="" + req_resource_set_ipv6="" + status="match"> + deadbeef + </certificate> + <!-- Repeated for each current certificate naming the client as subject --> + <issuer>deadbeef</issuer> + </class> +</message> +','<?xml version="1.0" encoding="UTF-8"?> +<message xmlns="http://www.apnic.net/specs/rescerts/up-down/" + version="1" + sender="sender name" + recipient="recipient name" + msg_ref="42" + type="revoke"> + <key class_name="class name" + ski="g(ski)"/> +</message> +','<?xml version="1.0" encoding="UTF-8"?> +<message xmlns="http://www.apnic.net/specs/rescerts/up-down/" + version="1" + sender="sender name" + recipient="recipient name" + msg_ref="42" + type="revoke_response"> + <key class_name="class name" + ski="g(ski)"/> +</message> +'); + +for my $xml (@xml) { + print("1:\n", $xml, "\n"); + print("2:\n", Dumper($xs->XMLin($xml)), "\n"); + print("3:\n"); + my $cms = encode($xml, $opt{cert}, $opt{key}); + print($cms, "\n"); + print("4:\n"); + $xml = decode($cms, $opt{dir}); + print($xml, "\n"); + print("5:\n", Dumper($xs->XMLin($xml)), "\n"); + print("6:\n"); + relaxng($xml, $opt{schema}); + print("\n"); + +# my $x = $xs->XMLin($xml); +# my $t = $xs->XMLout($x); +# print("\n###\n", $xml, "\n", Dumper($x), "\n", $t); +} |