BEGIN {
die
'Perl version 5.6.0 or greater is required'
if
($] < 5.006); }
our
$VERSION
=
'0.20'
;
$VERSION
=
eval
$VERSION
;
our
@EXPORT_OK
=
qw (
getSNTPTime );
TRUE
=> 1,
FALSE
=> 0,
TIMEOUT
=> 10,
MAXBYTES
=> 512,
UNIX_EPOCH
=> 2208988800,
MIN_UDP_PORT
=> 1,
MAX_UDP_PORT
=> 65536,
DEFAULT_NTP_PORT
=> 123,
};
sub
getSNTPTime {
my
$error
=
undef
;
my
%moduleInput
=
@_
;
return
(
$error
=
"Not defined key(s)"
, \
%moduleInput
)
if
(_checkHashKeys(
%moduleInput
));
return
(
$error
=
"Not defined Hostname/IP"
, \
%moduleInput
)
if
(!
$moduleInput
{-hostname});
return
(
$error
=
"Not correct port number"
, \
%moduleInput
)
if
(_verifyPort(
$moduleInput
{-port}));
return
(
$error
=
"Not correct timeOut input"
, \
%moduleInput
)
if
(_verifyNumericInput(
$moduleInput
{-timeOut}));
return
(
$error
=
"Not correct RFC4330 input"
, \
%moduleInput
)
if
(_verifyBoolean(
$moduleInput
{-RFC4330}));
return
(
$error
=
"Not correct clearScreen input"
, \
%moduleInput
)
if
(_verifyBoolean(
$moduleInput
{-clearScreen}));
my
$client_socket
;
eval
{
$client_socket
= new IO::Socket::INET (
PeerHost
=>
$moduleInput
{-hostname},
Type
=> SOCK_DGRAM,
PeerPort
=>
$moduleInput
{-port} || DEFAULT_NTP_PORT,
Proto
=>
'udp'
) or
die
"Error Creating Socket"
;
};
return
(
$error
=
"Problem While Creating Socket '$!'"
, \
%moduleInput
)
if
( $@ && $@ =~ /Error Creating Socket/ );
my
%SNTP_Client_Hash
= (
"LI"
=> 0,
"VN"
=> 4,
"Mode"
=> 3,
"Stratum"
=> 0,
"Poll"
=> 0,
"Precision"
=> 0,
"Root Delay"
=> 0,
"Root Dispersion"
=> 0,
"Reference Identifier"
=> 0,
"Reference Timestamp"
=>
"0.0"
,
"Originate Timestamp"
=>
"0.0"
,
"Receive Timestamp Sec"
=> 0,
"Receive Timestamp Micro Sec"
=> 0,
"Transmit Timestamp Sec"
=> 0,
"Transmit Timestamp Micro Sec"
=> 0,
);
my
@SNTP_Receive
= (
"LI VN Mode"
,
"Stratum"
,
"Poll"
,
"Precision"
,
"Root Delay"
,
"Root Delay Fraction"
,
"Root Dispersion"
,
"Root Dispersion Fraction"
,
"Reference Identifier"
,
"Reference Timestamp Sec"
,
"Reference Timestamp Micro Sec"
,
"Originate Timestamp Sec"
,
"Originate Timestamp Micro Sec"
,
"Receive Timestamp Sec"
,
"Receive Timestamp Micro Sec"
,
"Transmit Timestamp Sec"
,
"Transmit Timestamp Micro Sec"
);
(
$SNTP_Client_Hash
{
"Transmit Timestamp Sec"
} ,
$SNTP_Client_Hash
{
"Transmit Timestamp Micro Sec"
} ) = gettimeofday();
my
$sendSntpPacket
=
pack
(
"B8 C3 N11"
,
'00100011'
,
(0) x 12,
$SNTP_Client_Hash
{
"Transmit Timestamp Sec"
},
$SNTP_Client_Hash
{
"Transmit Timestamp Micro Sec"
} );
eval
{
$client_socket
->
send
(
$sendSntpPacket
)
or
die
"Error Sending"
;
};
return
(
$error
=
"Problem While Sending '$!'"
, \
%moduleInput
)
if
( $@ && $@ =~ /Error Sending/ );
$moduleInput
{-timeOut} = TIMEOUT
if
( !
defined
$moduleInput
{-timeOut});
my
$rcvSntpPacket
=
undef
;
eval
{
local
$SIG
{ALRM} =
sub
{
die
"Error Timeout"
; };
alarm
(
$moduleInput
{-timeOut});
$client_socket
->
recv
(
$rcvSntpPacket
, MAXBYTES )
or
die
"Error Receiving"
;
alarm
(0)
};
if
( $@ && $@ =~ /Error Receiving/ ){
return
(
$error
=
"Problem While Receiving '$!'"
, \
%moduleInput
);
}
elsif
($@ && $@ =~ /Error Timeout/) {
return
(
$error
=
"Net::SNTP::Client timed out waiting the packet '$!'"
, \
%moduleInput
);
}
(
$SNTP_Client_Hash
{
"Receive Timestamp Sec"
} ,
$SNTP_Client_Hash
{
"Receive Timestamp Micro Sec"
} ) = gettimeofday();
eval
{
$client_socket
->
close
()
or
die
"Error Closing Socket"
;
};
return
(
$error
=
"Problem While Clossing Socket '$!'"
, \
%moduleInput
)
if
( $@ && $@ =~ /Error Closing Socket/ );
my
%RcV
;
@RcV
{
@SNTP_Receive
} =
unpack
(
"B8 C3 s n3 H8 N8"
,
$rcvSntpPacket
);
$RcV
{
"LI Binary"
} =
substr
(
$RcV
{
"LI VN Mode"
} , 0 , 2 );
$RcV
{
"LI"
} = _binaryToDecimal(
$RcV
{
"LI Binary"
} , 8 ,
"c"
);
delete
$RcV
{
"LI Binary"
};
$RcV
{
"VN Binary"
} =
substr
(
$RcV
{
"LI VN Mode"
} , 2 , 3 );
$RcV
{
"VN"
} = _binaryToDecimal(
$RcV
{
"VN Binary"
} , 8 ,
"c"
);
delete
$RcV
{
"VN Binary"
};
$RcV
{
"Mode Binary"
} =
substr
(
$RcV
{
"LI VN Mode"
} , 5 , 3 );
$RcV
{
"Mode"
} = _binaryToDecimal(
$RcV
{
"Mode Binary"
} , 8 ,
"c"
);
delete
$RcV
{
"Mode Binary"
};
delete
$RcV
{
"LI VN Mode"
};
$RcV
{
"Poll"
} = (
sprintf
(
"%.1d"
,
$RcV
{
"Poll"
}));
if
(
$RcV
{
"Precision"
} > 127) {
$RcV
{
"Precision"
} =
$RcV
{
"Precision"
} - 255;
}
else
{
$RcV
{
"Precision"
} =
"-"
.
$RcV
{
"Precision"
};
}
$RcV
{
"Root Delay Fraction"
} =
sprintf
(
"%05d"
,
$RcV
{
"Root Delay Fraction"
});
$RcV
{
"Root Delay"
} =
$RcV
{
"Root Delay"
} .
"."
.
$RcV
{
"Root Delay Fraction"
};
$RcV
{
"Root Dispersion Fraction"
} =
sprintf
(
"%05d"
,
$RcV
{
"Root Dispersion Fraction"
});
$RcV
{
"Root Dispersion"
} =
$RcV
{
"Root Dispersion"
} .
"."
.
$RcV
{
"Root Dispersion Fraction"
};
$RcV
{
"Reference Identifier"
} =
_unpackIP(
$RcV
{
"Stratum"
},
$RcV
{
"Reference Identifier"
});
$RcV
{
"Reference Timestamp Sec"
} -= UNIX_EPOCH;
$RcV
{
"Receive Timestamp Sec"
} -= UNIX_EPOCH;
$RcV
{
"Transmit Timestamp Sec"
} -= UNIX_EPOCH;
my
$d
= (
(
(
$SNTP_Client_Hash
{
"Receive Timestamp Sec"
} .
"."
.
$SNTP_Client_Hash
{
"Receive Timestamp Micro Sec"
} ) -
(
$SNTP_Client_Hash
{
"Transmit Timestamp Sec"
} .
"."
.
$SNTP_Client_Hash
{
"Transmit Timestamp Micro Sec"
} )
) -
(
(
$RcV
{
"Transmit Timestamp Sec"
} .
"."
.
$RcV
{
"Transmit Timestamp Micro Sec"
} ) -
(
$RcV
{
"Receive Timestamp Sec"
} .
"."
.
$RcV
{
"Receive Timestamp Micro Sec"
} )
)
);
my
$t
= (
(
(
(
$RcV
{
"Receive Timestamp Sec"
} .
"."
.
$RcV
{
"Receive Timestamp Micro Sec"
} ) -
(
$SNTP_Client_Hash
{
"Transmit Timestamp Sec"
} .
"."
.
$SNTP_Client_Hash
{
"Transmit Timestamp Micro Sec"
} )
) +
(
(
$RcV
{
"Transmit Timestamp Sec"
} .
"."
.
$RcV
{
"Transmit Timestamp Micro Sec"
} ) -
(
$SNTP_Client_Hash
{
"Receive Timestamp Sec"
} .
"."
.
$SNTP_Client_Hash
{
"Receive Timestamp Micro Sec"
} )
)
) / 2
);
(
system
$^O eq
'MSWin32'
?
'cls'
:
'clear'
)
if
(
$moduleInput
{-clearScreen});
my
%moduleOutput
= ();
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
".$SNTP_Client_Hash{"
LI
"}."
\t\t\t
".$RcV{"
LI
"}."
\t VN \t\t\t
".$SNTP_Client_Hash{"
VN
"}."
\t\t\t
".$RcV{"
VN
"}."
\t Mode \t\t\t
".$SNTP_Client_Hash{"
Mode
"}."
\t\t\t
".$RcV{"
Mode
"}."
\t Stratum \t\t
".$SNTP_Client_Hash{"
Stratum
"}."
\t\t\t
".$RcV{"
Stratum
"}."
\t Poll \t\t\t
".$SNTP_Client_Hash{"
Poll
"}."
\t\t\t
".$RcV{"
Poll
"}."
\t Precision \t\t
".$SNTP_Client_Hash{"
Precision
"}."
\t\t\t
".$RcV{"
Precision
"}."
\t Root Delay \t\t
".$SNTP_Client_Hash{"
Root Delay
"}."
\t\t\t
".$RcV{"
Root Delay
"}."
\t Root Dispersion \t
".$SNTP_Client_Hash{"
Root Dispersion
"}."
\t\t\t
".$RcV{"
Root Dispersion
"}."
\t Reference Identifier \t
".$SNTP_Client_Hash{"
Reference Identifier
"}."
\t\t\t
".$RcV{"
Reference Identifier
"}."
\t Reference Timestamp \t
".$SNTP_Client_Hash{"
Reference Timestamp
"}."
\t\t\t ".
$RcV
{
"Reference Timestamp Sec"
}.
"."
.
$RcV
{
"Reference Timestamp Micro Sec"
}."
\t Originate Timestamp \t
".$SNTP_Client_Hash{"
Originate Timestamp
"}."
\t\t\t ".
$RcV
{
"Originate Timestamp Sec"
}.
"."
.
$RcV
{
"Originate Timestamp Micro Sec"
}."
\t Receive Timestamp \t ".
$SNTP_Client_Hash
{
"Receive Timestamp Sec"
}.
"."
.
$SNTP_Client_Hash
{
"Receive Timestamp Micro Sec"
}.
" \t "
.
$RcV
{
"Receive Timestamp Sec"
} .
"."
.
$RcV
{
"Receive Timestamp Micro Sec"
}."
\t Transmit Timestamp \t ".
$SNTP_Client_Hash
{
"Transmit Timestamp Sec"
} .
"."
.
$SNTP_Client_Hash
{
"Transmit Timestamp Micro Sec"
}.
" \t "
.
$RcV
{
"Transmit Timestamp Sec"
} .
"."
.
$RcV
{
"Transmit Timestamp Micro Sec"
}.
""
;
}
else
{
%moduleOutput
= (
$moduleInput
{-hostname} => {
"LI"
=>
$RcV
{
"LI"
},
"VN"
=>
$RcV
{
"VN"
},
"Mode"
=>
$RcV
{
"Mode"
},
"Stratum"
=>
$RcV
{
"Stratum"
},
"Poll"
=>
$RcV
{
"Poll"
},
"Precision"
=>
$RcV
{
"Precision"
},
"Root Delay"
=>
$RcV
{
"Root Delay"
},
"Root Dispersion"
=>
$RcV
{
"Root Dispersion"
},
"Reference Identifier"
=>
$RcV
{
"Reference Identifier"
},
"Reference Timestamp"
=>
$RcV
{
"Reference Timestamp Sec"
}.
"."
.
$RcV
{
"Reference Timestamp Micro Sec"
},
"Originate Timestamp"
=>
$RcV
{
"Originate Timestamp Sec"
}.
"."
.
$RcV
{
"Originate Timestamp Micro Sec"
},
"Receive Timestamp"
=>
$RcV
{
"Receive Timestamp Sec"
}.
"."
.
$RcV
{
"Receive Timestamp Micro Sec"
},
"Transmit Timestamp"
=>
$RcV
{
"Transmit Timestamp Sec"
}.
"."
.
$RcV
{
"Transmit Timestamp Micro Sec"
},
},
$
0
=> {
"LI"
=>
$SNTP_Client_Hash
{
"LI"
},
"VN"
=>
$SNTP_Client_Hash
{
"VN"
},
"Mode"
=>
$SNTP_Client_Hash
{
"Mode"
},
"Stratum"
=>
$SNTP_Client_Hash
{
"Stratum"
},
"Poll"
=>
$SNTP_Client_Hash
{
"Poll"
},
"Precision"
=>
$SNTP_Client_Hash
{
"Precision"
},
"Root Delay"
=>
$SNTP_Client_Hash
{
"Root Delay"
},
"Root Dispersion"
=>
$SNTP_Client_Hash
{
"Root Dispersion"
},
"Reference Identifier"
=>
$SNTP_Client_Hash
{
"Reference Identifier"
},
"Reference Timestamp"
=>
$SNTP_Client_Hash
{
"Reference Timestamp"
},
"Originate Timestamp"
=>
$SNTP_Client_Hash
{
"Originate Timestamp"
},
"Receive Timestamp"
=>
$SNTP_Client_Hash
{
"Receive Timestamp Sec"
}.
"."
.
$SNTP_Client_Hash
{
"Receive Timestamp Micro Sec"
},
"Transmit Timestamp"
=>
$SNTP_Client_Hash
{
"Transmit Timestamp Sec"
}.
"."
.
$SNTP_Client_Hash
{
"Transmit Timestamp Micro Sec"
},
},
RFC4330
=> {
"Round Trip Delay"
=>
$d
,
"Clock Offset"
=>
$t
}
)
}
return
$error
, \
%moduleOutput
;
}
sub
_checkHashKeys {
my
@keysToCompare
= (
"-hostname"
,
"-port"
,
"-timeOut"
,
"-RFC4330"
,
"-clearScreen"
);
my
%hashInputToCompare
=
@_
;
my
@hashInputKeysToCompare
=
keys
%hashInputToCompare
;
my
@differendKeys
= _keyDifference(\
@hashInputKeysToCompare
, \
@keysToCompare
);
if
(
@differendKeys
) {
return
TRUE }
else
{
return
FALSE };
};
sub
_keyDifference {
my
%hashdiff
=
map
{
$_
=> 1 } @{
$_
[1]};
return
grep
{ !
defined
$hashdiff
{
$_
} } @{
$_
[0]};
}
sub
_verifyNumericInput {
my
$numericInput
=
shift
;
return
FALSE
if
(!
defined
$numericInput
);
if
(
defined
$numericInput
&&
$numericInput
=~ /^[0-9]+$/ &&
$numericInput
> 0 ) {
return
FALSE;
}
return
TRUE;
};
sub
_verifyPort {
my
$port
=
shift
;
return
FALSE
if
(!
defined
$port
);
if
( !_verifyNumericInput(
$port
) ) {
if
(
$port
>= MIN_UDP_PORT && MAX_UDP_PORT >=
$port
) {
return
FALSE;
}
}
return
TRUE;
};
sub
_verifyBoolean {
my
$input
=
shift
;
return
FALSE
if
(!
defined
$input
);
if
( !_verifyNumericInput(
$input
) ) {
if
(
$input
eq
"0"
or
$input
eq
"1"
) {
return
FALSE;
}
}
return
TRUE;
};
sub
_unpackIP{
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
;
};
sub
_binaryToDecimal {
my
$bits
=
shift
;
my
$size
=
shift
;
my
$template
=
shift
;
return
unpack
(
$template
,
pack
(
"B$size"
,
substr
(
"0"
x
$size
.
$bits
, -
$size
)));
};
1;