[Git][NTPsec/ntpsec][master] Now that ntpsweep has been Pythonized, the Perl utility libraries can go away.
Eric S. Raymond
gitlab at mg.gitlab.com
Fri Sep 9 12:26:53 UTC 2016
Eric S. Raymond pushed to branch master at NTPsec / ntpsec
Commits:
dc20b2b5 by Eric S. Raymond at 2016-09-09T08:25:21-04:00
Now that ntpsweep has been Pythonized, the Perl utility libraries can go away.
- - - - -
3 changed files:
- README
- − perllib/NTP/Mode6/Packet.pm
- − perllib/NTP/Util.pm
Changes:
=====================================
README
=====================================
--- a/README
+++ b/README
@@ -77,6 +77,10 @@ ntpq/:: Directory containing sources for a utility program to
ntpstats/:: Statistics visualization and analysis tools built around
the Python ntpstats.py module. Includes ntpviz.
+ntpsweep/:: Directory containing source for a utility program that can
+ fetch basic information about timservers, recursing through
+ peers to map the nearby topology of the time-service network.
+
ntptime/:: Directory containing a utility for reading and modifying
kernel parameters related to the local clock.
@@ -89,13 +93,10 @@ ntpwait/:: Directory containing a script that blocks until ntpd is
in state 4 (synchronized). Useful at boot time, to delay
the boot sequence until after "ntpd -g" has set the time.
-perllib/:: NTP interface package required to query Mode 6 packets
- from the daemon from Perl scripts.
-
ports/:: Subdirectories of this contain code for non-Unix operating
systems. At present there is just one, for Windows.
-pylib/:: Installable Python helper classes.
+pylib/:: Installable Python helper classes for scripts.
tests/:: Self-test code.
=====================================
perllib/NTP/Mode6/Packet.pm deleted
=====================================
--- a/perllib/NTP/Mode6/Packet.pm
+++ /dev/null
@@ -1,221 +0,0 @@
-package NTP::Mode6::Packet;
-use strict;
-use warnings;
-use Carp;
-use Exporter qw(import);
-our @EXPORT_OK = qw(OP_UNSPEC OP_READSTAT OP_READVAR OP_WRITEVAR OP_READCLOCK
- OP_WRITECLOCK OP_SETTRAP OP_ASYNCMSG OP_CONFIGURE
- OP_READ_MRU OP_READ_ORDLIST_A OP_REQ_NONCE OP_UNSETTRAP);
-our %EXPORT_TAGS = (const => \@EXPORT_OK);
-
-use constant {
- OP_UNSPEC => 0, # unspeciffied
- OP_READSTAT => 1, # read status
- OP_READVAR => 2, # read variables
- OP_WRITEVAR => 3, # write variables
- OP_READCLOCK => 4, # read clock variables
- OP_WRITECLOCK => 5, # write clock variables
- OP_SETTRAP => 6, # set trap address (obsolete, unused)
- OP_ASYNCMSG => 7, # asynchronous message
- OP_CONFIGURE => 8, # runtime configuration
- OP_READ_MRU => 10, # retrieve MRU (mrulist)
- OP_READ_ORDLIST_A => 11, # ordered list req. auth.
- OP_REQ_NONCE => 12, # request a client nonce
- OP_UNSETTRAP => 31, # unset trap (obsolete, unused)
-};
-
-use constant {
- SST_TS_UNSPEC => 0, # unspec
- SST_TS_ATOM => 1, # pps
- SST_TS_LF => 2, # lf radio
- SST_TS_HF => 3, # hf radio
- SST_TS_UHF => 4, # uhf radio
- SST_TS_LOCAL => 5, # local
- SST_TS_NTP => 6, # ntp
- SST_TS_UDPTIME => 7, # other
- SST_TS_WRSTWTCH => 8, # wristwatch
- SST_TS_TELEPHONE => 9, # telephone
-};
-
-use constant CTL_HEADER_LENGTH => 12;
-
-sub new {
- my ($class, %opts) = @_;
- my $self = {
- version => defined $opts{version} ? $opts{version} : 2,
- leap => defined $opts{leap} ? $opts{leap} : 0,
- sequence => defined $opts{sequence} ? $opts{sequence} : 0,
- status => defined $opts{status} ? $opts{status} : 0,
- assoc_id => defined $opts{assoc_id} ? $opts{assoc_id} : 0,
- offset => defined $opts{offset} ? $opts{offset} : 0,
- error_bit => defined $opts{is_error} ? $opts{is_error} : 0,
- response_bit => defined $opts{is_response} ? $opts{is_response} : 0,
- more_bit => defined $opts{more} ? $opts{more} : 0,
- opcode => defined $opts{opcode} ? $opts{opcode} : 0,
- };
- my $ret = bless $self, $class;
- if (defined $opts{data}) {
- $self->data($opts{data});
- }
- else {
- $self->data('');
- }
- return $ret;
-}
-
-sub version {
- my ($self, $version) = @_;
- $self->{version} = $version if defined $version;
- return $self->{version};
-}
-
-sub leap {
- my ($self, $leap) = @_;
- $self->{leap} = 1 if $leap;
- return $self->{leap};
-}
-
-sub assoc_id {
- my ($self, $assoc_id) = @_;
- $self->{assoc_id} = $assoc_id if defined $assoc_id;
- return $self->{assoc_id};
-}
-
-sub is_response {
- my ($self, $is_response) = @_;
- $self->{response_bit} = 1 if defined $is_response;
- return $self->{response_bit};
-}
-
-sub is_command {
- my ($self, $is_command) = @_;
- $self->{response_bit} = 0 if $is_command;
- return !$self->{response_bit};
-}
-
-sub is_error {
- my ($self, $is_error) = @_;
- $self->{error_bit} = $is_error if defined $is_error;
- return $self->{error_bit};
-}
-
-sub more {
- my ($self, $is_more) = @_;
- $self->{more_bit} = $is_more if defined $is_more;
- return $self->{more_bit};
-}
-
-sub opcode {
- my ($self, $opcode) = @_;
- $self->{opcode} = $opcode if defined $opcode;
- return $self->{opcode};
-}
-
-sub sequence {
- my ($self, $sequence) = @_;
- $self->{sequence} = $sequence if defined $sequence;
- return $self->{sequence};
-}
-
-sub status {
- my ($self, $status) = @_;
- $self->{status} = $status if defined $status;
- return $self->{status};
-}
-
-sub offset {
- my ($self, $offset) = @_;
- $self->{offset} = $offset if defined $offset;
- return $self->{offset};
-}
-
-sub data_length {
- my $self = shift;
- return $self->{count};
-}
-
-sub data {
- my ($self, $data) = @_;
- if (defined $data) {
- # TODO: prevent passing unicode?
- $self->{count} = length $data;
- $self->{data} = $data;
- }
- return $self->{data};
-}
-
-sub encode {
- my $self = shift;
-
- my $li_vn_mode = 0;
- $li_vn_mode = ($self->leap() & 7) << 3;
- $li_vn_mode |= ($self->version() & 7) << 3;
- $li_vn_mode |= 6;
-
- my $r_m_e_op = 0;
- $r_m_e_op |= 0x80 if $self->is_response;
- $r_m_e_op |= 0x40 if $self->is_error;
- $r_m_e_op |= 0x20 if $self->more;
- $r_m_e_op |= $self->opcode;
-
- # Align to 32-bit boundary
- my $padding = 0;
- while (($self->data_length()+CTL_HEADER_LENGTH+$padding) & 3) {
- $padding++;
- }
-
- my $msg = pack "CCnnnnnA*C$padding", $li_vn_mode, $r_m_e_op,
- $self->sequence, $self->status, $self->assoc_id, $self->offset,
- $self->data_length, $self->data, 0 x $padding;
- return $msg;
-}
-
-sub decode {
- my ($self, $msg) = @_;
-
- my @res = unpack 'CCnnnnnA*', $msg;
-
- my $li_vn_mode = shift @res;
- my $mode = 3;
- $mode = $li_vn_mode & 0x7;
- croak 'Not an NTP Mode 6 packet' if $mode != 6;
- $self->version(($li_vn_mode >> 3) & 0x7);
- $self->leap(($li_vn_mode >> 6) & 0x3);
-
- my $r_m_e_op = shift @res;
- $r_m_e_op & 0x80 ?
- $self->is_response(1) :
- $self->is_command(1);
- $self->is_error(1) if $r_m_e_op & 0x40;
- $self->more(1) if $r_m_e_op & 0x20;
- $self->opcode($r_m_e_op & 0x1f);
-
- $self->sequence(shift @res);
- $self->status(shift @res);
- $self->assoc_id(shift @res);
- $self->offset(shift @res);
-
- my $count = shift @res;
- $self->data(shift @res);
- croak "count($count) != recieved data length(".$self->data_length.")"
- if $self->data_length != $count;
-}
-
-sub eq {
- my ($self, $ex) = @_;
-
- croak 'Not a NTP::Mode6::Packet object'
- if ref $ex ne 'NTP::Mode6::Packet';
-
- #TODO: move diag out of this method
- my @diag;
- for (grep { $_ !~ /^(data|count)$/ } keys %$self) {
- push @diag, "$_: $self->{$_} | $ex->{$_}"
- if $self->{ $_ } != $ex->{ $_ };
- }
- push @diag, "data: $self->{data} | $ex->{data}"
- if $self->{data} ne $ex->{data};
- return join "\n", @diag;
-}
-
-1;
=====================================
perllib/NTP/Util.pm deleted
=====================================
--- a/perllib/NTP/Util.pm
+++ /dev/null
@@ -1,148 +0,0 @@
-package NTP::Util;
-use strict;
-use warnings;
-use Exporter 'import';
-use Carp;
-use version 0.77;
-
-our @EXPORT_OK = qw(ntp_read_vars do_dns ntp_peers ntp_ntpdig_line);
-
-my $ntpq_path = 'ntpq';
-my $ntpdig_path = 'ntpdig';
-
-our $IP_AGNOSTIC;
-
-BEGIN {
- require Socket;
- if (version->parse($Socket::VERSION) >= version->parse(1.94)) {
- Socket->import(qw(getaddrinfo getnameinfo SOCK_RAW AF_INET));
- $IP_AGNOSTIC = 1;
- }
- else {
- Socket->import(qw(inet_aton SOCK_RAW AF_INET));
- }
-}
-
-my %obsolete_vars = (
- phase => 'offset',
- rootdispersion => 'rootdisp',
-);
-
-sub ntp_read_vars {
- my ($peer, $vars, $host) = @_;
- my $do_all = !@$vars;
- my %out_vars = map {; $_ => undef } @$vars;
-
- $out_vars{status_line} = {} if $do_all;
-
- my $cmd = "$ntpq_path -n -c 'rv $peer ".(join ',', @$vars)."'";
- $cmd .= " $host" if defined $host;
- $cmd .= " |";
-
- open my $fh, $cmd or croak "Could not start ntpq: $!";
-
- while (<$fh>) {
- return undef if /Connection refused/;
-
- if (/^asso?c?id=0 status=(\S{4}) (\S+), (\S+),/gi) {
- $out_vars{status_line}{status} = $1;
- $out_vars{status_line}{leap} = $2;
- $out_vars{status_line}{sync} = $3;
- }
-
- while (/(\w+)=([^,]+),?\s/g) {
- my ($var, $val) = ($1, $2);
- $val =~ s/^"([^"]+)"$/$1/;
- $var = $obsolete_vars{$var} if exists $obsolete_vars{$var};
- if ($do_all) {
- $out_vars{$var} = $val
- }
- else {
- $out_vars{$var} = $val if exists $out_vars{$var};
- }
- }
- }
-
- close $fh or croak "running ntpq failed: $! (exit status $?)";
- return \%out_vars;
-}
-
-sub do_dns {
- my ($host) = @_;
-
- if ($IP_AGNOSTIC) {
- my ($err, $res);
-
- ($err, $res) = getaddrinfo($host, '', {socktype => SOCK_RAW});
- die "getaddrinfo failed: $err\n" if $err;
-
- ($err, $res) = getnameinfo($res->{addr}, 0);
- die "getnameinfo failed: $err\n" if $err;
-
- return $res;
- }
- # Too old perl, do only ipv4
- elsif ($host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
- return gethostbyaddr inet_aton($host), AF_INET;
- }
- else {
- return;
- }
-}
-
-sub ntp_peers {
- my ($host) = @_;
-
- $host ||= '';
- my $cmd = "$ntpq_path -npw $host |";
-
- open my $fh, $cmd or croak "Could not start ntpq: $!";
-
- <$fh> for 1 .. 2;
-
- my @columns = qw(tally host refid st t when poll reach delay offset jitter);
- my @peers;
- while (<$fh>) {
- if (/^([ x+#*o-])((?:[\w.*:-]+\s+){10}|([\w.*:-]+\s+))$/) {
- my $col = 0;
- my @line = ($1, split /\s+/, $2);
- if( @line == 2 ) {
- defined ($_ = <$fh>) or last;
- s/^\s+//;
- push @line, split /\s+/;
- }
- my $r = { map {; $columns[ $col++ ] => $_ } @line };
- $r->{remote} = $r->{tally} . $r->{host};
- push @peers, $r;
- }
- else {
- #TODO return error (but not needed anywhere now)
- warn "ERROR: $_";
- }
- }
-
- close $fh or croak "running ntpq failed: $! (exit status $?)";
- return \@peers;
-}
-
-# TODO: we don't need this but it would be nice to have all the line parsed
-sub ntp_ntpdig_line {
- my ($host) = @_;
-
- my $cmd = "$ntpdig_path $host |";
- open my $fh, $cmd or croak "Could not start ntpdig: $!";
-
- my ($offset, $stratum);
- while (<$fh>) {
- next if !/^\d{4}-\d\d-\d\d/;
- chomp;
- my @output = split / /;
-
- $offset = $output[3];
- ($stratum = $output[7]) =~ s/s(\d{1,2})/$1/;
- }
- close $fh or croak "running ntpdig failed: $! (exit status $?)";
- return ($offset, $stratum);
-}
-
-1;
View it on GitLab: https://gitlab.com/NTPsec/ntpsec/commit/dc20b2b58585cb9210bbeb6635b8a3dcad713d93
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.ntpsec.org/pipermail/vc/attachments/20160909/3db2c783/attachment.html>
More information about the vc
mailing list