88 lines
3.8 KiB
Perl
88 lines
3.8 KiB
Perl
|
#!/usr/bin/env perl
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use Digest::SHA qw(sha256);
|
||
|
|
use FindBin qw($Bin);
|
||
|
|
use JSON::PP;
|
||
|
|
use lib "$Bin";
|
||
|
|
use LXMF::MessagePack qw(pack_array parse_item);
|
||
|
|
|
||
|
|
my $examples_dir = "$Bin/../examples";
|
||
|
|
my $manifest = read_json("$examples_dir/lxmf_message_vectors.json");
|
||
|
|
my $minimal = read_hex("$examples_dir/lxmf_message_minimal.hex");
|
||
|
|
my $stamped = read_hex("$examples_dir/lxmf_message_stamped.hex");
|
||
|
|
|
||
|
|
verify_lxmessage("minimal", $minimal, $manifest, 4);
|
||
|
|
verify_lxmessage("stamped", $stamped, $manifest, 5);
|
||
|
|
|
||
|
|
check(unpack("H*", $minimal) eq $manifest->{minimal_lxmf_hex}, "minimal full bytes match manifest");
|
||
|
|
check(unpack("H*", $stamped) eq $manifest->{stamped_lxmf_hex}, "stamped full bytes match manifest");
|
||
|
|
|
||
|
|
print "All LXMessage test-vector checks passed.\n";
|
||
|
|
|
||
|
|
sub verify_lxmessage {
|
||
|
|
my ($name, $bytes, $expected, $expected_count) = @_;
|
||
|
|
|
||
|
|
check(length($bytes) > 96, "$name vector has fixed prefix and payload");
|
||
|
|
my $destination_hash = substr($bytes, 0, 16);
|
||
|
|
my $source_hash = substr($bytes, 16, 16);
|
||
|
|
my $signature = substr($bytes, 32, 64);
|
||
|
|
my $packed_payload = substr($bytes, 96);
|
||
|
|
|
||
|
|
check(unpack("H*", $destination_hash) eq $expected->{destination_hash_hex}, "$name destination hash");
|
||
|
|
check(unpack("H*", $source_hash) eq $expected->{source_hash_hex}, "$name source hash");
|
||
|
|
check(unpack("H*", $signature) eq $expected->{signature_hex}, "$name signature position and length");
|
||
|
|
|
||
|
|
my $offset = 0;
|
||
|
|
my $payload = parse_item($packed_payload, \$offset);
|
||
|
|
check($offset == length($packed_payload), "$name payload consumes all remaining bytes");
|
||
|
|
check($payload->{type} eq "array", "$name payload is a MessagePack array");
|
||
|
|
check(@{$payload->{items}} == $expected_count, "$name payload has $expected_count entries");
|
||
|
|
|
||
|
|
my @items = @{$payload->{items}};
|
||
|
|
check($items[0]{type} eq "float64", "$name payload[0] timestamp is float64");
|
||
|
|
check($items[0]{value} == $expected->{timestamp}, "$name payload[0] timestamp value");
|
||
|
|
check($items[1]{type} eq "binary", "$name payload[1] title is binary");
|
||
|
|
check(unpack("H*", $items[1]{value}) eq $expected->{title_hex}, "$name payload[1] title value");
|
||
|
|
check($items[2]{type} eq "binary", "$name payload[2] content is binary");
|
||
|
|
check(unpack("H*", $items[2]{value}) eq $expected->{content_hex}, "$name payload[2] content value");
|
||
|
|
check($items[3]{type} eq "map", "$name payload[3] fields is a map");
|
||
|
|
check(@{$items[3]{entries}} == 0, "$name payload[3] fields map is empty");
|
||
|
|
|
||
|
|
my $unstamped_payload = pack_array(map { $_->{raw} } @items[0 .. 3]);
|
||
|
|
my $message_id = sha256($destination_hash . $source_hash . $unstamped_payload);
|
||
|
|
my $signed_part = $destination_hash . $source_hash . $unstamped_payload . $message_id;
|
||
|
|
|
||
|
|
check(unpack("H*", $unstamped_payload) eq $expected->{payload_without_stamp_hex}, "$name canonical unstamped payload");
|
||
|
|
check(unpack("H*", $message_id) eq $expected->{message_id_hex}, "$name message ID excludes optional stamp");
|
||
|
|
check(unpack("H*", $signed_part) eq $expected->{signed_part_hex}, "$name signature input excludes optional stamp");
|
||
|
|
|
||
|
|
if ($expected_count == 5) {
|
||
|
|
check($items[4]{type} eq "binary", "$name payload[4] stamp is binary");
|
||
|
|
check(unpack("H*", $items[4]{value}) eq $expected->{stamp_hex}, "$name payload[4] stamp value");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub read_json {
|
||
|
|
my ($path) = @_;
|
||
|
|
open my $fh, "<:raw", $path or die "cannot read $path: $!\n";
|
||
|
|
local $/;
|
||
|
|
return JSON::PP->new->decode(<$fh>);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub read_hex {
|
||
|
|
my ($path) = @_;
|
||
|
|
open my $fh, "<:raw", $path or die "cannot read $path: $!\n";
|
||
|
|
local $/;
|
||
|
|
my $hex = <$fh>;
|
||
|
|
$hex =~ s/\s+//g;
|
||
|
|
die "$path contains non-hexadecimal data\n" if $hex =~ /[^0-9a-fA-F]/;
|
||
|
|
return pack("H*", $hex);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub check {
|
||
|
|
my ($condition, $description) = @_;
|
||
|
|
die "not ok - $description\n" unless $condition;
|
||
|
|
print "ok - $description\n";
|
||
|
|
}
|