aboutsummaryrefslogtreecommitdiff
path: root/usr.sbin/xntpd/scripts/monitoring
diff options
context:
space:
mode:
Diffstat (limited to 'usr.sbin/xntpd/scripts/monitoring')
-rw-r--r--usr.sbin/xntpd/scripts/monitoring/README154
-rw-r--r--usr.sbin/xntpd/scripts/monitoring/loopwatch.config.SAMPLE89
-rwxr-xr-xusr.sbin/xntpd/scripts/monitoring/lr.pl145
-rwxr-xr-xusr.sbin/xntpd/scripts/monitoring/ntp.pl477
-rwxr-xr-xusr.sbin/xntpd/scripts/monitoring/ntploopstat457
-rwxr-xr-xusr.sbin/xntpd/scripts/monitoring/ntploopwatch1631
-rwxr-xr-xusr.sbin/xntpd/scripts/monitoring/ntptrap453
-rwxr-xr-xusr.sbin/xntpd/scripts/monitoring/timelocal.pl78
8 files changed, 0 insertions, 3484 deletions
diff --git a/usr.sbin/xntpd/scripts/monitoring/README b/usr.sbin/xntpd/scripts/monitoring/README
deleted file mode 100644
index fa8ad8bb9585..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/README
+++ /dev/null
@@ -1,154 +0,0 @@
-This directory contains support for monitoring the local clock of xntp daemons.
-
-WARNING: The scripts and routines contained in this directory are bete realease!
- Do not depend on their correct operation. They are, however, in regular
- use at University of Erlangen-Nuernberg. No severe problems are known
- for this code.
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-PLEASE THINK TWICE BEFORE STARTING MONITORING REMOTE XNTP DEAMONS !!!!
-MONITORING MAY INCREASE THE LOAD OF THE DEAMON MONITORED AND MAY
-INCREASE THE NETWORK LOAD SIGNIFICANTLY
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-Files are:
-
-README:
- This file
-
-ntptrap:
- perl script to log ntp mode 6 trap messages.
-
- It sends a set_trap request to each server given and dumps the
- trap messages received. It handles refresh of set_trap.
- Currently it handles only NTP V2, however the NTP V3 servers
- also accept v2 requests. It will not interpret v3 system and peer
- stati correctly.
-
- usage:
- ntptrap [-n] [-p <port>] [-l <debug-output>] servers...
-
- -n: do not send set_trap requests
-
- port: port to listen for responses
- useful if you have a configured trap
-
- debug-output: file to write trace output to (for debugging)
-
- This script convinced me that ntp trap messages are only of
- little use.
-
-ntploopstat:
- perl script to gather loop info statistics from xntpd via mode 7
- LOOP_INFO requests.
-
- This script collects data to allow monitoring of remote xntp servers
- where it is not possible to directly access the loopstats file
- produced by xntpd itself. Of course, it can be used to sample
- a local server if it is not configured to produce a loopstats file.
-
- Please note, this program poses a high load on the server as
- a communication takes place every delay seconds ! USE WITH CARE !
-
- usage:
- ntploopstat [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver]
-
- delay: number of seconds to wait between samples
- default: 60 seconds
- timeout: number of seconds to wait for reply
- default 12 seconds
- logfile: file to log samples to
- default: loopstats:<ntpserver>:
- (note the trailing colon)
- This name actually is a prefix.
- The file name is dynamically derived by appending
- the name of the month the sample belongs to.
- Thus all samples of a month end up in the same file.
-
- the format of the files generated is identical to the format used by
- xntpd with the loopstats file:
- MJD <seconds since midnight UTC> offset frequency compliance
-
- if a timeout occurs the next sample is tried after delay/2 seconds
-
- The script will terminate after MAX_FAIL (currently 60) consecutive errors.
- Errors are counted for:
- - error on send call
- - error on select call
- - error on recv call
- - short packet received
- - bad packet
- - error on open for logfile
-
-ntploopwatch:
- perl script to display loop filter statistics collected by ntploopstat
- or dumped directly by xntpd.
-
- Gnuplot is used to produce a graphical representation of the sample
- values, that have been preprocessed and analysed by this script.
-
- It can either be called to produce a printout of specific data set or
- used to continously monitor the values. Monitoring is achieved by
- periodically reprocessing the logfiles, which are updated regularly
- either by a running ntploopstat process or by the running xntpd.
-
- usage:
- to watch statistics permanently:
- ntploopwatch [-v[<level>]] [-c <config-file>] [-d <working-dir>]
-
- to get a single print out specify also
- -P<printer> [-s<samples>]
- [-S <start-time>] [-E <end-time>]
- [-O <MaxOffs>] [-o <MinOffs>]
-
- level: level of verbosity for debugging
- config-file: file to read configurable settings from
- On each iteration it is checked and reread
- if it has been changed
- default: loopwatch.config
- working-dir: specify working directory for process, affects
- interpretation of relative file names
-
- All other flags are only useful with printing plots, as otherwise
- command line values would be replaced by settings from the config file.
-
- printer: specify printer to print plot
- BSD print systems semantics apply; if printer is omitted
- the name "ps" is used; plots are prepared using
- PostScript, thus the printer should best accept
- postscript input
-
- For the following see also the comments in loopwatch.config.SAMPLE
-
- samples: use last # samples from input data
- start-time: ignore input samples before this date
- end-time: ignore input samples after this date
- if both start-time and end-time are specified
- a given samples value is ignored
- MaxOffs:
- MinOffs: restrict value range
-
-loopwatch.config.SAMPLE:
- sample config file for ntploopwatch
- each configurable option is explained there
-
-lr.pl:
- linear regression package used by ntploopwatch to compute
- linear approximations for frequency and offset values
- within display range
-
-timelocal.pl:
- used during conversion of ISO_DATE_TIME values specified in loopwatch
- config files to unix epoch values (seconds since 1970-01-01_00:00_00 UTC)
-
- A version of this file is distributed with perl-4.x, however,
- it has a bug related to dates crossing 1970, causing endless loops..
- The version contained here has been fixed.
-
-ntp.pl:
- perl support for ntp v2 mode 6 message handling
- WARNING: This code is beta level - it triggers a memory leak;
- as for now it is not quite clear, wether this is caused by a
- bug in perl or by bad usage of perl within this script.
-
diff --git a/usr.sbin/xntpd/scripts/monitoring/loopwatch.config.SAMPLE b/usr.sbin/xntpd/scripts/monitoring/loopwatch.config.SAMPLE
deleted file mode 100644
index 8cefea395db0..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/loopwatch.config.SAMPLE
+++ /dev/null
@@ -1,89 +0,0 @@
-# sample configuration and control file for ntploowatch
-#
-# delay: sampling interval in seconds
-delay=60
-# samples: use only last # samples
-samples=600
-# DO NOT USE srcprefix in shared config files
-# srcprefix: name of file to read samples from
-# current time suffix (month name) is appended
-# defaults to "./var@$STATHOST/loopstats."
-# The string "$STATHOST"is replaced by the name of the host
-# being monitored
-#srcprefix=./var@$STATHOST/loopstats.
-#
-# showoffs: yes/no control display of offset values
-showoffs=yes
-#
-# showfreq: yes/no control display of frequency values
-showfreq=yes
-#
-# showcmpl: yes/no control display of compliance values
-showcmpl=no
-#
-# showoreg: yes/no control display of linear regression of offset values
-showoreg=no
-#
-# showfreg: yes/no control display of linear regression of frequency values
-showfreg=no
-#
-# timebase: dynamic/ISO_DATE_TIME point of zero for linear regression
-# ISO_DATE_TIME: yyyy-mm-dd_hh:mm:ss.ms
-# values are interpreted using local time zone
-# parts omitted from front default to current date/time
-# parts omitted from end default to lowest permitted values
-# to get aa:bb being interpreted as minutes:seconds use aa:bb.0
-# for dynamic '00:00:00.0 of current day' is used
-timebase=dynamic
-#
-# freqbase: dynamic/<baseval>
-# if a number is given, subtract this from sampling values for display
-# if dynamic is selected, freqbase is adjusted to fit into the range of
-# offset values
-freqbase=dynamic
-#
-# cmplscale: dynamic/<scaling>
-# if a number is given, the sampling values are divided by this number
-# if dynamic is selected, cmplscale is adjusted to fit into the range of
-# offset values
-cmplscale=dynamic
-#
-# DumbScale: 0/1
-# 0 enables dynamic adjust of value ranges for freqbase and cmplscale
-# timescale is labeled with human readable times
-# 1 only uses explicit scaling for numbers
-# timescale is labeled with hours relative to timebase
-DumbScale=0
-#
-# StartTime: none/ISO_DATE_TIME
-# ignore any samples before the specified date
-StartTime=none
-#
-# EndTime: none/ISO_DATE_TIME
-# ignore any samples after the specified date
-#
-# if both StartTime and EndTime are specified
-# the value specified for samples is ignored
-EndTime=none
-#
-# MaxOffs: none/<number>
-# limit display (y-axis) to values not larger than <number>
-MaxOffset=none
-#
-# MinOffs: none/<number>
-# limit display (y-axis) to values not smaller than <number>
-MinOffset=none
-
-#
-# verbose: <number>
-# specify level for debugging
-# default is 0 for printing and 1 for monitoring
-# level 1 will just print a timestamp for any display update
-# (this is every delay seconds)
-verbose=1
-#
-# deltaT: <seconds>
-# mark `holes' in the sample data grater than <seconds>
-# by a break in the plot
-# default: 512 seconds
-deltaT=512
diff --git a/usr.sbin/xntpd/scripts/monitoring/lr.pl b/usr.sbin/xntpd/scripts/monitoring/lr.pl
deleted file mode 100755
index 02c7550ec3ad..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/lr.pl
+++ /dev/null
@@ -1,145 +0,0 @@
-;#
-;# lr.pl,v 3.1 1993/07/06 01:09:08 jbj Exp
-;#
-;#
-;# Linear Regression Package for perl
-;# to be 'required' from perl
-;#
-;# Copyright (c) 1992
-;# Frank Kardel, Rainer Pruy
-;# Friedrich-Alexander Universitaet Erlangen-Nuernberg
-;#
-;#
-;#############################################################
-
-##
-## y = A + Bx
-##
-## B = (n * Sum(xy) - Sum(x) * Sum(y)) / (n * Sum(x^2) - Sum(x)^2)
-##
-## A = (Sum(y) - B * Sum(x)) / n
-##
-
-##
-## interface
-##
-*lr_init = *lr'lr_init; #';# &lr_init(tag); initialize data set for tag
-*lr_sample = *lr'lr_sample; #';# &lr_sample(x,y,tag); enter sample
-*lr_Y = *lr'lr_Y; #';# &lr_Y(x,tag); compute y for given x
-*lr_X = *lr'lr_X; #';# &lr_X(y,tag); compute x for given y
-*lr_r = *lr'lr_r; #';# &lr_r(tag); regression coeffizient
-*lr_cov = *lr'lr_cov; #';# &lr_cov(tag); covariance
-*lr_A = *lr'lr_A; #';# &lr_A(tag);
-*lr_B = *lr'lr_B; #';# &lr_B(tag);
-*lr_sigma = *lr'lr_sigma; #';# &lr_sigma(tag); standard deviation
-*lr_mean = *lr'lr_mean; #';# &lr_mean(tag);
-#########################
-
-package lr;
-
-sub tagify
-{
- local($tag) = @_;
- if (defined($tag))
- {
- *lr_n = eval "*${tag}_n";
- *lr_sx = eval "*${tag}_sx";
- *lr_sx2 = eval "*${tag}_sx2";
- *lr_sxy = eval "*${tag}_sxy";
- *lr_sy = eval "*${tag}_sy";
- *lr_sy2 = eval "*${tag}_sy2";
- }
-}
-
-sub lr_init
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- $lr_n = 0;
- $lr_sx = 0.0;
- $lr_sx2 = 0.0;
- $lr_sxy = 0.0;
- $lr_sy = 0.0;
- $lr_sy2 = 0.0;
-}
-
-sub lr_sample
-{
- local($_x, $_y) = @_;
-
- &tagify($_[$[+2]) if defined($_[$[+2]);
-
- $lr_n++;
- $lr_sx += $_x;
- $lr_sy += $_y;
- $lr_sxy += $_x * $_y;
- $lr_sx2 += $_x**2;
- $lr_sy2 += $_y**2;
-}
-
-sub lr_B
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- return 1 unless ($lr_n * $lr_sx2 - $lr_sx**2);
- return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / ($lr_n * $lr_sx2 - $lr_sx**2);
-}
-
-sub lr_A
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- return ($lr_sy - &lr_B * $lr_sx) / $lr_n;
-}
-
-sub lr_Y
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- return &lr_A + &lr_B * $_[$[];
-}
-
-sub lr_X
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- return ($_[$[] - &lr_A) / &lr_B;
-}
-
-sub lr_r
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- local($s) = ($lr_n * $lr_sx2 - $lr_sx**2) * ($lr_n * $lr_sy2 - $lr_sy**2);
-
- return 1 unless $s;
-
- return ($lr_n * $lr_sxy - $lr_sx * $lr_sy) / sqrt($s);
-}
-
-sub lr_cov
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- return ($lr_sxy - $lr_sx * $lr_sy / $lr_n) / ($lr_n - 1);
-}
-
-sub lr_sigma
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- return 0 if $lr_n <= 1;
- return sqrt(($lr_sy2 - ($lr_sy * $lr_sy) / $lr_n) / ($lr_n));
-}
-
-sub lr_mean
-{
- &tagify($_[$[]) if defined($_[$[]);
-
- return 0 if $lr_n <= 0;
- return $lr_sy / $lr_n;
-}
-
-&lr_init();
-
-1;
diff --git a/usr.sbin/xntpd/scripts/monitoring/ntp.pl b/usr.sbin/xntpd/scripts/monitoring/ntp.pl
deleted file mode 100755
index f3bfd2bfe0b9..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/ntp.pl
+++ /dev/null
@@ -1,477 +0,0 @@
-#!/local/bin/perl
-;#
-;# ntp.pl,v 3.1 1993/07/06 01:09:09 jbj Exp
-;#
-;# process loop filter statistics file and either
-;# - show statistics periodically using gnuplot
-;# - or print a single plot
-;#
-;# Copyright (c) 1992
-;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
-;#
-;#
-;#############################################################
-
-package ntp;
-
-$NTP_version = 2;
-$ctrl_mode=6;
-
-$byte1 = (($NTP_version & 0x7)<< 3) & 0x34 | ($ctrl_mode & 0x7);
-$MAX_DATA = 468;
-
-$sequence = 0; # initial sequence number incred before used
-$pad=4;
-$do_auth=0; # no possibility today
-$keyid=0;
-;#list if known keys (passwords)
-%KEYS = ( 0, "\200\200\200\200\200\200\200\200",
- );
-
-;#-----------------------------------------------------------------------------
-;# access routines for ntp control packet
- ;# NTP control message format
- ;# C LI|VN|MODE LI 2bit=00 VN 3bit=2(3) MODE 3bit=6 : $byte1
- ;# C R|E|M|Op R response E error M more Op opcode
- ;# n sequence
- ;# n status
- ;# n associd
- ;# n offset
- ;# n count
- ;# a+ data (+ padding)
- ;# optional authentication data
- ;# N key
- ;# N2 checksum
-
-;# first bye of packet
-sub pkt_LI { return ($_[$[] >> 6) & 0x3; }
-sub pkt_VN { return ($_[$[] >> 3) & 0x7; }
-sub pkt_MODE { return ($_[$[] ) & 0x7; }
-
-;# second byte of packet
-sub pkt_R { return ($_[$[] & 0x80) == 0x80; }
-sub pkt_E { return ($_[$[] & 0x40) == 0x40; }
-sub pkt_M { return ($_[$[] & 0x20) == 0x20; }
-sub pkt_OP { return $_[$[] & 0x1f; }
-
-;#-----------------------------------------------------------------------------
-
-sub setkey
-{
- local($id,$key) = @_;
-
- $KEYS{$id} = $key if (defined($key));
- if (! defined($KEYS{$id}))
- {
- warn "Key $id not yet specified - key not changed\n";
- return undef;
- }
- return ($keyid,$keyid = $id)[$[];
-}
-
-;#-----------------------------------------------------------------------------
-sub numerical { $a <=> $b; }
-
-;#-----------------------------------------------------------------------------
-
-sub send #'
-{
- local($fh,$opcode, $associd, $data,$address) = @_;
- $fh = caller(0)."'$fh";
-
- local($junksize,$junk,$packet,$offset,$ret);
- $offset = 0;
-
- $sequence++;
- while(1)
- {
- $junksize = length($data);
- $junksize = $MAX_DATA if $junksize > $MAX_DATA;
-
- ($junk,$data) = $data =~ /^(.{$junksize})(.*)$/;
- $packet
- = pack("C2n5a".(($junk eq "") ? 0 : &pad($junksize+12,$pad)-12),
- $byte1,
- ($opcode & 0x1f) | ($data ? 0x20 : 0),
- $sequence,
- 0, $associd,
- $offset, $junksize, $junk);
- if ($do_auth)
- {
- ;# not yet
- }
- $offset += $junksize;
-
- if (defined($address))
- {
- $ret = send($fh, $packet, 0, $address);
- }
- else
- {
- $ret = send($fh, $packet, 0);
- }
-
- if (! defined($ret))
- {
- warn "send failed: $!\n";
- return undef;
- }
- elsif ($ret != length($packet))
- {
- warn "send failed: sent only $ret from ".length($packet). "bytes\n";
- return undef;
- }
- return $sequence unless $data;
- }
-}
-
-;#-----------------------------------------------------------------------------
-;# status interpretation
-;#
-sub getval
-{
- local($val,*list) = @_;
-
- return $list{$val} if defined($list{$val});
- return sprintf("%s#%d",$list{"-"},$val) if defined($list{"-"});
- return "unknown-$val";
-}
-
-;#---------------------------------
-;# system status
-;#
-;# format: |LI|CS|SECnt|SECode| LI=2bit CS=6bit SECnt=4bit SECode=4bit
-sub ssw_LI { return ($_[$[] >> 14) & 0x3; }
-sub ssw_CS { return ($_[$[] >> 8) & 0x3f; }
-sub ssw_SECnt { return ($_[$[] >> 4) & 0xf; }
-sub ssw_SECode { return $_[$[] & 0xf; }
-
-%LI = ( 0, "leap_none", 1, "leap_add_sec", 2, "leap_del_sec", 3, "sync_alarm", "-", "leap");
-%ClockSource = (0, "sync_unspec",
- 1, "sync_lf_clock",
- 2, "sync_uhf_clock",
- 3, "sync_hf_clock",
- 4, "sync_local_proto",
- 5, "sync_ntp",
- 6, "sync_udp/time",
- 7, "sync_wristwatch",
- "-", "ClockSource",
- );
-
-%SystemEvent = (0, "event_unspec",
- 1, "event_restart",
- 2, "event_fault",
- 3, "event_sync_chg",
- 4, "event_sync/strat_chg",
- 5, "event_clock_reset",
- 6, "event_bad_date",
- 7, "event_clock_excptn",
- "-", "event",
- );
-sub LI
-{
- &getval(&ssw_LI($_[$[]),*LI);
-}
-sub ClockSource
-{
- &getval(&ssw_CS($_[$[]),*ClockSource);
-}
-
-sub SystemEvent
-{
- &getval(&ssw_SECode($_[$[]),*SystemEvent);
-}
-
-sub system_status
-{
- return sprintf("%s, %s, %d event%s, %s", &LI($_[$[]), &ClockSource($_[$[]),
- &ssw_SECnt($_[$[]), ((&ssw_SECnt($_[$[])==1) ? "" : "s"),
- &SystemEvent($_[$[]));
-}
-;#---------------------------------
-;# peer status
-;#
-;# format: |PStat|PSel|PCnt|PCode| Pstat=6bit PSel=2bit PCnt=4bit PCode=4bit
-sub psw_PStat_config { return ($_[$[] & 0x8000) == 0x8000; }
-sub psw_PStat_authenable { return ($_[$[] & 0x4000) == 0x4000; }
-sub psw_PStat_authentic { return ($_[$[] & 0x2000) == 0x2000; }
-sub psw_PStat_reach { return ($_[$[] & 0x1000) == 0x1000; }
-sub psw_PStat_sane { return ($_[$[] & 0x0800) == 0x0800; }
-sub psw_PStat_dispok { return ($_[$[] & 0x0400) == 0x0400; }
-sub psw_PStat { return ($_[$[] >> 10) & 0x3f; }
-sub psw_PSel { return ($_[$[] >> 8) & 0x3; }
-sub psw_PCnt { return ($_[$[] >> 4) & 0xf; }
-sub psw_PCode { return $_[$[] & 0xf; }
-
-%PeerSelection = (0, "sel_reject",
- 1, "sel_candidate",
- 2, "sel_selcand",
- 3, "sel_sys.peer",
- "-", "PeerSel",
- );
-%PeerEvent = (0, "event_unspec",
- 1, "event_ip_err",
- 2, "event_authen",
- 3, "event_unreach",
- 4, "event_reach",
- 5, "event_clock_excptn",
- 6, "event_stratum_chg",
- "-", "event",
- );
-
-sub PeerSelection
-{
- &getval(&psw_PSel($_[$[]),*PeerSelection);
-}
-sub PeerEvent
-{
- &getval(&psw_PCode($_[$[]),*PeerEvent);
-}
-
-sub peer_status
-{
- local($x) = ("");
- $x .= "config," if &psw_PStat_config($_[$[]);
- $x .= "authenable," if &psw_PStat_authenable($_[$[]);
- $x .= "authentic," if &psw_PStat_authentic($_[$[]);
- $x .= "reach," if &psw_PStat_reach($_[$[]);
- $x .= &psw_PStat_sane($_[$[]) ? "sane," : "insane,";
- $x .= "hi_disp," unless &psw_PStat_dispok($_[$[]);
-
- $x .= sprintf(" %s, %d event%s, %s", &PeerSelection($_[$[]),
- &psw_PCnt($_[$[]), ((&psw_PCnt($_[$[]) == 1) ? "" : "s"),
- &PeerEvent($_[$[]));
- return $x;
-}
-
-;#---------------------------------
-;# clock status
-;#
-;# format: |CStat|CEvnt| CStat=8bit CEvnt=8bit
-sub csw_CStat { return ($_[$[] >> 8) & 0xff; }
-sub csw_CEvnt { return $_[$[] & 0xff; }
-
-%ClockStatus = (0, "clk_nominal",
- 1, "clk_timeout",
- 2, "clk_badreply",
- 3, "clk_fault",
- 4, "clk_prop",
- 5, "clk_baddate",
- 6, "clk_badtime",
- "-", "clk",
- );
-
-sub clock_status
-{
- return sprintf("%s, last %s",
- &getval(&csw_CStat($_[$[]),*ClockStatus),
- &getval(&csw_CEvnt($_[$[]),*ClockStatus));
-}
-
-;#---------------------------------
-;# error status
-;#
-;# format: |Err|reserved| Err=8bit
-;#
-sub esw_Err { return ($_[$[] >> 8) & 0xff; }
-
-%ErrorStatus = (0, "err_unspec",
- 1, "err_auth_fail",
- 2, "err_invalid_fmt",
- 3, "err_invalid_opcode",
- 4, "err_unknown_assoc",
- 5, "err_unknown_var",
- 6, "err_invalid_value",
- 7, "err_adm_prohibit",
- );
-
-sub error_status
-{
- return sprintf("%s", &getval(&esw_Err($_[$[]),*ErrorStatus));
-}
-
-;#-----------------------------------------------------------------------------
-;#
-;# cntrl op name translation
-
-%CntrlOpName = (1, "read_status",
- 2, "read_variables",
- 3, "write_variables",
- 4, "read_clock_variables",
- 5, "write_clock_variables",
- 6, "set_trap",
- 7, "trap_response",
- 31, "unset_trap", # !!! unofficial !!!
- "-", "cntrlop",
- );
-
-sub cntrlop_name
-{
- return &getval($_[$[],*CntrlOpName);
-}
-
-;#-----------------------------------------------------------------------------
-
-$STAT_short_pkt = 0;
-$STAT_pkt = 0;
-
-;# process a NTP control message (response) packet
-;# returns a list ($ret,$data,$status,$associd,$op,$seq,$auth_keyid)
-;# $ret: undef --> not yet complete
-;# "" --> complete packet received
-;# "ERROR" --> error during receive, bad packet, ...
-;# else --> error packet - list may contain useful info
-
-
-sub handle_packet
-{
- local($pkt,$from) = @_; # parameters
- local($len_pkt) = (length($pkt));
-;# local(*FRAGS,*lastseen);
- local($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data);
- local($autch_keyid,$auth_cksum);
-
- $STAT_pkt++;
- if ($len_pkt < 12)
- {
- $STAT_short_pkt++;
- return ("ERROR","short packet received");
- }
-
- ;# now break packet apart
- ($li_vn_mode,$r_e_m_op,$seq,$status,$associd,$offset,$count,$data) =
- unpack("C2n5a".($len_pkt-12),$pkt);
- $data=substr($data,$[,$count);
- if ((($len_pkt - 12) - &pad($count,4)) >= 12)
- {
- ;# looks like an authenticator
- ($auth_keyid,$auth_cksum) =
- unpack("Na8",substr($pkt,$len_pkt-12+$[,12));
- $STAT_auth++;
- ;# no checking of auth_cksum (yet ?)
- }
-
- if (&pkt_VN($li_vn_mode) != $NTP_version)
- {
- $STAT_bad_version++;
- return ("ERROR","version ".&pkt_VN($li_vn_mode)."packet ignored");
- }
-
- if (&pkt_MODE($li_vn_mode) != $ctrl_mode)
- {
- $STAT_bad_mode++;
- return ("ERROR", "mode ".&pkt_MODE($li_vn_mode)." packet ignored");
- }
-
- ;# handle single fragment fast
- if ($offset == 0 && &pkt_M($r_e_m_op) == 0)
- {
- $STAT_single_frag++;
- if (&pkt_E($r_e_m_op))
- {
- $STAT_err_pkt++;
- return (&error_status($status),
- $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
- $auth_keyid);
- }
- else
- {
- return ("",
- $data,$status,$associd,&pkt_OP($r_e_m_op),$seq,
- $auth_keyid);
- }
- }
- else
- {
- ;# fragment - set up local name space
- $id = "$from$seq".&pkt_OP($r_e_m_op);
- $ID{$id} = 1;
- *FRAGS = "$id FRAGS";
- *lastseen = "$id lastseen";
-
- $STAT_frag++;
-
- $lastseen = 1 if !&pkt_M($r_e_m_op);
- if (!defined(%FRAGS))
- {
- (&pkt_M($r_e_m_op) ? " more" : "")."\n";
- $FRAGS{$offset} = $data;
- ;# save other info
- @FRAGS = ($status,$associd,&pkt_OP($r_e_m_op),$seq,$auth_keyid,$r_e_m_op);
- }
- else
- {
- (&pkt_M($r_e_m_op) ? " more" : "")."\n";
- ;# add frag to previous - combine on the fly
- if (defined($FRAGS{$offset}))
- {
- $STAT_dup_frag++;
- return ("ERROR","duplicate fragment at $offset seq=$seq");
- }
-
- $FRAGS{$offset} = $data;
-
- undef($loff);
- foreach $off (sort numerical keys(%FRAGS))
- {
- next unless defined($FRAGS{$off});
- if (defined($loff) &&
- ($loff + length($FRAGS{$loff})) == $off)
- {
- $FRAGS{$loff} .= $FRAGS{$off};
- delete $FRAGS{$off};
- last;
- }
- $loff = $off;
- }
-
- ;# return packet if all frags arrived
- ;# at most two frags with possible padding ???
- if ($lastseen && defined($FRAGS{0}) &&
- scalar(@x=sort numerical keys(%FRAGS)) <= 2 &&
- (length($FRAGS{0}) + 8) > $x[$[+1])
- {
- @x=((&pkt_E($r_e_m_op) ? &error_status($status) : ""),
- $FRAGS{0},@FRAGS);
- &pkt_E($r_e_m_op) ? $STAT_err_frag++ : $STAT_frag_all++;
- undef(%FRAGS);
- undef(@FRAGS);
- undef($lastseen);
- delete $ID{$id};
- &main'clear_timeout($id);
- return @x;
- }
- else
- {
- &main'set_timeout($id,time+$timeout,"&ntp'handle_packet_timeout(\"".unpack("H*",$id)."\");"); #'";
- }
- }
- return (undef);
- }
-}
-
-sub handle_packet_timeout
-{
- local($id) = @_;
- local($r_e_m_op,*FRAGS,*lastseen,@x) = (@FRAGS[$[+5]);
-
- *FRAGS = "$id FRAGS";
- *lastseen = "$id lastseen";
-
- @x=((&pkt_E($r_e_m_op) ? &error_status($status) : "TIMEOUT"),
- $FRAGS{0},@FRAGS[$[ .. $[+4]);
- $STAT_frag_timeout++;
- undef(%FRAGS);
- undef(@FRAGS);
- undef($lastseen);
- delete $ID{$id};
- return @x;
-}
-
-
-sub pad
-{
- return $_[$[+1] * int(($_[$[] + $_[$[+1] - 1) / $_[$[+1]);
-}
-
-1;
diff --git a/usr.sbin/xntpd/scripts/monitoring/ntploopstat b/usr.sbin/xntpd/scripts/monitoring/ntploopstat
deleted file mode 100755
index 75cdff227b27..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/ntploopstat
+++ /dev/null
@@ -1,457 +0,0 @@
-#!/local/bin/perl -w--*-perl-*-
-;#
-;# ntploopstat,v 3.1 1993/07/06 01:09:11 jbj Exp
-;#
-;# Poll NTP server using NTP mode 7 loopinfo request.
-;# Log info and timestamp to file for processing by ntploopwatch.
-;#
-;#
-;# Copyright (c) 1992
-;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
-;#
-;#################################################################
-;#
-;# The format written to the logfile is the same as used by xntpd
-;# for the loopstats file.
-;# This script however allows to gather loop filter statistics from
-;# remote servers where you do not have access to the loopstats logfile.
-;#
-;# Please note: Communication delays affect the accuracy of the
-;# timestamps recorded. Effects from these delays will probably
-;# not show up, as timestamps are recorded to the second only.
-;# (Should have implemented &gettimeofday()..)
-;#
-
-$0 =~ s!^.*/([^/]+)$!\1!; # beautify script name
-
-$ntpserver = 'localhost'; # default host to poll
-$delay = 60; # default sampling rate
- ;# keep it shorter than minpoll (=64)
- ;# to get all values
-
-require "ctime.pl";
-;# handle bug in early ctime distributions
-$ENV{'TZ'} = 'MET' unless defined($ENV{'TZ'}) || $] > 4.010;
-
-if (defined(@ctime'MoY))
-{
- *MonthName = *ctime'MoY;
-}
-else
-{
- @MonthName = ('Jan','Feb','Mar','Apr','May','Jun',
- 'Jul','Aug','Sep','Oct','Nov','Dec');
-}
-
-;# this routine can be redefined to point to syslog if necessary
-sub msg
-{
- return unless $verbose;
-
- print STDERR "$0: ";
- printf STDERR @_;
-}
-
-;#############################################################
-;#
-;# process command line
-$usage = <<"E-O-S";
-
-usage:
- $0 [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver]
-E-O-S
-
-while($_ = shift)
-{
- /^-v(\d*)$/ && ($verbose=($1 eq '') ? 1 : $1,1) && next;
- /^-d(\d*)$/ &&
- do {
- ($1 ne '') && ($delay = $1,1) && next;
- @ARGV || die("$0: delay value missing after -d\n$usage");
- $delay = shift;
- ($delay >= 0) || die("$0: bad delay value \"$delay\"\n$usage");
- next;
- };
- /^-l$/ &&
- do {
- @ARGV || die("$0: logfile missing after -l\n$usage");
- $logfile = shift;
- next;
- };
- /^-t(\d*(\.\d*)?)$/ &&
- do {
- ($1 ne '') && ($timeout = $1,1) && next;
- @ARGV || die("$0: timeout value missing after -t\n$usage\n");
- $timeout = shift;
- ($timeout > 0) ||
- die("$0: bad timeout value \"$timeout\"\n$usage");
- next;
- };
-
- /^-/ && die("$0: unknown option \"$_\"\n$usage");
-
- ;# any other argument is server to poll
- $ntpserver = $_;
- last;
-}
-
-if (@ARGV)
-{
- warn("unexpected arguments: ".join(" ",@ARGV).".\n");
- die("$0: too many servers specified\n$usage");
-}
-
-;# logfile defaults to include server name
-;# The name of the current month is appended and
-;# the file is opened and closed for each sample.
-;#
-$logfile = "loopstats:$ntpserver." unless defined($logfile);
-$timeout = 12.0 unless defined($timeout); # wait $timeout seconds for reply
-
-$MAX_FAIL = 60; # give up after $MAX_FAIL failed polls
-
-
-$MJD_1970 = 40587;
-
-if (eval 'require "syscall.ph";')
-{
- if (defined(&SYS_gettimeofday))
- {
- ;# assume standard
- ;# gettimeofday(struct timeval *tp,struct timezone *tzp)
- ;# syntax for gettimeofday syscall
- ;# tzp = NULL -> undef
- ;# tp = (long,long)
- eval 'sub time { local($tz) = pack("LL",0,0);
- (&msg("gettimeofday failed: $!\n"),
- return (time))
- unless syscall(&SYS_gettimeofday,$tz,undef) == 0;
- local($s,$us) = unpack("LL",$tz);
- return $s + $us/1000000; }';
- local($t1,$t2,$t3);
- $t1 = time;
- eval '$t2 = &time;';
- $t3 = time;
- die("$0: gettimeofday failed: $@.\n") if defined($@) && $@;
- die("$0: gettimeofday inconsistency time=$t1,gettimeofday=$t2,time=$t2\n")
- if (int($t1) != int($t2) && int($t3) != int($t2));
- &msg("Using gettimeofday for timestamps\n");
- }
- else
- {
- warn("No gettimeofday syscall found - using time builtin for timestamps\n");
- eval 'sub time { return time; }';
- }
-}
-else
-{
- warn("No syscall.ph file found - using time builtin for timestamps\n");
- eval 'sub time { return time; }';
-}
-
-
-;#------------------+
-;# from ntp_request.h
-;#------------------+
-
-;# NTP mode 7 packet format:
-;# Byte 1: ResponseBit MoreBit Version(3bit) Mode(3bit)==7
-;# Byte 2: AuthBit Sequence # - 0 - 127 see MoreBit
-;# Byte 3: Implementation #
-;# Byte 4: Request Code
-;#
-;# Short 1: Err(3bit) NumItems(12bit)
-;# Short 2: MBZ(3bit)=0 DataItemSize(12bit)
-;# 0 - 500 byte Data
-;# if AuthBit is set:
-;# Long: KeyId
-;# 2xLong: AuthCode
-
-;#
-$IMPL_XNTPD = 2;
-$REQ_LOOP_INFO = 8;
-
-
-;# request packet for REQ_LOOP_INFO:
-;# B1: RB=0 MB=0 V=2 M=7
-;# B2: S# = 0
-;# B3: I# = IMPL_XNTPD
-;# B4: RC = REQ_LOOP_INFO
-;# S1: E=0 NI=0
-;# S2: MBZ=0 DIS=0
-;# data: 32 byte 0 padding
-;# 8byte timestamp if encryption, 0 padding otherwise
-$loopinfo_reqpkt =
- pack("CCCC nn x32 x8", 0x17, 0, $IMPL_XNTPD, $REQ_LOOP_INFO, 0, 0);
-
-;# ignore any auth data in packets
-$loopinfo_response_size =
- 1+1+1+1+2+2 # header size like request pkt
- + 8 # l_fp last_offset
- + 8 # l_fp drift_comp
- + 4 # u_long compliance
- + 4 # u_long watchdog_timer
- ;
-$loopinfo_response_fmt = "C4n2N2N2NN";
-$loopinfo_response_fmt_v2 = "C4n2N2N2N2N";
-
-;#
-;# prepare connection to server
-;#
-
-;# workaround for broken socket.ph on dynix_ptx
-eval 'sub INTEL {1;}' unless defined(&INTEL);
-eval 'sub ATT {1;}' unless defined(&ATT);
-
-require "sys/socket.ph";
-
-require 'netinet/in.ph';
-
-;# if you do not have netinet/in.ph enable the following lines
-;#eval 'sub INADDR_ANY { 0x00000000; }' unless defined(&INADDR_ANY);
-;#eval 'sub IPPRORO_UDP { 17; }' unless defined(&IPPROTO_UDP);
-
-if ($ntpserver =~ /^((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)$/)
-{
- local($a,$b,$c,$d) = ($1,$3,$5,$7);
- $a = oct($a) if defined($2);
- $b = oct($b) if defined($4);
- $c = oct($c) if defined($6);
- $d = oct($d) if defined($8);
- $server_addr = pack("C4", $a,$b,$c,$d);
-
- $server_mainname
- = (gethostbyaddr($server_addr,&AF_INET))[$[] || $ntpserver;
-}
-else
-{
- ($server_mainname,$server_addr)
- = (gethostbyname($ntpserver))[$[,$[+4];
-
- die("$0: host \"$ntpserver\" is unknown\n")
- unless defined($server_addr);
-}
-&msg ("Address of server \"$ntpserver\" is \"%d.%d.%d.%d\"\n",
- unpack("C4",$server_addr));
-
-$proto_udp = (getprotobyname('udp'))[$[+2] || &IPPROTO_UDP;
-
-$ntp_port =
- (getservbyname('ntp','udp'))[$[+2] ||
- (warn "Could not get port number for service \"ntp/udp\" using 123\n"),
- ($ntp_port=123);
-
-;#
-0 && &SOCK_DGRAM; # satisfy perl -w ...
-socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) ||
- die("Cannot open socket: $!\n");
-
-bind(S, pack("S n N x8", &AF_INET, 0, &INADDR_ANY)) ||
- die("Cannot bind: $!\n");
-
-($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
-
-&msg("Listening at address %d.%d.%d.%d port %d\n",
- unpack("C4",$my_addr), $my_port);
-
-$server_inaddr = pack("Sna4x8", &AF_INET, $ntp_port, $server_addr);
-
-;############################################################
-;#
-;# the main loop:
-;# send request
-;# get reply
-;# wait til next sample time
-
-undef($lasttime);
-$lostpacket = 0;
-
-while(1)
-{
- $stime = &time;
-
- &msg("Sending request $stime...\n");
-
- $ret = send(S,$loopinfo_reqpkt,0,$server_inaddr);
-
- if (! defined($ret) || $ret < length($loopinfo_reqpkt))
- {
- warn("$0: send failed ret=($ret): $!\n");
- $fail++;
- next;
- }
-
- &msg("Waiting for reply...\n");
-
- $mask = ""; vec($mask,fileno(S),1) = 1;
- $ret = select($mask,undef,undef,$timeout);
-
- if (! defined($ret))
- {
- warn("$0: select failed: $!\n");
- $fail++;
- next;
- }
- elsif ($ret == 0)
- {
- warn("$0: request to $ntpserver timed out ($timeout seconds)\n");
- ;# do not count this event as failure
- ;# it usually this happens due to dropped udp packets on noisy and
- ;# havily loaded lines, so just try again;
- $lostpacket = 1;
- next;
- }
-
- &msg("Receiving reply...\n");
-
- $len = 520; # max size of a mode 7 packet
- $reply = ""; # just make it defined for -w
- $ret = recv(S,$reply,$len,0);
-
- if (!defined($ret))
- {
- warn("$0: recv failed: $!\n");
- $fail++;
- next;
- }
-
- $etime = &time;
- &msg("Received at\t$etime\n");
-
- ;#$time = ($stime + $etime) / 2; # symmetric delay assumed
- $time = $etime; # the above assumption breaks for X25
- ;# so taking etime makes timestamps be a
- ;# little late, but keeps them increasing
- ;# monotonously
-
- &msg(sprintf("Reply from %d.%d.%d.%d took %f seconds\n",
- (unpack("SnC4",$ret))[$[+2 .. $[+5], ($etime - $stime)));
-
- if ($len < $loopinfo_response_size)
- {
- warn("$0: short packet ($len bytes) received ($loopinfo_response_size bytes expected\n");
- $fail++;
- next;
- }
-
- ($b1,$b2,$b3,$b4,$s1,$s2,
- $offset_i,$offset_f,$drift_i,$drift_f,$compl,$watchdog)
- = unpack($loopinfo_response_fmt,$reply);
-
- ;# check reply
- if (($s1 >> 12) != 0) # error !
- {
- die("$0: got error reply ".($s1>>12)."\n");
- }
- if (($b1 != 0x97 && $b1 != 0x9f) || # Reply NotMore V=2 M=7
- ($b2 != 0 && $b2 != 0x80) || # S=0 Auth no/yes
- $b3 != $IMPL_XNTPD || # ! IMPL_XNTPD
- $b4 != $REQ_LOOP_INFO || # Ehh.. not loopinfo reply ?
- $s1 != 1 || # ????
- ($s2 != 24 && $s2 != 28) #
- )
- {
- warn("$0: Bad/unexpected reply from server:\n");
- warn(" \"".unpack("H*",$reply)."\"\n");
- warn(" ".sprintf("b1=%x b2=%x b3=%x b4=%x s1=%d s2=%d\n",
- $b1,$b2,$b3,$b4,$s1,$s2));
- $fail++;
- next;
- }
- elsif ($s2 == 28)
- {
- ;# seems to be a version 2 xntpd
- ($b1,$b2,$b3,$b4,$s1,$s2,
- $offset_i,$offset_f,$drift_i,$drift_f,$compl_i,$compl_f,$watchdog)
- = unpack($loopinfo_response_fmt_v2,$reply);
- $compl = &lfptoa($compl_i, $compl_f);
- }
-
- $time -= $watchdog;
-
- $offset = &lfptoa($offset_i, $offset_f);
- $drift = &lfptoa($drift_i, $drift_f);
-
- &log($time,$offset,$drift,$compl) && ($fail = 0);;
-}
-continue
-{
- die("$0: Too many failures - terminating\n") if $fail > $MAX_FAIL;
- &msg("Sleeping " . ($lostpacket ? ($delay / 2) : $delay) . " seconds...\n");
-
- sleep($lostpacket ? ($delay / 2) : $delay);
- $lostpacket = 0;
-}
-
-sub log
-{
- local($time,$offs,$freq,$cmpl) = @_;
- local($y,$m,$d);
- local($fname,$suff) = ($logfile);
-
-
- ;# silently drop sample if distance to last sample is too low
- if (defined($lasttime) && ($lasttime + 2) >= $time)
- {
- &msg("Dropped packet - old sample\n");
- return 1;
- }
-
- ;# $suff determines which samples end up in the same file
- ;# could have used $year (;-) or WeekOfYear, DayOfYear,....
- ;# Change it to your suit...
-
- ($d,$m,$y) = (localtime($time))[$[+3 .. $[+5];
- $suff = sprintf("%04d%02d%02d",$y+1900,$m+1,$d);
- $fname .= $suff;
- if (!open(LOG,">>$fname"))
- {
- warn("$0: open($fname) failed: $!\n");
- $fail++;
- return 0;
- }
- else
- {
- ;# file format
- ;# MJD seconds offset drift compliance
- printf LOG ("%d %.3lf %.8lf %.7lf %d\n",
- int($time/86400)+$MJD_1970,
- $time - int($time/86400) * 86400,
- $offs,$freq,$cmpl);
- close(LOG);
- $lasttime = $time;
- }
- return 1;
-}
-
-;# see ntp_fp.h to understand this
-sub lfptoa
-{
- local($i,$f) = @_;
- local($sign) = 1;
-
-
- if ($i & 0x80000000)
- {
- if ($f == 0)
- {
- $i = -$i;
- }
- else
- {
- $f = -$f;
- $i = ~$i;
- $i += 1; # 2s complement
- }
- $sign = -1;
- ;#print "NEG: $i $f\n";
- }
- else
- {
- ;#print "POS: $i $f\n";
- }
- ;# unlike xntpd I have perl do the dirty work.
- ;# Using floats here may affect precision, but
- ;# currently these bits aren't significant anyway
- return $sign * ($i + $f/2**32);
-}
diff --git a/usr.sbin/xntpd/scripts/monitoring/ntploopwatch b/usr.sbin/xntpd/scripts/monitoring/ntploopwatch
deleted file mode 100755
index 655ed7188cea..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/ntploopwatch
+++ /dev/null
@@ -1,1631 +0,0 @@
-#!/local/bin/perl -w--*-perl-*-
-;#
-;# ntploopwatch,v 3.1 1993/07/06 01:09:13 jbj Exp
-;#
-;# process loop filter statistics file and either
-;# - show statistics periodically using gnuplot
-;# - or print a single plot
-;#
-;# Copyright (c) 1992
-;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
-;#
-;#
-;#############################################################
-$0 =~ s!^.*/([^/]+)$!\1!;
-$F = ' ' x length($0);
-$|=1;
-
-$ENV{'SHELL'} = '/bin/sh'; # use bourne shell
-
-undef($config);
-undef($workdir);
-undef($PrintIt);
-undef($samples);
-undef($StartTime);
-undef($EndTime);
-($a,$b) if 0; # keep -w happy
-$usage = <<"E-O-P";
-usage:
- to watch statistics permanently:
- $0 [-v[<level>]] [-c <config-file>] [-d <working-dir>]
- $F [-h <hostname>]
-
- to get a single print out specify also
- $F -P[<printer>] [-s<samples>]
- $F [-S <start-time>] [-E <end-time>]
- $F [-Y <MaxOffs>] [-y <MinOffs>]
-
-If You like long option names, You can use:
- -help
- -c +config
- -d +directory
- -h +host
- -v +verbose[=<level>]
- -P +printer[=<printer>]
- -s +samples[=<samples>]
- -S +starttime
- -E +endtime
- -Y +maxy
- -y +miny
-
-If <printer> contains a '/' (slash character) output is directed to
-a file of this name instead of delivered to a printer.
-E-O-P
-
-;# add directory to look for lr.pl and timelocal.pl (in front of current list)
-unshift(@INC,"/src/NTP/v3/xntp/monitoring");
-
-require "lr.pl"; # linear regresion routines
-
-$MJD_1970 = 40587; # from ntp.h (V3)
-$RecordSize = 48; # usually a line fits into 42 bytes
-$MinClip = 0.12; # clip Y scales with greater range than this
-
-;# largest extension of Y scale from mean value, factor for standart deviation
-$FuzzLow = 2; # for side closer to zero
-$FuzzBig = 1; # for side farther from zero
-
-require "ctime.pl";
-require "timelocal.pl";
-;# early distributions of ctime.pl had a bug
-$ENV{'TZ'} = 'MET' unless defined $ENV{'TZ'} || $[ > 4.010;
-if (defined(@ctime'MoY))
-{
- *Month=*ctime'MoY;
- *Day=*ctime'DoW;
-}
-else
-{
- @Month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
- @Day = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
-}
-;# max number of days per month
-@MaxNumDaysPerMonth = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
-
-;# config settable parameters
-$delay = 60;
-$srcprefix = "./var\@\$STATHOST/loopstats.";
-$showoffs = 1;
-$showfreq = 1;
-$showcmpl = 0;
-$showoreg = 0;
-$showfreg = 0;
-undef($timebase);
-undef($freqbase);
-undef($cmplscale);
-undef($MaxY);
-undef($MinY);
-$deltaT = 512; # indicate sample data gaps greater than $deltaT seconds
-$verbose = 1;
-
-while($_ = shift(@ARGV))
-{
- (/^[+-]help$/) && die($usage);
-
- (/^-c$/ || /^\+config$/) &&
- (@ARGV || die($usage), $config = shift(@ARGV), next);
-
- (/^-d$/ || /^\+directory$/) &&
- (@ARGV || die($usage), $workdir = shift(@ARGV), next);
-
- (/^-h$/ || /^\+host$/) &&
- (@ARGV || die($usage), $STATHOST = shift, next);
-
- (/^-v(\d*)$/ || /^\+verbose=?(\d*)$/) &&
- ($verbose=($1 eq "") ? 1 : $1, next);
-
- (/^-P(\S*)$/ || /^\+[Pp]rinter=?(\S*)$/) &&
- ($PrintIt = $1, $verbose==1 && ($verbose = 0), next);
-
- (/^-s(\d*)$/ || /^\+samples=?(\d*)$/) &&
- (($samples = ($1 eq "") ? (shift || die($usage)): $1), next);
-
- (/^-S$/ || /^\+[Ss]tart[Tt]ime$/) &&
- (@ARGV || die($usage), $StartTime=&date_time_spec2seconds(shift),next);
-
- (/^-E$/ || /^\+[Ee]nd[Tt]ime$/) &&
- (@ARGV || die($usage), $EndTime = &date_time_spec2seconds(shift),next);
-
- (/^-Y$/ || /^\+[Mm]ax[Yy]$/) &&
- (@ARGV || die($usage), $MaxY = shift, next);
-
- (/^-y$/ || /^\+[Mm]in[Yy]$/) &&
- (@ARGV || die($usage), $MinY = shift, next);
-
- die("$0: unexpected argument \"$_\"\n$usage");
-}
-
-if (defined($workdir))
-{
- chdir($workdir) ||
- die("$0: failed to change working dir to \"$workdir\": $!\n");
-}
-
-$PrintIt = "ps" if defined($PrintIt) && $PrintIt eq "";
-
-if (!defined($PrintIt))
-{
- defined($samples) &&
- print "WARNING: your samples value may be shadowed by config file settings\n";
- defined($StartTime) &&
- print "WARNING: your StartTime value may be shadowed by config file settings\n";
- defined($EndTime) &&
- print "WARNING: your EndTime value may be shadowed by config file settings\n";
- defined($MaxY) &&
- print "WARNING: your MaxY value may be shadowed by config file settings\n";
- defined($MinY) &&
- print "WARNING: your MinY value may be shadowed by config file settings\n";
-
- ;# check operating environment
- ;#
- ;# gnuplot usually has X support
- ;# I vaguely remember there was one with sunview support
- ;#
- ;# If Your plotcmd can display graphics using some other method
- ;# (Tek window,..) fix the following test
- ;# (or may be, just disable it)
- ;#
- !(defined($ENV{'DISPLAY'}) || defined($ENV{'WINDOW_PARENT'})) &&
- die("Need window system to monitor statistics\n");
-}
-
-;# configuration file
-$config = "loopwatch.config" unless defined($config);
-($STATHOST = $config) =~ s!.*loopwatch\.config.([^/\.]*)$!\1!
- unless defined($STATHOST);
-($STATTAG = $STATHOST) =~ s/^([^\.\*\s]+)\..*$/\1/;
-
-$srcprefix =~ s/\$STATHOST/$STATHOST/g;
-
-;# plot command
-@plotcmd=("gnuplot",
- '-title', "Ntp loop filter statistics $STATHOST",
- '-name', "NtpLoopWatch_$STATTAG");
-$tmpfile = "/tmp/ntpstat.$$";
-
-;# other variables
-$doplot = ""; # assembled command for @plotcmd to display plot
-undef($laststat);
-
-;# plot value ranges
-undef($mintime);
-undef($maxtime);
-undef($minoffs);
-undef($maxoffs);
-undef($minfreq);
-undef($maxfreq);
-undef($mincmpl);
-undef($maxcmpl);
-undef($miny);
-undef($maxy);
-
-;# stop operation if plot command dies
-sub sigchld
-{
- local($pid) = wait;
- unlink($tmpfile);
- warn(sprintf("%s: %s died: exit status: %d signal %d\n",
- $0,
- (defined($Plotpid) && $Plotpid == $pid)
- ? "plotcmd" : "unknown child $pid",
- $?>>8,$? & 0xff)) if $?;
- exit(1) if $? && defined($Plotpid) && $pid == $Plotpid;
-}
-&sigchld if 0;
-$SIG{'CHLD'} = "sigchld";
-$SIG{'CLD'} = "sigchld";
-
-sub abort
-{
- unlink($tmpfile);
- defined($Plotpid) && kill('TERM',$Plotpid);
- die("$0: received signal SIG$_[$[] - exiting\n");
-}
-&abort if 0; # make -w happy - &abort IS used
-$SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = $SIG{'PIPE'} = "abort";
-
-;#
-sub abs
-{
- ($_[$[] < 0) ? -($_[$[]) : $_[$[];
-}
-
-;#####################
-;# start of real work
-
-print "starting plot command (" . join(" ",@plotcmd) . ")\n" if $verbose > 1;
-
-$Plotpid = open(PLOT,"|-");
-select((select(PLOT),$|=1)[$[]); # make PLOT line bufferd
-
-defined($Plotpid) ||
- die("$0: failed to start plot command: $!\n");
-
-unless ($Plotpid)
-{
- ;# child == plot command
- close(STDOUT);
- open(STDOUT,">&STDERR") ||
- die("$0: failed to redirect STDOUT of plot command: $!\n");
-
- print STDOUT "plot command running as $$\n";
-
- exec @plotcmd;
- die("$0: failed to exec (@plotcmd): $!\n");
- exit(1); # in case ...
-}
-
-sub read_config
-{
- local($at) = (stat($config))[$[+9];
- local($_,$c,$v);
-
- (undef($laststat),(print("stat $config failed: $!\n")),return) if ! defined($at);
- return if (defined($laststat) && ($laststat == $at));
- $laststat = $at;
-
- print "reading configuration from \"$config\"\n" if $verbose;
-
- open(CF,"<$config") ||
- (warn("$0: failed to read \"$config\" - using old settings ($!)\n"),
- return);
- while(<CF>)
- {
- chop;
- s/^([^\#]*[^\#\s]?)\s*\#.*$//;
- next if /^\s*$/;
-
- s/^\s*([^=\s]*)\s*=\s*(.*\S)\s*$/\1=\2/;
-
- ($c,$v) = split(/=/,$_,2);
- print "processing \"$c=$v\"\n" if $verbose > 3;
- ($c eq "delay") && ($delay = $v,1) && next;
- ($c eq 'samples') && (!defined($PrintIt) || !defined($samples)) &&
- ($samples = $v,1) && next;
- ($c eq 'srcprefix') && (($srcprefix=$v)=~s/\$STATHOST/$STATHOST/g,1)
- && next;
- ($c eq 'showoffs') &&
- ($showoffs = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
- ($c eq 'showfreq') &&
- ($showfreq = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
- ($c eq 'showcmpl') &&
- ($showcmpl = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
- ($c eq 'showoreg') &&
- ($showoreg = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
- ($c eq 'showfreg') &&
- ($showfreg = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
-
- ($c eq 'exit') && (unlink($tmpfile),die("$0: exit by config request\n"));
-
- ($c eq 'freqbase' ||
- $c eq 'cmplscale') &&
- do {
- if (! defined($v) || $v eq "" || $v eq 'dynamic')
- {
- eval "undef(\$$c);";
- }
- else
- {
- eval "\$$c = \$v;";
- }
- next;
- };
- ($c eq 'timebase') &&
- do {
- if (! defined($v) || $v eq "" || $v eq "dynamic")
- {
- undef($timebase);
- }
- else
- {
- $timebase=&date_time_spec2seconds($v);
- }
- };
- ($c eq 'EndTime') &&
- do {
- next if defined($EndTime) && defined($PrintIt);
- if (! defined($v) || $v eq "" || $v eq "none")
- {
- undef($EndTime);
- }
- else
- {
- $EndTime=&date_time_spec2seconds($v);
- }
- };
- ($c eq 'StartTime') &&
- do {
- next if defined($StartTime) && defined($PrintIt);
- if (! defined($v) || $v eq "" || $v eq "none")
- {
- undef($StartTime);
- }
- else
- {
- $StartTime=&date_time_spec2seconds($v);
- }
- };
-
- ($c eq 'MaxY') &&
- do {
- next if defined($MaxY) && defined($PrintIt);
- if (! defined($v) || $v eq "" || $v eq "none")
- {
- undef($MaxY);
- }
- else
- {
- $MaxY=$v;
- }
- };
-
- ($c eq 'MinY') &&
- do {
- next if defined($MinY) && defined($PrintIt);
- if (! defined($v) || $v eq "" || $v eq "none")
- {
- undef($MinY);
- }
- else
- {
- $MinY=$v;
- }
- };
-
- ($c eq 'deltaT') &&
- do {
- if (!defined($v) || $v eq "")
- {
- undef($deltaT);
- }
- else
- {
- $deltaT = $v;
- }
- next;
- };
- ($c eq 'verbose') && ! defined($PrintIt) &&
- do {
- if (!defined($v) || $v == 0)
- {
- $verbose = 0;
- }
- else
- {
- $verbose = $v;
- }
- next;
- };
- ;# otherwise: silently ignore unrecognized config line
- }
- close(CF);
- ;# set show defaults when nothing selected
- $showoffs = $showfreq = $showcmpl = 1
- unless $showoffs || $showfreq || $showcmpl;
- if ($verbose > 3)
- {
- print "new configuration:\n";
- print " delay\t= $delay\n";
- print " samples\t= $samples\n";
- print " srcprefix\t= $srcprefix\n";
- print " showoffs\t= $showoffs\n";
- print " showfreq\t= $showfreq\n";
- print " showcmpl\t= $showcmpl\n";
- print " showoreg\t= $showoreg\n";
- print " showfreg\t= $showfreg\n";
- printf " timebase\t= %s",defined($timebase)?&ctime($timebase):"dynamic\n";
- printf " freqbase\t= %s\n",defined($freqbase) ?"$freqbase":"dynamic";
- printf " cmplscale\t= %s\n",defined($cmplscale)?"$cmplscale":"dynamic";
- printf " StartTime\t= %s",defined($StartTime)?&ctime($StartTime):"none\n";
- printf " EndTime\t= %s", defined($EndTime) ? &ctime($EndTime):"none\n";
- printf " MaxY\t= %s",defined($MaxY)? $MaxY :"none\n";
- printf " MinY\t= %s",defined($MinY)? $MinY :"none\n";
- print " verbose\t= $verbose\n";
- }
-print "configuration file read\n" if $verbose > 2;
-}
-
-sub make_doplot
-{
- local($c) = ("");
- local($fmt)
- = ("%s \"%s\" using 1:%d title '%s <%lf %lf> %6s' with lines");
- local($regfmt)
- = ("%s ((%lf * x) + %lf) title 'lin. approx. %s (%f t[h]) %s %f <%f> %6s' with lines");
-
- $doplot = " set title 'NTP loopfilter statistics for $STATHOST " .
- "(last $LastCnt samples from $srcprefix*)'\n";
-
- local($xts,$xte,$i,$t);
-
- local($s,$c) = ("");
-
- ;# number of integral seconds to get at least 12 tic marks on x axis
- $t = int(($maxtime - $mintime) / 12 + 0.5);
- $t = 1 unless $t; # prevent $t to be zero
- foreach $i (30,
- 60,5*60,15*60,30*60,
- 60*60,2*60*60,6*60*60,12*60*60,
- 24*60*60,48*60*60)
- {
- last if $t < $i;
- $t = $t - ($t % $i);
- }
- print "time label resolution: $t seconds\n" if $verbose > 1;
-
- ;# make gnuplot use wall clock time labels instead of NTP seconds
- for ($c="", $i = $mintime - ($mintime % $t);
- $i <= $maxtime + $t;
- $i += $t, $c=",")
- {
- $s .= $c;
- ((int($i / $t) % 2) &&
- ($s .= sprintf("'' %lf",($i - $LastTimeBase)/3600))) ||
- (($t <= 60) &&
- ($s .= sprintf("'%d:%02d:%02d' %lf",
- (localtime($i))[$[+2,$[+1,$[+0],
- ($i - $LastTimeBase)/3600)))
- || (($t <= 2*60*60) &&
- ($s .= sprintf("'%d:%02d' %lf",
- (localtime($i))[$[+2,$[+1],
- ($i - $LastTimeBase)/3600)))
- || (($t <= 12*60*60) &&
- ($s .= sprintf("'%s %d:00' %lf",
- $Day[(localtime($i))[$[+6]],
- (localtime($i))[$[+2],
- ($i - $LastTimeBase)/3600)))
- || ($s .= sprintf("'%d.%d-%d:00' %lf",
- (localtime($i))[$[+3,$[+4,$[+2],
- ($i - $LastTimeBase)/3600));
- }
- $doplot .= "set xtics ($s)\n";
-
- chop($xts = &ctime($mintime));
- chop($xte = &ctime($maxtime));
- $doplot .= "set xlabel 'Start: $xts -- Time Scale -- End: $xte'\n";
- $doplot .= "set yrange [" ;
- $doplot .= defined($MinY) ? sprintf("%lf", $MinY) : $miny;
- $doplot .= ':';
- $doplot .= defined($MaxY) ? sprintf("%lf", $MaxY) : $maxy;
- $doplot .= "]\n";
-
- $doplot .= " plot";
- $c = "";
- $showoffs &&
- ($doplot .= sprintf($fmt,$c,$tmpfile,2,
- "offset",
- $minoffs,$maxoffs,
- "[ms]"),
- $c = ",");
- $showcmpl &&
- ($doplot .= sprintf($fmt,$c,$tmpfile,4,
- "compliance" .
- (&abs($LastCmplScale) > 1
- ? " / $LastCmplScale"
- : (&abs($LastCmplScale) == 1 ? "" : " * ".(1/$LastCmplScale))),
- $mincmpl/$LastCmplScale,$maxcmpl/$LastCmplScale,
- ""),
- $c = ",");
- $showfreq &&
- ($doplot .= sprintf($fmt,$c,$tmpfile,3,
- "frequency" .
- ($LastFreqBase > 0
- ? " - $LastFreqBaseString"
- : ($LastFreqBase == 0 ? "" : " + $LastFreqBaseString")),
- $minfreq * $FreqScale - $LastFreqBase,
- $maxfreq * $FreqScale - $LastFreqBase,
- "[${FreqScaleInv}ppm]"),
- $c = ",");
- $showoreg && $showoffs &&
- ($doplot .= sprintf($regfmt, $c,
- &lr_B('offs'),&lr_A('offs'),
- "offset ",
- &lr_B('offs'),
- ((&lr_A('offs')) < 0 ? '-' : '+'),
- &abs(&lr_A('offs')), &lr_r('offs'),
- "[ms]"),
- $c = ",");
- $showfreg && $showfreq &&
- ($doplot .= sprintf($regfmt, $c,
- &lr_B('freq') * $FreqScale,
- (&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase,
- "frequency",
- &lr_B('freq') * $FreqScale,
- ((&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase) < 0 ? '-' : '+',
- &abs((&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase),
- &lr_r('freq'),
- "[${FreqScaleInv}ppm]"),
- $c = ",");
- $doplot .= "\n";
-}
-
-%F_key = ();
-%F_name = ();
-%F_size = ();
-%F_mtime = ();
-%F_first = ();
-%F_last = ();
-
-sub genfile
-{
- local($cnt,$in,$out,@fpos) = @_;
-
- local(@F,@t,$t,$lastT) = ();
- local(@break,@time,@offs,@freq,@cmpl,@loffset,@filekey) = ();
- local($lm,$l,@f);
-
- local($sdir,$sname);
-
- ;# allocate some storage for the tables
- ;# otherwise realloc may get into troubles
- if (defined($StartTime) && defined($EndTime))
- {
- $l = ($EndTime-$StartTime) -$[+1 +1; # worst case: 1 sample per second
- }
- else
- {
- $l = $cnt + 10;
- }
- print "preextending arrays to $l entries\n" if $verbose > 2;
- $#break = $l; for ($i=$[; $i<=$l;$i++) { $break[$i] = 0; }
- $#time = $l; for ($i=$[; $i<=$l;$i++) { $time[$i] = 0; }
- $#offs = $l; for ($i=$[; $i<=$l;$i++) { $offs[$i] = 0; }
- $#freq = $l; for ($i=$[; $i<=$l;$i++) { $freq[$i] = 0; }
- $#cmpl = $l; for ($i=$[; $i<=$l;$i++) { $cmpl[$i] = 0; }
- $#loffset = $l; for ($i=$[; $i<=$l;$i++) { $loffset[$i] = 0; }
- $#filekey = $l; for ($i=$[; $i<=$l;$i++) { $filekey[$i] = 0; }
- ;# now reduce size again
- $#break = $[ - 1;
- $#time = $[ - 1;
- $#offs = $[ - 1;
- $#freq = $[ - 1;
- $#cmpl = $[ - 1;
- $#loffset = $[ - 1;
- $#filekey = $[ - 1;
- print "memory allocation ready\n" if $verbose > 2;
- sleep(3) if $verbose > 1;
-
- if (index($in,"/") < $[)
- {
- $sdir = ".";
- $sname = $in;
- }
- else
- {
- ($sdir,$sname) = ($in =~ m!^(.*)/([^/]*)!);
- $sname = "" unless defined($sname);
- }
-
- if (!defined($Lsdir) || $Lsdir ne $sdir || $Ltime != (stat($sdir))[$[+9] ||
- grep($F_mtime{$_} != (stat($F_name{$_}))[$[+9], @F_files))
-
- {
- print "rescanning directory \"$sdir\" for files \"$sname*\"\n"
- if $verbose > 1;
-
- ;# rescan directory on changes
- $Lsdir = $sdir;
- $Ltime = (stat($sdir))[$[+9];
- </X{> if 0; # dummy line - calm down my formatter
- local(@newfiles) = < ${in}*[0-9] >;
- local($st_dev,$st_ino,$st_mtime,$st_size,$name,$key,$modified);
-
- foreach $name (@newfiles)
- {
- ($st_dev,$st_ino,$st_size,$st_mtime) =
- (stat($name))[$[,$[+1,$[+7,$[+9];
- $modified = 0;
- $key = sprintf("%lx|%lu", $st_dev, $st_ino);
-
- print "candidate file \"$name\"",
- (defined($st_dev) ? "" : " failed: $!"),"\n"
- if $verbose > 2;
-
- if (! defined($F_key{$name}) || $F_key{$name} ne $key)
- {
- $F_key{$name} = $key;
- $modified++;
- }
- if (!defined($F_name{$key}) || $F_name{$key} != $name)
- {
- $F_name{$key} = $name;
- $modified++;
- }
- if (!defined($F_size{$key}) || $F_size{$key} != $st_size)
- {
- $F_size{$key} = $st_size;
- $modified++;
- }
- if (!defined($F_mtime{$key}) || $F_mtime{$key} != $st_mtime)
- {
- $F_mtime{$key} = $st_mtime;
- $modified++;
- }
- if ($modified)
- {
- print "new data \"$name\" key: $key;\n" if $verbose > 1;
- print " size: $st_size; mtime: $st_mtime;\n"
- if $verbose > 1;
- $F_last{$key} = $F_first{$key} = $st_mtime;
- $F_first{$key}--; # prevent zero divide later on
- ;# now compute derivated attributes
- open(IN, "<$name") ||
- do {
- warn "$0: failed to open \"$name\": $!";
- next;
- };
-
- while(<IN>)
- {
- @F = split;
- next if @F < 5;
- next if $F[$[] eq "";
- $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
- $t += $F[$[+1];
- $F_first{$key} = $t;
- print "\tfound first entry: $t ",&ctime($t)
- if $verbose > 4;
- last;
- }
- seek(IN,
- ($st_size > 4*$RecordSize) ? $st_size - 4*$RecordSize : 0,
- 0);
- while(<IN>)
- {
- @F = split;
- next if @F < 5;
- next if $F[$[] eq "";
- $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
- $t += $F[$[+1];
- $F_last{$key} = $t;
- $_ = <IN>;
- print "\tfound last entry: $t ", &ctime($t)
- if $verbose > 4 && ! defined($_);
- last unless defined($_);
- redo;
- ;# Ok, calm down...
- ;# using $_ = <IN> in conjunction with redo
- ;# is semantically equivalent to the while loop, but
- ;# I needed a one line look ahead and this solution
- ;# was what I thought of first
- ;# and.. If you do not like it dont look
- }
- close(IN);
- print(" first: ",$F_first{$key},
- " last: ",$F_last{$key},"\n") if $verbose > 1;
- }
- }
- ;# now reclaim memory used for files no longer referenced ...
- local(%Names);
- grep($Names{$_} = 1,@newfiles);
- foreach (keys %F_key)
- {
- next if defined($Names{$_});
- delete $F_key{$_};
- $verbose > 2 && print "no longer referenced: \"$_\"\n";
- }
- %Names = ();
-
- grep($Names{$_} = 1,values(%F_key));
- foreach (keys %F_name)
- {
- next if defined($Names{$_});
- delete $F_name{$_};
- $verbose > 2 && print "unref name($_)= $F_name{$_}\n";
- }
- foreach (keys %F_size)
- {
- next if defined($Names{$_});
- delete $F_size{$_};
- $verbose > 2 && print "unref size($_)\n";
- }
- foreach (keys %F_mtime)
- {
- next if defined($Names{$_});
- delete $F_mtime{$_};
- $verbose > 2 && print "unref mtime($_)\n";
- }
- foreach (keys %F_first)
- {
- next if defined($Names{$_});
- delete $F_first{$_};
- $verbose > 2 && print "unref first($_)\n";
- }
- foreach (keys %F_last)
- {
- next if defined($Names{$_});
- delete $F_last{$_};
- $verbose > 2 && print "unref last($_)\n";
- }
- ;# create list sorted by time
- @F_files = sort {$F_first{$a} <=> $F_first{$b}; } keys(%F_name);
- if ($verbose > 1)
- {
- print "Resulting file list:\n";
- foreach (@F_files)
- {
- print "\t$_\t$F_name{$_}\n";
- }
- }
- }
-
- printf("processing %s; output \"$out\" (%d input files)\n",
- ((defined($StartTime) && defined($EndTime))
- ? "time range"
- : (defined($StartTime) ? "$cnt samples from StartTime" :
- (defined($EndTime) ? "$cnt samples to EndTime" :
- "last $cnt samples"))),
- scalar(@F_files))
- if $verbose > 1;
-
- ;# open output file - will be input for plotcmd
- open(OUT,">$out") ||
- do {
- warn("$0: cannot create \"$out\": $!\n");
- };
-
- @f = @F_files;
- if (defined($StartTime))
- {
- while (@f && ($F_last{$f[$[]} < $StartTime))
- {
- print("shifting ", $F_name{$f[$[]},
- " last: ", $F_last{$f[$[]},
- " < StartTime: $StartTime\n")
- if $verbose > 3;
- shift(@f);
- }
-
-
- }
- if (defined($EndTime))
- {
- while (@f && ($F_first{$f[$#f]} > $EndTime))
- {
- print("popping ", $F_name{$f[$#f]},
- " first: ", $F_first{$f[$#f]},
- " > EndTime: $EndTime\n")
- if $verbose > 3;
- pop(@f);
- }
- }
-
- if (@f)
- {
- if (defined($StartTime))
- {
- print "guess start according to StartTime ($StartTime)\n"
- if $verbose > 3;
-
- if ($fpos[$[] eq 'start')
- {
- if (grep($_ eq $fpos[$[+1],@f))
- {
- shift(@f) while @f && $f[$[] ne $fpos[$[+1];
- }
- else
- {
- @fpos = ('start', $f[$[], undef);
- }
- }
- else
- {
- @fpos = ('start' , $f[$[], undef);
- }
-
- if (!defined($fpos[$[+2]))
- {
- if ($StartTime <= $F_first{$f[$[]})
- {
- $fpos[$[+2] = 0;
- }
- else
- {
- $fpos[$[+2] =
- int($F_size{$f[$[]} *
- (($StartTime - $F_first{$f[$[]})/
- ($F_last{$f[$[]} - $F_first{$f[$[]})));
- $fpos[$[+2] = ($fpos[$[+2] <= 2 * $RecordSize)
- ? 0 : $fpos[$[+2] - 2 * $RecordSize;
- ;# anyway as the data may contain "time holes"
- ;# our heuristics may baldly fail
- ;# so just start at 0
- $fpos[$[+2] = 0;
- }
- }
- }
- elsif (defined($EndTime))
- {
- print "guess starting point according to EndTime ($EndTime)\n"
- if $verbose > 3;
-
- if ($fpos[$[] eq 'end')
- {
- if (grep($_ eq $fpos[$[+1],@f))
- {
- shift(@f) while @f && $f[$[] ne $fpos[$[+1];
- }
- else
- {
- @fpos = ('end', $f[$[], undef);
- }
- }
- else
- {
- @fpos = ('end', $f[$[], undef);
- }
-
- if (!defined($fpos[$[+2]))
- {
- local(@x) = reverse(@f);
- local($s,$c) = (0,$cnt);
- if ($EndTime < $F_last{$x[$[]})
- {
- ;# last file will only be used partially
- $s = int($F_size{$x[$[]} *
- (($EndTime - $F_first{$x[$[]}) /
- ($F_last{$x[$[]} - $F_first{$x[$[]})));
- $s = int($s/$RecordSize);
- $c -= $s - 1;
- if ($c <= 0)
- {
- ;# start is in the same file
- $fpos[$[+1] = $x[$[];
- $fpos[$[+2] = ($c >=-2) ? 0 : (-$c - 2) * $RecordSize;
- shift(@f) while @f && ($f[$[] ne $x[$[]);
- }
- else
- {
- shift(@x);
- }
- }
-
- if (!defined($fpos[$[+2]))
- {
- local($_);
- while($_ = shift(@x))
- {
- $s = int($F_size{$_}/$RecordSize);
- $c -= $s - 1;
- if ($c <= 0)
- {
- $fpos[$[+1] = $_;
- $fpos[$[+2] = ($c>-2) ? 0 : (-$c - 2) * $RecordSize;
- shift(@f) while @f && ($f[$[] ne $_);
- last;
- }
- }
- }
- }
- }
- else
- {
- print "guessing starting point according to count ($cnt)\n"
- if $verbose > 3;
- ;# guess offset to get last available $cnt samples
- if ($fpos[$[] eq 'cnt')
- {
- if (grep($_ eq $fpos[$[+1],@f))
- {
- print "old positioning applies\n" if $verbose > 3;
- shift(@f) while @f && $f[$[] ne $fpos[$[+1];
- }
- else
- {
- @fpos = ('cnt', $f[$[], undef);
- }
- }
- else
- {
- @fpos = ('cnt', $f[$[], undef);
- }
-
- if (!defined($fpos[$[+2]))
- {
- local(@x) = reverse(@f);
- local($s,$c) = (0,$cnt);
-
- local($_);
- while($_ = shift(@x))
- {
- print "examing \"$_\" $c samples still needed\n"
- if $verbose > 4;
- $s = int($F_size{$_}/$RecordSize);
- $c -= $s - 1;
- if ($c <= 0)
- {
- $fpos[$[+1] = $_;
- $fpos[$[+2] = ($c>-2) ? 0 : (-$c - 2) * $RecordSize;
- shift(@f) while @f && ($f[$[] ne $_);
- last;
- }
- }
- if (!defined($fpos[$[+2]))
- {
- print "no starting point yet - using start of data\n"
- if $verbose > 2;
- $fpos[$[+2] = 0;
- }
- }
- }
- }
- print "Ooops, no suitable input file ??\n"
- if $verbose > 1 && @f <= 0;
-
- printf("Starting at (%s) \"%s\" offset %ld using %d files\n",
- $fpos[$[+1],
- $F_name{$fpos[$[+1]},
- $fpos[$[+2],
- scalar(@f))
- if $verbose > 2;
-
- $lm = 1;
- $l = 0;
- foreach $key (@f)
- {
- $file = $F_name{$key};
- print "processing file \"$file\"\n" if $verbose > 2;
-
- open(IN,"<$file") ||
- (warn("$0: cannot read \"$file\": $!\n"), next);
-
- ;# try to seek to a position nearer to the start of the interesting lines
- ;# should always affect only first item in @f
- ($key eq $fpos[$[+1]) &&
- (($verbose > 1) &&
- print("Seeking to offset $fpos[$[+2]\n"),
- seek(IN,$fpos[$[+2],0) ||
- warn("$0: seek(\"$F_name{$key}\" failed: $|\n"));
-
- while(<IN>)
- {
- $l++;
- ($verbose > 3) &&
- (($l % $lm) == 0 && print("\t$l lines read\n") &&
- (($l == 2) && ($lm = 10) ||
- ($l == 100) && ($lm = 100) ||
- ($l == 500) && ($lm = 500) ||
- ($l == 1000) && ($lm = 1000) ||
- ($l == 5000) && ($lm = 5000) ||
- ($l == 10000) && ($lm = 10000)));
-
- @F = split;
-
- next if @F < 5; # no valid input line is this short
- next if $F[$[] eq "";
- ($F[$[] !~ /^\d+$/) && # A 'never should have happend' error
- die("$0: unexpected input line: $_\n");
-
- ;# modified Julian to UNIX epoch
- $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
- $t += $F[$[+1]; # add seconds + fraction
-
- ;# multiply offset by 1000 to get ms - try to avoid float op
- (($F[$[+2] =~ s/(\d*)\.(\d{3})(\d*)/\1\2.\3/) &&
- $F[$[+2] =~ s/0+([\d\.])/($1 eq '.') ? '0.' : $1/e) # strip leading zeros
- || $F[$[+2] *= 1000;
-
-
- ;# skip samples out of specified time range
- next if (defined($StartTime) && $StartTime > $t);
- next if (defined($EndTime) && $EndTime < $t);
-
- next if defined($lastT) && $t < $lastT; # backward in time ??
-
- push(@offs,$F[$[+2]);
- push(@freq,$F[$[+3] * (2**20/10**6));
- push(@cmpl,$F[$[+4]);
-
- push(@break, (defined($lastT) && ($t - $lastT > $deltaT)));
- $lastT = $t;
- push(@time,$t);
- push(@loffset, tell(IN) - length($_));
- push(@filekey, $key);
-
- shift(@break),shift(@time),shift(@offs),
- shift(@freq), shift(@cmpl),shift(@loffset),
- shift(@filekey)
- if @time > $cnt &&
- ! (defined($StartTime) && defined($EndTime));
-
- last if @time >= $cnt && defined($StartTime) && !defined($EndTime);
- }
- close(IN);
- last if @time >= $cnt && defined($StartTime) && !defined($EndTime);
- }
- print "input scanned ($l lines/",scalar(@time)," samples)\n"
- if $verbose > 1;
-
- &lr_init('offs');
- &lr_init('freq');
-
- if (@time)
- {
- local($_,@F);
-
- local($timebase) unless defined($timebase);
- local($freqbase) unless defined($freqbase);
- local($cmplscale) unless defined($cmplscale);
-
- undef($mintime,$maxtime,$minoffs,$maxoffs,
- $minfreq,$maxfreq,$mincmpl,$maxcmpl,
- $miny,$maxy);
-
- print "computing ranges\n" if $verbose > 2;
-
- $LastCnt = @time;
-
- ;# @time is in ascending order (;-)
- $mintime = @time[$[];
- $maxtime = @time[$#time];
- unless (defined($timebase))
- {
- local($time,@X) = (time);
- @X = localtime($time);
-
- ;# compute today 00:00:00
- $timebase = $time - ((($X[$[+2]*60)+$X[$[+1])*60+$X[$[]);
-
- }
- $LastTimeBase = $timebase;
-
- if ($showoffs)
- {
- local($i,$m,$f);
-
- $minoffs = &min(@offs);
- $maxoffs = &max(@offs);
-
- ;# I know, it is not perl style using indices to access arrays,
- ;# but I have to proccess two arrays in sync, non-destructively
- ;# (otherwise a (shift(@a1),shift(a2)) would do),
- ;# I dont like to make copies of these arrays as they may be huge
- $i = $[;
- &lr_sample(($time[$i]-$timebase)/3600,$offs[$i],'offs'),$i++
- while $i <= $#time;
-
- ($minoffs == $maxoffs) && ($minoffs -= 0.1,$maxoffs += 0.1);
-
- $i = &lr_sigma('offs');
- $m = &lr_mean('offs');
-
- print "mean offset: $m sigma: $i\n" if $verbose > 2;
-
- if (($maxoffs - $minoffs) > $MinClip)
- {
- $f = (&abs($minoffs) < &abs($maxoffs)) ? $FuzzLow : $FuzzBig;
- $miny = (($m - $minoffs) <= ($f * $i))
- ? $minoffs : ($m - $f * $i);
- $f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
- $maxy = (($maxoffs - $m) <= ($f * $i))
- ? $maxoffs : ($m + $f * $i);
- }
- else
- {
- $miny = $minoffs;
- $maxy = $maxoffs;
- }
- ($maxy-$miny) == 0 &&
- (($maxy,$miny)
- = (($maxoffs - $minoffs) > 0)
- ? ($maxoffs,$minoffs) : ($MinClip,-$MinClip));
-
- $maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
- $miny = $MinY if defined($MinY) && $MinY > $miny;
-
- print "offset min clipped from $minoffs to $miny\n"
- if $verbose > 2 && $minoffs != $miny;
- print "offset max clipped from $maxoffs to $maxy\n"
- if $verbose > 2 && $maxoffs != $maxy;
- }
-
- if ($showfreq)
- {
- local($i,$m);
-
- $minfreq = &min(@freq);
- $maxfreq = &max(@freq);
-
- $i = $[;
- &lr_sample(($time[$i]-$timebase)/3600,$freq[$i]-$minfreq,'freq'),
- $i++
- while $i <= $#time;
-
- $i = &lr_sigma('freq');
- $m = &lr_mean('freq') + $minfreq;
-
- print "mean frequency: $m sigma: $i\n" if $verbose > 2;
-
- if (defined($maxy))
- {
- local($s) =
- ($maxfreq - $minfreq)
- ? ($maxy - $miny) / ($maxfreq - $minfreq) : 1;
-
- if (defined($freqbase))
- {
- $FreqScale = 1;
- $FreqScaleInv = "";
- }
- else
- {
- $FreqScale = 1;
- $FreqScale = 10 ** int(log($s)/log(10) - 0.8);
- $FreqScaleInv =
- ("$FreqScale" =~ /^10(0*)$/) ? "0.${1}1" :
- ($FreqScale == 1 ? "" : (1/$FreqScale));
-
- $freqbase = $m * $FreqScale;
- $freqbase -= &lr_mean('offs');
-
- ;# round resulting freqbase
- ;# to precision of min max difference
- $s = int(log(($maxfreq-$minfreq)*$FreqScale)/log(10))-1;
- $s = 10 ** $s;
- $freqbase = int($freqbase / $s) * $s;
- }
- }
- else
- {
- $FreqScale = 1;
- $FreqScaleInv = "";
- $freqbase = $m unless defined($freqbase);
- if (($maxfreq - $minfreq) > $MinClip)
- {
- $f = (&abs($minfreq) < &abs($maxfreq))
- ? $FuzzLow : $FuzzBig;
- $miny = (($freqbase - $minfreq) <= ($f * $i))
- ? ($minfreq-$freqbase) : (- $f * $i);
- $f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
- $maxy = (($maxfreq - $freqbase) <= ($f * $i))
- ? ($maxfreq-$freqbase) : ($f * $i);
- }
- else
- {
- $miny = $minfreq - $freqbase;
- $maxy = $maxfreq - $freqbase;
- }
- ($maxy - $miny) == 0 &&
- (($maxy,$miny) =
- (($maxfreq - $minfreq) > 0)
- ? ($maxfreq-$freqbase,$minfreq-$freqbase) : (0.5,-0.5));
-
- $maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
- $miny = $MinY if defined($MinY) && $MinY > $miny;
-
- print("frequency min clipped from ",$minfreq-$freqbase,
- " to $miny\n")
- if $verbose > 2 && $miny != ($minfreq - $freqbase);
- print("frequency max clipped from ",$maxfreq-$freqbase,
- " to $maxy\n")
- if $verbose > 2 && $maxy != ($maxfreq - $freqbase);
- }
- $LastFreqBaseString =
- sprintf("%g",$freqbase >= 0 ? $freqbase : -$freqbase);
- $LastFreqBase = $freqbase;
- print "LastFreqBaseString now \"$LastFreqBaseString\"\n"
- if $verbose > 5;
- }
- else
- {
- $FreqScale = 1;
- $FreqScaleInv = "";
- $LastFreqBase = 0;
- $LastFreqBaseString = "";
- }
-
- if ($showcmpl)
- {
- $mincmpl = &min(@cmpl);
- $maxcmpl = &max(@cmpl);
-
- if (!defined($cmplscale))
- {
- if (defined($maxy))
- {
- local($cmp)
- = (&abs($miny) > &abs($maxy)) ? &abs($miny) : $maxy;
- $cmplscale = $cmp == $maxy ? 1 : -1;
-
- foreach (0.01, 0.02, 0.05,
- 0.1, 0.2, 0.25, 0.4, 0.5,
- 1, 2, 4, 5,
- 10, 20, 25, 50,
- 100, 200, 250, 500, 1000)
- {
- $cmplscale *= $_, last if $maxcmpl/$_ <= $cmp;
- }
- }
- else
- {
- $cmplscale = 1;
- $miny = $mincmpl ? 0 : -$MinClip;
- $maxy = $maxcmpl+$MinClip;
- }
- }
- $LastCmplScale = $cmplscale;
- }
- else
- {
- $LastCmplScale = 1;
- }
-
- print "creating plot command input file\n" if $verbose > 2;
-
-
- print OUT ("# preprocessed NTP statistics file for $STATHOST\n");
- print OUT ("# timebase is: ",&ctime($LastTimeBase))
- if defined($LastTimeBase);
- print OUT ("# frequency is offset by ",
- ($LastFreqBase >= 0 ? "+" : "-"),
- "$LastFreqBaseString [${FreqScaleInv}ppm]\n");
- print OUT ("# compliance is scaled by $LastCmplScale\n");
- print OUT ("# time [h]\toffset [ms]\tfrequency [${FreqScaleInv}ppm]\tcompliance\n");
-
- printf OUT ("%s%lf\t%lf\t%lf\t%lf\n",
- (shift(@break) ? "\n" : ""),
- (shift(@time) - $LastTimeBase)/3600,
- shift(@offs),
- shift(@freq) * $FreqScale - $LastFreqBase,
- shift(@cmpl) / $LastCmplScale)
- while(@time);
- }
- else
- {
- ;# prevent plotcmd from processing empty file
- print "Creating plot command dummy...\n" if $verbose > 2;
- print OUT "# dummy samples\n0 1 2 3\n1 1 2 3\n";
- &lr_sample(0,1,'offs');
- &lr_sample(1,1,'offs');
- &lr_sample(0,2,'freq');
- &lr_sample(1,2,'freq');
- @time = (0, 1); $maxtime = 1; $mintime = 0;
- @offs = (1, 1); $maxoffs = 1; $minoffs = 1;
- @freq = (2, 2); $maxfreq = 2; $minfreq = 2;
- @cmpl = (3, 3); $maxcmpl = 3; $mincmpl = 3;
- $LastCnt = 2;
- $LastFreqBase = 0;
- $LastCmplScale = 1;
- $LastTimeBase = 0;
- $miny = -$MinClip;
- $maxy = 3 + $MinClip;
- }
- close(OUT);
-
- print "plot command input file created\n"
- if $verbose > 2;
-
- if (($fpos[$[] eq 'cnt' && @loffset >= $cnt) ||
- ($fpos[$[] eq 'start' && $time[$[] <= $StartTime) ||
- ($fpos[$[] eq 'end'))
- {
- return ($fpos[$[],$filekey[$[],$loffset[$[]);
- }
- else # found to few lines - next time start search earlier in file
- {
- if ($fpos[$[] eq 'start')
- {
- ;# the timestamps we got for F_first and F_last guaranteed
- ;# that no file is left out
- ;# the only thing that could happen is:
- ;# we guessed the starting point wrong
- ;# compute a new guess from the first record found
- ;# if this equals our last guess use data of first record
- ;# otherwise try new guess
-
- if ($fpos[$[+1] eq $filekey[$[] && $loffset[$[] > $fpos[$[+2])
- {
- local($noff);
- $noff = $loffset[$[] - ($cnt - @loffset + 1) * $RecordSize;
- $noff = 0 if $noff < 0;
-
- return (@fpos[$[,$[+1], ($noff == $fpos[$[+2]) ? $loffset[$[] : $noff);
- }
- return ($fpos[$[],$filekey[$[],$loffset[$[]);
- }
- elsif ($fpos[$[] eq 'end' || $fpos[$[] eq 'cnt')
- {
- ;# try to start earlier in file
- ;# if we already started at the beginning
- ;# try to use previous file
- ;# this assumes distance to better starting point is at most one file
- ;# the primary guess at top of genfile() should usually allow this
- ;# assumption
- ;# if the offset of the first sample used is within
- ;# a different file than we guessed it must have occured later
- ;# in the sequence of files
- ;# this only can happen if our starting file did not contain
- ;# a valid sample from the starting point we guessed
- ;# however this does not invalidate our assumption, no check needed
- local($noff,$key);
- if ($fpos[$[+2] > 0)
- {
- $noff = $fpos[$[+2] - $RecordSize * ($cnt - @loffset + 1);
- $noff = 0 if $noff < 0;
- return (@fpos[$[,$[+1],$noff);
- }
- else
- {
- if ($fpos[$[+1] eq $F_files[$[])
- {
- ;# first file - and not enough samples
- ;# use data of first sample
- return ($fpos[$[], $filekey[$[], $loffset[$[]);
- }
- else
- {
- ;# search key of previous file
- $key = $F_files[$[];
- @F = reverse(@F_files);
- while ($_ = shift(@F))
- {
- if ($_ eq $fpos[$[+1])
- {
- $key = shift(@F) if @F;
- last;
- }
- }
- $noff = int($F_size{$key} / $RecordSize);
- $noff -= $cnt - @loffset;
- $noff = 0 if $noff < 0;
- $noff *= $RecordSize;
- return ($fpos[$[], $key, $noff);
- }
- }
- }
- else
- {
- return ();
- }
-
- return 0 if @loffset <= 1 || ($loffset[$#loffset] - $loffset[$[]) <= 1;
-
- ;# EOF - 1.1 * avg(line) * $cnt
- local($val) = $loffset[$#loffset]
- - $cnt * 11 * (($loffset[$#loffset] - $loffset[$[]) / @loffset) / 10;
- return ($val < 0) ? 0 : $val;
- }
-}
-
-;# initial setup of plot
-print "initialize plotting\n" if $verbose;
-if (defined($PrintIt))
-{
- if ($PrintIt =~ m,/,)
- {
- print "Saving plot to file $PrintIt\n";
- print PLOT "set output '$PrintIt'\n";
- }
- else
- {
- print "Printing plot on printer $PrintIt\n";
- print PLOT "set output '| lpr -P$PrintIt -h'\n";
- }
- print PLOT "set terminal postscript landscape color solid 'Helvetica' 10\n";
-}
-print PLOT "set grid\n";
-print PLOT "set tics out\n";
-print PLOT "set format y '%g '\n";
-printf PLOT "set time 47\n" unless defined($PrintIt);
-
-@filepos =();
-while(1)
-{
- print &ctime(time) if $verbose;
-
- ;# update diplay characteristics
- &read_config;# unless defined($PrintIt);
-
- unlink($tmpfile);
- @filepos = &genfile($samples,$srcprefix,$tmpfile,@filepos);
-
- ;# make plotcmd display samples
- &make_doplot;
- print "Displaying plot...\n" if $verbose > 1;
- print "command for plot sub process:\n$doplot----\n" if $verbose > 3;
- print PLOT $doplot;
-}
-continue
-{
- if (defined($PrintIt))
- {
- delete $SIG{'CHLD'};
- print PLOT "quit\n";
- close(PLOT);
- if ($PrintIt =~ m,/,)
- {
- print "Plot saved to file $PrintIt\n";
- }
- else
- {
- print "Plot spooled to printer $PrintIt\n";
- }
- unlink($tmpfile);
- exit(0);
- }
- ;# wait $delay seconds
- print "waiting $delay seconds ..." if $verbose > 2;
- sleep($delay);
- print " continuing\n" if $verbose > 2;
- undef($LastFreqBaseString);
-}
-
-
-sub date_time_spec2seconds
-{
- local($_) = @_;
- ;# a date_time_spec consistes of:
- ;# YYYY-MM-DD_HH:MM:SS.ms
- ;# values can be omitted from the beginning and default than to
- ;# values of current date
- ;# values omitted from the end default to lowest possible values
-
- local($time) = time;
- local($sec,$min,$hour,$mday,$mon,$year)
- = localtime($time);
-
- local($last) = ();
-
- s/^\D*(.*\d)\D*/\1/; # strip off garbage
-
- PARSE:
- {
- if (s/^(\d{4})(-|$)//)
- {
- if ($1 < 1970)
- {
- warn("$0: can not handle years before 1970 - year $1 ignored\n");
- return undef;
- }
- elsif ( $1 >= 2070)
- {
- warn("$0: can not handle years past 2070 - year $1 ignored\n");
- return undef;
- }
- else
- {
- $year = $1 % 100; # 0<= $year < 100
- ;# - interpreted 70 .. 99,00 .. 69
- }
- $last = $[ + 5;
- last PARSE if $_ eq '';
- warn("$0: bad date_time_spec: \"$_\" found after YEAR\n"),
- return(undef)
- if $2 eq '';
- }
-
- if (s/^(\d{1,2})(-|$)//)
- {
- warn("$0: implausible month $1\n"),return(undef)
- if $1 < 1 || $1 > 12;
- $mon = $1 - 1;
- $last = $[ + 4;
- last PARSE if $_ eq '';
- warn("$0: bad date_time_spec: \"$_\" found after MONTH\n"),
- return(undef)
- if $2 eq '';
- }
- else
- {
- warn("$0: bad date_time_spec \"$_\"\n"),return(undef)
- if defined($last);
-
- }
-
- if (s/^(\d{1,2})([_ ]|$)//)
- {
- warn("$0: implausible month day $1 for month ".($mon+1)." (".
- $MaxNumDaysPerMonth[$mon].")$mon\n"),
- return(undef)
- if $1 < 1 || $1 > $MaxNumDaysPerMonth[$mon];
- $mday = $1;
- $last = $[ + 3;
- last PARSE if $_ eq '';
- warn("$0: bad date_time_spec \"$_\" found after MDAY\n"),
- return(undef)
- if $2 eq '';
- }
- else
- {
- warn("$0: bad date_time_spec \"$_\"\n"), return undef
- if defined($last);
- }
-
- ;# now we face a problem:
- ;# if ! defined($last) a prefix of "07:"
- ;# can be either 07:MM or 07:ss
- ;# to get the second interpretation make the user add
- ;# a msec fraction part and check for this special case
- if (! defined($last) && s/^(\d{1,2}):(\d{1,2}\.\d+)//)
- {
- warn("$0: implausible minute $1\n"), return undef
- if $1 < 0 || $1 >= 60;
- warn("$0: implausible second $1\n"), return undef
- if $2 < 0 || $2 >= 60;
- $min = $1;
- $sec = $2;
- $last = $[ + 1;
- last PARSE if $_ eq '';
- warn("$0: bad date_time_spec \"$_\" after SECONDS\n");
- return undef;
- }
-
- if (s/^(\d{1,2})(:|$)//)
- {
- warn("$0: implausible hour $1\n"), return undef
- if $1 < 0 || $1 > 24;
- $hour = $1;
- $last = $[ + 2;
- last PARSE if $_ eq '';
- warn("$0: bad date_time_spec found \"$_\" after HOUR\n"),
- return undef
- if $2 eq '';
- }
- else
- {
- warn("$0: bad date_time_spec \"$_\"\n"), return undef
- if defined($last);
- }
-
- if (s/^(\d{1,2})(:|$)//)
- {
- warn("$0: implausible minute $1\n"), return undef
- if $1 < 0 || $1 >=60;
- $min = $1;
- $last = $[ + 1;
- last PARSE if $_ eq '';
- warn("$0: bad date_time_spec found \"$_\" after MINUTE\n"),
- return undef
- if $2 eq '';
- }
- else
- {
- warn("$0: bad date_time_spec \"$_\"\n"), return undef
- if defined($last);
- }
-
- if (s/^(\d{1,2}(\.\d+)?)//)
- {
- warn("$0: implausible second $1\n"), return undef
- if $1 < 0 || $1 >=60;
- $sec = $1;
- $last = $[;
- last PARSE if $_ eq '';
- warn("$0: bad date_time_spec found \"$_\" after SECOND\n");
- return undef;
- }
- }
-
- return $time unless defined($last);
-
- $sec = 0 if $last > $[;
- $min = 0 if $last > $[ + 1;
- $hour = 0 if $last > $[ + 2;
- $mday = 1 if $last > $[ + 3;
- $mon = 0 if $last > $[ + 4;
- local($rtime) = &timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 0);
-
- ;# $rtime may be off if daylight savings time is in effect at given date
- return $rtime + ($sec - int($sec))
- if $hour == (localtime($rtime))[$[+2];
- return
- &timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 1)
- + ($sec - int($sec));
-}
-
-
-sub min
-{
- local($m) = shift;
-
- grep((($m > $_) && ($m = $_),0),@_);
- $m;
-}
-
-sub max
-{
- local($m) = shift;
-
- grep((($m < $_) && ($m = $_),0),@_);
- $m;
-}
diff --git a/usr.sbin/xntpd/scripts/monitoring/ntptrap b/usr.sbin/xntpd/scripts/monitoring/ntptrap
deleted file mode 100755
index 69c66608af97..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/ntptrap
+++ /dev/null
@@ -1,453 +0,0 @@
-#!/local/bin/perl --*-perl-*-
-;#
-;# ntptrap,v 3.1 1993/07/06 01:09:15 jbj Exp
-;#
-;# a client for the xntp mode 6 trap mechanism
-;#
-;# Copyright (c) 1992
-;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
-;#
-;#
-;#############################################################
-$0 =~ s!^.*/([^/]+)$!\1!; # strip to filename
-;# enforce STDOUT and STDERR to be line buffered
-$| = 1;
-select((select(STDERR),$|=1)[$[]);
-
-;#######################################
-;# load utility routines and definitions
-;#
-require('ntp.pl'); # implementation of the NTP protocol
-eval { require('sys/socket.ph'); require('netinet/in.ph') unless defined(&INADDR_ANY); } ||
-do {
- die("$0: $@") unless $[ == index($@, "Can't locate ");
- warn "$0: $@";
- warn "$0: supplying some default definitions\n";
- eval 'sub INADDR_ANY { 0; } sub AF_INET {2;} sub SOCK_DGRAM {2;} 1;' || die "$0: $@";
-};
-require('getopts.pl'); # option parsing
-require('ctime.pl'); # date/time formatting
-
-;######################################
-;# define some global constants
-;#
-$BASE_TIMEOUT=10;
-$FRAG_TIMEOUT=10;
-$MAX_TRY = 5;
-$REFRESH_TIME=60*15; # 15 minutes (server uses 1 hour)
-$ntp'timeout = $FRAG_TIMEOUT; #';
-
-;######################################
-;# now process options
-;#
-sub usage
-{
- die("usage: $0 [-n] [-p <port>] [-l <logfile>] [host] ...\n");
-}
-
-$opt_l = "/dev/null"; # where to write debug messages to
-$opt_p = 0; # port to use locally - (0 does mean: will be choosen by kernel)
-
-&usage unless &Getopts('l:p:');
-&Getopts if 0; # make -w happy
-
-@Hosts = ($#ARGV < $[) ? ("localhost") : @ARGV;
-
-;# setup for debug output
-$DEBUGFILE=$opt_l;
-$DEBUGFILE="&STDERR" if $DEBUGFILE eq '-';
-
-open(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n");
-select((select(DEBUG),$|=1)[$[]);
-
-;# &log prints a single trap record (adding a (local) time stamp)
-sub log
-{
- chop($date=&ctime(time));
- print "$date ",@_,"\n";
-}
-
-sub debug
-{
- print DEBUG @_,"\n";
-}
-;#
-$proto_udp = (getprotobyname('udp'))[$[+2] ||
- (warn("$0: Could not get protocoll number for 'udp' using 17"), 17);
-
-$ntp_port = (getservbyname('ntp','udp'))[$[+2] ||
- (warn("$0: Could not get port number for service ntp/udp using 123"), 123);
-
-;#
-socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n");
-
-;#
-bind(S, pack("S n N x8", &AF_INET, $opt_p, &INADDR_ANY)) ||
- die("Cannot bind: $!\n");
-
-($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
-&log(sprintf("Listening at address %d.%d.%d.%d port %d",
- unpack("C4",$my_addr), $my_port));
-
-;# disregister with all servers in case of termination
-sub cleanup
-{
- &log("Aborted by signal \"$_[$[]\"") if defined($_[$[]);
-
- foreach (@Hosts)
- {
- &ntp'send(S,31,0,"",pack("Sna4x8",&AF_INET,$ntp_port,$Hosts{$_})); #';
- }
- close(S);
- exit(2);
-}
-
-$SIG{'HUP'} = 'cleanup';
-$SIG{'INT'} = 'cleanup';
-$SIG{'QUIT'} = 'cleanup';
-$SIG{'TERM'} = 'cleanup';
-
-0 && $a && $b;
-sub timeouts # sort timeout id array
-{
- $TIMEOUTS{$a} <=> $TIMEOUTS{$b};
-}
-
-;# a Request element looks like: pack("a4SC",addr,associd,op)
-@Requests= ();
-
-;# compute requests for set trap control msgs to each host given
-{
- local($name,$addr);
-
- foreach (@Hosts)
- {
- if (/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
- {
- ($name,$addr) =
- (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[,$[+4];
- unless (defined($name))
- {
- $name = sprintf("[[%d.%d.%d.%d]]",$1,$2,$3,$4);
- $addr = pack("C4",$1,$2,$3,$4);
- }
- }
- else
- {
- ($name,$addr) = (gethostbyname($_))[$[,$[+4];
- unless (defined($name))
- {
- warn "$0: unknown host \"$_\" - ignored\n";
- next;
- }
- }
- next if defined($Host{$name});
- $Host{$name} = $addr;
- push(@Requests,pack("a4SC",$addr,0,6)); # schedule a set trap request for $name
- }
-}
-
-sub hostname
-{
- local($addr) = @_;
- return $HostName{$addr} if defined($HostName{$addr});
- local($name) = gethostbyaddr($addr,&AF_INET);
- &debug(sprintf("hostname(%d.%d.%d.%d) = \"%s\"",unpack("C4",$addr),$name))
- if defined($name);
- defined($name) && ($HostName{$addr} = $name) && (return $name);
- &debug(sprintf("Failed to get name for %d.%d.%d.%d",unpack("C4",$addr)));
- return sprintf("[%d.%d.%d.%d]",unpack("C4",$addr));
-}
-
-;# when no hosts were given on the commandline no requests have been scheduled
-&usage unless (@Requests);
-
-&debug(sprintf("%d request(s) scheduled",scalar(@Requests)));
-grep(&debug(" - ".$_),keys(%Host));
-
-;# allocate variables;
-$addr="";
-$assoc=0;
-$op = 0;
-$timeout = 0;
-$ret="";
-%TIMEOUTS = ();
-%TIMEOUT_PROCS = ();
-@TIMEOUTS = ();
-
-$len = 512;
-$buf = " " x $len;
-
-while (1)
-{
- if (@Requests || @TIMEOUTS) # if there is some work pending
- {
- if (@Requests)
- {
- ($addr,$assoc,$op) = unpack("a4SC",($req = shift(@Requests)));
- &debug(sprintf("Request: %s: %s(%d)",&hostname($addr), &ntp'cntrlop_name($op), $assoc)); #';))
- $ret = &ntp'send(S,$op,$assoc,"", #'(
- pack("Sna4x8",&AF_INET,$ntp_port,$addr));
- &set_timeout("retry-".unpack("H*",$req),time+$BASE_TIMEOUT,
- sprintf("&retry(\"%s\");",unpack("H*",$req)));
-
- last unless (defined($ret)); # warn called by ntp'send();
-
- ;# if there are more requests just have a quick look for new messages
- ;# otherwise grant server time for a response
- $timeout = @Requests ? 0 : $BASE_TIMEOUT;
- }
- if ($timeout && @TIMEOUTS)
- {
- ;# ensure not to miss a timeout
- if ($timeout + time > $TIMEOUTS{$TIMEOUTS[$[]})
- {
- $timeout = $TIMEOUTS{$TIMEOUTS[$[]} - time;
- $timeout = 0 if $timeout < 0;
- }
- }
- }
- else
- {
- ;# no work yet - wait for some messages dropping in
- ;# usually this will not hapen as the refresh semantic will
- ;# always have a pending timeout
- undef($timeout);
- }
-
- vec($mask="",fileno(S),1) = 1;
- $ret = select($mask,undef,undef,$timeout);
-
- warn("$0: select: $!\n"),last if $ret < 0; # give up on error return from select
-
- if ($ret == 0)
- {
- ;# timeout
- if (@TIMEOUTS && time > $TIMEOUTS{$TIMEOUTS[$[]})
- {
- ;# handle timeout
- $timeout_proc =
- (delete $TIMEOUT_PROCS{$TIMEOUTS[$[]},
- delete $TIMEOUTS{shift(@TIMEOUTS)})[$[];
- eval $timeout_proc;
- die "timeout eval (\"$timeout_proc\"): $@\n" if $@;
- }
- ;# else: there may be something to be sent
- }
- else
- {
- ;# data avail
- $from = recv(S,$buf,$len,0);
- ;# give up on error return from recv
- warn("$0: recv: $!\n"), last unless (defined($from));
-
- $from = (unpack("Sna4",$from))[$[+2]; # keep host addr only
- ;# could check for ntp_port - but who cares
- &debug("-Packet from ",&hostname($from));
-
- ;# stuff packet into ntp mode 6 receive machinery
- ($ret,$data,$status,$associd,$op,$seq,$auth_keyid) =
- &ntp'handle_packet($buf,$from); # ';
- &debug(sprintf("%s uses auth_keyid %d",&hostname($from),$auth_keyid)) if defined($auth_keyid);
- next unless defined($ret);
-
- if ($ret eq "")
- {
- ;# handle packet
- ;# simple trap response messages have neither timeout nor retries
- &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))) unless $op == 7;
- delete $RETRY{pack("a4SC",$from,$associd,$op)} unless $op == 7;
-
- &process_response($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid);
- }
- else
- {
- ;# some kind of error
- &log(sprintf("%50s: %s: %s",(gethostbyaddr($from,&AF_INET))[$[],$ret,$data));
- if ($ret ne "TIMEOUT" && $ret ne "ERROR")
- {
- &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op)));
- }
- }
- }
-
-}
-
-warn("$0: terminating\n");
-&cleanup;
-exit 0;
-
-;##################################################
-;# timeout support
-;#
-sub set_timeout
-{
- local($id,$time,$proc) = @_;
-
- $TIMEOUTS{$id} = $time;
- $TIMEOUT_PROCS{$id} = $proc;
- @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
- chop($date=&ctime($time));
- &debug(sprintf("Schedule timeout \"%s\" for %s", $id, $date));
-}
-
-sub clear_timeout
-{
- local($id) = @_;
- delete $TIMEOUTS{$id};
- delete $TIMEOUT_PROCS{$id};
- @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
- &debug("Clear timeout \"$id\"");
-}
-
-0 && &refresh;
-sub refresh
-{
- local($addr) = @_;
- $addr = pack("H*",$addr);
- &debug(sprintf("Refreshing trap for %s", &hostname($addr)));
- push(@Requests,pack("a4SC",$addr,0,6));
-}
-
-0 && &retry;
-sub retry
-{
- local($tag) = @_;
- $tag = pack("H*",$tag);
- $RETRY{$tag} = 0 if (!defined($RETRY{$tag}));
-
- if (++$RETRY{$tag} > $MAX_TRY)
- {
- &debug(sprintf("Retry failed: %s assoc %5d op %d",
- &hostname(substr($tag,$[,4)),
- unpack("x4SC",$tag)));
- return;
- }
- &debug(sprintf("Retrying: %s assoc %5d op %d",
- &hostname(substr($tag,$[,4)),
- unpack("x4SC",$tag)));
- push(@Requests,$tag);
-}
-
-sub process_response
-{
- local($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid) = @_;
-
- $msg="";
- if ($op == 7) # trap response
- {
- $msg .= sprintf("%40s trap#%-5d",
- &hostname($from),$seq);
- &debug (sprintf("\nTrap %d associd %d:\n%s\n===============\n",$seq,$associd,$data));
- if ($associd == 0) # system event
- {
- $msg .= " SYSTEM ";
- $evnt = &ntp'SystemEvent($status); #';
- $msg .= "$evnt ";
- ;# for special cases add additional info
- ($stratum) = ($data =~ /stratum=(\d+)/);
- ($refid) = ($data =~ /refid=([\w\.]+)/);
- $msg .= "stratum=$stratum refid=$refid";
- if ($refid =~ /\[?(\d+)\.(\d+)\.(\d+)\.(\d+)/)
- {
- $msg .= " " . (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[];
- }
- if ($evnt eq "event_sync_chg")
- {
- $msg .= sprintf("%s %s ",
- &ntp'LI($status), #',
- &ntp'ClockSource($status) #'
- );
- }
- elsif ($evnt eq "event_sync/strat_chg")
- {
- ($peer) = ($data =~ /peer=([0-9]+)/);
- $msg .= " peer=$peer";
- }
- elsif ($evnt eq "event_clock_excptn")
- {
- if (($device) = ($data =~ /device=\"([^\"]+)\"/))
- {
- ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
- $Cstatus = hex($cstatus);
- $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
- ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
- $msg .= " \"$device\" \"$timecode\"";
- }
- else
- {
- push(@Requests,pack("a4SC",$from, $associd, 4));
- }
- }
- }
- else # peer event
- {
- $msg .= sprintf("peer %5d ",$associd);
- ($srcadr) = ($data =~ /srcadr=\[?([\d\.]+)/);
- $msg .= sprintf("%-18s %40s ", "[$srcadr]",
- &hostname(pack("C4",split(/\./,$srcadr))));
- $evnt = &ntp'PeerEvent($status); #';
- $msg .= "$evnt ";
- ;# for special cases include additional info
- if ($evnt eq "event_clock_excptn")
- {
- if (($device) = ($data =~ /device=\"([^\"]+)\"/))
- {
- ;#&debug("----\n$data\n====\n");
- ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
- $Cstatus = hex($cstatus);
- $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
- ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
- $msg .= " \"$device\" \"$timecode\"";
- }
- else
- {
- ;# no clockvars included - post a cv request
- push(@Requests,pack("a4SC",$from, $associd, 4));
- }
- }
- elsif ($evnt eq "event_stratum_chg")
- {
- ($stratum) = ($data =~ /stratum=(\d+)/);
- $msg .= "new stratum $stratum";
- }
- }
- }
- elsif ($op == 6) # set trap resonse
- {
- &debug("Set trap ok from ",&hostname($from));
- &set_timeout("refresh-".unpack("H*",$from),time+$REFRESH_TIME,
- sprintf("&refresh(\"%s\");",unpack("H*",$from)));
- return;
- }
- elsif ($op == 4) # read clock variables response
- {
- ;# status of clock
- $msg .= sprintf(" %40s ", &hostname($from));
- if ($associd == 0)
- {
- $msg .= "system clock status: ";
- }
- else
- {
- $msg .= sprintf("peer %5d clock",$associd);
- }
- $msg .= sprintf("%-32s",&ntp'clock_status($status)); #');
- ($device) = ($data =~ /device=\"([^\"]+)\"/);
- ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
- $msg .= " \"$device\" \"$timecode\"";
- }
- elsif ($op == 31) # unset trap response (UNOFFICIAL op)
- {
- ;# clear timeout
- &debug("Clear Trap ok from ",&hostname($from));
- &clear_timeout("refresh-".unpack("H*",$from));
- return;
- }
- else # unexpected response
- {
- $msg .= "unexpected response to op $op assoc=$associd";
- $msg .= sprintf(" status=%04x",$status);
- }
- &log($msg);
-}
diff --git a/usr.sbin/xntpd/scripts/monitoring/timelocal.pl b/usr.sbin/xntpd/scripts/monitoring/timelocal.pl
deleted file mode 100755
index 061f925ac915..000000000000
--- a/usr.sbin/xntpd/scripts/monitoring/timelocal.pl
+++ /dev/null
@@ -1,78 +0,0 @@
-;# timelocal.pl
-;#
-;# Usage:
-;# $time = timelocal($sec,$min,$hours,$mday,$mon,$year,$junk,$junk,$isdst);
-;# $time = timegm($sec,$min,$hours,$mday,$mon,$year);
-
-;# These routines are quite efficient and yet are always guaranteed to agree
-;# with localtime() and gmtime(). We manage this by caching the start times
-;# of any months we've seen before. If we know the start time of the month,
-;# we can always calculate any time within the month. The start times
-;# themselves are guessed by successive approximation starting at the
-;# current time, since most dates seen in practice are close to the
-;# current date. Unlike algorithms that do a binary search (calling gmtime
-;# once for each bit of the time value, resulting in 32 calls), this algorithm
-;# calls it at most 6 times, and usually only once or twice. If you hit
-;# the month cache, of course, it doesn't call it at all.
-
-;# timelocal is implemented using the same cache. We just assume that we're
-;# translating a GMT time, and then fudge it when we're done for the timezone
-;# and daylight savings arguments. The timezone is determined by examining
-;# the result of localtime(0) when the package is initialized. The daylight
-;# savings offset is currently assumed to be one hour.
-
-CONFIG: {
- package timelocal;
-
- @epoch = localtime(0);
- $tzmin = $epoch[2] * 60 + $epoch[1]; # minutes east of GMT
- if ($tzmin > 0) {
- $tzmin = 24 * 60 - $tzmin; # minutes west of GMT
- $tzmin -= 24 * 60 if $epoch[5] == 70; # account for the date line
- }
-
- $SEC = 1;
- $MIN = 60 * $SEC;
- $HR = 60 * $MIN;
- $DAYS = 24 * $HR;
- $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
- 1;
-}
-
-sub timegm {
- package timelocal;
-
- $ym = pack(C2, @_[5,4]);
- $cheat = $cheat{$ym} || &cheat;
- $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
-}
-
-sub timelocal {
- package timelocal;
-
- $ym = pack(C2, @_[5,4]);
- $cheat = $cheat{$ym} || &cheat;
- $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS
- + $tzmin * $MIN - 60 * 60 * ($_[8] != 0);
-}
-
-package timelocal;
-
-sub cheat {
- $year = $_[5];
- $month = $_[4];
- $guess = $^T;
- @g = gmtime($guess);
- $year += $YearFix if $year < $epoch[5];
- while ($diff = $year - $g[5]) {
- $guess += $diff * (364 * $DAYS);
- @g = gmtime($guess);
- }
- while ($diff = $month - $g[4]) {
- $guess += $diff * (28 * $DAYS);
- @g = gmtime($guess);
- }
- $g[3]--;
- $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
- $cheat{$ym} = $guess;
-}
generated by cgit v1.2.3 (git 2.25.1) at 2025-02-22 16:11:35 +0000