After accomplishing Task 2, see Codex_Response... for details.
This commit is contained in:
parent
fab12ad9bf
commit
d483d40d5c
16 changed files with 888 additions and 0 deletions
181
tools/LXMF/MessagePack.pm
Normal file
181
tools/LXMF/MessagePack.pm
Normal file
|
|
@ -0,0 +1,181 @@
|
|||
package LXMF::MessagePack;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Exporter 'import';
|
||||
|
||||
our @EXPORT_OK = qw(
|
||||
pack_array
|
||||
pack_bin
|
||||
pack_float64
|
||||
pack_map
|
||||
parse_item
|
||||
);
|
||||
|
||||
sub pack_float64 {
|
||||
my ($value) = @_;
|
||||
return "\xcb" . pack("d>", $value);
|
||||
}
|
||||
|
||||
sub pack_bin {
|
||||
my ($value) = @_;
|
||||
my $length = length($value);
|
||||
|
||||
return "\xc4" . pack("C", $length) . $value if $length <= 0xff;
|
||||
return "\xc5" . pack("n", $length) . $value if $length <= 0xffff;
|
||||
return "\xc6" . pack("N", $length) . $value;
|
||||
}
|
||||
|
||||
sub pack_array {
|
||||
my (@items) = @_;
|
||||
my $length = scalar @items;
|
||||
my $header;
|
||||
|
||||
if ($length <= 15) {
|
||||
$header = pack("C", 0x90 | $length);
|
||||
}
|
||||
elsif ($length <= 0xffff) {
|
||||
$header = "\xdc" . pack("n", $length);
|
||||
}
|
||||
else {
|
||||
$header = "\xdd" . pack("N", $length);
|
||||
}
|
||||
|
||||
return $header . join("", @items);
|
||||
}
|
||||
|
||||
sub pack_map {
|
||||
my (@entries) = @_;
|
||||
die "pack_map requires key/value byte-string pairs\n" if @entries % 2;
|
||||
|
||||
my $length = @entries / 2;
|
||||
my $header;
|
||||
|
||||
if ($length <= 15) {
|
||||
$header = pack("C", 0x80 | $length);
|
||||
}
|
||||
elsif ($length <= 0xffff) {
|
||||
$header = "\xde" . pack("n", $length);
|
||||
}
|
||||
else {
|
||||
$header = "\xdf" . pack("N", $length);
|
||||
}
|
||||
|
||||
return $header . join("", @entries);
|
||||
}
|
||||
|
||||
sub _take {
|
||||
my ($bytes, $offset_ref, $length) = @_;
|
||||
die "truncated MessagePack item\n" if $$offset_ref + $length > length($bytes);
|
||||
my $value = substr($bytes, $$offset_ref, $length);
|
||||
$$offset_ref += $length;
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub _parse_length {
|
||||
my ($bytes, $offset_ref, $width) = @_;
|
||||
my $raw = _take($bytes, $offset_ref, $width);
|
||||
return unpack("C", $raw) if $width == 1;
|
||||
return unpack("n", $raw) if $width == 2;
|
||||
return unpack("N", $raw);
|
||||
}
|
||||
|
||||
sub parse_item {
|
||||
my ($bytes, $offset_ref) = @_;
|
||||
$offset_ref //= \my $offset;
|
||||
$$offset_ref //= 0;
|
||||
|
||||
my $start = $$offset_ref;
|
||||
my $code = unpack("C", _take($bytes, $offset_ref, 1));
|
||||
my $item = { code => $code };
|
||||
|
||||
if ($code <= 0x7f) {
|
||||
@$item{qw(type value)} = ("integer", $code);
|
||||
}
|
||||
elsif ($code >= 0xe0) {
|
||||
@$item{qw(type value)} = ("integer", $code - 256);
|
||||
}
|
||||
elsif (($code & 0xf0) == 0x90) {
|
||||
_parse_array($bytes, $offset_ref, $item, $code & 0x0f);
|
||||
}
|
||||
elsif (($code & 0xf0) == 0x80) {
|
||||
_parse_map($bytes, $offset_ref, $item, $code & 0x0f);
|
||||
}
|
||||
elsif (($code & 0xe0) == 0xa0) {
|
||||
my $length = $code & 0x1f;
|
||||
@$item{qw(type value)} = ("string", _take($bytes, $offset_ref, $length));
|
||||
}
|
||||
elsif ($code == 0xc0) {
|
||||
$item->{type} = "nil";
|
||||
$item->{value} = undef;
|
||||
}
|
||||
elsif ($code == 0xc2 || $code == 0xc3) {
|
||||
@$item{qw(type value)} = ("boolean", $code == 0xc3 ? 1 : 0);
|
||||
}
|
||||
elsif ($code == 0xca) {
|
||||
@$item{qw(type value)} = ("float32", unpack("f>", _take($bytes, $offset_ref, 4)));
|
||||
}
|
||||
elsif ($code == 0xcb) {
|
||||
@$item{qw(type value)} = ("float64", unpack("d>", _take($bytes, $offset_ref, 8)));
|
||||
}
|
||||
elsif ($code >= 0xc4 && $code <= 0xc6) {
|
||||
my $width = 1 << ($code - 0xc4);
|
||||
my $length = _parse_length($bytes, $offset_ref, $width);
|
||||
@$item{qw(type value)} = ("binary", _take($bytes, $offset_ref, $length));
|
||||
}
|
||||
elsif ($code >= 0xcc && $code <= 0xcf) {
|
||||
my @formats = ("C", "n", "N", "Q>");
|
||||
my @widths = (1, 2, 4, 8);
|
||||
my $index = $code - 0xcc;
|
||||
@$item{qw(type value)} = (
|
||||
"integer",
|
||||
unpack($formats[$index], _take($bytes, $offset_ref, $widths[$index])),
|
||||
);
|
||||
}
|
||||
elsif ($code >= 0xd0 && $code <= 0xd3) {
|
||||
my @formats = ("c", "s>", "l>", "q>");
|
||||
my @widths = (1, 2, 4, 8);
|
||||
my $index = $code - 0xd0;
|
||||
@$item{qw(type value)} = (
|
||||
"integer",
|
||||
unpack($formats[$index], _take($bytes, $offset_ref, $widths[$index])),
|
||||
);
|
||||
}
|
||||
elsif ($code == 0xd9 || $code == 0xda || $code == 0xdb) {
|
||||
my $width = 1 << ($code - 0xd9);
|
||||
my $length = _parse_length($bytes, $offset_ref, $width);
|
||||
@$item{qw(type value)} = ("string", _take($bytes, $offset_ref, $length));
|
||||
}
|
||||
elsif ($code == 0xdc || $code == 0xdd) {
|
||||
my $width = $code == 0xdc ? 2 : 4;
|
||||
_parse_array($bytes, $offset_ref, $item, _parse_length($bytes, $offset_ref, $width));
|
||||
}
|
||||
elsif ($code == 0xde || $code == 0xdf) {
|
||||
my $width = $code == 0xde ? 2 : 4;
|
||||
_parse_map($bytes, $offset_ref, $item, _parse_length($bytes, $offset_ref, $width));
|
||||
}
|
||||
else {
|
||||
die sprintf("unsupported MessagePack code 0x%02x at offset %d\n", $code, $start);
|
||||
}
|
||||
|
||||
$item->{start} = $start;
|
||||
$item->{end} = $$offset_ref;
|
||||
$item->{raw} = substr($bytes, $start, $$offset_ref - $start);
|
||||
return $item;
|
||||
}
|
||||
|
||||
sub _parse_array {
|
||||
my ($bytes, $offset_ref, $item, $length) = @_;
|
||||
$item->{type} = "array";
|
||||
$item->{items} = [map { parse_item($bytes, $offset_ref) } 1 .. $length];
|
||||
}
|
||||
|
||||
sub _parse_map {
|
||||
my ($bytes, $offset_ref, $item, $length) = @_;
|
||||
$item->{type} = "map";
|
||||
$item->{entries} = [
|
||||
map { [parse_item($bytes, $offset_ref), parse_item($bytes, $offset_ref)] } 1 .. $length
|
||||
];
|
||||
}
|
||||
|
||||
1;
|
||||
32
tools/README.md
Normal file
32
tools/README.md
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
# LXMessage Test-Vector Tooling
|
||||
|
||||
The scripts in this directory verify the implementation-derived LXMessage
|
||||
packing behavior described in `Code_Response_1.md`.
|
||||
|
||||
They use only Perl core modules. The local `LXMF::MessagePack` module implements
|
||||
the MessagePack subset needed to generate the vectors and parse their complete
|
||||
payloads.
|
||||
|
||||
Generate deterministic vectors:
|
||||
|
||||
```sh
|
||||
perl tools/make_test_vectors.pl
|
||||
```
|
||||
|
||||
Verify the vectors:
|
||||
|
||||
```sh
|
||||
perl tools/verify_examples.pl
|
||||
```
|
||||
|
||||
The vectors confirm:
|
||||
|
||||
- the 16-byte destination hash, 16-byte source hash, and 64-byte signature
|
||||
positions;
|
||||
- payload order `[timestamp, title, content, fields, optional_stamp]`;
|
||||
- float64 timestamp and binary title/content/stamp encodings;
|
||||
- the message ID calculation;
|
||||
- exclusion of the optional stamp from the message ID and signature input.
|
||||
|
||||
The signature bytes are deterministic placeholders. These vectors do not claim
|
||||
to verify Ed25519 signing or signature validation.
|
||||
76
tools/make_test_vectors.pl
Executable file
76
tools/make_test_vectors.pl
Executable file
|
|
@ -0,0 +1,76 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Digest::SHA qw(sha256);
|
||||
use FindBin qw($Bin);
|
||||
use File::Path qw(make_path);
|
||||
use JSON::PP;
|
||||
use lib "$Bin";
|
||||
use LXMF::MessagePack qw(pack_array pack_bin pack_float64 pack_map);
|
||||
|
||||
my $output_dir = "$Bin/../examples";
|
||||
make_path($output_dir);
|
||||
|
||||
my $destination_hash = pack("C*", 0x00 .. 0x0f);
|
||||
my $source_hash = pack("C*", 0x10 .. 0x1f);
|
||||
my $signature = pack("C*", 0x20 .. 0x5f);
|
||||
my $stamp = pack("C*", 0xa0 .. 0xbf);
|
||||
|
||||
my $timestamp = 1_700_000_000.25;
|
||||
my $title = "Test title";
|
||||
my $content = "Deterministic LXMF body";
|
||||
my $fields = pack_map();
|
||||
|
||||
my @required_items = (
|
||||
pack_float64($timestamp),
|
||||
pack_bin($title),
|
||||
pack_bin($content),
|
||||
$fields,
|
||||
);
|
||||
|
||||
my $payload = pack_array(@required_items);
|
||||
my $stamped_payload = pack_array(@required_items, pack_bin($stamp));
|
||||
my $message_id = sha256($destination_hash . $source_hash . $payload);
|
||||
my $signed_part = $destination_hash . $source_hash . $payload . $message_id;
|
||||
|
||||
my $minimal = $destination_hash . $source_hash . $signature . $payload;
|
||||
my $stamped = $destination_hash . $source_hash . $signature . $stamped_payload;
|
||||
|
||||
write_hex("$output_dir/lxmf_message_minimal.hex", $minimal);
|
||||
write_hex("$output_dir/lxmf_message_stamped.hex", $stamped);
|
||||
|
||||
my $manifest = {
|
||||
description => "Deterministic LXMessage packing vectors; signature bytes are placeholders",
|
||||
format => "destination_hash || source_hash || signature || msgpack_payload",
|
||||
payload_order => [qw(timestamp title content fields optional_stamp)],
|
||||
destination_hash_hex => unpack("H*", $destination_hash),
|
||||
source_hash_hex => unpack("H*", $source_hash),
|
||||
signature_hex => unpack("H*", $signature),
|
||||
signature_valid => JSON::PP::false,
|
||||
timestamp => $timestamp,
|
||||
title_hex => unpack("H*", $title),
|
||||
content_hex => unpack("H*", $content),
|
||||
fields => {},
|
||||
stamp_hex => unpack("H*", $stamp),
|
||||
payload_without_stamp_hex => unpack("H*", $payload),
|
||||
payload_with_stamp_hex => unpack("H*", $stamped_payload),
|
||||
message_id_hex => unpack("H*", $message_id),
|
||||
signed_part_hex => unpack("H*", $signed_part),
|
||||
minimal_lxmf_hex => unpack("H*", $minimal),
|
||||
stamped_lxmf_hex => unpack("H*", $stamped),
|
||||
};
|
||||
|
||||
open my $json_fh, ">:raw", "$output_dir/lxmf_message_vectors.json"
|
||||
or die "cannot write vector manifest: $!\n";
|
||||
print {$json_fh} JSON::PP->new->canonical->pretty->encode($manifest);
|
||||
close $json_fh;
|
||||
|
||||
print "Generated deterministic LXMessage vectors in $output_dir\n";
|
||||
|
||||
sub write_hex {
|
||||
my ($path, $bytes) = @_;
|
||||
open my $fh, ">:raw", $path or die "cannot write $path: $!\n";
|
||||
print {$fh} unpack("H*", $bytes), "\n";
|
||||
close $fh;
|
||||
}
|
||||
88
tools/verify_examples.pl
Executable file
88
tools/verify_examples.pl
Executable file
|
|
@ -0,0 +1,88 @@
|
|||
#!/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";
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue