Silly ntpd packet decoder for my study group

ntp-packet-decoder.pl

#!/usr/local/bin/perl

use v5.14;
use warnings;

use IO::Socket 1.18;
use Digest::MD5 qw(md5 md5_hex);
use Time::HiRes qw(time);

# epoch = January 1, 1900
# 64 bit timestamps, 32 bits for seconds since epoch, 32 bits for fractional
# seconds
#
# S = server, C = client
#
# t0 = C sends req
# t1 = S receives req
# t2 = S sends res
# t3 = C receives res
# t3 - t0 = time elapsed between between req and res on C
# t2 - t1 = time spent to compute res on S
# round trip delay = (t3 - t0) - (t2 - t1)
# offset to C's clock = ((t1 - t0) + (t3 - t2)) / 2

use constant {
    # seconds between NTP epoch (Jan 1 1900) and UNIX epoch (Jan 1 1970)
    NTP_EPOCH_OFFSET => 2_208_988_800,
};

my $pack_format = join(
    " ",
    qw[
        C c c c
        n B16
        n B16
        C C C C
        N B32
        N B32
        N B32
        N B32
    ],
#        n n/A
#        n n/A
);

my $t0 = time() + NTP_EPOCH_OFFSET;

my $packet;
$packet .= pack(
    $pack_format,
    pack_leap_version_mode(0, 4, 3), 0, 0, 0, # li/vn/mode, stratum, poll, precision
    0, frac2bin(0.0), # root delay
    0, frac2bin(0.0), # root dispersion
    pack_reference_id("JJY"), # ref_id 10.187.212.22
    0, frac2bin(0.0), # t_ref
    int($t0), frac2bin($t0), # t0
    0, frac2bin(0.0), # t1
    0, frac2bin(0.0), # t2
                      # t3 is computed on the client upon packet arrival
#    1, 123, # extension 1
#    2, 321, # extension 2
);

my $sock = IO::Socket::INET->new(
    PeerAddr => "ntp0",
    PeerPort => "ntp",
    Proto    => "udp",
    Timeout  => 10,
) or die $!;
$sock->send($packet) or die $!;
$sock->recv($packet, 128);

my $t3 = time();

say "Received: " . length($packet);
open my $fh, ">:raw", "/tmp/ntp";
print $fh $packet;
close $fh;

#say md5_hex($packet);
#
#my $md5  = md5($packet);
#$packet .= pack("N", 31337);
#$packet .= $md5;

my @fields = qw(
    leap/ver/mode stratum poll precision
    root_sec root_frac
    disp_sec disp_frac
    ref_id_1 ref_id_2 ref_id_3 ref_id_4
    ref_sec ref_frac
    t0_sec t0_frac
    t1_sec t1_frac
    t2_sec t2_frac
);
#    ext1_type ext1_val
#    ext2_type ext2_val
#    key
#    md5
my $unpack_format = join(
    " ",
    qw[
        C c c c
        n B16
        n B16
        C C C C
        N B32
        N B32
        N B32
        N B32
    ],
#        n n/A
#        n n/A
#        N
#        H*
);

my @values = unpack($unpack_format, $packet);

my $stashed_stratum;
my @stashed_ref_id;
my $stashed_epoch;
for my $i (0 .. $#fields) {
    my $k = $fields[$i];
    my $v = $values[$i];

    if($k =~ /_sec\z/) {
        $stashed_epoch = $v;
        next;
    }
    elsif($k =~ /^([^_]+)_frac\z/) {
        $k = $1;
        $stashed_epoch += bin2frac($v);
        if($k ne "root" and $k ne "disp") {
            $stashed_epoch -= NTP_EPOCH_OFFSET;
        }
        $v = $stashed_epoch;
    }
    elsif($k eq "leap/ver/mode") {
        $v = unpack_leap_version_mode($v);
    }
    elsif($k eq "stratum") {
        $stashed_stratum = $v;
        $v = stratum_with_description($v);
    }
    elsif($k eq "poll" or $k eq "precision") {
        $v = log2d($v);
    }
    elsif($k =~ /^ref_id_[0-9]$/) {
        push @stashed_ref_id, $v;
        if(@stashed_ref_id < 4) {
            next;
        }
        $k = "ref_id";
        $v = unpack_reference_id(\@stashed_ref_id, $stashed_stratum);
        $stashed_stratum = undef;
        @stashed_ref_id  = ();
    }

    printf("%-10s = %s\n", $k, $v);
}

printf("%-10s = %s\n", "t3",  $t3);

sub log2d {
    my($n) = @_;

    if($n < 0) {
        return 1.0 / (1.0 << -$n);
    }
    else {
        return 1 << $n;
    }
}

sub unpack_reference_id {
    my($ref_id_bytes, $stratum) = @_;

    if($stratum == 0 or $stratum == 1) {
        my $string = join("", map(chr, @$ref_id_bytes));
        $string =~ s/\s+$//;
        if($stratum == 0) {
            $string .= " (kiss code)";
        }
        else {
            $string .= " (reference clock id)";
        }
        return $string;
    }
    else {
        return join(".", @$ref_id_bytes);
    }
}

sub pack_reference_id {
    my($string) = @_;

    while(length($string) < 4) {
        $string .= " ";
    }

    map(ord, split(//, $string));
}

sub pack_leap_version_mode {
    my($leap_indicator, $version, $mode) = @_;

    ((($leap_indicator << 3) | $version) << 3) | $mode;
}

sub unpack_leap_version_mode {
    my($num) = @_;

    my $leap_indicator = ($num >> 6) & 0b00000011;
    my $version        = ($num >> 3) & 0b00000111;
    my $mode           = ($num >> 0) & 0b00000111;

    $leap_indicator = [
        "no leap second",
        "61 seconds",
        "59 seconds",
        "unknown",
    ]->[$leap_indicator];

    $mode = [
        "reserved",
        "symmetric active",
        "symmetric passive",
        "client",
        "server",
        "broadcast",
        "control message",
        "reserved",
    ]->[$mode];

    sprintf("%s/%d/%s", $leap_indicator, $version, $mode);
}

sub stratum_with_description {
    my($stratum) = @_;

    my $desc;
    if($stratum == 0)     { $desc = "invalid or unspecified"; }
    elsif($stratum == 1)  { $desc = "primary"; }
    elsif($stratum == 16) { $desc = "unsynchronised"; }
    elsif($stratum >= 2 and $stratum <= 15) { $desc = "secondary"; }
    else { $desc = "reserved"; }

    $desc;
}

sub bin2frac {
    my($bin) = @_;

    my $frac;
    for my $digit (reverse(split(//, $bin))) {
        $frac += $digit;
        $frac /= 2;
    }

    sprintf("%.5f", $frac);
}

sub frac2bin {
    my($frac) = @_;

    my $bin = '';
    while(length($bin) < 32) {
        $bin .= int($frac * 2);
        $frac = ($frac * 2) - int($frac * 2);
    }

    $bin;
}