#!/usr/bin/env perl # ./analyze_reticulum_latency_20260516_0842.pl 20250516_0836_zerodev1.txt 20250516_0836_zerodev2.txt # chmod 755 analyze_reticulum_latency_20260516_0842.pl # 2026-05-16 ChatGPT # $Header$ # $HeadURL$ use strict; use warnings; use POSIX qw(strftime); use Time::Local qw(timegm); use List::Util qw(min max sum); my $usage = "Usage: $0 node1.log node2.log [more.log ...]\n"; @ARGV >= 2 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 @rows; my %by_dir; for my $file (@ARGV) { open my $fh, '<', $file or die "Cannot open $file: $!\n"; my $first = <$fh>; defined $first or die "Empty file: $file\n"; chomp $first; my ($year, $month, $day, $tz) = parse_log_date($first); my $receiver = receiver_from_filename($file); while (my $line = <$fh>) { chomp $line; # Example: # [08:33:11.753] RX link=<...>: hello from zerodev2 send_epoch=1778945591.644050 next unless $line =~ /^\[(\d\d):(\d\d):(\d\d)\.(\d{3})\]\s+RX\s+.*?:\s+(.+?)\s+from\s+(\S+)\s+send_epoch=([0-9]+(?:\.[0-9]+)?)/; my ($hh, $mi, $ss, $ms, $message, $sender, $send_epoch) = ($1, $2, $3, $4, $5, $6, $7); my $recv_epoch = epoch_from_local_parts($year, $month, $day, $hh, $mi, $ss, $ms, $tz); my $latency = $recv_epoch - $send_epoch; my $row = { file => $file, sender => $sender, receiver => $receiver, message => $message, send_epoch => $send_epoch + 0.0, recv_epoch => $recv_epoch + 0.0, latency => $latency + 0.0, line => $line, }; push @rows, $row; push @{ $by_dir{"$sender->$receiver"} }, $row; } close $fh; } if (!@rows) { die "No RX lines with send_epoch= were found. Add send_epoch to the payload before running this analyzer.\n"; } print "Reticulum BLE latency analysis\n"; print "Generated: ", strftime('%Y-%m-%d %H:%M:%S %Z', localtime), "\n"; print "Input files:\n"; print " $_\n" for @ARGV; print "\n"; for my $dir (sort keys %by_dir) { my @lat = map { $_->{latency} } @{ $by_dir{$dir} }; my $n = scalar @lat; my $mean = sum(@lat) / $n; my $median = percentile(50, @lat); my $p95 = percentile(95, @lat); my $stddev = stddev(@lat); printf "Direction: %s\n", $dir; printf " samples : %d\n", $n; printf " min : %.6f s %.3f ms\n", min(@lat), min(@lat) * 1000.0; printf " median : %.6f s %.3f ms\n", $median, $median * 1000.0; printf " mean : %.6f s %.3f ms\n", $mean, $mean * 1000.0; printf " p95 : %.6f s %.3f ms\n", $p95, $p95 * 1000.0; printf " max : %.6f s %.3f ms\n", max(@lat), max(@lat) * 1000.0; printf " stddev : %.6f s %.3f ms\n", $stddev, $stddev * 1000.0; print "\n"; } print "Per-message detail:\n"; printf "%10s %-10s %-10s %-18s %12s\n", 'lat_ms', 'sender', 'receiver', 'message', 'recv_minus_send'; for my $r (sort { $a->{recv_epoch} <=> $b->{recv_epoch} } @rows) { printf "%10.3f %-10s %-10s %-18s %12.6f\n", $r->{latency} * 1000.0, $r->{sender}, $r->{receiver}, $r->{message}, $r->{latency}; } print "\n"; print "Caution: one-way latency assumes sender and receiver clocks are synchronized.\n"; print "For tighter measurement, include chronyc tracking output near the run, or use echo/ACK round-trip timestamps.\n"; sub parse_log_date { my ($line) = @_; # Supports: # Sat May 16 08:32:49 PDT 2026 # Sat May 16 08:32:51 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, $tz, $year) = ($1, $2, uc($3), $4); 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 first line: $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 $file; } 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); }