Hello Everyone,

About a year ago I started with the idea of creating a Perl module based on Net::NTP. The module that I am thinking to create would be named (Net::SNTP::Client). The difference between those two is the precision, from my point of view the Net::NTP module does not get correct millisecond/nanosecond precision. The module is based on RFC4330, where according to the RFC different precision will achieved on LinuxOS and WindowsOS.

In theory the module should be compatible with all OS (WindowsOS, LinuxOS and MacOS) please verify that with me since I only have LinuxOS.

I am planning to create also another module Net::SNTP::Server which is approximately an SNTP server and when I say approximately is because I can not figure it out how to replicate the server side. But any way first thing first.

Is it possible to take a look and assist me in possible improvements and comments. Since this is my first module I have no experience so maybe the module is not well written.

The execution of the script is very simple, create a script e.g. client.pl and put the code bellow.

client.pl

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

#path to the location of the module
use lib '/home/username/Desktop/SNTP_Module/'; # note here
use Net::SNTP::Client;

=netNTP
use Net::NTP;
my %response = get_ntp_response("192.36.144.22:123");

print Dumper \%response;
=cut

my %hashInput = (
    -hostname      => "192.36.144.22",
    -port          => 123,
    -RFC4330       => 1,
    -clearScreen   => 1,
);

my ($error, $hashOutput) = getSNTPTime( %hashInput );

print Dumper $hashOutput;
print "Error: $error\n" if ($error);

[download]

I have inserted four options:

    -hostname      => NTP Hostname or NTP IP
    -port          => 123 Default or Users choice e.g. 5000
    -RFC4330       => 1
    -clearScreen   => 1

[download]

The first option is to get an RFC4330 printout way, and the second option is to clear the screen before the printout. I think both options will be useful on the printout of the script.

I have chosen to paste the module in the folder path "/home/username/Desktop/SNTP_Module/Net/SNTP/Client.pl". Remember for testing purposes to change the path on client.pl accordingly on the location that you will place the module.

Update 1: Removing (EXPORT_OK, EXPORT_TAGS, shebang line) based on toolic comments.

Update 2: Removing $frac2bin unused sub.

Update 3: Adding some checks on the input of getSNTPTime sub

Update 4: Adding Plain Old Documentation format and updating code based on Monk::Thomas comments.

Update 5: Updating code based on Monk::Thomas new comments.

Update 6: Updating code, with new updated Plain Old Documentation.

Net::SNTP::Client.pm

package Net::SNTP::Client;

=head1 NAME

Net::SNTP::Client - Perl module to retrieve higher accuracy from NTP s
+erver

=head1 SYNOPSIS

  use Net::SNTP::Client;

  my %hashInput = (
      -hostname      => "0.pool.ntp.org", # hostnmae or IP
      -port          => 123, # default NTP port 123 
      -RFC4330       => 1,
      -clearScreen   => 1,
      );

  my ( $error , $hashRefOutput ) = getSNTPTime( %hashInput );

=head1 ABSTRACT

The module sends a UDP packet formated according to L<RFC4330|https://
+tools.ietf.org/html/rfc4330> to a defined NTP server set by the user.
+ The received packet, gets decoded to a human readable form and also 
+calculated the roundtrip delay d and system clock offset t, based on 
+the decoded data.

=head1 DESCRIPTION

This module exports a single method (getSNTPTime) and returns an assoc
+iative hash of hashes upon RFC4330 and a string in case of an error o
+ccurs. The response from the NTP or SNTP server is beeen decoded to a
+ human readable format. The obtained information recieved from the se
+rver can be can be used into further processing or manipulation accor
+ding to the user needs. Maximum accuracy down to nano seconds can onl
+y be achieved on LinuxOS.

=head2 EXPORT

  my %hashInput = (
      -hostname      => "0.pool.ntp.org", # hostnmae or IP
      -port          => 123, # default NTP port 123 
      -RFC4330       => 1,
      -clearScreen   => 1,
      );

  my ( $error , $hashRefOutput ) = getSNTPTime( %hashInput );

This module exports a single method - getSNTPTime and an error string 
+in case of an error or a faulty operation. It expects a hash as an in
+put. The input can have four different hash keys => values (-hostname
+, port, RFC4330 and -clearScreen). 

-hostname: The mandatory key inorder the method to produce an output i
+s only the hostname, the rest of the keys are optional. 

-port: By default the the port is set to 123 (NTP default port). The u
+ser has the option to overwite the port based on his preference (e.g.
+ -port => 123456).

-RFC4330: This is an optional way to produce an easy visuable output b
+ased on RFC4330 documentation.

-clearScreen: This is an optional choice based on user preference if h
+e/she desires to clear the "terminal screen" before printing the capt
+ured data.

=cut

use strict;
use warnings;

## Validate the version of Perl

BEGIN
{
   die 'Perl version 5.6.0 or greater is required' if ($] < 5.006);
}

## Version of the Net::SNTP::Client module

our $VERSION = '0.01';
    $VERSION = eval $VERSION;

## Load our modules

use IO::Socket::INET;
use Time::HiRes qw( gettimeofday );

## Handle importing/exporting of symbols

use base qw( Exporter );
our @ISA         = qw ( Exporter );
our @EXPORT      = qw ( getSNTPTime );

## Define constands

use constant {
    TRUE             => 1,
    FALSE            => 0,
    MAXBYTES         => 512,
    ARGUMENTS        => 1,
    UNIX_EPOCH       => 2208988800,
    MIN_UDP_PORT     => 1,
    MAX_UDP_PORT     => 65535,
    DEFAULT_NTP_PORT => 123,
};

sub getSNTPTime {

    my $unpack_ip = sub {
    my $ip;
    my $stratum = shift;    
    my $tmp_ip = shift;
    if($stratum < 2){
        $ip = unpack("A4", 
             pack("H8", $tmp_ip)
        );
    }else{
        $ip = sprintf("%d.%d.%d.%d",
              unpack("C4",
                 pack("H8", $tmp_ip)
              )
        );
    }
    return $ip;
    };

    my $bin_2_frac = sub {
    my @bin = split '', shift;
    my $frac = 0;
    while (@bin) {
        $frac = ( $frac + pop @bin ) / 2;
    }
    return $frac;
    };

    my $bin_2_dec = sub {
    my $bits     = shift;
    my $size     = shift;
    my $template = shift;
    return unpack($template, pack("B$size", substr("0" x $size . $bits
+ , -$size)));
    };

    my $checkHashKeys = sub {
    my @keysToCompare = ( "-hostname", "-port", "-RFC4330", "-clearScr
+een" );
    my %hashInputToCompare = @_;
    my @hashInputKeysToCompare = keys %hashInputToCompare;
    
    my @differendKeys = keyDifference(\@hashInputKeysToCompare, \@keys
+ToCompare);
    
    if (@differendKeys) { return TRUE } else { return FALSE };
    
    sub keyDifference {
        my %hashdiff = map{ $_ => 1 } @{$_[1]}; 
        return grep { !defined $hashdiff{$_} }  @{$_[0]};
    }
    };

    my $verify_port = sub {
    my $port = shift;
    if ( defined $port && $port =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\
+d+)?\z/i ) {
        if ( $port <= MIN_UDP_PORT || $port >= MAX_UDP_PORT ) {
        return TRUE;
        }
    }
    return FALSE;
    };
    
    my $dot = ".";
    my $error = undef;
    my $rcvSntpPacket = undef;

    my %moduleInput = @_;
    my %moduleOutput = ();

    return ($error = "Not defined key(s)", \%moduleInput) if ($checkHa
+shKeys->(%moduleInput));
    return ($error = "Not defined Hostname", \%moduleInput) if (!$modu
+leInput{-hostname});
    return ($error = "Not correct port number", \%moduleInput) if ($ve
+rify_port->($moduleInput{-port}));

    my $client_socket;

    eval {
    $client_socket = new IO::Socket::INET (
        PeerHost => $moduleInput{-hostname},
        Type     => SOCK_DGRAM,
        PeerPort => $moduleInput{-port} || DEFAULT_NTP_PORT, # Default
+ NTP port 123
        Proto    => 'udp'
        ) or die "Error Creating Socket";
    };
    return ($error = "Problem While Creating Socket '$!'", \%moduleInp
+ut) if ( $@ && $@ =~ /Error Creating Socket/ );

    my $clientLi = 0;
    my $clientVn = 4;
    my $clientMode = 3;
    # $li = 00 2 bit = value 0 no warning
    # $vn = 100 3 bit = Value 4 IPV4
    # $mode = 011 3 bit = Value 3 client mode
    my $clientLiVnMode = '00100011'; # 8 bit
    my $clientStratum = '0'; # 8 bit
    my $clientPoll = '0'; # 8 bit
    my $clientPrecision = '0'; # 8 bit
    my $clientRootDelay = '0'; # 32 bit
    my $clientDispersion = '0'; # 32 bit
    my $clientReferenceIdentifier = '0'; # 32 bit
    my $clientReferenceTimestampSec = '0'; # 32 bit
    my $clientReferenceTimestampMicrosec = '0'; # 32 bit
    my $clientOriginateTimestampSec = '0'; # 32 bit
    my $clientOriginateTimestampMicrosec = '0'; # 32 bit
    my $clientReceiveTimestampSec = '0'; # 32 bit
    my $clientReceiveTimestampMicrosec = '0'; # 32 bit

    my ($clientTransmitSec , $clientTransmitMicrosec) = gettimeofday()
+;
    my $clientTransmitTimestamp = $clientTransmitSec . $dot . $clientT
+ransmitMicrosec;

    my @arraySendSntpPacket = ( $clientLiVnMode , $clientStratum , $cl
+ientPoll , $clientPrecision , $clientRootDelay , $clientDispersion , 
+$clientReferenceIdentifier , $clientReferenceTimestampSec , $clientRe
+ferenceTimestampMicrosec , $clientOriginateTimestampSec , $clientOrig
+inateTimestampMicrosec , $clientReceiveTimestampSec , $clientReceiveT
+imestampMicrosec , $clientTransmitSec , $clientTransmitMicrosec );

    my $sendSntpPacket = pack "B8 C3 N11", @arraySendSntpPacket;

    eval {
    $client_socket->send( $sendSntpPacket )
        or die "Error Sending";
    };
    return ($error = "Problem While Sending '$!'", \%moduleInput) if (
+ $@ && $@ =~ /Error Sending/ );

    eval {
    $client_socket->recv( $rcvSntpPacket , MAXBYTES )
        or die "Error Receiving";
    };
    return ($error = "Problem While Receiving '$!'", \%moduleInput) if
+ ( $@ && $@ =~ /Error Receiving/ );

    ($clientReceiveTimestampSec , $clientReceiveTimestampMicrosec) = g
+ettimeofday();
    my $clientReceiveTimestamp = $clientReceiveTimestampSec . $dot . $
+clientReceiveTimestampMicrosec;

    eval {
    $client_socket->close()
        or die "Error Closing Socket";
    };
    return ($error = "Problem While Clossing Socket '$!'", \%moduleInp
+ut) if ( $@ && $@ =~ /Error Closing Socket/ );

    my @arrayRcvSntpPacket = unpack("B8 C3 n B16 n B16 H8 N8" , $rcvSn
+tpPacket);

    my ( $serverLiVnMode , $serverStratum , $serverPollInterval , $ser
+verPrecision , $serverRootDelaySec , $serverRootDelayMicrosec , $serv
+erDispersionSec, $serverDispersionMicrosec , $serverReferenceIdentifi
+erBinary , $serverReferenceTimestampSec , $serverReferenceTimestampMi
+crosec , $serverOriginateTimestampSec , $serverOriginateTimestampMicr
+osec , $serverReceiveTimestampSec , $serverReceiveTimestampMicrosec ,
+ $serverTransmitTimestampSec , $serverTransmitTimestampMicrosec ) = @
+arrayRcvSntpPacket;

    my $serverLiBinary = substr( $serverLiVnMode , 0 , 2 );
    my $serverLi = $bin_2_dec->( $serverLiBinary , 8 , "c" );

    my $serverVnBinary = substr( $serverLiVnMode , 2 , 3 );
    my $serverVn = $bin_2_dec->( $serverVnBinary , 8 , "c" );

    my $serverModeBinary = substr( $serverLiVnMode , 5 , 3 );
    my $serverMode = $bin_2_dec->( $serverModeBinary , 8 , "c" );

    my $serverPoll = (sprintf("%0.1d", $serverPollInterval));

    if ($serverPrecision < 127) {
    $serverPrecision = 0;
    }
    else {
    $serverPrecision = $serverPrecision - 255;
    }

    my $serverRootDelay = ($bin_2_frac -> ($serverRootDelayMicrosec));
    my $serverDispersionSeconds = sprintf("%0.10f", $serverDispersionS
+ec);
    $serverDispersionSeconds =~ s/\..*$//;
    my $serverDispersionFinalSeconds = $bin_2_frac->($serverDispersion
+Seconds);
    my $serverDispersionMicroSeconds = sprintf("%0.10f", $serverDisper
+sionMicrosec);
    $serverDispersionMicroSeconds =~ s/\..*$//;
    my $serverDispersionFinalMicroSeconds = $bin_2_frac->($serverDispe
+rsionMicroSeconds);
    my $serverReferenceIdentifier = $unpack_ip->($serverStratum, $serv
+erReferenceIdentifierBinary);

    $serverReferenceTimestampSec -= UNIX_EPOCH;
    my $serverReferenceTimestamp = $serverReferenceTimestampSec . $dot
+ . $serverReferenceTimestampMicrosec;
    my $serverOriginateTimestamp = $serverOriginateTimestampSec . $dot
+ . $serverOriginateTimestampMicrosec;
    $serverReceiveTimestampSec -= UNIX_EPOCH;
    my $serverReceiveTimestamp = $serverReceiveTimestampSec . $dot . $
+serverReceiveTimestampMicrosec;
    $serverTransmitTimestampSec -= UNIX_EPOCH;
    my $serverTransmitTimestamp = $serverTransmitTimestampSec . $dot .
+ $serverTransmitTimestampMicrosec;

    my $d = ( ( $clientReceiveTimestamp -  $clientTransmitTimestamp ) 
+- ( $serverReceiveTimestamp - $serverTransmitTimestamp ) );
    my $t = ( ( ( $serverReceiveTimestamp -  $clientTransmitTimestamp 
+) + ( $serverTransmitTimestamp - $clientReceiveTimestamp ) ) / 2 );

    (system $^O eq 'MSWin32' ? 'cls' : 'clear') if ($moduleInput{-clea
+rScreen});

    if ($moduleInput{-RFC4330}) {    
    $moduleOutput{-RFC4330} = "
\t Timestamp Name \t ID \t When Generated
\t ------------------------------------------------------------
\t Originate Timestamp \t T1 \t time request sent by client
\t Receive Timestamp \t T2 \t time request received by server
\t Transmit Timestamp \t T3 \t time reply sent by server
\t Destination Timestamp \t T4 \t time reply received by client

\t The roundtrip delay d and local clock offset t are defined as

\t d = (T4 - T1) - (T2 - T3) \t t = ((T2 - T1) + (T3 - T4)) / 2 \n

\t Round Trip delay: ".$d."\n
\t Clock offset: ".$t."\n

\t Field Name \t\t\t Unicast/Anycast
\t\t\t\t Request \t\t Reply
\t ------------------------------------------------------------
\t LI \t\t\t ".$clientLi." \t\t\t ".$serverLi."
\t VN \t\t\t ".$clientVn." \t\t\t ".$serverVn."
\t Mode \t\t\t ".$clientMode." \t\t\t ".$serverMode."
\t Stratum \t\t ".$clientStratum." \t\t\t ".$serverStratum."
\t Poll \t\t\t ".$clientPoll." \t\t\t ".$serverPollInterval."
\t Precision \t\t ".$clientPrecision." \t\t\t ".$serverPrecision."
\t Root Delay \t\t ".$clientRootDelay." \t\t\t ".$serverRootDelay."
\t Root Dispersion \t ".$clientDispersion." \t\t\t ".$serverDispersion
+FinalMicroSeconds."
\t Reference Identifier \t ".$clientReferenceIdentifier." \t\t\t ".$se
+rverReferenceIdentifier."
\t Reference Timestamp \t ".$clientReferenceTimestampSec.$clientRefere
+nceTimestampMicrosec." \t\t\t ".$serverReferenceTimestamp."
\t Originate Timestamp \t ".$clientOriginateTimestampSec.$clientOrigin
+ateTimestampMicrosec." \t\t\t ".$serverOriginateTimestamp."
\t Receive Timestamp \t ".$clientReceiveTimestamp." \t ".$serverReceiv
+eTimestamp."
\t Transmit Timestamp \t ".$clientTransmitTimestamp." \t ".$serverTran
+smitTimestamp."\n\n";
    }
    else {
    %moduleOutput = (
        $moduleInput{-hostname} => {
        "LI"                   => $serverLi,
        "VN"                   => $serverVn,
        "Mode"                 => $serverMode,
        "Stratum"              => $serverStratum,
        "Poll"                 => $serverPollInterval,
        "Precision"            => $serverPrecision,
        "Root Delay"           => $serverRootDelay,
        "Root Dispersion"      => $serverDispersionFinalMicroSeconds,
        "Reference Identifier" => $serverReferenceIdentifier,
        "Reference Timestamp"  => $serverReferenceTimestamp,
        "Originate Timestamp"  => $serverOriginateTimestamp,
        "Receive Timestamp"    => $serverReceiveTimestamp,
        "Transmit Timestamp"   => $clientTransmitTimestamp,
        },
        $0 => {
        "LI"                   => $clientLi,
        "VN"                   => $clientVn,
        "Mode"                 => $clientMode,
        "Stratum"              => $clientStratum,
        "Poll"                 => $clientPoll,
        "Precision"            => $clientPrecision,
        "Root Delay"           => $clientRootDelay,
        "Root Dispersion"      => $clientDispersion,
        "Reference Identifier" => $clientReferenceIdentifier,
        "Reference Timestamp"  => $clientReferenceTimestampSec.$client
+ReferenceTimestampMicrosec,
        "Originate Timestamp"  => $clientOriginateTimestampSec.$client
+OriginateTimestampMicrosec,
        "Receive Timestamp"    => $clientReceiveTimestamp,
        "Transmit Timestamp"   => $serverTransmitTimestamp,
        },
        RFC4330 => {
        "Round Trip Delay"     => $d,
        "Clock Offset"         => $t
        }
        );
    }

    return $error, \%moduleOutput;
}

=head1 BUGS AND SUPPORT

This module should be considered beta quality, everything seems to wor
+k but it may yet contain critical bugs.

If you find any, report it via email (to garyfalos@cpan.org), please.

Feedback and comments are also welcome!

=head1 SEE ALSO

perl, IO::Socket, Net::NTP, RFC4330

Net::NTP has a similar focus as this module. In my opinion it is less 
+accurate when it comes to the precission bellow second(s).

=head1 AUTHOR

Athanasios Garyfalos E<lt>garyfalos@cpan.orgE<gt>

=head1 ACKNOWLEDGMENTS

The original concept for this module was based on F<NTP.pm>
written by James G. Willmore E<lt>willmorejg@gmail.comE<gt>.

Copyright 2004 by James G. Willmore

This library is free software; you can redistribute it and/or modify i
+t under
 the same terms as Perl itself.

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2015 Athanasios Garyfalos.  All rights reserved.

This program is free software; you may redistribute it and/or modify i
+t under
 the same terms as the Perl 5 programming language system itself.

=head1 CHANGE LOG
$Log: Client.pm,v $
Revision 1.0  2015/07/01 22:53:31 Thanos

=cut

1;

[download]

Thank you for your time and effort reading and replying to my question/review.

Seeking for Perl wisdom...on the process of learning...not there...yet!

In reply to RFC: Net::SNTP::Client v1 by thanos1983

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.