jlpoole/ble-reticulum
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

works

Browse source
This commit is contained in:
John Poole 2026-05-16 14:37:03 -07:00
commit b7232b5e1e
1 changed files with 508 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

508
scripts/analyze_reticulum_file_transfer_20260516_1130.pl Normal file
View file

@ -0,0 +1,508 @@
#!/usr/bin/env perl
# ./analyze_reticulum_file_transfer_20260516_1130.pl 20250516_1115_zerodev1.txt 20250516_1115_zerodev2.txt
# ./analyze_reticulum_file_transfer_20260516_1130.pl --detail 20250516_1115_zerodev1.txt 20250516_1115_zerodev2.txt
# ./analyze_reticulum_file_transfer_20260516_1130.pl --csv chunks_$(date +%Y%m%d_%H%M).csv 20250516_1115_zerodev1.txt 20250516_1115_zerodev2.txt
# chmod 755 analyze_reticulum_file_transfer_20260516_1130.pl
# 2026-05-16 ChatGPT
# $Header$
# $HeadURL$
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use POSIX qw(strftime);
use Time::Local qw(timegm);
use List::Util qw(min max sum);
my $detail = 0;
my $csv_file = '';
my $show_provenance = 0;
GetOptions(
'detail!' => \$detail,
'csv=s' => \$csv_file,
'provenance!' => \$show_provenance,
) or die usage();
@ARGV >= 1 or die usage();
my %mon = (
Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5,
Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11,
);
my %tz_offset = (
UTC => 0,
GMT => 0,
PST => -8 * 3600,
PDT => -7 * 3600,
);
my @chunks;
my @hellos;
my @log_reports;
my %sent_declared;
for my $file (@ARGV) {
my $report = parse_file($file);
push @log_reports, $report;
push @chunks, @{ $report->{chunks} };
push @hellos, @{ $report->{hellos} };
for my $k (keys %{ $report->{sent_declared} }) {
$sent_declared{$k} = $report->{sent_declared}{$k};
}
}
@chunks or die "No RX file_chunk records with send_epoch= were found.\n";
print "Reticulum BLE file transfer analysis\n";
print "Generated: ", strftime('%Y-%m-%d %H:%M:%S %Z', localtime), "\n";
print "Input files:\n";
print " $_\n" for @ARGV;
print "\n";
print "Log provenance summary:\n";
for my $r (@log_reports) {
printf " %-28s receiver=%-10s date='%s' command_lines=%d post_marker_lines=%d\n",
basename($r->{file}), $r->{receiver}, ($r->{date_line} // 'UNKNOWN'),
scalar(@{ $r->{commands} }), $r->{post_marker_lines};
}
print "\n";
if ($show_provenance) {
print "Captured command clumps:\n";
for my $r (@log_reports) {
print "--- ", $r->{file}, " ---\n";
print $_ for @{ $r->{commands} };
print "\n";
}
}
print "Chrony clock notes from logs:\n";
for my $r (@log_reports) {
printf " %s\n", basename($r->{file});
if (@{ $r->{chrony_system_time} }) {
for my $line (@{ $r->{chrony_system_time} }) {
print " $line\n";
}
}
else {
print " no 'System time' lines found\n";
}
}
print "\n";
print "Declared outbound sends observed in logs:\n";
if (%sent_declared) {
for my $k (sort keys %sent_declared) {
my $s = $sent_declared{$k};
printf " sender=%-10s file=%-24s chunks=%4d bytes=%7d chunk_data_bytes=%s\n",
$s->{sender}, $s->{message_file}, $s->{chunks}, $s->{bytes}, ($s->{chunk_data_bytes} // 'n/a');
}
}
else {
print " none found\n";
}
print "\n";
my %by_dir;
for my $c (@chunks) {
push @{ $by_dir{ $c->{sender} . '->' . $c->{receiver} } }, $c;
}
for my $dir (sort keys %by_dir) {
my @r = sort { $a->{chunk_no} <=> $b->{chunk_no} } @{ $by_dir{$dir} };
my @lat = map { $_->{latency} } @r;
my @recv_gap = consecutive_deltas(map { $_->{recv_epoch} } @r);
my @send_gap = consecutive_deltas(map { $_->{send_epoch} } @r);
my $n = scalar @r;
my $first = $r[0];
my $last = $r[-1];
my $expected = max(map { $_->{chunk_total} } @r);
my $bytes = sum(map { $_->{bytes} } @r);
my $missing = missing_ranges([ map { $_->{chunk_no} } @r ], $expected);
my $dupes = duplicate_list(map { $_->{chunk_no} } @r);
my $recv_span = $last->{recv_epoch} - $first->{recv_epoch};
my $send_span = $last->{send_epoch} - $first->{send_epoch};
my $recv_payload_rate = $recv_span > 0 ? $bytes / $recv_span : 0;
my $send_payload_rate = $send_span > 0 ? $bytes / $send_span : 0;
printf "Direction: %s\n", $dir;
printf " file : %s\n", $first->{message_file};
printf " chunks received : %d of %d\n", $n, $expected;
printf " completeness : %.2f%%\n", 100.0 * $n / $expected if $expected;
printf " missing chunks : %s\n", @$missing ? join(',', @$missing) : 'none';
printf " duplicate chunks : %s\n", @$dupes ? join(',', @$dupes) : 'none';
printf " payload bytes RX : %d\n", $bytes;
printf " first chunk RX : %s\n", $first->{recv_clock};
printf " last chunk RX : %s\n", $last->{recv_clock};
printf " receiver span : %.3f s\n", $recv_span;
printf " sender span : %.3f s\n", $send_span;
printf " payload rate RX span : %.1f B/s %.1f bit/s\n", $recv_payload_rate, $recv_payload_rate * 8.0;
printf " payload rate TX span : %.1f B/s %.1f bit/s\n", $send_payload_rate, $send_payload_rate * 8.0;
print_latency_block('one-way latency', @lat);
print_gap_block('receiver inter-chunk gap', @recv_gap);
print_gap_block('sender inter-chunk gap', @send_gap);
print "\n";
}
if (@hellos) {
print "Hello/handshake RX records:\n";
for my $h (sort { $a->{recv_epoch} <=> $b->{recv_epoch} } @hellos) {
printf " %-10s -> %-10s recv=%s latency=%8.3f ms message='%s'\n",
$h->{sender}, $h->{receiver}, $h->{recv_clock},
$h->{latency} * 1000.0, $h->{message};
}
print "\n";
}
if ($detail) {
print "Per-chunk detail:\n";
printf "%12s %-10s %-10s %8s %8s %8s %10s %10s %10s\n",
'recv_time', 'sender', 'receiver', 'chunk', 'total', 'bytes', 'lat_ms', 'recv_gap', 'send_gap';
for my $dir (sort keys %by_dir) {
my @r = sort { $a->{chunk_no} <=> $b->{chunk_no} } @{ $by_dir{$dir} };
my ($prev_recv, $prev_send);
for my $c (@r) {
my $rg = defined $prev_recv ? $c->{recv_epoch} - $prev_recv : undef;
my $sg = defined $prev_send ? $c->{send_epoch} - $prev_send : undef;
printf "%12s %-10s %-10s %8d %8d %8d %10.3f %10s %10s\n",
$c->{recv_clock}, $c->{sender}, $c->{receiver},
$c->{chunk_no}, $c->{chunk_total}, $c->{bytes}, $c->{latency} * 1000.0,
defined $rg ? sprintf('%.3f', $rg) : '',
defined $sg ? sprintf('%.3f', $sg) : '';
$prev_recv = $c->{recv_epoch};
$prev_send = $c->{send_epoch};
}
}
print "\n";
}
if ($csv_file ne '') {
open my $out, '>', $csv_file or die "Cannot write $csv_file: $!\n";
print $out join(',', qw(receiver sender file chunk_no chunk_total bytes send_epoch recv_epoch latency_s latency_ms recv_time source_log)), "\n";
for my $c (sort { $a->{recv_epoch} <=> $b->{recv_epoch} } @chunks) {
print $out join(',',
csvq($c->{receiver}), csvq($c->{sender}), csvq($c->{message_file}),
$c->{chunk_no}, $c->{chunk_total}, $c->{bytes},
sprintf('%.6f', $c->{send_epoch}), sprintf('%.6f', $c->{recv_epoch}),
sprintf('%.6f', $c->{latency}), sprintf('%.3f', $c->{latency} * 1000.0),
csvq($c->{recv_clock}), csvq($c->{source_log})
), "\n";
}
close $out;
print "CSV written: $csv_file\n\n";
}
print "Caution: one-way latency assumes sender and receiver clocks are synchronized.\n";
print "Your chronyc tracking output helps bound this error, but it is not a substitute for ACK/round-trip timing.\n";
sub parse_file {
my ($file) = @_;
open my $fh, '<', $file or die "Cannot open $file: $!\n";
my $receiver = receiver_from_filename($file);
my @commands;
my @chunks;
my @hellos;
my @chrony_system_time;
my %sent_declared;
my $pending_chunk_data_bytes;
my $in_command_clump = 1;
my $post_marker_lines = 0;
my ($year, $month, $day, $tz, $date_line);
my $current_record = '';
my $current_recv_parts;
my $current_line_no = 0;
my $line_no = 0;
while (my $line = <$fh>) {
++$line_no;
if ($in_command_clump) {
push @commands, $line;
if ($line =~ /^#\s*End of command clump\s*$/) {
$in_command_clump = 0;
}
next;
}
++$post_marker_lines;
chomp(my $line_chomp = $line);
if (!defined $date_line && $line_chomp =~ /^\S+\s+\S+\s+\d{1,2}\s+\d\d:\d\d:\d\d(?:\s+(?:AM|PM))?\s+\S+\s+\d{4}$/i) {
$date_line = $line_chomp;
($year, $month, $day, $tz) = parse_log_date($line_chomp);
}
if ($line_chomp =~ /^System time\s+:/) {
push @chrony_system_time, $line_chomp;
}
if ($line_chomp =~ /^\[(\d\d):(\d\d):(\d\d)\.(\d{3})\]\s+Starting node\s+(\S+)/) {
$receiver = $1 if 0; # placeholder to keep pattern variables local-looking
}
if ($line_chomp =~ /^\[(\d\d):(\d\d):(\d\d)\.(\d{3})\]\s+Sending file\s+(\S+)\s+as\s+(\d+)\s+chunk\(s\),\s+(\d+)\s+bytes/) {
next unless defined $date_line;
my ($hh, $mi, $ss, $ms, $path, $chunks, $bytes) = ($1, $2, $3, $4, $5, $6, $7);
my $key = $receiver . '|' . basename($path);
$sent_declared{$key} = {
sender => $receiver,
path => $path,
message_file => basename($path),
chunks => $chunks + 0,
bytes => $bytes + 0,
time_epoch => epoch_from_local_parts($year, $month, $day, $hh, $mi, $ss, $ms, $tz),
chunk_data_bytes => $pending_chunk_data_bytes,
};
}
if ($line_chomp =~ /Requested message chunk size\s+(\d+)\s+exceeds Reticulum link budget; using\s+(\d+)\s+data bytes per chunk/) {
$pending_chunk_data_bytes = $2;
for my $k (keys %sent_declared) {
$sent_declared{$k}{chunk_data_bytes} = $2;
}
}
if ($line =~ /^\[(\d\d):(\d\d):(\d\d)\.(\d{3})\]\s+RX\s+/) {
flush_record(\$current_record, $current_recv_parts, $current_line_no, \@chunks, \@hellos,
$file, $receiver, $year, $month, $day, $tz) if $current_record ne '';
$current_record = $line;
$current_recv_parts = [$1, $2, $3, $4];
$current_line_no = $line_no;
if ($line =~ /send_epoch=/) {
flush_record(\$current_record, $current_recv_parts, $current_line_no, \@chunks, \@hellos,
$file, $receiver, $year, $month, $day, $tz);
}
}
elsif ($current_record ne '') {
$current_record .= $line;
if ($line =~ /send_epoch=/) {
flush_record(\$current_record, $current_recv_parts, $current_line_no, \@chunks, \@hellos,
$file, $receiver, $year, $month, $day, $tz);
}
}
}
flush_record(\$current_record, $current_recv_parts, $current_line_no, \@chunks, \@hellos,
$file, $receiver, $year, $month, $day, $tz) if $current_record ne '';
close $fh;
return {
file => $file,
receiver => $receiver,
commands => \@commands,
date_line => $date_line,
post_marker_lines => $post_marker_lines,
chunks => \@chunks,
hellos => \@hellos,
chrony_system_time => \@chrony_system_time,
sent_declared => \%sent_declared,
};
}
sub flush_record {
my ($record_ref, $recv_parts, $line_no, $chunks_ref, $hellos_ref, $file, $receiver, $year, $month, $day, $tz) = @_;
return if $$record_ref eq '';
my $record = $$record_ref;
$$record_ref = '';
return unless defined $year;
return unless $record =~ /send_epoch=([0-9]+(?:\.[0-9]+)?)/s;
my $send_epoch = $1 + 0.0;
my ($hh, $mi, $ss, $ms) = @$recv_parts;
my $recv_epoch = epoch_from_local_parts($year, $month, $day, $hh, $mi, $ss, $ms, $tz);
my $latency = $recv_epoch - $send_epoch;
my $recv_clock = sprintf('%02d:%02d:%02d.%03d', $hh, $mi, $ss, $ms);
if ($record =~ /file_chunk\s+(\d+)\/(\d+)\s+from\s+(\S+)\s+bytes=(\d+)\s+file=(\S+)/s) {
push @$chunks_ref, {
source_log => $file,
source_line => $line_no,
receiver => $receiver,
sender => $3,
chunk_no => $1 + 0,
chunk_total => $2 + 0,
bytes => $4 + 0,
message_file => $5,
send_epoch => $send_epoch,
recv_epoch => $recv_epoch,
latency => $latency,
recv_clock => $recv_clock,
};
}
elsif ($record =~ /RX\s+link=<[^>]+>:\s+(.+?)\s+from\s+(\S+)\s+send_epoch=/s) {
my ($message, $sender) = ($1, $2);
$message =~ s/\s+/ /g;
push @$hellos_ref, {
source_log => $file,
source_line => $line_no,
receiver => $receiver,
sender => $sender,
message => $message,
send_epoch => $send_epoch,
recv_epoch => $recv_epoch,
latency => $latency,
recv_clock => $recv_clock,
};
}
}
sub print_latency_block {
my ($label, @values) = @_;
return unless @values;
printf " %-21s min/median/mean/p95/max/stddev: %.3f / %.3f / %.3f / %.3f / %.3f / %.3f ms\n",
$label,
min(@values) * 1000.0,
percentile(50, @values) * 1000.0,
(sum(@values) / @values) * 1000.0,
percentile(95, @values) * 1000.0,
max(@values) * 1000.0,
stddev(@values) * 1000.0;
}
sub print_gap_block {
my ($label, @values) = @_;
return unless @values;
printf " %-21s min/median/mean/p95/max/stddev: %.3f / %.3f / %.3f / %.3f / %.3f / %.3f ms\n",
$label,
min(@values) * 1000.0,
percentile(50, @values) * 1000.0,
(sum(@values) / @values) * 1000.0,
percentile(95, @values) * 1000.0,
max(@values) * 1000.0,
stddev(@values) * 1000.0;
}
sub parse_log_date {
my ($line) = @_;
# Supports:
# Sat May 16 11:12:57 PDT 2026
# Sat May 16 11:12:58 AM PDT 2026
if ($line =~ /^\S+\s+(\S+)\s+(\d{1,2})\s+(\d\d):(\d\d):(\d\d)(?:\s+(AM|PM))?\s+(\S+)\s+(\d{4})/i) {
my ($mon_name, $day, $ampm, $tz, $year) = ($1, $2, $6, uc($7), $8);
exists $mon{$mon_name} or die "Cannot parse month '$mon_name' in: $line\n";
exists $tz_offset{$tz} or die "Unknown timezone '$tz' in: $line\nAdd it to %tz_offset.\n";
return ($year, $mon{$mon_name}, $day, $tz);
}
die "Cannot parse log date from: $line\n";
}
sub epoch_from_local_parts {
my ($year, $month, $day, $hh, $mi, $ss, $ms, $tz) = @_;
my $epoch_as_if_utc = timegm($ss, $mi, $hh, $day, $month, $year - 1900);
return $epoch_as_if_utc - $tz_offset{$tz} + ($ms / 1000.0);
}
sub receiver_from_filename {
my ($file) = @_;
return $1 if $file =~ /(zerodev\d+)/;
return basename($file);
}
sub consecutive_deltas {
my (@v) = @_;
my @d;
for (my $i = 1; $i < @v; ++$i) {
push @d, $v[$i] - $v[$i - 1];
}
return @d;
}
sub missing_ranges {
my ($seen_ref, $expected) = @_;
my %seen = map { $_ => 1 } @$seen_ref;
my @missing = grep { !$seen{$_} } 1 .. $expected;
return [] unless @missing;
my @ranges;
my ($start, $prev) = ($missing[0], $missing[0]);
for my $m (@missing[1 .. $#missing]) {
if ($m == $prev + 1) {
$prev = $m;
}
else {
push @ranges, $start == $prev ? $start : "$start-$prev";
($start, $prev) = ($m, $m);
}
}
push @ranges, $start == $prev ? $start : "$start-$prev";
return \@ranges;
}
sub duplicate_list {
my (@v) = @_;
my %count;
++$count{$_} for @v;
return [ sort { $a <=> $b } grep { $count{$_} > 1 } keys %count ];
}
sub percentile {
my ($p, @values) = @_;
@values = sort { $a <=> $b } @values;
return undef unless @values;
return $values[0] if @values == 1;
my $rank = ($p / 100.0) * (@values - 1);
my $lo = int($rank);
my $hi = $lo + 1;
return $values[$lo] if $hi > $#values;
my $frac = $rank - $lo;
return $values[$lo] + (($values[$hi] - $values[$lo]) * $frac);
}
sub stddev {
my (@values) = @_;
return 0 if @values < 2;
my $mean = sum(@values) / @values;
my $ss = 0;
$ss += ($_ - $mean) ** 2 for @values;
return sqrt($ss / @values);
}
sub format_hms_epoch {
my ($epoch) = @_;
my $whole = int($epoch);
my $ms = int(($epoch - $whole) * 1000.0 + 0.5);
if ($ms >= 1000) {
++$whole;
$ms -= 1000;
}
return strftime('%H:%M:%S', localtime($whole)) . sprintf('.%03d', $ms);
}
sub basename {
my ($path) = @_;
$path =~ s{.*/}{};
return $path;
}
sub csvq {
my ($v) = @_;
$v = '' unless defined $v;
$v =~ s/"/""/g;
return '"' . $v . '"';
}
sub usage {
return <<'USAGE';
Usage: analyze_reticulum_file_transfer_20260516_1130.pl [options] node1.log node2.log [more.log ...]
Options:
--detail print one row per received file chunk
--csv file.csv write per-chunk data to CSV
--provenance print captured command clumps from each log
The script ignores the command provenance at the top of each captured terminal log
until it sees '# End of command clump'. It then parses the date, chronyc notes,
file send declarations, hello RX messages, and multiline RX file_chunk records.
USAGE
}