690 lines
24 KiB
Perl
Executable file
690 lines
24 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
# ./analyze_reticulum_file_transfer_20260518_1930.pl 20250518_1843_zerodev1_Gate2F_If_30seconds.txt 20250518_1843_zerodev2_Gate2F_If_30seconds.txt
|
|
# ./analyze_reticulum_file_transfer_20260518_1930.pl --detail 20250518_1843_zerodev1_Gate2F_If_30seconds.txt 20250518_1843_zerodev2_Gate2F_If_30seconds.txt
|
|
# ./analyze_reticulum_file_transfer_20260518_1930.pl --provenance --command-root /usr/local/src/ble-reticulum 20250518_1843_zerodev1_Gate2F_If_30seconds.txt 20250518_1843_zerodev2_Gate2F_If_30seconds.txt
|
|
# ./analyze_reticulum_file_transfer_20260518_1930.pl --csv chunks_$(date +%Y%m%d_%H%M).csv 20250518_1843_zerodev1_Gate2F_If_30seconds.txt 20250518_1843_zerodev2_Gate2F_If_30seconds.txt
|
|
#
|
|
=pod
|
|
This version accepts both terminal captures that begin with a pasted command clump
|
|
and newer terminal captures that begin with a shell prompt invoking a command-clump
|
|
script, for example:
|
|
|
|
jlpoole@zerodev1:/usr/local/src/ble-reticulum $ migration/zerodev1_command_clump_Gate2F_If.sh
|
|
|
|
When --provenance is used, the report prints the captured inline command clump
|
|
or, if possible, reads and prints the invoked shell script for posterity. If the
|
|
invoked script is not available locally, the report prints the candidate paths it
|
|
tried so the capture still documents which script was used.
|
|
|
|
=cut
|
|
#
|
|
# chmod 755 analyze_reticulum_file_transfer_20260518_1930.pl
|
|
# 2026-05-18 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);
|
|
use Cwd qw(getcwd abs_path);
|
|
use File::Spec;
|
|
|
|
my $detail = 0;
|
|
my $csv_file = '';
|
|
my $show_provenance = 0;
|
|
my $command_root = '';
|
|
|
|
GetOptions(
|
|
'detail!' => \$detail,
|
|
'csv=s' => \$csv_file,
|
|
'provenance!' => \$show_provenance,
|
|
'command-root=s'=> \$command_root,
|
|
) 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, $command_root);
|
|
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 " %-44s receiver=%-10s date='%s' provenance=%-13s command_lines=%d data_lines=%d\n",
|
|
basename($r->{file}), $r->{receiver}, ($r->{date_line} // 'UNKNOWN'),
|
|
$r->{provenance_type}, scalar(@{ $r->{commands} }), $r->{data_lines};
|
|
|
|
if (defined $r->{invoked_script}) {
|
|
printf " invoked_script : %s\n", $r->{invoked_script};
|
|
printf " invoked_working_dir : %s\n", ($r->{invoked_cwd} // 'UNKNOWN');
|
|
printf " resolved_script : %s\n", ($r->{resolved_script} // 'not readable locally');
|
|
}
|
|
}
|
|
print "\n";
|
|
|
|
print "CPP backend preflight summary:\n";
|
|
for my $r (@log_reports) {
|
|
printf " %s\n", basename($r->{file});
|
|
my $cpp = $r->{cpp};
|
|
printf " BLE_RETICULUM_SESSION_BACKEND : %s\n", ($cpp->{env_session_backend} // 'not seen');
|
|
printf " BLE_RETICULUM_FRAGMENTATION_BACKEND : %s\n", ($cpp->{env_fragmentation_backend} // 'not seen');
|
|
printf " ble_protocol_core_cpp : %s\n", ($cpp->{module_path} // 'not seen');
|
|
printf " fragmentation backend : %s\n", ($cpp->{fragmentation_backend} // 'not seen');
|
|
printf " session backend : %s\n", ($cpp->{session_backend} // 'not seen');
|
|
printf " CPP backend preflight : %s\n", ($cpp->{preflight_ok} ? 'OK' : 'NOT SEEN');
|
|
printf " BLEInterface backend line : %s\n", ($cpp->{bleinterface_backend} // 'not seen');
|
|
}
|
|
print "\n";
|
|
|
|
if ($show_provenance) {
|
|
print "Command provenance:\n";
|
|
for my $r (@log_reports) {
|
|
print "--- ", $r->{file}, " ---\n";
|
|
if (@{ $r->{commands} }) {
|
|
print $_ for @{ $r->{commands} };
|
|
}
|
|
elsif (defined $r->{invoked_script}) {
|
|
print "Invoked from terminal capture:\n";
|
|
print " cwd : ", ($r->{invoked_cwd} // 'UNKNOWN'), "\n";
|
|
print " script : ", $r->{invoked_script}, "\n";
|
|
if (defined $r->{resolved_script}) {
|
|
print "\nResolved local script file: $r->{resolved_script}\n";
|
|
print_file_with_indent($r->{resolved_script}, ' ');
|
|
}
|
|
else {
|
|
print "\nCould not read the invoked script locally. Candidate paths tried:\n";
|
|
print " $_\n" for @{ $r->{script_candidates} };
|
|
}
|
|
}
|
|
else {
|
|
print "No inline command clump or invoked script line was detected.\n";
|
|
}
|
|
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, $command_root) = @_;
|
|
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 %cpp;
|
|
my $pending_chunk_data_bytes;
|
|
my $in_command_clump = 0;
|
|
my $saw_command_clump_start = 0;
|
|
my $provenance_type = 'none';
|
|
my $data_lines = 0;
|
|
my ($invoked_script, $invoked_cwd, $resolved_script, @script_candidates);
|
|
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;
|
|
my $raw = $line;
|
|
chomp(my $line_chomp = $line);
|
|
|
|
if (($line_no == 1 && $line_chomp =~ /^#/)
|
|
|| $line_chomp =~ /^#\s*(?:[^#].*)?Command clump START\s*$/i
|
|
|| $line_chomp =~ /^#\s*Gate\b.*Command/i) {
|
|
$in_command_clump = 1;
|
|
$saw_command_clump_start = 1;
|
|
$provenance_type = 'inline-clump';
|
|
push @commands, $raw;
|
|
next;
|
|
}
|
|
|
|
if ($in_command_clump) {
|
|
push @commands, $raw;
|
|
if ($line_chomp =~ /^#\s*End of command clump\s*$/i
|
|
|| $line_chomp =~ /^#\s*zerodev\d+ Command clump END\s*$/i
|
|
|| $line_chomp =~ /^#\s*(?:[^#].*)?Command clump END\s*$/i) {
|
|
$in_command_clump = 0;
|
|
}
|
|
next;
|
|
}
|
|
|
|
if (!defined $invoked_script && $line_chomp =~ /^\S+@\S+:(.+?)\$\s+(.+\.sh)(?:\s+.*)?$/) {
|
|
$invoked_cwd = trim($1);
|
|
$invoked_script = trim($2);
|
|
$invoked_script =~ s/\s+.*$//;
|
|
$provenance_type = 'script' unless $saw_command_clump_start;
|
|
($resolved_script, @script_candidates) = resolve_invoked_script($file, $invoked_cwd, $invoked_script, $command_root);
|
|
next;
|
|
}
|
|
|
|
++$data_lines;
|
|
|
|
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 =~ /^PYTHON:\s*(.+)$/) {
|
|
$cpp{python} = $1;
|
|
}
|
|
elsif ($line_chomp =~ /^PYTHONPATH:\s*(.+)$/) {
|
|
$cpp{pythonpath} = $1;
|
|
}
|
|
elsif ($line_chomp =~ /^BLE_RETICULUM_SESSION_BACKEND:\s*(.+)$/) {
|
|
$cpp{env_session_backend} = $1;
|
|
}
|
|
elsif ($line_chomp =~ /^BLE_RETICULUM_FRAGMENTATION_BACKEND:\s*(.+)$/) {
|
|
$cpp{env_fragmentation_backend} = $1;
|
|
}
|
|
elsif ($line_chomp =~ /^ble_protocol_core_cpp:\s*(.+)$/) {
|
|
$cpp{module_path} = $1;
|
|
}
|
|
elsif ($line_chomp =~ /^fragmentation backend:\s*(.+)$/) {
|
|
$cpp{fragmentation_backend} = $1;
|
|
}
|
|
elsif ($line_chomp =~ /^session backend:\s*(.+)$/) {
|
|
$cpp{session_backend} = $1;
|
|
}
|
|
elsif ($line_chomp =~ /^CPP backend preflight:\s*OK\s*$/) {
|
|
$cpp{preflight_ok} = 1;
|
|
}
|
|
elsif ($line_chomp =~ /BLEInterface\[BLE Interface\]\s+fragmentation backend:\s*(.+)$/) {
|
|
$cpp{bleinterface_backend} = $1;
|
|
}
|
|
|
|
if ($line_chomp =~ /^\[(\d\d):(\d\d):(\d\d)\.(\d{3})\]\s+Starting node\s+(\S+)/) {
|
|
$receiver = $5;
|
|
}
|
|
|
|
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 ($raw =~ /^\[(\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 = $raw;
|
|
$current_recv_parts = [$1, $2, $3, $4];
|
|
$current_line_no = $line_no;
|
|
if ($raw =~ /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 .= $raw;
|
|
if ($raw =~ /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,
|
|
data_lines => $data_lines,
|
|
provenance_type => $provenance_type,
|
|
invoked_script => $invoked_script,
|
|
invoked_cwd => $invoked_cwd,
|
|
resolved_script => $resolved_script,
|
|
script_candidates => \@script_candidates,
|
|
chunks => \@chunks,
|
|
hellos => \@hellos,
|
|
chrony_system_time => \@chrony_system_time,
|
|
sent_declared => \%sent_declared,
|
|
cpp => \%cpp,
|
|
};
|
|
}
|
|
|
|
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 resolve_invoked_script {
|
|
my ($log_file, $remote_cwd, $script, $command_root) = @_;
|
|
my @candidates;
|
|
my $log_dir = dirname($log_file);
|
|
my $local_cwd = getcwd();
|
|
|
|
if (File::Spec->file_name_is_absolute($script)) {
|
|
push @candidates, $script;
|
|
}
|
|
else {
|
|
push @candidates, File::Spec->catfile($remote_cwd, $script) if defined $remote_cwd && $remote_cwd ne '';
|
|
push @candidates, File::Spec->catfile($command_root, $script) if defined $command_root && $command_root ne '';
|
|
push @candidates, File::Spec->catfile($log_dir, $script) if defined $log_dir && $log_dir ne '';
|
|
push @candidates, File::Spec->catfile($log_dir, basename($script)) if defined $log_dir && $log_dir ne '';
|
|
push @candidates, File::Spec->catfile($local_cwd, $script) if defined $local_cwd && $local_cwd ne '';
|
|
}
|
|
|
|
my %seen;
|
|
@candidates = grep { defined $_ && $_ ne '' && !$seen{$_}++ } @candidates;
|
|
for my $candidate (@candidates) {
|
|
return ($candidate, @candidates) if -r $candidate && -f $candidate;
|
|
}
|
|
return (undef, @candidates);
|
|
}
|
|
|
|
sub print_file_with_indent {
|
|
my ($file, $indent) = @_;
|
|
open my $fh, '<', $file or do {
|
|
print $indent, "Cannot open $file: $!\n";
|
|
return;
|
|
};
|
|
while (my $line = <$fh>) {
|
|
print $indent, $line;
|
|
}
|
|
close $fh;
|
|
}
|
|
|
|
sub dirname {
|
|
my ($path) = @_;
|
|
$path =~ s{/+$}{};
|
|
return '.' unless $path =~ m{/};
|
|
$path =~ s{/[^/]+$}{};
|
|
return $path eq '' ? '/' : $path;
|
|
}
|
|
|
|
sub trim {
|
|
my ($v) = @_;
|
|
$v = '' unless defined $v;
|
|
$v =~ s/^\s+//;
|
|
$v =~ s/\s+$//;
|
|
return $v;
|
|
}
|
|
|
|
sub usage {
|
|
return <<'USAGE';
|
|
Usage: analyze_reticulum_file_transfer_20260518_1930.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 provenance
|
|
--command-root DIR local checkout root used to resolve invoked .sh scripts
|
|
|
|
This script accepts two provenance styles:
|
|
|
|
1. Old captures with an inline pasted command clump ending in:
|
|
# End of command clump
|
|
|
|
2. New captures where the first terminal line invokes a script, for example:
|
|
jlpoole@zerodev1:/usr/local/src/ble-reticulum $ migration/zerodev1_command_clump_Gate2F_If.sh
|
|
|
|
With --provenance, the report prints the inline clump or tries to read the invoked
|
|
script file. If the remote path is not available locally, pass --command-root
|
|
pointing at the local ble-reticulum checkout.
|
|
USAGE
|
|
}
|