+* Incorporate Oliver Kindernay's GSoC 2013 scripts/ cleanup.
(4.2.7p390) 2013/09/26 Released by Harlan Stenn <stenn@ntp.org>
* [Bug 2482] Cleanup of droproot and jail support for Solaris.
(4.2.7p389) 2013/09/24 Released by Harlan Stenn <stenn@ntp.org>
Rather than determine our $(srcdir) from sntp/Makefile.am \
COPYRIGHT-please serves as a fixed target.
-$(srcdir)/.checkChangeLog: $(srcdir)/ChangeLog $(srcdir)/scripts/checkChangeLog
+$(srcdir)/.checkChangeLog: $(srcdir)/ChangeLog $(srcdir)/scripts/build/checkChangeLog
cd $(srcdir) && \
- ./scripts/checkChangeLog
+ ./scripts/build/checkChangeLog
sntp/built-sources-only: FRC.sntp
@cd sntp && $(MAKE) $(AM_MAKEFLAGS) built-sources-only
cd $(srcdir) \
&& $(PATH_TEST) -e CommitLog \
-a SCCS/s.ChangeSet -ot CommitLog \
- || scripts/genCommitLog
+ || scripts/build/genCommitLog
libtool: $(LIBTOOL_DEPS)
./config.status --recheck
set -e
-(cd sntp && ../scripts/genver) || { echo scripts/genver failed ; exit 1; }
+(cd sntp && ../scripts/build/genver) || {
+ echo scripts/build/genver failed ; exit 1; }
# autoreconf says:
# The environment variables AUTOCONF, AUTOHEADER, AUTOMAKE, ACLOCAL,
AC_CONFIG_FILES([ntpsnmpd/Makefile])
AC_CONFIG_FILES([parseutil/Makefile])
AC_CONFIG_FILES([scripts/Makefile])
-AC_CONFIG_FILES([scripts/calc_tickadj], [chmod +x scripts/calc_tickadj])
-AC_CONFIG_FILES([scripts/checktime], [chmod +x scripts/checktime])
-AC_CONFIG_FILES([scripts/freq_adj], [chmod +x scripts/freq_adj])
-AC_CONFIG_FILES([scripts/html2man], [chmod +x scripts/html2man])
-AC_CONFIG_FILES([scripts/mkver], [chmod +x scripts/mkver])
-AC_CONFIG_FILES([scripts/ntp-wait], [chmod +x scripts/ntp-wait])
-AC_CONFIG_FILES([scripts/ntpsweep], [chmod +x scripts/ntpsweep])
-AC_CONFIG_FILES([scripts/ntptrace], [chmod +x scripts/ntptrace])
+AC_CONFIG_FILES([scripts/lib/Makefile])
+AC_CONFIG_FILES([scripts/calc_tickadj/calc_tickadj], [chmod +x scripts/calc_tickadj/calc_tickadj])
+AC_CONFIG_FILES([scripts/calc_tickadj/Makefile])
+AC_CONFIG_FILES([scripts/build/mkver], [chmod +x scripts/build/mkver])
+AC_CONFIG_FILES([scripts/ntp-wait/ntp-wait], [chmod +x scripts/ntp-wait/ntp-wait])
+AC_CONFIG_FILES([scripts/ntp-wait/Makefile])
+AC_CONFIG_FILES([scripts/ntpsweep/ntpsweep], [chmod +x scripts/ntpsweep/ntpsweep])
+AC_CONFIG_FILES([scripts/ntpsweep/Makefile])
+AC_CONFIG_FILES([scripts/ntptrace/ntptrace], [chmod +x scripts/ntptrace/ntptrace])
+AC_CONFIG_FILES([scripts/ntptrace/Makefile])
AC_CONFIG_FILES([scripts/ntpver], [chmod +x scripts/ntpver])
AC_CONFIG_FILES([scripts/plot_summary], [chmod +x scripts/plot_summary])
AC_CONFIG_FILES([scripts/summary], [chmod +x scripts/summary])
+AC_CONFIG_FILES([scripts/build/Makefile])
AC_CONFIG_FILES([tests/Makefile])
AC_CONFIG_FILES([tests/libntp/Makefile])
AC_CONFIG_FILES([util/Makefile])
+perllibdir="${datadir}/ntp/lib"
+AC_DEFINE_DIR([PERLLIBDIR], [perllibdir], [data dir])
+
+calc_tickadj_opts="scripts/calc_tickadj/calc_tickadj-opts"
+AC_SUBST_FILE([calc_tickadj_opts])
+ntp_wait_opts="scripts/ntp-wait/ntp-wait-opts"
+AC_SUBST_FILE([ntp_wait_opts])
+ntpsweep_opts="scripts/ntpsweep/ntpsweep-opts"
+AC_SUBST_FILE([ntpsweep_opts])
+ntptrace_opts="scripts/ntptrace/ntptrace-opts"
+AC_SUBST_FILE([ntptrace_opts])
+summary_opts="scripts/summary-opts"
+AC_SUBST_FILE([summary_opts])
+plot_summary_opts="scripts/plot_summary-opts"
+AC_SUBST_FILE([plot_summary_opts])
+
AC_CONFIG_SUBDIRS([sntp])
AC_OUTPUT
$(srcdir)/invoke-ntpd.texi: $(srcdir)/ntpd-opts.def $(srcdir)/ntpdbase-opts.def $(std_def_list)
$(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntpd-opts.def
- $(top_srcdir)/scripts/check--help $@
+ $(top_srcdir)/scripts/build/check--help $@
$(PROGRAMS): $(LDADD)
cd ../sntp && $(MAKE) $(AM_MAKEFLAGS) check-scm-rev
version.c: $(ntpd_OBJECTS) ../libntp/libntp.a @LIBPARSE@ Makefile $(top_srcdir)/sntp/scm-rev
- env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/mkver ntpd
+ env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/build/mkver ntpd
version.o: version.c
env CCACHE_DISABLE=1 $(COMPILE) -c version.c -o version.o
cd ../sntp && $(MAKE) $(AM_MAKEFLAGS) check-scm-rev
version.c: $(ntpdate_OBJECTS) ../libntp/libntp.a Makefile $(top_srcdir)/sntp/scm-rev
- env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/mkver ntpdate
+ env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/build/mkver ntpdate
version.o: version.c
env CCACHE_DISABLE=1 $(COMPILE) -c version.c -o version.o
$(srcdir)/invoke-ntpdc.texi: $(srcdir)/ntpdc-opts.def $(std_def_list)
$(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntpdc-opts.def
- $(top_srcdir)/scripts/check--help $@
+ $(top_srcdir)/scripts/build/check--help $@
$(srcdir)/ntpdc.html: $(srcdir)/invoke-ntpdc.menu $(srcdir)/invoke-ntpdc.texi $(srcdir)/ntpdc.texi $(top_srcdir)/sntp/include/version.texi
cd $(srcdir) && ( makeinfo --force --html --no-split -I ../sntp -o ntpdc.html ntpdc.texi || true )
cd ../sntp && $(MAKE) $(AM_MAKEFLAGS) check-scm-rev
version.c: $(ntpdc_OBJECTS) ../libntp/libntp.a Makefile $(top_srcdir)/sntp/scm-rev
- env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/mkver ntpdc
+ env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/build/mkver ntpdc
version.o: version.c
env CCACHE_DISABLE=1 $(COMPILE) -c version.c -o version.o
$(srcdir)/invoke-ntpq.texi: $(srcdir)/ntpq-opts.def $(std_def_list)
$(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntpq-opts.def
- $(top_srcdir)/scripts/check--help $@
+ $(top_srcdir)/scripts/build/check--help $@
$(srcdir)/ntpq.html: $(srcdir)/ntpq.texi $(top_srcdir)/sntp/include/version.texi
cd $(srcdir) && ( makeinfo --force --html --no-split -o ntpq.html ntpq.texi || true )
cd ../sntp && $(MAKE) $(AM_MAKEFLAGS) check-scm-rev
version.c: $(ntpq_OBJECTS) ../libntp/libntp.a Makefile $(top_srcdir)/sntp/scm-rev
- env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/mkver ntpq
+ env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/build/mkver ntpq
version.o: version.c
env CCACHE_DISABLE=1 $(COMPILE) -c version.c -o version.o
$(srcdir)/invoke-ntpsnmpd.texi: $(srcdir)/ntpsnmpd-opts.def $(std_def_list)
$(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntpsnmpd-opts.def
- $(top_srcdir)/scripts/check--help $@
+ $(top_srcdir)/scripts/build/check--help $@
$(srcdir)/ntpsnmpd.html: $(srcdir)/ntpsnmpd.texi $(top_srcdir)/sntp/include/version.texi
cd $(srcdir) && ( makeinfo --force --html --no-split -o ntpsnmpd.html ntpsnmpd.texi || true )
+SUBDIRS = build calc_tickadj ntp-wait ntpsweep ntptrace lib
+
NULL=
man1_MANS=
man8_MANS=
-man_MANS= ntp-wait.$(NTP_WAIT_MS)
DISTCLEANFILES= config.log $(man_MANS)
$(top_srcdir)/sntp/include/version.def \
$(NULL)
-EXTRA_SCRIPTS = ntp-wait ntptrace
-bin_SCRIPTS = $(NTP_WAIT_DB) $(NTPTRACE_DB)
-libexec_SCRIPTS = $(NTP_WAIT_DL) $(NTPTRACE_DL)
-sbin_SCRIPTS = $(NTP_WAIT_DS) $(NTPTRACE_DS)
-
-html_DATA= \
- $(srcdir)/ntp-wait.html \
- $(NULL)
-
noinst_SCRIPTS = \
- calc_tickadj \
- checktime \
- freq_adj \
- html2man \
- mkver \
- ntpsweep \
ntpver \
plot_summary \
summary \
$(NULL)
-noinst_DATA= \
- $(srcdir)/invoke-ntp-wait.menu \
- $(srcdir)/invoke-ntp-wait.texi \
- $(srcdir)/ntp-wait.man.in \
- $(srcdir)/ntp-wait.mdoc.in \
- $(NULL)
-
install-data-local: install-html
EXTRA_DIST = \
- check--help \
- checkChangeLog \
- fixautomakedepsmagic \
- genCommitLog \
- genver \
- hpadjtime.sh \
- invoke-ntp-wait.menu \
- invoke-ntp-wait.texi \
+ deprecated \
monitoring \
- ntp-close \
- ntp-groper \
- ntp-restart \
- ntp-status \
- ntp-wait.1ntp-waitman \
- ntp-wait.1ntp-waitmdoc \
- ntp-wait.man.in \
- ntp-wait.mdoc.in \
- ntp-wait.html \
- ntp-wait.texi \
- ntp-wait-opts.def \
- rc1 \
- rc2 \
+ rc \
stats \
- UpdatePoint \
- VersionName \
$(NULL)
-###
-
-$(srcdir)/ntp-wait.1ntp-waitman: $(srcdir)/ntp-wait-opts.def $(std_def_list)
- $(run_ag) -DMAN_SECTION=1ntp-waitman -Tagman-cmd.tpl ntp-wait-opts.def
-
-$(srcdir)/ntp-wait.man.in: $(srcdir)/ntp-wait.1ntp-waitman $(top_srcdir)/sntp/scripts/mansec2subst.sed
- sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntp-wait.1ntp-waitman > $(srcdir)/ntp-wait.man.in+
- mv $(srcdir)/ntp-wait.man.in+ $(srcdir)/ntp-wait.man.in
-
-###
-
-$(srcdir)/ntp-wait.1ntp-waitmdoc: $(srcdir)/ntp-wait-opts.def $(std_def_list)
- $(run_ag) -DMAN_SECTION=1ntp-waitmdoc -Tagmdoc-cmd.tpl ntp-wait-opts.def
+OPTTPL = ../sntp/ag-tpl/perlopt.tpl
-$(srcdir)/ntp-wait.mdoc.in: $(srcdir)/ntp-wait.1ntp-waitmdoc $(top_srcdir)/sntp/scripts/mansec2subst.sed
- sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntp-wait.1ntp-waitmdoc > $(srcdir)/ntp-wait.mdoc.in+
- mv $(srcdir)/ntp-wait.mdoc.in+ $(srcdir)/ntp-wait.mdoc.in
+##
-###
+plot_summary: plot_summary-opts
-ntp-wait.$(NTP_WAIT_MS): $(srcdir)/ntp-wait.$(MANTAGFMT).in $(top_builddir)/config.status
- $(top_builddir)/config.status --file=ntp-wait.$(NTP_WAIT_MS)+:$(srcdir)/ntp-wait.$(MANTAGFMT).in
- mv ntp-wait.$(NTP_WAIT_MS)+ ntp-wait.$(NTP_WAIT_MS)
+plot_summary-opts: plot_summary-opts.def $(OPTTPL)
+ $(run_ag) plot_summary-opts.def
-###
+##
-$(srcdir)/invoke-ntp-wait.menu: $(srcdir)/invoke-ntp-wait.texi
- @: do-nothing action to avoid default SCCS get, .menu built with .texi
+summary: summary-opts
-$(srcdir)/invoke-ntp-wait.texi: $(srcdir)/ntp-wait-opts.def $(std_def_list)
- $(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntp-wait-opts.def
- -$(top_srcdir)/../scripts/check--help $@
+summary-opts: summary-opts.def $(OPTTPL)
+ $(run_ag) summary-opts.def
-$(srcdir)/ntp-wait.html: $(srcdir)/invoke-ntp-wait.menu $(srcdir)/invoke-ntp-wait.texi $(srcdir)/ntp-wait.texi $(top_srcdir)/sntp/include/version.texi
- cd $(srcdir) && ( makeinfo --force --html --no-split -I ../sntp -o ntp-wait.html ntp-wait.texi || true )
calc_tickadj Calculates "optimal" value for tick given ntp.drift file
-freq_adj Calculates and optionally sets the clock frequency
- based on ntp.drift . For FreeBSD systems.
-
-mkver.in script to create new version numbers for all sources
-
monitoring directory containing perl scripts useful for monitoring
operations
-rc1 start/stop scripts for NTP
-
-rc2 start/stop script for NTP
-
-ntp-close find public stratum 2 servers that don't respond
-
-ntp-groper script useful for reaching out and rattling the cages of
- NTP peers to see if animals are inside the bars
-
-ntp-restart script useful for killing and restarting the NTP daemon
+rc start/stop scripts for NTP
ntp-wait Blocks until ntpd is in state 4 (synchronized).
- Hopefully useful at boot time, to delay the boot sequence
+ Useful at boot time, to delay the boot sequence
until after "ntpd -g" has set the time.
ntpsweep prints per host given in <file> the NTP stratum level, the
clock offset in seconds, the daemon version, the operating
system and the processor.
-ntpver What version of the NTP daemon is running?
+ntptrace Trace ntp peers of a server up to stratum 1.
stats directory containing awk and shell scripts useful for
maintaining statistics summaries of clockstats, loopstats
and peerstats files
-support directory containing shell and perl scripts useful for
- configuration and monitoring of NTP subnets
+summary Generate summary files out of stat files produced by NTP
+ daemon.
+
+plot_summary Plot summaries generated by summary script.
--- /dev/null
+run_ag= cd $(srcdir) && env PATH="$(abs_builddir):$(PATH)" \
+ autogen -L ../sntp/include -L ../sntp/ag-tpl
+
+noinst_SCRIPTS = mkver
+
+EXTRA_DIST = \
+ check--help \
+ checkChangeLog \
+ fixautomakedepsmagic \
+ genCommitLog \
+ genver \
+ UpdatePoint \
+ VersionName
esac
printf "Previous version: "
-scripts/VersionName
+scripts/build/VersionName
# apply packageinfo.sh changes
0)
mv packageinfo.sh+ packageinfo.sh
printf "Updated version: "
- scripts/VersionName
+ scripts/build/VersionName
;;
*)
printf "Next version would be: "
- scripts/VersionName -p ./packageinfo.sh+
+ scripts/build/VersionName -p ./packageinfo.sh+
rm packageinfo.sh+
;;
esac
set -e
-clt=`./scripts/genChangeLogTag`
+clt=`./scripts/build/genChangeLogTag`
first=`line < ChangeLog`
case "$first" in
#! /bin/sh
-dversion=`./scripts/VersionName`
+dversion=`./scripts/build/VersionName`
tag=`date +"(${dversion}) %Y/%m/%d Released by Harlan Stenn <stenn@ntp.org>"`
echo $tag
. ../packageinfo.sh
-dversion=`../scripts/VersionName -p ../packageinfo.sh`
+dversion=`../scripts/build/VersionName -p ../packageinfo.sh`
set +e
+++ /dev/null
-#! @PATH_PERL@
-#
-# drift of 104.8576 -> +1 tick. Base of 10000 ticks.
-#
-# 970306 HMS Deal with nanoseconds. Fix sign of adjustments.
-
-$df="/etc/ntp.drift";
-# Assumes a 100Hz box with "tick" of 10000
-# Someday, we might call "tickadj" for better values...
-$base=10000; # tick: 1,000,000 / HZ
-$cvt=104.8576; # 2 ** 20 / $base
-$v1=0.;
-$v2="";
-
-if (open(DF, $df))
- {
- if ($_=<DF>)
- {
- ($v1, $v2) = split;
- }
-
- while ($v1 < 0)
- {
- $v1 += $cvt;
- $base--;
- }
-
- while ($v1 > $cvt)
- {
- $v1 -= $cvt;
- $base++;
- }
- }
-
-printf("%.3f (drift)\n", $v1);
-
-printf("%d usec; %d nsec\n", $base, ($base + ($v1/$cvt)) * 1000);
-
--- /dev/null
+run_ag= cd $(srcdir) && env PATH="$(abs_builddir):$(PATH)" \
+ autogen -L ../../sntp/include -L ../../sntp/ag-tpl \
+ --writable
+
+EXTRA_DIST = \
+ $(srcdir)/calc_tickadj.in \
+ $(srcdir)/calc_tickadj \
+ $(srcdir)/calc_tickadj.1calc_tickadjman \
+ $(srcdir)/calc_tickadj.1calc_tickadjmdoc \
+ $(srcdir)/calc_tickadj.texi \
+ $(srcdir)/calc_tickadj.html \
+ $(srcdir)/calc_tickadj.1 \
+ $(srcdir)/calc_tickadj-opts.def \
+ $(srcdir)/calc_tickadj-opts \
+ $(srcdir)/invoke-calc_tickadj.texi \
+ $(srcdir)/invoke-calc_tickadj.menu
+
+noinst_SCRIPTS = calc_tickadj
+
+noinst_DATA = \
+ $(srcdir)/calc_tickadj.in \
+ $(srcdir)/calc_tickadj.1calc_tickadjman \
+ $(srcdir)/calc_tickadj.1calc_tickadjmdoc \
+ $(srcdir)/calc_tickadj.texi \
+ $(srcdir)/calc_tickadj.html \
+ $(srcdir)/calc_tickadj.1 \
+ $(srcdir)/calc_tickadj-opts.def \
+ $(srcdir)/calc_tickadj-opts \
+ $(srcdir)/invoke-calc_tickadj.texi \
+ $(srcdir)/invoke-calc_tickadj.menu
+
+calc_tickadj: $(srcdir)/calc_tickadj-opts
+
+$(srcdir)/calc_tickadj-opts: $(srcdir)/calc_tickadj-opts.def $(srcdir)/../../sntp/ag-tpl/perlopt.tpl
+ $(run_ag) calc_tickadj-opts.def
+
+clean-local: extra-clean
+
+extra-clean:
+ rm calc_tickadj
+ rm *.html *man *mdoc *.1 invoke-calc_tickadj.* calc_tickadj.*.in
+
+### Nroff
+
+$(srcdir)/calc_tickadj.1calc_tickadjman: $(srcdir)/calc_tickadj-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1calc_tickadjman -Tagman-cmd.tpl calc_tickadj-opts.def
+
+$(srcdir)/calc_tickadj.man.in: $(srcdir)/calc_tickadj.1calc_tickadjman $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/calc_tickadj.1calc_tickadjman > $(srcdir)/calc_tickadj.man.in+
+ mv $(srcdir)/calc_tickadj.man.in+ $(srcdir)/calc_tickadj.man.in
+
+### Mdoc
+
+$(srcdir)/calc_tickadj.1calc_tickadjmdoc: $(srcdir)/calc_tickadj-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1calc_tickadjmdoc -Tagmdoc-cmd.tpl calc_tickadj-opts.def
+
+$(srcdir)/calc_tickadj.mdoc.in: $(srcdir)/calc_tickadj.1calc_tickadjmdoc $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/calc_tickadj.1calc_tickadjmdoc > $(srcdir)/calc_tickadj.mdoc.in+
+ mv $(srcdir)/calc_tickadj.mdoc.in+ $(srcdir)/calc_tickadj.mdoc.in
+
+### Manpage
+
+$(srcdir)/calc_tickadj.1: $(srcdir)/calc_tickadj.$(MANTAGFMT).in $(top_builddir)/config.status
+ $(top_builddir)/config.status --file=calc_tickadj.1+:$(srcdir)/calc_tickadj.$(MANTAGFMT).in
+ mv calc_tickadj.1+ calc_tickadj.1
+
+### Texinfo
+
+$(srcdir)/invoke-calc_tickadj.menu: $(srcdir)/invoke-calc_tickadj.texi
+ @: do-nothing action to avoid default SCCS get, .menu built with .texi
+
+$(srcdir)/invoke-calc_tickadj.texi: calc_tickadj $(srcdir)/calc_tickadj-opts.def $(std_def_list)
+ $(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section calc_tickadj-opts.def
+ $(top_srcdir)/scripts/build/check--help $@
+
+### HTML
+
+$(srcdir)/calc_tickadj.html: $(srcdir)/invoke-calc_tickadj.menu $(srcdir)/invoke-calc_tickadj.texi $(srcdir)/calc_tickadj.texi
+ cd $(srcdir) && ( makeinfo --force --html --no-split -I ../sntp -o calc_tickadj.html calc_tickadj.texi || true )
--- /dev/null
+
+# DO NOT EDIT THE FOLLOWING
+#
+# It's auto generated option handling code
+
+use Getopt::Long qw(GetOptionsFromArray);
+Getopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always));
+
+my $usage;
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR $usage;
+ exit $ret;
+}
+
+sub paged_usage {
+ my ($ret) = @_;
+ my $pager = $ENV{PAGER} || '(less || more)';
+
+ open STDOUT, "| $pager" or die "Can't fork a pager: $!";
+ print $usage;
+
+ exit $ret;
+}
+
+sub processOptions {
+ my $args = shift;
+
+ my $opts = {
+ 'drift-file' => '/etc/ntp/drift',
+ 'tick' => '',
+ 'help' => '', 'more-help' => ''
+ };
+ my $argument = '';
+ my $ret = GetOptionsFromArray($args, $opts, (
+ 'drift-file|d=s', 'tick|t=i',
+ 'help|?', 'more-help'));
+
+ $usage = <<'USAGE';
+calc_tickadj - Calculates "optimal" value for tick given ntp drift file.
+USAGE: calc_tickadj [ -<flag> [<val>] | --<name>[{=| }<val>] ]...
+
+ -d, --drift-file=str Ntp drift file to use
+ -t, --tick=num Tick value of this host
+ -?, --help Display usage information and exit
+ , --more-help Pass the extended usage information through a pager
+
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.
+USAGE
+
+ usage(0) if $opts->{'help'};
+ paged_usage(0) if $opts->{'more-help'};
+ $_[0] = $opts;
+ return $ret;
+}
+
+END { close STDOUT };
+
--- /dev/null
+AutoGen Definitions perlopt;
+#include autogen-version.def
+
+prog-name = calc_tickadj;
+prog-title = 'Calculates "optimal" value for tick given ntp drift file.';
+long-opts;
+gnu-usage;
+
+flag = {
+ name = drift-file;
+ value = d;
+ arg-type = string;
+ arg-default = '/etc/ntp/drift';
+ descrip = 'Ntp drift file to use';
+ doc = 'Use the specified drift file for calculations';
+};
+
+flag = {
+ name = tick;
+ value = t;
+ arg-type = number;
+ descrip = 'Tick value of this host';
+ doc = 'The current tick which to adjustment will be calculated';
+};
+
+doc-section = {
+ ds-type = 'DESCRIPTION';
+ ds-format = 'texi';
+ ds-text = <<- _EndOfDoc
+The @code{calc_tickadj} script uses provided ntp drift file to generate optimal
+tick value. Generally, ntpd can do better job if the drift value is the
+smallest possible number.
+
+The example output of
+@example
+$ ./calc_tickadj
+81.699 (drift)
+9999 usec; 9999779 nsec
+$ cat /etc/ntp/drift
+-23.159
+@end example
+
+means the following. If tick on that box is 10,000, by making the value 9999
+we'll shift the box from its current drift of -23.159 to a drift of 81.699, and
+in doing so we'll speed the clock up a little every second instead of slowing
+the clock down a little.
+
+If 'tick' on that box is 10,000,000 then by setting it to 9999779 the drift
+value will be somewhere around 0.0.
+
+@code{calc_tickadj} tries to determine the the tick value by using
+@code{tickadj} program from ntp package. If this doesn't work you can specify
+current tick manually on command line.
+ _EndOfDoc;
+};
--- /dev/null
+#! @PATH_PERL@ -w
+#
+# drift of 104.8576 -> +1 tick. Base of 10000 ticks.
+#
+# 970306 HMS Deal with nanoseconds. Fix sign of adjustments.
+package calc_tickadj;
+use strict;
+
+exit run(@ARGV) unless caller;
+
+sub run {
+ my $opts;
+ if (!processOptions(\@_, $opts)) {
+ usage(1);
+ };
+ my $drift_file = $opts->{'drift-file'};
+ my $tick = $opts->{'tick'};
+
+ if (!$tick) {
+ my ($fl) = `tickadj`;
+ if (defined $fl && $fl =~ /(?:KERNEL|PRESET)?\s*tick\s+=\s+(\d+)/) {
+ $tick = $1;
+ }
+ else {
+ die "Could not get tick value, try manually with -t/--tick\n";
+ }
+ }
+
+ # Drift file is in PPM where Milion is actually 2**20
+ my $cvt = (2 ** 20) / $tick;
+ my $drift = 0.;
+
+ open my $dfh, $drift_file or die "Could not open $drift_file: $!\n";
+
+ $drift = <$dfh>;
+
+ close $dfh;
+ die "Invalid drift file value <$drift>" if $drift !~ /[+-]?\d+\.?[0-9]+/;
+
+ while ($drift < 0) {
+ $drift += $cvt;
+ $tick--;
+ }
+
+ while ($drift > $cvt) {
+ $drift -= $cvt;
+ $tick++;
+ }
+
+ printf "%.3f (drift)\n", $drift;
+ printf "%d usec; %d nsec\n", $tick, ($tick + ($drift/$cvt)) * 1000;
+
+ return 0;
+}
+
+@calc_tickadj_opts@
+
+1;
+__END__
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename calc_tickadj.info
+@settitle calc_tickadj User's Manual
+@include ../..//sntp/include/version.texi
+@paragraphindent 2
+@c %**end of header
+
+@ifinfo
+This file documents the use of @code{calc_tickadj}, a program from the NTP
+Project, that is used calculate optimal tick value based on given drift file.
+@end ifinfo
+
+@direntry
+* calc_tickadj: (calc_tickadj). Calculate optimal tick value from a drift file.
+@end direntry
+
+@titlepage
+@title calc_tickadj User's Manual
+@subtitle calc_tickadj, version @value{VERSION}, @value{UPDATED}
+@c @author Max @email{foo@ntp.org}
+@end titlepage
+
+@node Top, calc_tickadj Description, (dir), (dir)
+@top calc_tickadj User's Manual
+
+This document describes the use of the NTP Project's @code{calc_tickadj} program.
+This document applies to version @value{VERSION} of @code{calc_tickadj}.
+
+@shortcontents
+
+@menu
+* calc_tickadj Description:: Description
+* calc_tickadj Invocation:: Invoking calc_tickadj
+@end menu
+
+@include invoke-calc_tickadj.texi
+++ /dev/null
-#! @PATH_PERL@
-#! @PATH_PERL@ -d
-#
-# This script compares the time of several machines with the
-# time on the local host.
-#
-# Use or modify it as you wish.
-#
-# As the original author is only expecting 14 minutes of fame,
-# leaving his name attached would be appreciated.
-#
-# R. Gary Cutbill <rgary@chrysalis.com>
-# 21 April 1999
-#
-$tol=2.0;
-$|=1;
-print "Time Check";
-
-open(HOSTS,"ypcat hosts.byaddr |"); # get a list of hosts from the yp server.
-
-while ($line=<HOSTS>) { # loop for each host getting the offset compared to localhost
- ($addr,$host,$aliases)=split(/\s+/,$line,3);
- $res=`/usr/local/bin/ntptrace -m 1 -r 1 -t 1 $host`;
- print ".";
- chop $res;
- push (@results,$res);
-}
-print "\n";
-
-
-#
-# Sort the list of hosts, and print out there offsets
-# from the local host.
-#
-@list=sort appropriately @results;
-foreach $i ( @list ) {
-
- @dargs=split(/\s+/,$i);
- if ( $dargs[1] eq "\*Timeout\*" ) {
- print "$i\n";
- chop $dargs[0];
- push(@down,$dargs[0]);
- } else {
- printf "%-25s %7s %3s %6s %10s %5s %8s %8s\n",@dargs;
- if ( ( $dargs[4] > $tol ) || ( $dargs[4] < -$tol ) ) {
- chop $dargs[0];
- push(@toofarout,$dargs[0]); }
- }
-}
-#
-# When the above list finishes, hosts that are different by +/- $tol (two seconds)
-# are in @toofarout. Hosts that are down are in @down. They are treated the same
-# way here, but you might want to do something different depending on your site.
-#
-# print a set of suggested rsh commands to run on the hosts that
-# don't have "good" time. "restartntp" is left as an excersize to the reader.
-# I usually use it to kill a running xntpd, ntpdate some server, and the start xntp
-# again.
-#
-print "\nConsider:\n";
-foreach $i ( (@down,@toofarout) ) {
- print " rsh $i sudo restartntp\n";
-}
-
-
-#
-# sort the results from the list. First by stratum, then by time deviation
-# Put hosts that didn't respond (timed out) on the bottom.
-#
-sub appropriately {
- @af=split(/\s+/,$a);
- @bf=split(/\s+/,$b);
- $aba= ($af[4]<0)?-$af[4]:$af[4];
- $abb= ($bf[4]<0)?-$bf[4]:$bf[4];
-
- ( $af[1] ne $bf[1] ) ? $bf[1] cmp $af[1] :
- ( ( $af[2] != $bf[2] ) ? ( $bf[2] <=> $af[2] ) :
- ( ( $aba != $abb ) ? ( $abb <=> $aba ) : ($af[0] cmp $bf[0] ) ) );
-}
--- /dev/null
+perllibdir = @PERLLIBDIR@
+
+nobase_perllib_DATA = NTP/Util.pm
+
+EXTRA_DIST = ${perllib_DATA}
--- /dev/null
+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_SAVECONFIG
+ 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
+ OP_ASYNCMSG => 7, # asynchronous message
+ OP_CONFIGURE => 8, # runtime configuration
+ OP_SAVECONFIG => 9, # save config to file
+ 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
+};
+
+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;
--- /dev/null
+package NTP::Util;
+use strict;
+use warnings;
+use Exporter 'import';
+use Carp;
+
+our @EXPORT_OK = qw(ntp_read_vars do_dns ntp_peers ntp_sntp_line);
+
+my $ntpq_path = 'ntpq';
+my $sntp_path = 'sntp';
+
+our $IP_AGNOSTIC;
+
+BEGIN {
+ require Socket;
+ if ($Socket::VERSION >= 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) = @_;
+
+ my $cmd = "$ntpq_path -np $host |";
+
+ open my $fh, $cmd or croak "Could not start ntpq: $!";
+
+ <$fh> for 1 .. 2;
+
+ my @columns = qw(remote refid st t when poll reach delay offset jitter);
+ my @peers;
+ while (<$fh>) {
+ if (/(?:[\w\.\*-]+\s*){10}/) {
+ my $col = 0;
+ push @peers, { map {; $columns[ $col++ ] => $_ } split /(?<=.)\s+/ };
+ }
+ 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_sntp_line {
+ my ($host) = @_;
+
+ my $cmd = "$sntp_path $host |";
+ open my $fh, $cmd or croak "Could not start sntp: $!";
+
+ my ($offset, $stratum);
+ while (<$fh>) {
+ next if !/^\d{4}-\d\d-\d\d/;
+ chomp;
+ my @output = split / /;
+
+ $offset = $output[3];
+ ($stratum = pop @output) =~ s/s(\d{1,2})/$1/;
+ }
+ close $fh or croak "running sntp failed: $! (exit status $?)";
+ return ($offset, $stratum);
+}
+++ /dev/null
-#! @PATH_PERL@ -w
-
-die "perl5 needed\n" unless ($] > 5);
-
-use Getopt::Std;
-
-$opt_n = 1000; # How many tries before we give up? (10 min+)
-$opt_s = 6; # Seconds to sleep between tries (6s = 10/min)
-$opt_v = 0; # Be verbose?
-
-getopts('n:s:v');
-
-$cmd = 'ntpq -c "rv 0"';
-
-$| = 1; # Autoflush output.
-
-print "Waiting for ntpd to synchronize... " if ($opt_v);
-for ($i = 0; $i < $opt_n; ++$i) {
- open(Q, $cmd." 2>&1 |") || die "Can't start ntpq: $!";
- while(<Q>) {
- chomp;
- # the first line should be similar to:
- # associd=0 status=0645 leap_none, sync_ntp, ...
- if (/^asso?c?id=0 status=(\S{4}) (\S+), (\S+),/i) {
- my $status = $1;
- my $leap = $2;
- my $sync = $3;
- # print $_;
- # print "status <$status>, leap <$leap>, sync <$sync>\n";
- last if ($leap =~ /(sync|leap)_alarm/);
- if ($leap =~ /leap_(none|((add|del)_sec))/) {
- # We could check $sync here to make sure we like the source...
- print "\bOK!\n" if ($opt_v);
- exit 0;
- }
- print "\bUnexpected 'leap' status <$leap>\n";
- exit 1;
- }
-
- if (/Connection refused/) {
- print "\bntpd is not running!\n" if ($opt_v);
- exit 1;
- }
-
- # Otherwise, we have a bigger problem.
- print "\bUnexpected first line <$_>\n";
- exit 1;
- }
- close(Q);
- print "\b".substr("*+:.", $i % 4, 1) if ($opt_v);
- sleep($opt_s);
-}
-print "\bNo!\nntpd did not synchronize.\n" if ($opt_v);
-exit 1;
+++ /dev/null
-.Dd September 26 2013
-.Dt NTP_WAIT @NTP_WAIT_MS@ User Commands
-.Os SunOS 5.10
-.\" EDIT THIS FILE WITH CAUTION (ntp-wait-opts.mdoc)
-.\"
-.\" It has been AutoGen-ed September 26, 2013 at 11:31:57 AM by AutoGen 5.18.1pre5
-.\" From the definitions ntp-wait-opts.def
-.\" and the template file agmdoc-cmd.tpl
-.Sh NAME
-.Nm ntp-wait
-.Nd Wait for ntpd to stabilize the system clock
-.Sh SYNOPSIS
-.Nm
-.\" Mixture of short (flag) options and long options
-.Op Fl flags
-.Op Fl flag Ar value
-.Op Fl \-option\-name Ar value
-.Pp
-All arguments must be options.
-.Pp
-.Sh DESCRIPTION
-.Nm
-will send at most
-.Ar num\-tries
-queries to
-.Xr ntpd 8 ,
-sleeping for
-.Ar secs\-between\-tries
-after each status return that says
-.Xr ntpd 8
-has not yet produced a synchronized and stable system clock.
-.Pp
-.Nm
-will do this quietly, unless the
-.Fl v
-flag is provided.
-.Sh "OPTIONS"
-.Bl -tag
-.It \-n " \fInum\-tries\fP, " \-\- "=" \fInum\-tries\fP
-Number of times to check ntpd.
-This option takes an integer number as its argument.
-The default \fInum\-tries\fP for this option is:
-.ti +4
- 100
-.sp
-The maximum number of times we will check \fBntpd\fP to see if
-it has been able to synchronize and stabilize the system clock.
-.It \-s " \fIsecs\-between\-tries\fP, " \-\- "=" \fIsecs\-between\-tries\fP
-How long to sleep between tries.
-This option takes an integer number as its argument.
-The default \fIsecs\-between\-tries\fP for this option is:
-.ti +4
- 6
-.sp
-We will sleep for \fIsecs\-between\-tries\fP after each query
-of \fBntpd\fP that returns "the time is not yet stable".
-.It \-v ", " \-\-
-Be verbose.
-.sp
-By default, \fBntp\-wait\fP is silent.
-With this option, \fBntp\-wait\fP will provide status information.
-.It \-? , " \-\-help"
-Display usage information and exit.
-.It \-! , " \-\-more\-help"
-Pass the extended usage information through a pager.
-.It \-\-version "[={\fIv|c|n\fP}]"
-Output version of program and exit. The default mode is `v', a simple
-version. The `c' mode will print copyright information and `n' will
-print the full copyright notice.
-.El
-.Sh "OPTION PRESETS"
-Any option that is not marked as \fInot presettable\fP may be preset
-by loading values from environment variables named:
-.nf
- \fBNTP_WAIT_<option\-name>\fP or \fBNTP_WAIT\fP
-.fi
-.ad
-cvt_prog='/usr/local/gnu/share/autogen/texi2mdoc'
-cvt_prog=`cd \`dirname "$cvt_prog"\` >/dev/null && pwd
- `/`basename "$cvt_prog"`
-cd $tmp_dir
-test \-x "$cvt_prog" || die "'$cvt_prog' is not executable"
-{
- list='synopsis description options option\-presets'
- for f in $list ; do cat $f ; echo ; done
- rm \-f $list name
- list='implementation\-notes environment files examples exit\-status errors
- compatibility see\-also conforming\-to history authors copyright bugs
- notes'
- for f in $list ; do cat $f ; echo ; done > .end\-doc
- rm \-f $list
- list=`ls \-1 *`' .end\-doc'
- for f in $list ; do cat $f ; echo ; done
- rm \-f $list
-} 1>.doc 2>/dev/null
-sed \-f .cmds .doc | /usr/local/gnu/bin/grep \-E \-v '^[ ]*$' | $cvt_prog
-.Sh "ENVIRONMENT"
-See \fBOPTION PRESETS\fP for configuration environment variables.
-.Sh "EXIT STATUS"
-One of the following exit values will be returned:
-.Bl -tag
-.It 0 " (EXIT_SUCCESS)"
-Successful program execution.
-.It 1 " (EXIT_FAILURE)"
-The operation failed or the command syntax was not valid.
-.It 70 " (EX_SOFTWARE)"
-libopts had an internal operational error. Please report
-it to autogen\-users@lists.sourceforge.net. Thank you.
-.El
-.Sh AUTHORS
-.An "Harlan Stenn"
-.Sh "COPYRIGHT"
-Copyright (C) 1970\-2013 The University of Delaware all rights reserved.
-This program is released under the terms of the NTP license, <http://ntp.org/license>.
-.Sh "BUGS"
-Please send bug reports to: http://bugs.ntp.org, bugs@ntp.org
-.Sh NOTES
-This document corresponds to version 4.2.7p390 of NTP.
-.Pp
-This manual page was \fIAutoGen\fP\-erated from the \fBntp\-wait\fP
-option definitions.
--- /dev/null
+man_MANS= ntp-wait.$(NTP_WAIT_MS)
+
+bin_SCRIPTS = $(NTP_WAIT_DB)
+libexec_SCRIPTS = $(NTP_WAIT_DL)
+sbin_SCRIPTS = $(NTP_WAIT_DS)
+
+run_ag= cd $(srcdir) && env PATH="$(abs_builddir):$(PATH)" \
+ autogen -L ../../sntp/include -L ../../sntp/ag-tpl \
+ --writable
+
+EXTRA_SCRIPTS = ntp-wait
+
+EXTRA_DIST = \
+ $(srcdir)/ntp-wait.in \
+ $(srcdir)/ntp-wait \
+ $(srcdir)/ntp-wait.1ntp-waitman \
+ $(srcdir)/ntp-wait.1ntp-waitmdoc \
+ $(srcdir)/ntp-wait.texi \
+ $(srcdir)/ntp-wait.html \
+ $(srcdir)/ntp-wait.1 \
+ $(srcdir)/ntp-wait-opts.def \
+ $(srcdir)/ntp-wait-opts \
+ $(srcdir)/invoke-ntp-wait.texi \
+ $(srcdir)/invoke-ntp-wait.menu
+
+html_DATA = $(srcdir)/ntp-wait.html
+
+noinst_DATA = \
+ $(srcdir)/ntp-wait.in \
+ $(srcdir)/ntp-wait.1ntp-waitman \
+ $(srcdir)/ntp-wait.1ntp-waitmdoc \
+ $(srcdir)/ntp-wait.texi \
+ $(srcdir)/ntp-wait.html \
+ $(srcdir)/ntp-wait.1 \
+ $(srcdir)/ntp-wait-opts.def \
+ $(srcdir)/ntp-wait-opts \
+ $(srcdir)/invoke-ntp-wait.texi \
+ $(srcdir)/invoke-ntp-wait.menu
+
+ntp-wait: $(srcdir)/ntp-wait-opts
+
+$(srcdir)/ntp-wait-opts: $(srcdir)/ntp-wait-opts.def ../../sntp/ag-tpl/perlopt.tpl
+ $(run_ag) ntp-wait-opts.def
+
+clean-local: extra-clean
+
+extra-clean:
+ rm ntp-wait
+ rm *.html *man *mdoc *.1 invoke-ntp-wait.* ntp-wait.man.in
+
+### Nroff
+
+$(srcdir)/ntp-wait.1ntp-waitman: $(srcdir)/ntp-wait-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1ntp-waitman -Tagman-cmd.tpl ntp-wait-opts.def
+
+$(srcdir)/ntp-wait.man.in: $(srcdir)/ntp-wait.1ntp-waitman $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntp-wait.1ntp-waitman > $(srcdir)/ntp-wait.man.in+
+ mv $(srcdir)/ntp-wait.man.in+ $(srcdir)/ntp-wait.man.in
+
+### Mdoc
+
+$(srcdir)/ntp-wait.1ntp-waitmdoc: $(srcdir)/ntp-wait-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1ntp-waitmdoc -Tagmdoc-cmd.tpl ntp-wait-opts.def
+
+$(srcdir)/ntp-wait.mdoc.in: $(srcdir)/ntp-wait.1ntp-waitmdoc $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntp-wait.1ntp-waitmdoc > $(srcdir)/ntp-wait.mdoc.in+
+ mv $(srcdir)/ntp-wait.mdoc.in+ $(srcdir)/ntp-wait.mdoc.in
+
+### Manpage
+
+$(srcdir)/ntp-wait.1: $(srcdir)/ntp-wait.$(MANTAGFMT).in $(top_builddir)/config.status
+ $(top_builddir)/config.status --file=ntp-wait.1+:$(srcdir)/ntp-wait.$(MANTAGFMT).in
+ mv ntp-wait.1+ ntp-wait.1
+
+### Texinfo
+
+$(srcdir)/invoke-ntp-wait.menu: $(srcdir)/invoke-ntp-wait.texi
+ @: do-nothing action to avoid default SCCS get, .menu built with .texi
+
+$(srcdir)/invoke-ntp-wait.texi: ntp-wait $(srcdir)/ntp-wait-opts.def $(std_def_list)
+ $(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntp-wait-opts.def
+ $(top_srcdir)/scripts/build/check--help $@
+
+### HTML
+
+$(srcdir)/ntp-wait.html: $(srcdir)/invoke-ntp-wait.menu $(srcdir)/invoke-ntp-wait.texi $(srcdir)/ntp-wait.texi $(top_srcdir)/sntp/include/version.texi
+ cd $(srcdir) && ( makeinfo --force --html --no-split -I ../sntp -o ntp-wait.html ntp-wait.texi || true )
--- /dev/null
+
+# DO NOT EDIT THE FOLLOWING
+#
+# It's auto generated option handling code
+
+use Getopt::Long qw(GetOptionsFromArray);
+Getopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always));
+
+my $usage;
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR $usage;
+ exit $ret;
+}
+
+sub paged_usage {
+ my ($ret) = @_;
+ my $pager = $ENV{PAGER} || '(less || more)';
+
+ open STDOUT, "| $pager" or die "Can't fork a pager: $!";
+ print $usage;
+
+ exit $ret;
+}
+
+sub processOptions {
+ my $args = shift;
+
+ my $opts = {
+ 'tries' => '100',
+ 'sleep' => '6',
+ 'verbose' => '',
+ 'help' => '', 'more-help' => ''
+ };
+ my $argument = '';
+ my $ret = GetOptionsFromArray($args, $opts, (
+ 'tries|n=i', 'sleep|s=i', 'verbose|v',
+ 'help|?', 'more-help'));
+
+ $usage = <<'USAGE';
+ntp-wait - Wait for ntpd to stabilize the system clock
+USAGE: ntp-wait [ -<flag> [<val>] | --<name>[{=| }<val>] ]...
+
+ -n, --tries=num Number of times to check ntpd
+ -s, --sleep=num How long to sleep between tries
+ -v, --verbose Be verbose
+ -?, --help Display usage information and exit
+ , --more-help Pass the extended usage information through a pager
+
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.
+USAGE
+
+ usage(0) if $opts->{'help'};
+ paged_usage(0) if $opts->{'more-help'};
+ $_[0] = $opts;
+ return $ret;
+}
+
+END { close STDOUT };
+
/* -*- Mode: Text -*- */
+autogen definitions perlopt;
-autogen definitions options;
-
-#include copyright.def
-// #include homerc.def
#include autogen-version.def
prog-name = "ntp-wait";
prog-title = "Wait for ntpd to stabilize the system clock";
package = ntp;
+long-opts;
+gnu-usage;
test-main;
-// #include version.def
-
flag = {
- value = n;
- arg-type = number;
- arg-name = "num-tries";
- arg-default = 100;
- descrip = "Number of times to check ntpd";
- doc = <<- _EndOfDoc_
- The maximum number of times we will check @code{ntpd} to see if
- it has been able to synchronize and stabilize the system clock.
+ name = tries;
+ value = n;
+ arg-type = number;
+ arg-default = 100;
+ descrip = "Number of times to check ntpd";
+ doc = <<- _EndOfDoc_
+ The maximum number of times we will check @code{ntpd} to see if
+ it has been able to synchronize and stabilize the system clock.
_EndOfDoc_;
};
flag = {
- value = s;
- arg-type = number;
- arg-name = "secs-between-tries";
- arg-default = 6;
- descrip = "How long to sleep between tries";
- doc = <<- _EndOfDoc_
- We will sleep for @file{secs-between-tries} after each query
- of @code{ntpd} that returns "the time is not yet stable".
+ name = sleep;
+ value = s;
+ arg-type = number;
+ arg-name = "secs-between-tries";
+ arg-default = 6;
+ descrip = "How long to sleep between tries";
+ doc = <<- _EndOfDoc_
+ We will sleep for @file{secs-between-tries} after each query
+ of @code{ntpd} that returns "the time is not yet stable".
_EndOfDoc_;
};
flag = {
- value = v;
- descrip = "Be verbose";
- doc = <<- _EndOfDoc_
- By default, @code{ntp-wait} is silent.
- With this option, @code{ntp-wait} will provide status information.
+ name = verbose;
+ value = v;
+ descrip = "Be verbose";
+ doc = <<- _EndOfDoc_
+ By default, @code{ntp-wait} is silent.
+ With this option, @code{ntp-wait} will provide status information.
_EndOfDoc_;
};
-/* explain: Additional information whenever the usage routine is invoked */
explain = <<- _END_EXPLAIN
_END_EXPLAIN;
will do this quietly, unless the
.Fl v
flag is provided.
+This can be useful at boot time, to delay the boot sequence until after
+.Ar ntpd -g
+has set the time.
_END_PROG_MDOC_DESCRIP;
};
ds-type = 'NOTES';
ds-format = 'mdoc';
ds-text = <<- _END_MDOC_NOTES
-This document corresponds to version #VERSION# of NTP.
+This document corresponds to version @VERSION@ of NTP.
_END_MDOC_NOTES;
};
--- /dev/null
+#! @PATH_PERL@
+package ntp_wait;
+use 5.006_000;
+use strict;
+use warnings;
+use lib "@PERLLIBDIR@";
+use NTP::Util qw(ntp_read_vars);
+
+exit run(@ARGV) unless caller;
+
+sub run {
+ my $opts;
+ if (!processOptions(\@_, $opts)) {
+ usage(1);
+ };
+
+ my $tries = $opts->{tries}; # How many tries before we give up? (10 min+)
+ my $sleep = $opts->{sleep}; # Seconds to sleep between tries (6s = 10/min)
+ my $verbose = $opts->{verbose}; # Be verbose?
+
+ # Autoflush stdout
+ $| = 1;
+
+ print "Waiting for ntpd to synchronize... " if $verbose;
+
+ for my $i (1 .. $tries) {
+ my $info = ntp_read_vars(0, []);
+
+ if (!defined $info) {
+ print "\bntpd is not running!\n" if $verbose;
+ return 1;
+ }
+
+ if (!exists $info->{status_line}{leap}) {
+ print "\bLeap status not avalaible\n";
+ return 1;
+ }
+
+ my $leap = $info->{status_line}{leap};
+ my $sync = $info->{status_line}{sync};
+
+ if ($leap =~ /(sync|leap)_alarm/) {
+ print "\b".(substr "*+:.", $i % 4, 1) if $verbose;
+ sleep $sleep if $i < $tries;
+ next;
+ }
+
+ if ($leap =~ /leap_(none|((add|del)_sec))/) {
+ # We could check $sync here to make sure we like the source...
+ print "\bOK!\n" if $verbose;
+ return 0;
+ }
+
+ print "\bUnexpected 'leap' status <$leap>\n";
+ return 1;
+ }
+
+ print "\bNo!\nntpd did not synchronize.\n" if $verbose;
+ return 1;
+}
+
+@ntp_wait_opts@
+
+1;
+__END__
--- /dev/null
+.Dd October 2 2013
+.Dt NTP_WAIT @NTP_WAIT_MS@ User Commands
+.Os FreeBSD 6.4-STABLE
+.\" EDIT THIS FILE WITH CAUTION (ntp-wait-opts.mdoc)
+.\"
+.\" It has been AutoGen-ed October 2, 2013 at 09:50:12 PM by AutoGen 5.18.1pre5
+.\" From the definitions ntp-wait-opts.def
+.\" and the template file agmdoc-cmd.tpl
+.Sh NAME
+.Nm ntp-wait
+.Nd Wait for ntpd to stabilize the system clock
+.Sh SYNOPSIS
+.Nm
+.\" Mixture of short (flag) options and long options
+.Op Fl flags
+.Op Fl flag Op Ar value
+.Op Fl \-option\-name Ns Oo Oo Ns "=| " Oc Ns Ar value Oc
+.Pp
+All arguments must be options.
+.Pp
+.Sh DESCRIPTION
+.Nm
+will send at most
+.Ar num\-tries
+queries to
+.Xr ntpd 8 ,
+sleeping for
+.Ar secs\-between\-tries
+after each status return that says
+.Xr ntpd 8
+has not yet produced a synchronized and stable system clock.
+.Pp
+.Nm
+will do this quietly, unless the
+.Fl v
+flag is provided.
+This can be useful at boot time, to delay the boot sequence until after
+.Ar ntpd \-g
+has set the time.
+.Sh "OPTIONS"
+.Bl -tag
+.It Fl n Ar number , Fl \-tries Ns = Ns Ar number
+Number of times to check ntpd.
+This option takes an integer number as its argument.
+The default
+.Ar number
+for this option is:
+.ti +4
+ 100
+.sp
+ The maximum number of times we will check \fBntpd\fP to see if
+ it has been able to synchronize and stabilize the system clock.
+.It Fl s Ar secs\-between\-tries , Fl \-sleep Ns = Ns Ar secs\-between\-tries
+How long to sleep between tries.
+This option takes an integer number as its argument.
+The default
+.Ar secs\-between\-tries
+for this option is:
+.ti +4
+ 6
+.sp
+ We will sleep for \fIsecs\-between\-tries\fP after each query
+ of \fBntpd\fP that returns "the time is not yet stable".
+.It Fl v , Fl \-verbose
+Be verbose.
+.sp
+ By default, \fBntp\-wait\fP is silent.
+ With this option, \fBntp\-wait\fP will provide status information.
+.It Fl \&? , Fl \-help
+Display usage information and exit.
+.It Fl \&! , Fl \-more\-help
+Pass the extended usage information through a pager.
+.El
+.Sh "EXIT STATUS"
+One of the following exit values will be returned:
+.Bl -tag
+.It 0 " (EXIT_SUCCESS)"
+Successful program execution.
+.It 1 " (EXIT_FAILURE)"
+The operation failed or the command syntax was not valid.
+.It 70 " (EX_SOFTWARE)"
+libopts had an internal operational error. Please report
+it to autogen\-users@lists.sourceforge.net. Thank you.
+.El
+.Sh AUTHORS
+.An "Harlan Stenn"
+.Sh NOTES
+This document corresponds to version @VERSION@ of NTP.
+.Pp
+This manual page was \fIAutoGen\fP\-erated from the \fBntp\-wait\fP
+option definitions.
@c %**start of header
@setfilename ntp-wait.info
@settitle Ntp-wait User's Manual
-@include ../sntp/include/version.texi
+@include ../../sntp/include/version.texi
@paragraphindent 2
@c %**end of header
@c @vskip 0pt plus 1filll
@node Top, ntp-wait Description, (dir), (dir)
-@top Simple Network Time Protocol User Manual
This document describes the use of the NTP Project's @code{ntp-wait} program.
* ntp-wait Invocation:: Invoking ntp-wait
@end menu
-@node ntp-wait Description
-@comment node-name, next, previous, up
-@section Description
-
-The @code{ntp-wait} program blocks until @code{ntpd} is in synchronized state.
-This can be useful at boot time, to delay the boot sequence until after
-@code{ntpd -g} has set the time.
-
@include invoke-ntp-wait.texi
+++ /dev/null
-#! @PATH_PERL@ -w
-#
-# $Id$
-#
-# DISCLAIMER
-#
-# Copyright (C) 1999,2000 Hans Lambermont and Origin B.V.
-#
-# Permission to use, copy, modify and distribute this software and its
-# documentation for any purpose and without fee is hereby granted,
-# provided that the above copyright notice appears in all copies and
-# that both the copyright notice and this permission notice appear in
-# supporting documentation. This software is supported as is and without
-# any express or implied warranties, including, without limitation, the
-# implied warranties of merchantability and fitness for a particular
-# purpose. The name Origin B.V. must not be used to endorse or promote
-# products derived from this software without prior written permission.
-#
-# Hans Lambermont <ntpsweep@lambermont.dyndns.org>
-
-require 5.0; # But actually tested on 5.004 ;)
-use Getopt::Long; # GetOptions()
-use strict;
-
-my $version = 1.3;
-(my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%;
-
-# Hardcoded paths/program names
-my $sntp = "sntp";
-my $ntpq = "ntpq";
-
-# no STDOUT buffering
-$| = 1;
-
-my ($help, $single_host, $showpeers, $maxlevel, $strip, $askversion);
-my $res = GetOptions("help!" => \$help,
- "host=s" => \$single_host,
- "peers!" => \$showpeers,
- "maxlevel=s" => \$maxlevel,
- "strip=s" => \$strip,
- "version!" => \$askversion);
-
-if ($askversion) {
- print("$version\n");
- exit 0;
-}
-
-if ($help || ((@ARGV != 1) && !$single_host)) {
- warn <<EOF;
-This is $program, version $version
-Copyright (C) 1999,2000 Hans Lambermont and Origin B.V. Disclaimer inside.
-
-Usage:
- $program [--help|--peers|--strip <string>|--maxlevel <level>|--version] \\
- <file>|[--host <hostname>]
-
-Description:
- $program prints per host given in <file> the NTP stratum level, the
- clock offset in seconds, the daemon version, the operating system and
- the processor. Optionally recursing through all peers.
-
-Options:
---help
- Print this short help text and exit.
---version
- Print version ($version) and exit.
-<file>
- Specify hosts file. File format is one hostname or ip number per line.
- Lines beginning with # are considered as comment.
---host <hostname>
- Speficy a single host, bypassing the need for a hosts file.
---peers
- Recursively list all peers a host synchronizes to.
- An '= ' before a peer means a loop. Recursion stops here.
---maxlevel <level>
- Traverse peers up to this level (4 is a reasonable number).
---strip <string>
- Strip <string> from hostnames.
-
-Examples:
- $program myhosts.txt --strip .foo.com
- $program --host some.host --peers --maxlevel 4
-EOF
- exit 1;
-}
-
-my $hostsfile = shift;
-my (@hosts, @known_hosts);
-my (%known_host_info, %known_host_peers);
-
-sub read_hosts()
-{
- local *HOSTS;
- open (HOSTS, $hostsfile) ||
- die "$program: FATAL: unable to read $hostsfile: $!\n";
- while (<HOSTS>) {
- next if /^\s*(#|$)/; # comment/empty
- chomp;
- push(@hosts, $_);
- }
- close(HOSTS);
-}
-
-# translate IP to hostname if possible
-sub ip2name {
- my($ip) = @_;
- my($addr, $name, $aliases, $addrtype, $length, @addrs);
- $addr = pack('C4', split(/\./, $ip));
- ($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($addr, 2);
- if ($name) {
- # return lower case name
- return("\L$name");
- } else {
- return($ip);
- }
-}
-
-# item_in_list($item, @list): returns 1 if $item is in @list, 0 if not
-sub item_in_list {
- my($item, @list) = @_;
- my($i);
- foreach $i (@list) {
- return 1 if ($item eq $i);
- }
- return 0;
-}
-
-sub scan_host($;$;$) {
- my($host, $level, @trace) = @_;
- my $stratum = 0;
- my $offset = 0;
- my $daemonversion = "";
- my $system = "";
- my $processor = "";
- my @peers;
- my $known_host = 0;
-
- if (&item_in_list($host, @known_hosts)) {
- $known_host = 1;
- } else {
- # sntp part
- open my $sntp_pipe, "$sntp $host 2>/dev/null |"
- or die "Cannot open $sntp pipe: $1";
-
- while (<$sntp_pipe>) {
- next if !/^\d{4}-\d\d-\d\d/;
- my @output = split / /;
-
- $offset = $output[3];
- ($stratum = pop @output) =~ s/s(\d{1,2})/$1/;
- }
- close $sntp_pipe;
-
- # got answers ? If so, go on.
- if ($stratum) {
- # ntpq part
- my $ntpqparams = "-c 'rv 0 processor,system,daemon_version'";
- open(NTPQ, "$ntpq $ntpqparams $host 2>/dev/null |") ||
- die "Cannot open ntpq pipe: $!\n";
- while (<NTPQ>) {
- /daemon_version="(.*)"/ && do {
- $daemonversion = $1;
- };
- /system="([^"]*)"/ && do {
- $system = $1;
- };
- /processor="([^"]*)"/ && do {
- $processor = $1;
- };
- }
- close(NTPQ);
-
- # Shorten daemon_version string.
- $daemonversion =~ s/(;|Mon|Tue|Wed|Thu|Fri|Sat|Sun).*$//;
- $daemonversion =~ s/version=//;
- $daemonversion =~ s/(x|)ntpd //;
- $daemonversion =~ s/(\(|\))//g;
- $daemonversion =~ s/beta/b/;
- $daemonversion =~ s/multicast/mc/;
-
- # Shorten system string
- $system =~ s/UNIX\///;
- $system =~ s/RELEASE/r/;
- $system =~ s/CURRENT/c/;
-
- # Shorten processor string
- $processor =~ s/unknown//;
- }
-
- # got answers ? If so, go on.
- if ($daemonversion) {
- # ntpq again, find out the peers this time
- if ($showpeers) {
- my $ntpqparams = "-pn";
- open(NTPQ, "$ntpq $ntpqparams $host 2>/dev/null |") ||
- die "Cannot open ntpq pipe: $!\n";
- while (<NTPQ>) {
- /^No association ID's returned$/ && do {
- last;
- };
- /^ remote/ && do {
- next;
- };
- /^==/ && do {
- next;
- };
- /^( |x|\.|-|\+|#|\*|o)([^ ]+)/ && do {
- push(@peers, ip2name($2));
- next;
- };
- print "ERROR: $_";
- }
- close(NTPQ);
- }
- }
-
- # Add scanned host to known_hosts array
- push(@known_hosts, $host);
- if ($stratum) {
- $known_host_info{$host} = sprintf("%2d %9.3f %-11s %-12s %s",
- $stratum, $offset, substr($daemonversion,0,11),
- substr($system,0,12), substr($processor,0,9));
- } else {
- # Stratum level 0 is consider invalid
- $known_host_info{$host} = sprintf(" ?");
- }
- $known_host_peers{$host} = [@peers];
- }
-
- if ($stratum || $known_host) { # Valid or known host
- my $printhost = ' ' x $level . $host;
- # Shorten host string
- if ($strip) {
- $printhost =~ s/$strip//;
- }
- # append number of peers in brackets if requested and valid
- if ($showpeers && ($known_host_info{$host} ne " ?")) {
- $printhost .= " (" . @{$known_host_peers{$host}} . ")";
- }
- # Finally print complete host line
- printf("%-32s %s\n",
- substr($printhost,0,32), $known_host_info{$host});
- if ($showpeers && (eval($maxlevel ? $level < $maxlevel : 1))) {
- my $peer;
- push(@trace, $host);
- # Loop through peers
- foreach $peer (@{$known_host_peers{$host}}) {
- if (&item_in_list($peer, @trace)) {
- # we've detected a loop !
- $printhost = ' ' x ($level + 1) . "= " . $peer;
- # Shorten host string
- if ($strip) {
- $printhost =~ s/$strip//;
- }
- printf("%-32s %s\n",
- substr($printhost,0,32));
- } else {
- if (substr($peer,0,3) ne "127") {
- &scan_host($peer, $level + 1, @trace);
- }
- }
- }
- }
- } else { # We did not get answers from this host
- my $printhost = ' ' x $level . $host;
- # Shorten host string
- if ($strip) {
- $printhost =~ s/$strip//;
- }
- printf("%-32s ?\n", substr($printhost,0,32));
- }
-}
-
-sub scan_hosts()
-{
- my $host;
- for $host (@hosts) {
- my @trace;
- push(@trace, $host);
- scan_host($host, 0, @trace);
- }
-}
-
-# Main program
-
-if ($single_host) {
- push(@hosts, $single_host);
-} else {
- &read_hosts($hostsfile);
-}
-
-# Print header
-print <<EOF;
-Host st offset(s) version system processor
---------------------------------+--+---------+-----------+------------+---------
-EOF
-
-&scan_hosts();
-
-exit 0;
--- /dev/null
+run_ag= cd $(srcdir) && env PATH="$(abs_builddir):$(PATH)" \
+ autogen -L ../../sntp/include -L ../../sntp/ag-tpl \
+ --writable
+
+noinst_SCRIPTS = ntpsweep
+
+EXTRA_DIST = \
+ $(srcdir)/ntpsweep.in \
+ $(srcdir)/ntpsweep.1ntpsweepman \
+ $(srcdir)/ntpsweep.1ntpsweepmdoc \
+ $(srcdir)/ntpsweep.texi \
+ $(srcdir)/ntpsweep.html \
+ $(srcdir)/ntpsweep.1 \
+ $(srcdir)/ntpsweep-opts.def \
+ $(srcdir)/ntpsweep-opts \
+ $(srcdir)/invoke-ntpsweep.texi \
+ $(srcdir)/invoke-ntpsweep.menu
+
+html_DATA = $(srcdir)/ntpsweep.html
+
+noinst_DATA = \
+ $(srcdir)/ntpsweep.in \
+ $(srcdir)/ntpsweep.1ntpsweepman \
+ $(srcdir)/ntpsweep.1ntpsweepmdoc \
+ $(srcdir)/ntpsweep.texi \
+ $(srcdir)/ntpsweep.html \
+ $(srcdir)/ntpsweep.1 \
+ $(srcdir)/ntpsweep-opts.def \
+ $(srcdir)/ntpsweep-opts \
+ $(srcdir)/invoke-ntpsweep.texi \
+ $(srcdir)/invoke-ntpsweep.menu
+
+ntpsweep: $(srcdir)/ntpsweep-opts
+
+$(srcdir)/ntpsweep-opts: $(srcdir)/ntpsweep-opts.def ../../sntp/ag-tpl/perlopt.tpl
+ $(run_ag) ntpsweep-opts.def
+
+clean-local: extra-clean
+
+extra-clean:
+ rm ntpsweep
+ rm *.html *man *mdoc *.1 invoke-ntpsweep.* ntpsweep.man.in
+
+### Nroff
+
+$(srcdir)/ntpsweep.1ntpsweepman: $(srcdir)/ntpsweep-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1ntpsweepman -Tagman-cmd.tpl ntpsweep-opts.def
+
+$(srcdir)/ntpsweep.man.in: $(srcdir)/ntpsweep.1ntpsweepman $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntpsweep.1ntpsweepman > $(srcdir)/ntpsweep.man.in+
+ mv $(srcdir)/ntpsweep.man.in+ $(srcdir)/ntpsweep.man.in
+
+### Mdoc
+
+$(srcdir)/ntpsweep.1ntpsweepmdoc: $(srcdir)/ntpsweep-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1ntpsweepmdoc -Tagmdoc-cmd.tpl ntpsweep-opts.def
+
+$(srcdir)/ntpsweep.mdoc.in: $(srcdir)/ntpsweep.1ntpsweepmdoc $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntpsweep.1ntpsweepmdoc > $(srcdir)/ntpsweep.mdoc.in+
+ mv $(srcdir)/ntpsweep.mdoc.in+ $(srcdir)/ntpsweep.mdoc.in
+
+### Manpage
+
+$(srcdir)/ntpsweep.1: $(srcdir)/ntpsweep.$(MANTAGFMT).in $(top_builddir)/config.status
+ $(top_builddir)/config.status --file=ntpsweep.1+:$(srcdir)/ntpsweep.$(MANTAGFMT).in
+ mv ntpsweep.1+ ntpsweep.1
+
+### Texinfo
+
+$(srcdir)/invoke-ntpsweep.menu: $(srcdir)/invoke-ntpsweep.texi
+ @: do-nothing action to avoid default SCCS get, .menu built with .texi
+
+$(srcdir)/invoke-ntpsweep.texi: ntpsweep $(srcdir)/ntpsweep-opts.def $(std_def_list)
+ $(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntpsweep-opts.def
+ $(top_srcdir)/scripts/build/check--help $@
+
+### HTML
+
+$(srcdir)/ntpsweep.html: $(srcdir)/invoke-ntpsweep.menu $(srcdir)/invoke-ntpsweep.texi $(srcdir)/ntpsweep.texi $(top_srcdir)/sntp/include/version.texi
+ cd $(srcdir) && ( makeinfo --force --html --no-split -I ../sntp -o ntpsweep.html ntpsweep.texi || true )
--- /dev/null
+
+# DO NOT EDIT THE FOLLOWING
+#
+# It's auto generated option handling code
+
+use Getopt::Long qw(GetOptionsFromArray);
+Getopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always));
+
+my $usage;
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR $usage;
+ exit $ret;
+}
+
+sub paged_usage {
+ my ($ret) = @_;
+ my $pager = $ENV{PAGER} || '(less || more)';
+
+ open STDOUT, "| $pager" or die "Can't fork a pager: $!";
+ print $usage;
+
+ exit $ret;
+}
+
+sub processOptions {
+ my $args = shift;
+
+ my $opts = {
+ 'host-list' => [],
+ 'peers' => '',
+ 'maxlevel' => '',
+ 'strip' => '',
+ 'host' => '',
+ 'help' => '', 'more-help' => ''
+ };
+ my $argument = '[hostfile]';
+ my $ret = GetOptionsFromArray($args, $opts, (
+ 'host-list|l=s', 'peers|p', 'maxlevel|m=i',
+ 'strip|s=s', 'host|h=s',
+ 'help|?', 'more-help'));
+
+ $usage = <<'USAGE';
+ntpsweep - Print various informations about given ntp servers
+USAGE: ntpsweep [ -<flag> [<val>] | --<name>[{=| }<val>] ]... [hostfile]
+
+ -l, --host-list=str Host to execute actions on
+ - may appear multiple times
+ -p, --peers Recursively list all peers a host synchronizes to
+ -m, --maxlevel=num Traverse peers up to this level (4 is a reasonable number)
+ -s, --strip=str Strip this string from hostnames
+ -?, --help Display usage information and exit
+ , --more-help Pass the extended usage information through a pager
+
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.
+USAGE
+
+ usage(0) if $opts->{'help'};
+ paged_usage(0) if $opts->{'more-help'};
+
+ if ($argument && $argument =~ /^[^\[]/ && !@$args) {
+ print STDERR "Not enough arguments supplied (See --help/-?)\n";
+ exit 1;
+ }
+ $_[0] = $opts;
+ return $ret;
+}
+
+END { close STDOUT };
+
--- /dev/null
+/* -*- Mode: Text -*- */
+autogen definitions perlopt;
+#include autogen-version.def
+
+prog-name = 'ntpsweep';
+prog-title = 'Print various informations about given ntp servers';
+package = ntp;
+argument = '[hostfile]';
+long-opts;
+gnu-usage;
+
+flag = {
+ name = host-list;
+ value = l;
+ arg-type = string;
+ max = NOLIMIT;
+ stack-arg;
+ descrip = 'Host to execute actions on';
+ doc = <<- _EndOfDoc_
+ Use this option to specify the host on which this script operates.
+ May appear multiple times.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = peers;
+ value = p;
+ descrip = 'Recursively list all peers a host synchronizes to';
+};
+
+flag = {
+ name = maxlevel;
+ value = m;
+ arg-type = number;
+ descrip = 'Traverse peers up to this level (4 is a reasonable number)';
+};
+
+flag = {
+ name = strip;
+ value = s;
+ arg-type = string;
+ descrip = 'Strip this string from hostnames';
+};
+
+/* Deprecated options */
+flag = {
+ name = host;
+ value = h;
+ arg-type = string;
+ descrip = 'Specify a single host';
+ deprecated;
+};
+
+doc-section = {
+ ds-type = 'DESCRIPTION';
+ ds-format = 'mdoc';
+ ds-text = <<- _END_PROG_MDOC_DESCRIP
+.Nm
+prints per host the NTP stratum level, the clock offset in seconds, the daemon
+version, the operating system and the processor. Optionally recursing through
+all peers.
+ _END_PROG_MDOC_DESCRIP;
+};
--- /dev/null
+#! @PATH_PERL@ -w
+#
+# $Id$
+#
+# DISCLAIMER
+#
+# Copyright (C) 1999,2000 Hans Lambermont and Origin B.V.
+#
+# Permission to use, copy, modify and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appears in all copies and
+# that both the copyright notice and this permission notice appear in
+# supporting documentation. This software is supported as is and without
+# any express or implied warranties, including, without limitation, the
+# implied warranties of merchantability and fitness for a particular
+# purpose. The name Origin B.V. must not be used to endorse or promote
+# products derived from this software without prior written permission.
+#
+# Hans Lambermont <ntpsweep@lambermont.dyndns.org>
+package ntpsweep;
+use 5.006_000;
+use strict;
+use lib "@PERLLIBDIR@";
+use NTP::Util qw(do_dns ntp_read_vars ntp_peers ntp_sntp_line);
+
+(my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%;
+my ($showpeers, $maxlevel, $strip);
+my (%known_host_info, %known_host_peers);
+
+exit run(@ARGV) unless caller;
+
+sub run {
+ my $opts;
+ if (!processOptions(\@_, $opts) ||
+ (((@_ != 1) && !$opts->{host} && !@{$opts->{'host-list'}}))) {
+ usage(1);
+ };
+
+ # no STDOUT buffering
+ $| = 1;
+ ($showpeers, $maxlevel, $strip) =
+ ($opts->{peers}, $opts->{maxlevel}, $opts->{strip});
+
+ my $hostsfile = shift;
+
+ # Main program
+
+ my @hosts;
+
+ if ($opts->{host}) {
+ push @hosts, $opts->{host};
+ }
+ else {
+ @hosts = read_hosts($hostsfile) if $hostsfile;
+ push @hosts, @{$opts->{'host-list'}};
+ }
+
+ # Print header
+ print <<EOF;
+Host st offset(s) version system processor
+--------------------------------+--+---------+-----------+------------+---------
+EOF
+
+ %known_host_info = ();
+ %known_host_peers = ();
+ scan_hosts(@hosts);
+
+ return 0;
+}
+
+sub scan_hosts {
+ my (@hosts) = @_;
+
+ my $host;
+ for $host (@hosts) {
+ scan_host($host, 0, $host => 1);
+ }
+}
+
+sub read_hosts {
+ my ($hostsfile) = @_;
+ my @hosts;
+
+ open my $hosts, $hostsfile
+ or die "$program: FATAL: unable to read $hostsfile: $!\n";
+
+ while (<$hosts>) {
+ next if /^\s*(#|$)/; # comment/empty
+ chomp;
+ push @hosts, $_;
+ }
+
+ close $hosts;
+ return @hosts;
+}
+
+sub scan_host {
+ my ($host, $level, %trace) = @_;
+ my $stratum = 0;
+ my $offset = 0;
+ my $daemonversion = "";
+ my $system = "";
+ my $processor = "";
+ my @peers;
+ my $known_host = 0;
+
+ if (exists $known_host_info{$host}) {
+ $known_host = 1;
+ }
+ else {
+ ($offset, $stratum) = ntp_sntp_line($host);
+
+ # got answers ? If so, go on.
+ if ($stratum) {
+ my $vars = ntp_read_vars(0, [qw(processor system daemon_version)], $host) || {};
+ $daemonversion = $vars->{daemon_version};
+ $system = $vars->{system};
+ $processor = $vars->{processor};
+
+ # Shorten daemon_version string.
+ $daemonversion =~ s/(;|Mon|Tue|Wed|Thu|Fri|Sat|Sun).*$//;
+ $daemonversion =~ s/version=//;
+ $daemonversion =~ s/(x|)ntpd //;
+ $daemonversion =~ s/(\(|\))//g;
+ $daemonversion =~ s/beta/b/;
+ $daemonversion =~ s/multicast/mc/;
+
+ # Shorten system string
+ $system =~ s/UNIX\///;
+ $system =~ s/RELEASE/r/;
+ $system =~ s/CURRENT/c/;
+
+ # Shorten processor string
+ $processor =~ s/unknown//;
+ }
+
+ # got answers ? If so, go on.
+ if ($daemonversion) {
+ if ($showpeers) {
+ my @peers_tmp = ntp_peers($host);
+ for (@peers_tmp) {
+ $_->{remote} =~ s/^(?: |x|\.|-|\+|#|\*|o)([^ ]+)/$1/;
+ push @peers, $_->{remote};
+ }
+ }
+ }
+
+ # Add scanned host to known_hosts array
+ #push @known_hosts, $host;
+ if ($stratum) {
+ $known_host_info{$host} = sprintf "%2d %9.3f %-11s %-12s %s",
+ $stratum, $offset, (substr $daemonversion, 0, 11),
+ (substr $system, 0, 12), (substr $processor, 0, 9);
+ }
+ else {
+ # Stratum level 0 is consider invalid
+ $known_host_info{$host} = " ?";
+ }
+ $known_host_peers{$host} = [@peers];
+ }
+
+ if ($stratum || $known_host) { # Valid or known host
+ my $printhost = ' ' x $level . (do_dns($host) || $host);
+ # Shorten host string
+ if ($strip) {
+ $printhost =~ s/$strip//;
+ }
+ # append number of peers in brackets if requested and valid
+ if ($showpeers && ($known_host_info{$host} ne " ?")) {
+ $printhost .= " (" . @{$known_host_peers{$host}} . ")";
+ }
+ # Finally print complete host line
+ printf "%-32s %s\n",
+ (substr $printhost, 0, 32), $known_host_info{$host};
+ if ($showpeers && ($maxlevel ? $level < $maxlevel : 1)) {
+ $trace{$host} = 1;
+ # Loop through peers
+ foreach my $peer (@{$known_host_peers{$host}}) {
+ if (exists $trace{$peer}) {
+ # we've detected a loop !
+ $printhost = ' ' x ($level + 1) . "= " . $peer;
+ # Shorten host string
+ $printhost =~ s/$strip// if $strip;
+ printf "%-32s\n", substr $printhost, 0, 32;
+ } else {
+ if ((substr $peer, 0, 3) ne "127") {
+ scan_host($peer, $level + 1, %trace);
+ }
+ }
+ }
+ }
+ }
+ else { # We did not get answers from this host
+ my $printhost = ' ' x $level . (do_dns($host) || $host);
+ $printhost =~ s/$strip// if $strip;
+ printf "%-32s ?\n", substr $printhost, 0, 32;
+ }
+}
+
+@ntpsweep_opts@
+
+1;
+__END__
--- /dev/null
+.Dd October 2 2013
+.Dt NTPSWEEP 1ntpsweepmdoc User Commands
+.Os FreeBSD 6.4-STABLE
+.\" EDIT THIS FILE WITH CAUTION (ntpsweep-opts.mdoc)
+.\"
+.\" It has been AutoGen-ed October 2, 2013 at 09:50:21 PM by AutoGen 5.18.1pre5
+.\" From the definitions ntpsweep-opts.def
+.\" and the template file agmdoc-cmd.tpl
+.Sh NAME
+.Nm ntpsweep
+.Nd Print various informations about given ntp servers
+.Sh SYNOPSIS
+.Nm
+.\" Mixture of short (flag) options and long options
+.Op Fl flags
+.Op Fl flag Op Ar value
+.Op Fl \-option\-name Ns Oo Oo Ns "=| " Oc Ns Ar value Oc
+[hostfile]
+.Pp
+.Sh DESCRIPTION
+.Nm
+prints per host the NTP stratum level, the clock offset in seconds, the daemon
+version, the operating system and the processor. Optionally recursing through
+all peers.
+.Sh "OPTIONS"
+.Bl -tag
+.It Fl l Ar string , Fl \-host\-list Ns = Ns Ar string
+Host to execute actions on.
+This option may appear an unlimited number of times.
+.sp
+ Use this option to specify the host on which this script operates.
+ May appear multiple times.
+.It Fl p , Fl \-peers
+Recursively list all peers a host synchronizes to.
+.sp
+This option has not been fully documented.
+.It Fl m Ar number , Fl \-maxlevel Ns = Ns Ar number
+Traverse peers up to this level (4 is a reasonable number).
+This option takes an integer number as its argument.
+.sp
+This option has not been fully documented.
+.It Fl s Ar string , Fl \-strip Ns = Ns Ar string
+Strip this string from hostnames.
+.sp
+This option has not been fully documented.
+.It Fl h Ar string , Fl \-host Ns = Ns Ar string
+Specify a single host.
+.sp
+This option has not been fully documented.
+.sp
+.B
+NOTE: THIS OPTION IS DEPRECATED
+.It Fl \&? , Fl \-help
+Display usage information and exit.
+.It Fl \&! , Fl \-more\-help
+Pass the extended usage information through a pager.
+.El
+.Sh "EXIT STATUS"
+One of the following exit values will be returned:
+.Bl -tag
+.It 0 " (EXIT_SUCCESS)"
+Successful program execution.
+.It 1 " (EXIT_FAILURE)"
+The operation failed or the command syntax was not valid.
+.It 70 " (EX_SOFTWARE)"
+libopts had an internal operational error. Please report
+it to autogen\-users@lists.sourceforge.net. Thank you.
+.El
+.Sh "NOTES"
+This manual page was \fIAutoGen\fP\-erated from the \fBntpsweep\fP
+option definitions.
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename ntpsweep.info
+@settitle ntpsweep User's Manual
+@include ../../sntp/include/version.texi
+@paragraphindent 2
+@c %**end of header
+
+@ifinfo
+This file documents the use of @code{ntpsweep},
+a program from
+the NTP Project,
+that is used to wait until @code{ntpd} has been able to
+synchronize and stabilize the time on the current host.
+@end ifinfo
+
+@direntry
+* ntpsweep: (ntpsweep). Wait for ntpd to synchronize and stabilize the system clock.
+@end direntry
+
+@titlepage
+@title ntpsweep User's Manual
+@subtitle ntpsweep, version @value{VERSION}, @value{UPDATED}
+@c @author Max @email{foo@ntp.org}
+@end titlepage
+
+@c @page
+@c @vskip 0pt plus 1filll
+
+@node Top, ntpsweep Description, (dir), (dir)
+
+This document describes the use of the NTP Project's @code{ntpsweep} program.
+
+This document applies to version @value{VERSION} of @code{ntpsweep}.
+
+@shortcontents
+
+@menu
+* ntpsweep Description:: Description
+* ntpsweep Invocation:: Invoking ntpsweep
+@end menu
+
+@include invoke-ntpsweep.texi
+++ /dev/null
-#! @PATH_PERL@ -w
-
-# John Hay -- John.Hay@icomtek.csir.co.za / jhay@FreeBSD.org
-
-use Socket;
-use Getopt::Std;
-use vars qw($opt_n $opt_m);
-
-$ntpq = "ntpq";
-
-$Getopt::Std::STANDARD_HELP_VERSION=1;
-getopts('nm:');
-
-$dodns = 1;
-$dodns = 0 if (defined($opt_n));
-
-$max_hosts = (defined($opt_m) ? $opt_m : 99);
-$max_hosts = 0 if ( $max_hosts !~ /^\d+$/ );
-$nb_host = 1;
-
-$host = shift;
-$host ||= "127.0.0.1";
-
-for (;;) {
- $nb_host++;
- $rootdelay = 0;
- $rootdispersion = 0;
- $stratum = 255;
- $cmd = "$ntpq -n -c rv $host";
- open(PH, $cmd . "|") || die "failed to start command $cmd: $!";
- while (<PH>) {
- $stratum = $1 if (/stratum=(\d+)/);
- $peer = $1 if (/peer=(\d+)/);
- # Very old servers report phase and not offset.
- $offset = $1 if (/(?:offset|phase)=([^\s,]+)/);
- $rootdelay = $1 if (/rootdelay=([^\s,]+)/);
- # firstly - rootdispersion, now - rootdisp
- $rootdispersion = $1 if (/(?:rootdisp|rootdispersion)=([^\s,]+)/);
- $refid = $1 if (/refid=([^\s,]+)/);
- }
- close(PH) || die "$cmd failed";
- last if ($stratum == 255);
- $offset /= 1000;
- $syncdistance = ($rootdispersion + ($rootdelay / 2)) / 1000;
- $dhost = $host;
- # Only do lookups of IPv4 addresses. The standard lookup functions
- # of perl only do IPv4 and I don't know if we should require extras.
- if ($dodns && $host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
- $iaddr = inet_aton($host);
- $name = (gethostbyaddr($iaddr, AF_INET))[0];
- $dhost = $name if (defined($name));
- }
- printf("%s: stratum %d, offset %f, synch distance %f",
- $dhost, $stratum, $offset, $syncdistance);
- printf(", refid '%s'", $refid) if ($stratum == 1);
- printf("\n");
- last if ($stratum == 0 || $stratum == 1 || $stratum == 16);
- last if ($refid =~ /^127\.127\.\d{1,3}\.\d{1,3}$/);
- last if ($nb_host > $max_hosts);
-
- $cmd = "$ntpq -n -c \"rv $peer\" $host";
- open(PH, $cmd . "|") || die "failed to start command $cmd: $!";
- $thost = "";
- while (<PH>) {
- $thost = $1, last if (/srcadr=(\S+),/);
- }
- close(PH) || die "$cmd failed";
- last if ($thost eq "");
- last if ($thost =~ /^127\.127\.\d{1,3}\.\d{1,3}$/);
- $host = $thost;
-}
-
--- /dev/null
+man_MANS= ntptrace.$(NTPTRACE_MS)
+
+bin_SCRIPTS = $(NTPTRACE_DB)
+libexec_SCRIPTS = $(NTPTRACE_DL)
+sbin_SCRIPTS = $(NTPTRACE_DS)
+
+run_ag= cd $(srcdir) && env PATH="$(abs_builddir):$(PATH)" \
+ autogen -L ../../sntp/include -L ../../sntp/ag-tpl \
+ --writable
+
+EXTRA_SCRIPTS = ntptrace
+
+EXTRA_DIST = \
+ $(srcdir)/ntptrace.in \
+ $(srcdir)/ntptrace.1ntptraceman \
+ $(srcdir)/ntptrace.1ntptracemdoc \
+ $(srcdir)/ntptrace.texi \
+ $(srcdir)/ntptrace.html \
+ $(srcdir)/ntptrace.1 \
+ $(srcdir)/ntptrace-opts.def \
+ $(srcdir)/ntptrace-opts \
+ $(srcdir)/invoke-ntptrace.texi \
+ $(srcdir)/invoke-ntptrace.menu
+
+html_DATA = $(srcdir)/ntptrace.html
+
+noinst_DATA = \
+ $(srcdir)/ntptrace.in \
+ $(srcdir)/ntptrace.1ntptraceman \
+ $(srcdir)/ntptrace.1ntptracemdoc \
+ $(srcdir)/ntptrace.texi \
+ $(srcdir)/ntptrace.html \
+ $(srcdir)/ntptrace.1 \
+ $(srcdir)/ntptrace-opts.def \
+ $(srcdir)/ntptrace-opts \
+ $(srcdir)/invoke-ntptrace.texi \
+ $(srcdir)/invoke-ntptrace.menu
+
+ntptrace: $(srcdir)/ntptrace-opts
+
+$(srcdir)/ntptrace-opts: $(srcdir)/ntptrace-opts.def ../../sntp/ag-tpl/perlopt.tpl
+ $(run_ag) ntptrace-opts.def
+
+clean-local: extra-clean
+
+extra-clean:
+ rm ntptrace
+ rm *.html *man *mdoc *.1 invoke-ntptrace.* ntptrace.man.in
+
+### Nroff
+
+$(srcdir)/ntptrace.1ntptraceman: $(srcdir)/ntptrace-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1ntptraceman -Tagman-cmd.tpl ntptrace-opts.def
+
+$(srcdir)/ntptrace.man.in: $(srcdir)/ntptrace.1ntptraceman $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntptrace.1ntptraceman > $(srcdir)/ntptrace.man.in+
+ mv $(srcdir)/ntptrace.man.in+ $(srcdir)/ntptrace.man.in
+
+### Mdoc
+
+$(srcdir)/ntptrace.1ntptracemdoc: $(srcdir)/ntptrace-opts.def $(std_def_list)
+ $(run_ag) -DMAN_SECTION=1ntptracemdoc -Tagmdoc-cmd.tpl ntptrace-opts.def
+
+$(srcdir)/ntptrace.mdoc.in: $(srcdir)/ntptrace.1ntptracemdoc $(top_srcdir)/sntp/scripts/mansec2subst.sed
+ sed -f $(top_srcdir)/sntp/scripts/mansec2subst.sed $(srcdir)/ntptrace.1ntptracemdoc > $(srcdir)/ntptrace.mdoc.in+
+ mv $(srcdir)/ntptrace.mdoc.in+ $(srcdir)/ntptrace.mdoc.in
+
+### Manpage
+
+$(srcdir)/ntptrace.1: $(srcdir)/ntptrace.$(MANTAGFMT).in $(top_builddir)/config.status
+ $(top_builddir)/config.status --file=ntptrace.1+:$(srcdir)/ntptrace.$(MANTAGFMT).in
+ mv ntptrace.1+ ntptrace.1
+
+### Texinfo
+
+$(srcdir)/invoke-ntptrace.menu: $(srcdir)/invoke-ntptrace.texi
+ @: do-nothing action to avoid default SCCS get, .menu built with .texi
+
+$(srcdir)/invoke-ntptrace.texi: ntptrace $(srcdir)/ntptrace-opts.def $(std_def_list)
+ $(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntptrace-opts.def
+ $(top_srcdir)/scripts/build/check--help $@
+
+### HTML
+
+$(srcdir)/ntptrace.html: $(srcdir)/invoke-ntptrace.menu $(srcdir)/invoke-ntptrace.texi $(srcdir)/ntptrace.texi $(top_srcdir)/sntp/include/version.texi
+ cd $(srcdir) && ( makeinfo --force --html --no-split -I ../sntp -o ntptrace.html ntptrace.texi || true )
--- /dev/null
+
+# DO NOT EDIT THE FOLLOWING
+#
+# It's auto generated option handling code
+
+use Getopt::Long qw(GetOptionsFromArray);
+Getopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always));
+
+my $usage;
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR $usage;
+ exit $ret;
+}
+
+sub paged_usage {
+ my ($ret) = @_;
+ my $pager = $ENV{PAGER} || '(less || more)';
+
+ open STDOUT, "| $pager" or die "Can't fork a pager: $!";
+ print $usage;
+
+ exit $ret;
+}
+
+sub processOptions {
+ my $args = shift;
+
+ my $opts = {
+ 'numeric' => '',
+ 'max-hosts' => '99',
+ 'host' => '127.0.0.1',
+ 'help' => '', 'more-help' => ''
+ };
+ my $argument = '[host]';
+ my $ret = GetOptionsFromArray($args, $opts, (
+ 'numeric|n', 'max-hosts|m=i', 'host|r=s',
+ 'help|?', 'more-help'));
+
+ $usage = <<'USAGE';
+ntptrace - Trace peers of an NTP server
+USAGE: ntptrace [ -<flag> [<val>] | --<name>[{=| }<val>] ]... [host]
+
+ -n, --numeric Print IP addresses instead of hostnames
+ -m, --max-hosts=num Maximum number of peers to trace
+ -r, --host=str Single remote host
+ -?, --help Display usage information and exit
+ , --more-help Pass the extended usage information through a pager
+
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.
+USAGE
+
+ usage(0) if $opts->{'help'};
+ paged_usage(0) if $opts->{'more-help'};
+
+ if ($argument && $argument =~ /^[^\[]/ && !@$args) {
+ print STDERR "Not enough arguments supplied (See --help/-?)\n";
+ exit 1;
+ }
+ $_[0] = $opts;
+ return $ret;
+}
+
+END { close STDOUT };
+
--- /dev/null
+/* -*- Mode: Text -*- */
+autogen definitions perlopt;
+
+//#include copyright.def
+#include autogen-version.def
+
+prog-name = 'ntptrace';
+prog-title = 'Trace peers of an NTP server';
+argument = '[host]';
+long-opts;
+gnu-usage;
+
+flag = {
+ name = numeric;
+ value = n;
+ descrip = 'Print IP addresses instead of hostnames';
+ doc = <<- _EndOfDoc_
+ Output hosts as dotted-quad numeric format rather than converting to
+ the canonical host names.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = max-hosts;
+ value = m;
+ arg-type = number;
+ arg-default = 99;
+ descrip = 'Maximum number of peers to trace';
+};
+
+flag = {
+ name = host;
+ value = r;
+ arg-type = string;
+ arg-default = '127.0.0.1';
+ descrip = 'Single remote host';
+};
+
+doc-section = {
+ ds-type = 'DESCRIPTION';
+ ds-format = 'texi';
+ ds-text = <<- _END_PROG_MDOC_DESCRIP
+@code{ntptrace} is a perl script that uses the ntpq utility program to follow
+the chain of NTP servers from a given host back to the primary time source. For
+ntptrace to work properly, each of these servers must implement the NTP Control
+and Monitoring Protocol specified in RFC 1305 and enable NTP Mode 6 packets.
+
+If given no arguments, ntptrace starts with localhost. Here is an example of
+the output from ntptrace:
+
+@example
+% ntptrace localhost: stratum 4, offset 0.0019529, synch distance 0.144135
+server2ozo.com: stratum 2, offset 0.0124263, synch distance 0.115784 usndh.edu:
+stratum 1, offset 0.0019298, synch distance 0.011993, refid 'WWVB'
+@end example
+
+On each line, the fields are (left to right): the host name, the host stratum,
+the time offset between that host and the local host (as measured by
+@code{ntptrace}; this is why it is not always zero for "localhost"), the host
+synchronization distance, and (only for stratum-1 servers) the reference clock
+ID. All times are given in seconds. Note that the stratum is the server hop
+count to the primary source, while the synchronization distance is the
+estimated error relative to the primary source. These terms are precisely
+defined in RFC-1305.
+ _END_PROG_MDOC_DESCRIP;
+};
--- /dev/null
+#! @PATH_PERL@ -w
+# John Hay -- John.Hay@icomtek.csir.co.za / jhay@FreeBSD.org
+package ntptrace;
+use 5.006_000;
+use strict;
+use lib "@PERLLIBDIR@";
+use NTP::Util qw(ntp_read_vars do_dns);
+
+exit run(@ARGV) unless caller;
+
+sub run {
+ my $opts;
+ if (!processOptions(\@_, $opts)) {
+ usage(1);
+ };
+
+ my $dodns = $opts->{numeric} ? 0 : 1;
+ my $max_hosts = $opts->{'max-hosts'};
+ my $host = shift || $opts->{host};
+ my $nb_host = 0;
+
+ for (;;) {
+ $nb_host++;
+
+ my %info = get_info($host);
+ last if not %info;
+
+ my $dhost = $host;
+ if ($dodns) {
+ my $name = do_dns($host);
+ $dhost = $name if defined $name;
+ }
+
+ printf "%s: stratum %d, offset %f, synch distance %f",
+ $dhost, $info{stratum}, $info{offset}, $info{syncdistance};
+ printf ", refid '%s'", $info{refid} if $info{stratum} == 1;
+ print "\n";
+
+ last if $info{stratum} == 0 || $info{stratum} == 1 ||
+ $info{stratum} == 16;
+ last if $info{refid} =~ /^127\.127\.\d{1,3}\.\d{1,3}$/;
+ last if $nb_host == $max_hosts;
+
+ my $next_host = get_next_host($info{peer}, $host);
+ last if $next_host eq '';
+ last if $next_host =~ /^127\.127\.\d{1,3}\.\d{1,3}$/;
+
+ $host = $next_host;
+ }
+ return 0;
+}
+
+sub get_info {
+ my ($host) = @_;
+ my ($rootdelay, $rootdisp, $info) = (0, 0);
+
+ $info = ntp_read_vars(0, [], $host);
+ return if not defined $info;
+ return if not exists $info->{stratum};
+
+ $info->{offset} /= 1000;
+ $info->{syncdistance} = ($info->{rootdisp} + ($info->{rootdelay} / 2)) / 1000;
+
+ return %$info;
+}
+
+
+sub get_next_host {
+ my ($peer, $host) = @_;
+
+ my $info = ntp_read_vars($peer, [qw(srcadr)], $host);
+ return if not defined $info;
+ return $info->{srcadr};
+}
+
+@ntptrace_opts@
+
+1;
+__END__
--- /dev/null
+.Dd October 2 2013
+.Dt NTPTRACE @NTPTRACE_MS@ User Commands
+.Os FreeBSD 6.4-STABLE
+.\" EDIT THIS FILE WITH CAUTION (ntptrace-opts.mdoc)
+.\"
+.\" It has been AutoGen-ed October 2, 2013 at 09:50:29 PM by AutoGen 5.18.1pre5
+.\" From the definitions ntptrace-opts.def
+.\" and the template file agmdoc-cmd.tpl
+.Sh NAME
+.Nm ntptrace
+.Nd Trace peers of an NTP server
+.Sh SYNOPSIS
+.Nm
+.\" Mixture of short (flag) options and long options
+.Op Fl flags
+.Op Fl flag Op Ar value
+.Op Fl \-option\-name Ns Oo Oo Ns "=| " Oc Ns Ar value Oc
+[host]
+.Pp
+.Sh DESCRIPTION
+\fBntptrace\fP is a perl script that uses the ntpq utility program to follow
+the chain of NTP servers from a given host back to the primary time source. For
+ntptrace to work properly, each of these servers must implement the NTP Control
+and Monitoring Protocol specified in RFC 1305 and enable NTP Mode 6 packets.
+.sp
+If given no arguments, ntptrace starts with localhost. Here is an example of
+the output from ntptrace:
+.sp
+.Bd -literal -offset indent
+% ntptrace localhost: stratum 4, offset 0.0019529, synch distance 0.144135
+server2ozo.com: stratum 2, offset 0.0124263, synch distance 0.115784 usndh.edu:
+stratum 1, offset 0.0019298, synch distance 0.011993, refid 'WWVB'
+.Ed
+.sp
+On each line, the fields are (left to right): the host name, the host stratum,
+the time offset between that host and the local host (as measured by
+\fBntptrace\fP; this is why it is not always zero for "localhost"), the host
+synchronization distance, and (only for stratum\-1 servers) the reference clock
+ID. All times are given in seconds. Note that the stratum is the server hop
+count to the primary source, while the synchronization distance is the
+estimated error relative to the primary source. These terms are precisely
+defined in RFC\-1305.
+.Sh "OPTIONS"
+.Bl -tag
+.It Fl n , Fl \-numeric
+Print IP addresses instead of hostnames.
+.sp
+Output hosts as dotted\-quad numeric format rather than converting to
+the canonical host names.
+.It Fl m Ar number , Fl \-max\-hosts Ns = Ns Ar number
+Maximum number of peers to trace.
+This option takes an integer number as its argument.
+The default
+.Ar number
+for this option is:
+.ti +4
+ 99
+.sp
+This option has not been fully documented.
+.It Fl r Ar string , Fl \-host Ns = Ns Ar string
+Single remote host.
+The default
+.Ar string
+for this option is:
+.ti +4
+ 127.0.0.1
+.sp
+This option has not been fully documented.
+.It Fl \&? , Fl \-help
+Display usage information and exit.
+.It Fl \&! , Fl \-more\-help
+Pass the extended usage information through a pager.
+.El
+.Sh "EXIT STATUS"
+One of the following exit values will be returned:
+.Bl -tag
+.It 0 " (EXIT_SUCCESS)"
+Successful program execution.
+.It 1 " (EXIT_FAILURE)"
+The operation failed or the command syntax was not valid.
+.It 70 " (EX_SOFTWARE)"
+libopts had an internal operational error. Please report
+it to autogen\-users@lists.sourceforge.net. Thank you.
+.El
+.Sh "NOTES"
+This manual page was \fIAutoGen\fP\-erated from the \fBntptrace\fP
+option definitions.
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename ntptrace.info
+@settitle Ntptrace User's Manual
+@include ../../sntp/include/version.texi
+@paragraphindent 2
+@c %**end of header
+
+@ifinfo
+This file documents the use of @code{ntptrace},
+a program from the NTP Project
+@end ifinfo
+
+@direntry
+* ntptrace: (ntptrace). Trace the ntp server to the primary time source.
+@end direntry
+
+@titlepage
+@title ntptrace User's Manual
+@subtitle ntptrace, version @value{VERSION}, @value{UPDATED}
+@c @author Max @email{foo@ntp.org}
+@end titlepage
+
+@c @page
+@c @vskip 0pt plus 1filll
+
+@node Top, ntptrace Description, (dir), (dir)
+@top Simple Network Time Protocol User Manual
+
+This document describes the use of the NTP Project's @code{ntptrace} program.
+This document applies to version @value{VERSION} of @code{ntptrace}.
+
+@shortcontents
+
+@menu
+* ntptrace Description:: Description
+* ntptrace Invocation:: Invoking ntptrace
+@end menu
+
+@include invoke-ntptrace.texi
--- /dev/null
+
+# DO NOT EDIT THE FOLLOWING
+#
+# It's auto generated option handling code
+
+use Getopt::Long qw(GetOptionsFromArray);
+Getopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always));
+
+my $usage;
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR $usage;
+ exit $ret;
+}
+
+sub paged_usage {
+ my ($ret) = @_;
+ my $pager = $ENV{PAGER} || '(less || more)';
+
+ open STDOUT, "| $pager" or die "Can't fork a pager: $!";
+ print $usage;
+
+ exit $ret;
+}
+
+sub processOptions {
+ my $args = shift;
+
+ my $opts = {
+ 'directory' => '/tmp',
+ 'identifier' => '',
+ 'offset-limit' => '0.128',
+ 'peer' => [],
+ 'plot-term' => '',
+ 'output-file' => '',
+ 'dont-wait' => '',
+ 'help' => '', 'more-help' => ''
+ };
+ my $argument = '';
+ my $ret = GetOptionsFromArray($args, $opts, (
+ 'directory=s', 'identifier=s', 'offset-limit=f',
+ 'peer=s', 'plot-term=s', 'output-file=s',
+ 'dont-wait',
+ 'help|?', 'more-help'));
+
+ $usage = <<'USAGE';
+plot_summary - plot statistics generated by summary script
+USAGE: plot_summary [ -<flag> [<val>] | --<name>[{=| }<val>] ]...
+
+ , --directory=str Where the summary files are
+ , --identifier=str Origin of the data
+ , --offset-limit=float Limit of absolute offset
+ , --peer=str Peers to generate plots for
+ - may appear multiple times
+ , --plot-term=str Gnuplot terminal
+ , --output-file=str Output file
+ , --dont-wait Don't wait for keystroke between plots
+ -?, --help Display usage information and exit
+ , --more-help Pass the extended usage information through a pager
+
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.
+USAGE
+
+ usage(0) if $opts->{'help'};
+ paged_usage(0) if $opts->{'more-help'};
+ $_[0] = $opts;
+ return $ret;
+}
+
+END { close STDOUT };
+
--- /dev/null
+/* -*- Mode: Text -*- */
+autogen definitions perlopt;
+#include autogen-version.def
+prog-name = 'plot_summary';
+prog-title = 'plot statistics generated by summary script';
+long-opts;
+gnu-usage;
+
+flag = {
+ name = directory;
+ arg-type = string;
+ arg-default = '/tmp';
+ descrip = 'Where the summary files are';
+ doc = <<- _EndOfDoc_
+ The directory where the @code{plot_summary} will search for the
+ *_summary files generated by @code{summary} script.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = identifier;
+ arg-type = string;
+ descrip = 'Origin of the data';
+ doc = <<- _EndOfDoc_
+ Where does the plotted data come from, default to string "host" plus
+ current hostname
+ _EndOfDoc_;
+};
+
+flag = {
+ name = offset-limit;
+ arg-type = string;
+ arg-name = float;
+ arg-default = "0.128";
+ descrip = 'Limit of absolute offset';
+ doc = <<- _EndOfDoc_
+ _EndOfDoc_;
+};
+
+flag = {
+ name = peer;
+ arg-type = string;
+ stack-arg;
+ max = NOLIMIT;
+ descrip = 'Peers to generate plots for';
+ doc = <<- _EndOfDoc_
+ By default the peer_summary plots are not generated. Use this option to
+ specify list of peers if you want to generate plots for them.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = plot-term;
+ arg-type = string;
+ descrip = 'Gnuplot terminal';
+ doc = <<- _EndOfDoc_
+ This is string is passed directly to the @code{gnuplot set terminal}
+ command. Default is @code{x11} if @code{DISPLAY} is set and
+ @code{dumb} is it's not'. See output from @code(gnuplot -e "set
+ terminal") for the list of avalaible options.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = output-file;
+ arg-type = str;
+ descrip = 'Output file';
+ doc = <<- _EndOfDoc_
+ Output file for @code{gnuplot}, default to stdout.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = dont-wait;
+ descrip = "Don't wait for keystroke between plots";
+ doc = <<- _EndOfDoc_
+ _EndOfDoc_;
+};
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-require 5.003; # "never tested with any other version of Perl"
+package plot_summary;
+use 5.006_000;
use strict;
-
use Time::Local;
-use Getopt::Long;
-# parse command line
-my $summary_dir = "/tmp";
-my $identifier = "host " . `hostname`; # origin of these data
-chomp $identifier; # remove newline
-my $offset_limit = 0.128; # limit of absolute offset
-my $output_file = ""; # output file defaults to stdout
-my $output_file_number = 1; # numbering of output files
-my $gnuplot_terminal = $ENV{DISPLAY} ? "x11" : "dumb";
-my $wait_after_plot = 1;
-my @peer_list = ();
+my ($identifier, $offset_limit, $gnuplot_terminal, $wait_after_plot,
+ $output_file, $output_file_number);
-my %options = ("directory|input-directory=s" => \$summary_dir,
- "identifier=s" => \$identifier,
- "offset-limit=f" => \$offset_limit,
- "output-file=s" => \$output_file,
- "peer=s@" => \@peer_list,
- "plot-term|gnuplot-term=s" => \$gnuplot_terminal,
- "wait-after-plot!" => \$wait_after_plot,
- );
+exit run(@ARGV) unless caller;
-if ( !GetOptions(%options) )
-{
- print STDERR "valid options for $0 are:\n";
- my $opt;
- foreach $opt (sort(keys %options)) {
- print STDERR "\t--$opt\t(default is ";
- if ( ref($options{$opt}) eq "ARRAY" ) {
- print STDERR join(", ", map { "'$_'" } @{$options{$opt}});
- } else {
- print STDERR "'${$options{$opt}}'";
- }
- print STDERR ")\n";
+sub run {
+ my $opts;
+ if (!processOptions(\@_, $opts)) {
+ usage(1);
}
- print STDERR "\n";
- die;
-}
-chomp $identifier;
-die "illegal offset-limit: $offset_limit" unless $offset_limit > 0.0;
-$offset_limit *= 1e6; # scale to microseconds
+ $identifier = $opts->{'identifier'};
+ if (!$identifier) {
+ $identifier = "host".`hostname`;
+ chomp $identifier;
+ }
+ $offset_limit = $opts->{'offset-limit'};
+ $output_file = $opts->{'output-file'};
+ $output_file_number = 1;
+ $gnuplot_terminal = $opts->{'plot-terminal'}
+ || ( $ENV{DISPLAY} ? "x11" : "dumb" );
+ $wait_after_plot = !$opts->{'dont-wait'};
+
+ die "illegal offset-limit: $offset_limit" unless $offset_limit > 0.0;
+ $offset_limit *= 1e6; # scale to microseconds
+
+ my $summary_dir = $opts->{'directory'};
+
+ my $loop_summary ="$summary_dir/loop_summary";
+ my $peer_summary ="$summary_dir/peer_summary";
+ my $clock_summary="$summary_dir/clock_summary";
+
+ my @peer_list = @{$opts->{'peer'}};
+
+ do_loop($loop_summary);
+ do_peer($peer_summary, $_) for @peer_list;
+}
# return the smallest value in the given list
sub min
"Daily mean values since $first_day\\n" .
"(Offset limit is $offset_limit microseconds)\"\n";
print "set ylabel \"[us]\"\n";
- print "set data style yerrorbars\n";
+ print "set style data yerrorbars\n";
print "set multiplot\n";
print "set size 1, 0.5\n";
print "set lmargin 8\n";
print "set xlabel\n";
print "set ylabel \"[us]\"\n";
print "set origin 0, 0.5\n";
- print "set data style linespoints\n";
+ print "set style data linespoints\n";
print "set multiplot\n";
print "plot $ylimit \"$out_file\" using 1:6 title \"Offset\", ";
print "\"$out_file\" using 1:6 smooth bezier " .
print "set origin 0, 0.66\n";
print "set title " .
"\"Peer Summary for $peer on $identifier since $first_day\"\n";
- print "set data style linespoints\n";
+ print "set style data linespoints\n";
print "set ylabel \"[us]\"\n";
print "plot \"$out_file\" using 1:3 title \"mean offset\", ";
print "\"$out_file\" using 1:3 smooth bezier " .
unlink $out_file;
}
+@plot_summary_opts@
-my $loop_summary ="$summary_dir/loop_summary";
-my $peer_summary ="$summary_dir/peer_summary";
-my $clock_summary="$summary_dir/clock_summary";
-
-do_loop $loop_summary;
-map { do_peer $peer_summary, $_ } @peer_list;
+1;
+__END__
--- /dev/null
+This directory contains some example rc scripts for ntpd.
+
+In general, ntpd should be started as soon as possible in the boot process. If
+any services require stable system clock, the ntpwait script should be run
+before them as late as possible.
+
+The rc.d contains scripts for systems using rc.d init system (originated in
+NetBSD). If a service requires stable system time, indicate it with TIMESYNC
+dependency and set ntpwait_enable to YES.
+
+For SysV init systems, you'll have to create links as /etc/rc2.d/S20ntpd and
+/etc/rc2.d/S80ntpwait yourself. (The numbers are just examples, try to give
+ntpd as much time as possible to synchronize before running ntpwait).
--- /dev/null
+#!/bin/sh
+
+NTPD=/usr/sbin/ntpd
+PIDFILE=/var/run/ntpd.pid
+USER=ntp
+GROUP=ntp
+NTPD_OPTS="-g -u $USER:$GROUP -p $PIDFILE"
+
+ntpd_start() {
+ if [ -r $PIDFILE ]; then
+ echo "ntpd seems to be already running under pid `cat $PIDFILE`."
+ echo "Delete $PIDFILE if this is not the case.";
+ return 1;
+ fi
+ echo -n "Starting NTP daemon... "
+
+ $NTPD $NTPD_OPTS
+
+ # You can't always rely on the ntpd exit code, see Bug #2420
+ # case "$?" in
+ # 0) echo "OK!"
+ # return 0;;
+ # *) echo "FAILED!"
+ # return 1;;
+ # esac
+
+ sleep 1
+
+ if ps -Ao args|grep -q "^$NTPD $NTPD_OPTS"; then
+ echo "OK!"
+ return 0
+ else
+ echo "FAILED!"
+ [ -e $PIDFILE ] && rm $PIDFILE
+ return 1
+ fi
+}
+
+ntpd_stop() {
+ if [ ! -r $PIDFILE ]; then
+ echo "ntpd doesn't seem to be running, cannot read the pid file."
+ return 1;
+ fi
+ echo -n "Stopping NTP daemon...";
+ PID=`cat $PIDFILE`
+
+ if kill -TERM $PID 2> /dev/null;then
+ # Give ntp 15 seconds to exit
+ for i in `seq 1 15`; do
+ if [ -n "`ps -p $PID|grep -v PID`" ]; then
+ echo -n .
+ sleep 1
+ else
+ echo " OK!"
+ rm $PIDFILE
+ return 0
+ fi
+ done
+ fi
+
+ echo " FAILED! ntpd is still running";
+ return 1
+}
+
+ntpd_status() {
+ if [ -r $PIDFILE ]; then
+ echo "NTP daemon is running as `cat $PIDFILE`"
+ else
+ echo "NTP daemon is not running"
+ fi
+}
+
+case "$1" in
+ 'start')
+ ntpd_start
+ ;;
+ 'stop')
+ ntpd_stop
+ ;;
+ 'restart')
+ ntpd_stop && ntpd_start
+ ;;
+ 'status')
+ ntpd_status
+ ;;
+ *)
+ echo "Usage: $0 (start|stop|restart|status)"
+esac
--- /dev/null
+#!/bin/sh
+
+NTPWAIT=/usr/sbin/ntpwait
+
+ntpwait_start() {
+ $NTPWAIT -v
+}
+
+case "$1" in
+ 'start')
+ ntpwait_start
+ ;;
+ *)
+ echo "Usage: $0 (start)"
+esac
--- /dev/null
+#!/bin/sh
+
+# PROVIDE: TIMESYNC
+# REQUIRE: LOGIN ntpwait
+
+# This depedency ensures that all services which require stable system clock
+# are run after ntpd is synchronized. It's run as late as possible, if you need
+# stable clock before login use BEFORE: LOGIN
--- /dev/null
+#!/bin/sh
+
+# PROVIDE: ntpd
+# REQUIRE: syslogd cleanvar devfs
+# BEFORE: SERVERS
+
+. /etc/rc.subr
+
+name="ntpd"
+rcvar="ntpd_enable"
+command="/usr/sbin/${name}"
+pidfile="/var/run/${name}.pid"
+start_precmd="ntpd_precmd"
+
+load_rc_config $name
+
+ntpd_precmd()
+{
+ rc_flags="-c ${ntpd_config} ${ntpd_flags}"
+
+ if checkyesno ntpd_sync_on_start; then
+ rc_flags="-g $rc_flags"
+ fi
+
+ if [ -z "$ntpd_chrootdir" ]; then
+ return 0;
+ fi
+
+ rc_flags="-u ntpd:ntpd -i ${ntpd_chrootdir} $rc_flags"
+}
+
+run_rc_command "$1"
--- /dev/null
+#!/bin/sh
+# This script, when run, runs ntp-wait if ntpd is enabled.
+
+# PROVIDE: ntpwait
+
+. /etc/rc.subr
+
+name="ntpwait"
+rcvar="ntpwait_enable"
+start_cmd="ntpwait_start"
+ntp_wait="/usr/sbin/ntp-wait"
+
+load_rc_config "$name"
+
+ntpwait_start() {
+ if checkyesno ntpd_enable; then
+ $ntp_wait -v
+ fi
+}
+
+run_rc_command "$1"
-#!/bin/sh
-/etc/init.d/xntp start
-#!/bin/sh
-if [ -x /etc/init.d/xntp ]
-then
- /etc/init.d/xntp stop
-fi
-exit 0
-#!/bin/sh
-/etc/init.d/xntp stop
-
-exit 0
-!default 755 root bin
-i pkginfo
-i preinstall
-i postinstall
-i preremove
-f none /etc/init.d/xntp=xntp 0755 root other
-l none /etc/rc2.d/S79xntp=/etc/init.d/xntp
-l none /etc/rc1.d/K79xntp=/etc/init.d/xntp
-l none /etc/rc0.d/K79xntp=/etc/init.d/xntp
-f none /usr/sbin/xntpd=xntpd/xntpd 0555 root other
-f none /usr/sbin/xntpdc=xntpdc/xntpdc 0555 root other
-f none /usr/sbin/ntpq=ntpq/ntpq 0555 root other
-f none /usr/sbin/ntptrace=ntptrace/ntptrace 0555 root other
-f none /usr/sbin/ntpdate=ntpdate/ntpdate 0555 root other
-f none /usr/share/man/man1m/xntpd.1m=doc/xntpd.8 0444 root other
-f none /usr/share/man/man1m/xntpdc.1m=doc/xntpdc.8 0444 root other
-f none /usr/share/man/man1m/ntpdate.1m=doc/ntpdate.8 0444 root other
-f none /usr/share/man/man1m/ntpq.1m=doc/ntpq.8 0444 root other
-f none /usr/share/man/man1m/ntptrace.1m=doc/ntptrace.8 0444 root other
-#!/bin/sh
-
-killproc() { # kill named processes
- pid=`/usr/bin/ps -e |
- /usr/bin/grep $1 |
- /usr/bin/sed -e 's/^ *//' -e 's/ .*//'`
- [ "$pid" != "" ] && kill $pid
-}
-
-case "$1" in
-'start')
- ps -e | grep xntpd > /dev/null 2>&1
- if [ $? -eq 0 ]
- then
- echo "ntp daemon already running. ntp start aborted"
- exit 0
- fi
- if [ -f /etc/inet/ntp.conf -a -x /usr/sbin/xntpd ]
- then
- /usr/sbin/xntpd -c /etc/inet/ntp.conf
- fi
- ;;
-'stop')
- killproc xntpd
- ;;
-*)
- echo "Usage: /etc/init.d/xntp { start | stop }"
- ;;
-esac
-#! /usr/bin/perl -w
-# 980904 Harlan Stenn - created
-
-# vvv CHANGE THESE vvv
-
-$ps = "/bin/ps x |";
-
-$ntp_conf = "/etc/ntp.conf";
-$ntpd = "/usr/local/bin/xntpd";
-$ntpdate = "/usr/local/bin/ntpdate -b -s 10.0.0.1 10.0.0.2";
-
-# ^^^ CHANGE THESE ^^^
-
-{
- if (0)
- {
- }
- elsif ($ARGV[0] eq "start")
- {
- @pidlist = pidlist($ntpd);
- if (defined(@pidlist))
- {
- warn "NTP is already running\n";
- }
- else
- {
- if ( -f $ntp_conf && -x $ntpd )
- {
- system ($ntpdate);
- system ($ntpd." -c ".$ntp_conf);
- }
- }
- }
- elsif ($ARGV[0] eq "stop")
- {
- @pidlist = pidlist($ntpd);
- kill 'TERM', @pidlist if (scalar(@pidlist) > 0);
- }
- else
- {
- die "Usage: $0 {start,stop}\n";
- }
-}
-
-sub pidlist ($)
- {
- my ($target) = @_;
- my ($qt) = quotemeta($target);
- my @pids;
-
- open(PS, $ps) || die "Can't run ps: $!\n";
- while (<PS>)
- {
- chomp;
- next unless (/$qt/);
- print "Got <$_>\n";
- if (/^\s*(\d+)\s+/)
- {
- push @pids, $1;
- }
- }
- close(PS);
- return @pids;
- }
--- /dev/null
+
+# DO NOT EDIT THE FOLLOWING
+#
+# It's auto generated option handling code
+
+use Getopt::Long qw(GetOptionsFromArray);
+Getopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always));
+
+my $usage;
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR $usage;
+ exit $ret;
+}
+
+sub paged_usage {
+ my ($ret) = @_;
+ my $pager = $ENV{PAGER} || '(less || more)';
+
+ open STDOUT, "| $pager" or die "Can't fork a pager: $!";
+ print $usage;
+
+ exit $ret;
+}
+
+sub processOptions {
+ my $args = shift;
+
+ my $opts = {
+ 'directory' => '/var/log/ntp',
+ 'end-date' => '',
+ 'output-directory' => '/tmp',
+ 'peer-dist-limit' => '400',
+ 'skip-time-steps' => '3600',
+ 'start-date' => '19700101',
+ 'help' => '', 'more-help' => ''
+ };
+ my $argument = '';
+ my $ret = GetOptionsFromArray($args, $opts, (
+ 'directory=s', 'end-date=i', 'output-directory=s',
+ 'peer-dist-limit=f', 'skip-time-steps=f', 'start-date=i',
+ 'help|?', 'more-help'));
+
+ $usage = <<'USAGE';
+summary - compute various stastics from NTP stat files
+USAGE: summary [ -<flag> [<val>] | --<name>[{=| }<val>] ]...
+
+ , --directory=str Directory containing stat files
+ , --end-date=num End date
+ , --output-directory=str Output directory
+ , --peer-dist-limit=float Peer dist limit
+ , --skip-time-steps=float Ignore time offsets larger that this
+ , --start-date=num Start date
+ -?, --help Display usage information and exit
+ , --more-help Pass the extended usage information through a pager
+
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.
+USAGE
+
+ usage(0) if $opts->{'help'};
+ paged_usage(0) if $opts->{'more-help'};
+ $_[0] = $opts;
+ return $ret;
+}
+
+END { close STDOUT };
+
--- /dev/null
+/* -*- Mode: Text -*- */
+autogen definitions perlopt;
+#include autogen-version.def
+prog-name = 'summary';
+prog-title = 'compute various stastics from NTP stat files';
+long-opts;
+gnu-usage;
+
+flag = {
+ name = directory;
+ arg-type = string;
+ arg-default = '/var/log/ntp';
+ descrip = 'Directory containing stat files';
+ doc = <<- _EndOfDoc_
+ The directory where @code{ntpd} will search for .stat files generated
+ by @code{ntpd}.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = end-date;
+ arg-type = number;
+ descrip = 'End date';
+ doc = <<- _EndOfDoc_
+ Process all files with the date suffix less or equal to value of this
+ option. Defaults to today minus one day (Use @code{date -u +%Y%m%d})
+ to get the timestamp.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = output-directory;
+ arg-type = str;
+ arg-default = '/tmp';
+ descrip = 'Output directory';
+ doc = <<- _EndOfDoc_
+ The output directory @code{summary} will write all output files to.
+ _EndOfDoc_;
+};
+
+flag = {
+ name = peer-dist-limit;
+ arg-type = string;
+ arg-name = float;
+ arg-default = 400;
+ descrip = 'Peer dist limit';
+ doc = <<- _EndOfDoc_
+ _EndOfDoc_;
+};
+
+flag = {
+ name = skip-time-steps;
+ arg-type = string;
+ arg-name = float;
+ arg-default = 3600;
+ descrip = 'Ignore time offsets larger that this';
+ doc = <<- _EndOfDoc_
+ _EndOfDoc_;
+};
+
+flag = {
+ name = start-date;
+ arg-type = num;
+ arg-default = 19700101;
+ descrip = 'Start date';
+ doc = <<- _EndOfDoc_
+ Process all files with the date suffix more or equal to value of
+ this option. Defaults to 197000101.
+ _EndOfDoc_;
+};
+
+doc-section = {
+ ds-type = 'DESCRIPTION';
+ ds-format = 'texi';
+ ds-text = <<- _EndOfDoc
+ _EndOfDoc;
+};
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-require 5.003; # "never tested with any other version of Perl"
+package summary;
+use 5.006_000;
use strict;
-use Getopt::Long;
+my ($log_date_pattern, $statsdir, $outputdir, $skip_time_steps, $startdate,
+ $enddate, $peer_dist_limit);
-my $log_date_pattern = '[12]\d{3}[01]\d[0-3]\d';
-my $statsdir = "/var/log/ntp"; # directory with input files
-my $outputdir = "/tmp"; # directory for output files
-my $skip_time_steps = 3600.0; # ignore time offsets larger that this
-my $startdate = "19700101"; # first data file to use (YYYYMMDD)
-my $enddate=`date -u +%Y%m%d`; chomp $enddate; --$enddate;
-my $peer_dist_limit = 400.0;
+exit run(@ARGV) unless caller;
-my %options = ("directory|input-directory=s" => \$statsdir,
- "output-directory=s" => \$outputdir,
- "skip-time-steps:f" => \$skip_time_steps,
- "start-date=s" => \$startdate,
- "end-date=s" => \$enddate,
- "peer-dist-limit=f" => \$peer_dist_limit);
+sub run {
+ my $opts;
+ if (!processOptions(\@ARGV, $opts)) {
+ usage(1);
+ };
-if ( !GetOptions(%options) )
-{
- print STDERR "valid options for $0 are:\n";
- my $opt;
- foreach $opt (sort(keys %options)) {
- print STDERR "\t--$opt\t(default is ";
- if ( ref($options{$opt}) eq "ARRAY" ) {
- print STDERR join(", ", map { "'$_'" } @{$options{$opt}});
- } else {
- print STDERR "'${$options{$opt}}'";
- }
- print STDERR ")\n";
+ $log_date_pattern = '[12]\d{3}[01]\d[0-3]\d';
+ $statsdir = $opts->{directory};
+ $outputdir = $opts->{'output-directory'};
+ $skip_time_steps = $opts->{'skip-time-steps'};
+ $startdate = $opts->{'start-date'};
+ $enddate = $opts->{'end-date'};
+ if (!$enddate){
+ $enddate = `date -u +%Y%m%d`;
+ chomp $enddate;
+ --$enddate;
}
- print STDERR "\n";
- die;
-}
+ $peer_dist_limit = $opts->{'peer-dist-limit'};
+
+ # check possibly current values of options
+ die "$statsdir: no such directory" unless (-d $statsdir);
+ die "$outputdir: no such directory" unless (-d $outputdir);
+ die "$skip_time_steps: skip-time-steps must be positive"
+ unless ($skip_time_steps >= 0.0);
+ die "$startdate: invalid start date|$`|$&|$'"
+ unless ($startdate =~ m/.*$log_date_pattern$/);
+ die "$enddate: invalid end date"
+ unless ($enddate =~ m/.*$log_date_pattern$/);
+
+ $skip_time_steps = 0.128 if ($skip_time_steps == 0);
+
+ my $loop_summary="$outputdir/loop_summary";
+ my $peer_summary="$outputdir/peer_summary";
+ my $clock_summary="$outputdir/clock_summary";
+ my (@loopfiles, @peerfiles, @clockfiles);
-# check possibly current values of options
-die "$statsdir: no such directory" unless (-d $statsdir);
-die "$outputdir: no such directory" unless (-d $outputdir);
-die "$skip_time_steps: skip-time-steps must be positive"
- unless ($skip_time_steps >= 0.0);
-die "$startdate: invalid start date|$`|$&|$'"
- unless ($startdate =~ m/.*$log_date_pattern$/);
-die "$enddate: invalid end date"
- unless ($enddate =~ m/.*$log_date_pattern$/);
+ print STDERR "Creating summaries from $statsdir ($startdate to $enddate)\n";
-$skip_time_steps = 0.128 if ($skip_time_steps == 0);
+ opendir SDIR, $statsdir or die "directory ${statsdir}: $!";
+ rewinddir SDIR;
+ @loopfiles=sort grep /loop.*$log_date_pattern/, readdir SDIR;
+ rewinddir SDIR;
+ @peerfiles=sort grep /peer.*$log_date_pattern/, readdir SDIR;
+ rewinddir SDIR;
+ @clockfiles=sort grep /clock.*$log_date_pattern/, readdir SDIR;
+ closedir SDIR;
+
+ # remove old summary files
+ for ($loop_summary, $peer_summary, $clock_summary) { unlink $_ if -f $_ };
+
+ my $date;
+ for (@loopfiles) {
+ $date = $_; $date =~ s/.*($log_date_pattern)$/$1/;
+ if ($date ge $startdate && $date le $enddate) {
+ do_loop($statsdir, $_, $loop_summary);
+ }
+ }
+
+ for (@peerfiles) {
+ $date = $_; $date =~ s/.*($log_date_pattern)$/$1/;
+ if ($date ge $startdate && $date le $enddate) {
+ do_peer($statsdir, $_, $peer_summary);
+ }
+ }
+
+ for (@clockfiles) {
+ $date = $_; $date =~ s/.*($log_date_pattern)$/$1/;
+ if ($date ge $startdate && $date le $enddate) {
+ do_clock($statsdir, $_, $clock_summary);
+ }
+ }
+
+ print STDERR "Creating peer summary with limit $peer_dist_limit\n";
+ peer_summary($peer_summary) if (-f $peer_summary);
+}
sub min
{
print sort @lines;
}
-my $loop_summary="$outputdir/loop_summary";
-my $peer_summary="$outputdir/peer_summary";
-my $clock_summary="$outputdir/clock_summary";
-my (@loopfiles, @peerfiles, @clockfiles);
-
-print STDERR "Creating summaries from $statsdir ($startdate to $enddate)\n";
-
-opendir SDIR, $statsdir or die "directory ${statsdir}: $!";
-rewinddir SDIR;
-@loopfiles=sort grep /loop.*$log_date_pattern/, readdir SDIR;
-rewinddir SDIR;
-@peerfiles=sort grep /peer.*$log_date_pattern/, readdir SDIR;
-rewinddir SDIR;
-@clockfiles=sort grep /clock.*$log_date_pattern/, readdir SDIR;
-closedir SDIR;
-
-# remove old summary files
-map { unlink $_ if -f $_ } ($loop_summary, $peer_summary, $clock_summary);
-
-my $date;
-map {
- $date = $_; $date =~ s/.*($log_date_pattern)$/$1/;
- if ($date ge $startdate && $date le $enddate) {
- do_loop $statsdir, $_, $loop_summary;
- }
-} @loopfiles;
-
-map {
- $date = $_; $date =~ s/.*($log_date_pattern)$/$1/;
- if ($date ge $startdate && $date le $enddate) {
- do_peer $statsdir, $_, $peer_summary;
- }
-} @peerfiles;
-
-map {
- $date = $_; $date =~ s/.*($log_date_pattern)$/$1/;
- if ($date ge $startdate && $date le $enddate) {
- do_clock $statsdir, $_, $clock_summary;
- }
-} @clockfiles;
+@summary_opts@
-print STDERR "Creating peer summary with limit $peer_dist_limit\n";
-peer_summary $peer_summary if (-f $peer_summary);
+1;
+__END__
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 30;
+use Test::Command;
+use List::MoreUtils qw(any);
+
+my @script_list = qw(
+ calc_tickadj/calc_tickadj ntp-wait/ntp-wait ntpsweep/ntpsweep
+ ntptrace/ntptrace summary plot_summary
+);
+
+for my $script (@script_list) {
+ fail("$script not a regular file") if (!-f $script);
+ pass("$script is a regular file");
+ fail("$script not an executabe") if (!-x $script);
+ pass("$script is an executable");
+ fail("$script is not readable") if (!-r $script);
+ pass("$script is readable");
+
+ TODO: {
+ #todo_skip "$script - Broken script/no perl", 2
+ # if any { $script eq $_ } qw(freq_adj ntp-groper ntp-status plot_summary);
+
+ require_ok("./$script");
+ cmd_is("./$script --rubbish", '', qr/^Unknown option:/, 1,
+ "$script reports unkown option");
+ }
+}
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 21;
+use Test::Util qw(check_help override);
+use Test::Command;
+use Test::Output;
+
+my $script_name = "calc_tickadj/calc_tickadj";
+
+my @options = (
+ [qw(drift-file=str d)],
+ [qw(tick=num t)]
+);
+
+check_help($script_name, @options);
+
+require_ok("./$script_name");
+
+BEGIN {
+ my ($tick, $drift, $drift_file, $open_fail);
+
+ override('calc_tickadj', open => sub (*;@) {
+ return if $open_fail;
+ is($_[1], $drift_file) if defined $drift_file;
+ CORE::open $_[0], '<', \$drift;
+ });
+
+ override('calc_tickadj', readpipe => sub {
+ return $tick;
+ });
+
+ sub run_calc_tickadj {
+ my %opts = @_;
+ $open_fail = delete $opts{fail_open} || 0;
+ $drift = delete $opts{drift} || '0.00';
+ $tick = delete $opts{tick} || '';
+ $drift_file = delete $opts{drift_file};
+ calc_tickadj::run(@{ delete $opts{opts} || [] })
+ }
+}
+
+my $ret;
+
+# Test tick detection
+for (
+ 'tick = 10000',
+ 'PRESET tick = 10000',
+ 'KERNEL tick = 10000',
+ ' tick = 10000',
+) {
+ stdout_like( sub { $ret = run_calc_tickadj(tick => $_) }, qr/10000 usec; 10000000 nsec/ );
+ ok(!$ret);
+}
+
+# Test how the script copes if tickadj is not found/outputs invalid data
+for (undef, "Invalid stuff") {
+ eval {
+ run_calc_tickadj(tick => $_);
+ } or do {
+ chomp $@;
+ is($@, 'Could not get tick value, try manually with -t/--tick')
+ };
+
+ # Still invalid data but pass tick as argument
+ stdout_like( sub { $ret = run_calc_tickadj(tick => $_, opts => [qw(-t 9999)]) }, qr/9999 usec; 9999000 nsec/);
+ ok(!$ret);
+}
+
+# Test -d switch
+stdout_like(
+ sub { $ret = run_calc_tickadj(drift_file => 'foobar', drift => '14.00', tick => 'tick = 10000', opts => [qw(-d foobar)]) },
+ qr/14.000 \(drift\)/
+);
+ok(!$ret);
+
+# Open on drift file fails
+eval {
+ run_calc_tickadj(fail_open => 1, opts => [qw(-t 10000)]);
+} or do {
+ chomp $@;
+ like($@, qr(Could not open))
+};
+
+# Open succeeds but drift file is invalid
+eval {
+ run_calc_tickadj(drift => 'NOTVALIDDRIFTVALUE', opts => [qw(-t 10000)])
+} or do {
+ chomp $@;
+ like($@, qr(Invalid drift file value <NOTVALIDDRIFTVALUE>));
+};
--- /dev/null
+package Test::Command;
+use strict;
+use warnings;
+use Test::Builder;
+use IPC::Open3;
+use IO::Handle;
+use Carp;
+use base qw(Exporter);
+our @EXPORT = qw(cmd_is start_command com_stdout_is com_stderr_is com_ret_is
+ com_slurp_stderr com_slurp_stdout wait_for_command);
+our $VERSION = 0.1;
+
+my $Test = Test::Builder->new();
+
+my ($pid, $writer_h, $stdout_h, $stderr_h);
+my $in_command = 0;
+
+$SIG{CHLD} = sub { wait_for_command() if $in_command; };
+
+sub start_command {
+ my (@cmd) = @_;
+
+ croak "Specify a command to start_command" unless @cmd;
+
+ ($pid, $writer_h, $stdout_h, $stderr_h) =
+ (0, IO::Handle->new(), IO::Handle->new(), IO::Handle->new());
+
+ # Older IPC:Open3 just warns is there was an error
+ local $SIG{__WARN__} = sub { die @_ };
+
+ $in_command = 1;
+ $pid = open3($writer_h, $stdout_h, $stderr_h, @cmd);
+}
+
+sub wait_for_command {
+ waitpid $pid, 0;
+ my $ret = $? >> 8;
+ if (com_slurp_stderr() =~ /^open3: (.+)$/) {
+ croak $1
+ }
+ return $ret;
+}
+
+sub com_ret_is {
+ my ($ex_ret, $descr) = @_;
+
+ local $SIG{CHLD} = 'IGNORE';
+ my $ret = wait_for_command;
+ $Test->ok(_test_ret($ret, $ex_ret), $descr);
+}
+
+sub com_stdout_is {
+ my ($ex_stdout, $descr) = @_;
+
+ my $stdout = com_slurp_stdout();
+ $Test->ok(_test_string($stdout, $ex_stdout, 'STDOUT'), $descr);
+}
+
+sub com_stderr_is {
+ my ($ex_stderr, $descr) = @_;
+
+ my $stderr = com_slurp_stderr();
+ $Test->ok(_test_string($stderr, $ex_stderr, 'STDERR'), $descr);
+}
+
+{
+ my $stderr;
+ sub com_slurp_stderr {
+ $stderr or $stderr = _slurp_fh($stderr_h);
+ }
+}
+{
+ my $stdout;
+ sub com_slurp_stdout {
+ $stdout or $stdout = _slurp_fh($stdout_h);
+ }
+}
+
+sub _test_one {
+ my ($s, $ex, $name) = @_;
+ my $diag = defined $ex && _test_string($s, $ex);
+ if ($diag) {
+ $Test->diag("$name doesn't match\n$diag\n");
+ return 0;
+ }
+ return 1;
+}
+
+sub cmd_is {
+ my ($cmd, $ex_stdout, $ex_stderr, $ex_ret, $descr);
+
+ if (ref $_[0] eq 'HASH') {
+ my %args = %{ $_[0] };
+ ($cmd, $ex_stdout, $ex_stderr, $ex_ret, $descr) =
+ @args{qw(run stdout stderr ret descr)};
+ }
+ else {
+ ($cmd, $ex_stdout, $ex_stderr, $ex_ret, $descr) = @_;
+ }
+
+
+ local $SIG{CHLD} = 'DEFAULT';
+ start_command($cmd);
+
+ my $stdout = com_slurp_stdout;
+ my $stderr = $stderr_h ? com_slurp_stderr : '';
+ my $ret = wait_for_command;
+ my $ok = 1;
+
+ _test_string($stdout, $ex_stdout, 'STDOUT') or $ok = 0;
+ _test_string($stderr, $ex_stderr, 'STDERR') or $ok = 0;
+ _test_ret($ret, $ex_ret) or $ok = 0;
+
+ $Test->ok($ok, $descr);
+}
+
+sub _slurp_fh {
+ my $fh = shift;
+ do { local $/; <$fh> }
+}
+
+sub _test_ret {
+ my ($got, $exp) = @_;
+
+ return 1 if not defined $exp;
+
+ if ($got != $exp) {
+ return $Test->diag(<<DIAG);
+Return value doesn't match
+Expected: $exp
+Got: $got
+DIAG
+ }
+ return 1;
+}
+
+sub _test_string {
+ my ($got, $exp, $name) = @_;
+
+ return 1 if not defined $exp;
+
+ if (ref $exp eq 'Regexp') {
+ if ($got !~ $exp) {
+ return $Test->diag(<<DIAG);
+$name doesn't match.
+Expected: '$exp'
+Got: '$got'
+DIAG
+ }
+ }
+ elsif (ref $exp eq 'CODE') {
+ if (!(my $ret = $exp->($got))) {
+ return $Test->diag(<<DIAG);
+$name doesn't match.
+Expected CODE to return true value
+Got: '$ret'
+DIAG
+ }
+ }
+ else {
+ if ($got ne $exp) {
+ return $Test->diag(<<DIAG);
+$name doesn't match.
+Expected: '$exp'
+Got: '$got'
+DIAG
+ }
+ }
+ return 1;
+}
+
+1;
+__END__
+=head1 NAME
+
+Test::Command - Test output and ret value of an external command.
+
+=head1 VERSION
+
+Version 0.1
+
+=head1 SYNOPSIS
+
+ use Test::More tests => 1;
+ use Test::Command;
+
+ cmd_is('ls', '.\n..', '', 0, "ls on empty directory");
+ cmd_is({run => 'ls', stdout => '.\n..', ret => 0});
+
+ start_command('ls');
+ ...
+ wait_for_command;
+ com_stdout_is('.\n..');
+
+=head1 DESCRIPTION
+
+Test::Command provides a simple interface for testing stdout, stderr and return
+value of an external command.
+
+=cut
+
+=head1 TESTS
+
+=over 4
+
+=item B<is_cmd( cmd, exp_stdout, exp_stderr, exp_ret, diag )>
+
+ Runs command and tests for expected results. Pass undef in the parameter you
+ don't want to test for.
+
+=over 4
+
+=item B<cmd> - string of command tu run
+
+=item B<exp_stdout> - expected stdout
+
+=item B<exp_stderr> - expected stderr
+
+=item B<exp_ret> - expected return value of a program
+
+=item B<diag> - diagnostic message printed if test failed
+
+=back
+
+=item B<start_command( cmd )>
+
+Start a command. Returns immediately and doesn't wait for command to finish.
+
+=item B<wait_for_command>
+
+Wait for command started with C<start_command> to finish. Returns exit status
+(return value of waipid) of the command.
+
+=item B<com_slurp_stdout>
+
+=item B<com_slurp_stderr>
+
+Slurp stdout/stderr of a process started with start_command and return it.
+
+=item B<com_stdout_is( ex_stdout, diag )>
+
+=item B<com_stderr_is( ex_stdout, diag )>
+
+Test stdout/stderr of the command started with start_command. This will block
+until the process has closed its stdout or stderr
+
+=item B<com_ret_is( ex_ret, diag )>
+
+Test for expected return value of a command started with start_command.
+
+=back
+
+All parameters that represent expected value for stdout or stderr can be a
+string, a compiled regexp or a code reference, which is passed the contents as
+a first parameter and is expected to return true or false value.
+
+=head1 AUTHOR
+
+Oliver Kindernay <oliver.kindernay@gmail.com>
+
+=cut
--- /dev/null
+package Test::Mode6::Server;
+use strict;
+use warnings;
+use IO::Socket::INET;
+use Test::Builder;
+use NTP::Mode6::Packet;
+use Carp;
+use Exporter qw(import);
+use Errno qw(EINTR);
+use Devel::Hexdump qw(xd);
+our @EXPORT = qw(start_mode6_server expect_mode6_command stop_mode6_server);
+
+my $socket;
+my $Test = Test::Builder->new();
+
+sub start_mode6_server {
+ $socket = IO::Socket::INET->new(
+ Proto => 'udp',
+ LocalPort => 123,
+ ) or croak "Could not create UDP socket on port 123: $!";
+ $Test->diag("NTP control server started");
+}
+
+sub _diag_and_fail {
+ $Test->diag(shift);
+ $Test->ok(0, shift);
+ 0;
+}
+
+sub expect_mode6_command {
+ my ($ex_packet, $respond, $descr) = @_;
+
+ return _diag_and_fail('Not a CODE reference', $descr)
+ if ref $respond ne 'CODE';
+
+ my $remote_addr = $socket->recv(my $in_msg = '', 4096, 0);
+ if (!$remote_addr) {
+ _diag_and_fail("Error in recv: $!", $descr) if $! != EINTR;
+ return;
+ }
+
+ my $recv_packet = NTP::Mode6::Packet->new();
+ $recv_packet->decode($in_msg);
+ my $diag = $recv_packet->eq($ex_packet);
+ if ($diag) {
+ _diag_and_fail("Packets don't match\n$diag", $descr);
+ return;
+ }
+
+ my $resp_packet = $respond->($recv_packet);
+ return _diag_and_fail('reponse sub didn\'t return NTP::Mode6::Packet object', $descr)
+ if ref $resp_packet ne 'NTP::Mode6::Packet';
+
+ my $out_msg = $resp_packet->encode;
+ $socket->send($out_msg, 0, $remote_addr) == length $out_msg
+ or return _diag_and_fail("Error sending response packet: $!", $descr);
+
+ $Test->ok(1, $descr);
+}
+
+sub stop_mode6_server {
+ close $socket;
+ $Test->diag("NTP control server stopped");
+}
+
+1;
--- /dev/null
+package Test::Util;
+use strict;
+use warnings;
+use Test::Command;
+use Test::More;
+use File::Basename qw(basename);
+use Exporter qw(import);
+use Carp qw(croak);
+use Scalar::Util qw(set_prototype);
+use Sub::Override;
+
+our @EXPORT_OK = qw(check_help override call_orig mock_ntp_util run_mocked);
+
+our $DIAG = 0;
+sub cdiag { diag @_ if $DIAG }
+
+sub check_help {
+ my ($script_path, @options) = @_;
+ my $script_name = basename($script_path);
+
+ cmd_is("$script_path -?", '',
+ sub {
+ my $help = shift;
+ my $i;
+
+ cdiag "Got help '$help'";
+
+ $help =~ /^$script_name\ [^\n]+\nUSAGE:\ $script_name\
+ \[\ -<flag>\ \[<val>\]\ \|\ --<name>\[{=\|\ }<val>\]\ \]
+ /x or return 0;
+
+ cdiag "Usage line OK";
+
+ for (@options, [qw(help ?)], [qw(more-help)]) {
+ my ($long, $short) = @$_;
+ my $o = $short ? "-$short, --$long" : " , --$long";
+
+ cdiag "Testing for $o\n";
+
+ return 0 if $help !~ /$o/;
+ }
+
+ cdiag "Options OK";
+
+ $help =~ <<'END' or return 0;
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.$
+END
+ cdiag "Bottom line OK";
+
+ return 1;
+ }, 0, "help's ok");
+}
+
+my $override = Sub::Override->new;
+
+{
+ my (@vars, @peers, @hosts, @offset_stratums);
+
+ sub mock_ntp_util {
+ my ($package, %mock) = @_;
+
+ $override->replace($package.'::ntp_read_vars' => sub {
+ return undef if !@vars;
+ croak 'vars elements should be HASH refs'
+ if ref $vars[0] ne 'HASH';
+ return +{ %{ shift @vars } };
+ }) if exists $mock{read_vars};
+
+ $override->replace($package.'::ntp_peers' => sub {
+ return () if !@peers;
+ croak 'peer elements should be ARRAY refs'
+ if ref $peers[0] ne 'ARRAY';
+ return @{ shift @peers }
+ }) if exists $mock{peers};
+
+ $override->replace($package.'::do_dns' => sub {
+ return shift @hosts
+ }) if exists $mock{dns};
+
+ $override->replace($package.'::ntp_sntp_line' => sub {
+ return () if !@offset_stratums;
+ croak 'offset_stratums elements should be ARRAY refs'
+ if ref $offset_stratums[0] ne 'ARRAY';
+ return @{ shift @offset_stratums };
+ }) if exists $mock{sntp_line};
+ }
+
+ sub run_mocked {
+ my %opts = @_;
+
+ for (qw(vars peers hosts offset_stratums)) {
+ croak "$_ is not an ARRAY reference" if exists $opts{$_} && ref $opts{$_} ne 'ARRAY';
+ }
+ croak "run is not a CODE reference" if ref $opts{run} ne 'CODE';
+
+ @vars = @{ $opts{vars} } if defined $opts{vars};
+ @peers = @{ $opts{peers}} if defined $opts{peers};
+ @hosts = @{ $opts{hosts}} if defined $opts{hosts};
+ @offset_stratums = @{ $opts{offset_stratums} } if defined $opts{offset_stratums};
+ $opts{run}->();
+ }
+}
+
+sub override {
+ my ($package, $subname, $code) = @_;
+
+ croak 'not a CODE reference' if ref $code ne 'CODE';
+
+ my $proto = prototype $code;
+ my $override = set_prototype(sub {
+ my $caller = caller;
+ if ($caller eq $package) {
+ return $code->(@_);
+ }
+ else {
+ call_orig($package, $subname);
+ }
+ }, $proto);
+
+ {
+ no strict 'refs';
+ *{"CORE::GLOBAL::".${subname}} = $override;
+ }
+}
+
+sub call_orig {
+ my ($pkg, $name) = (shift, shift);
+ # TODO: cache this?
+ _make_helper($pkg, $name)->(@_);
+}
+
+
+# Doing this right would require some hairy code and a lot more work (just look
+# at Fatal.pm) Since we just want to override open sleep and few other builtins
+# this is sufficient.
+my %orig_helpers = (
+ sleep => 'return CORE::sleep $_[0]',
+ open => '
+ no strict q(refs);
+ if (@_ == 1) {
+ return CORE::open($_[0]);
+ }
+ elsif (@_ == 2) {
+ return CORE::open($_[0], $_[1]);
+ }
+ elsif (@_ >= 3) {
+ return CORE::open($_[0], $_[1], @_[2 .. $#_]);
+ }
+ ',
+);
+
+# This a helper for the override sub, it generates sub that provides the
+# original package context
+sub _make_helper {
+ my ($pkg, $name) = @_;
+ my $sub = eval "
+ sub {
+ package $pkg;
+ $orig_helpers{$name}
+ }
+ ";
+ die "Eval failed for ${pkg}: $@" unless $sub;
+ return $sub;
+}
+
+1;
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 22;
+use Test::Command;
+use Test::Output;
+use Test::Util qw(check_help mock_ntp_util run_mocked override);
+
+my $script_name = 'ntp-wait/ntp-wait';
+
+require_ok($script_name);
+
+my @options = (
+ [qw(tries=num n)],
+ [qw(sleep=num s)],
+ [qw(verbose v)],
+);
+check_help("./$script_name", @options);
+
+mock_ntp_util('ntp_wait', read_vars => 1);
+
+{
+ my $sleep_for;
+
+ BEGIN {
+ override('ntp_wait', sleep => sub {
+ is(shift, $sleep_for, 'sleep with the right value');
+ });
+ }
+
+ sub run_ntp_wait {
+ my (%opts) = @_;
+ $sleep_for = delete $opts{sleep_for} || 0;
+ run_mocked(run => sub { ntp_wait::run(@{ delete $opts{opts} || [] }) }, %opts);
+ }
+}
+
+my $ret;
+
+my %vars = (
+ status_line => {
+ leap => 'leap_alarm',
+ }
+);
+
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => [\%vars], opts => [qw(-n 1 -s 0 -v)]) },
+ qr/ntpd did not synchronize/,
+ 'failed to synchronize in time with leap_alarm'
+);
+is($ret, 1, 'fails when failed to synchronize with leap_alarm');
+
+%vars = (
+ status_line => {
+ leap => 'sync_alarm',
+ }
+);
+
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => [\%vars], opts => [qw(-n 1 -s 0 -v)]) },
+ qr/ntpd did not synchronize/,
+ 'failed to synchronize in time with sync_alarm'
+);
+is($ret, 1, 'fails when failed to synchronize with sync_alarm');
+
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => [\%vars], opts => [qw(-n 1 -s 0 -v)]) },
+ qr/ntpd did not synchronize/,
+ 'failed to synchronize in time with -v'
+);
+is($ret, 1, 'fails when failed to synchronize with -v');
+
+
+%vars = (
+ status_line => {
+ leap => 'leap_bogus',
+ }
+);
+
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => [\%vars], opts => [qw(-n 2 -s 0 -v)]) },
+ qr/Unexpected 'leap' status <leap_bogus>/,
+ 'prints debug information on invalid leap status'
+);
+is($ret, 1, 'fails on invalid leap status');
+
+
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => [{}], opts => [qw(-n 2 -s 0 -v)]) },
+ qr/Leap status not avalaible/,
+ 'print debug information when no leap returned'
+);
+is($ret, 1, 'fails if not leap returned');
+
+%vars = (
+ status_line => {
+ leap => 'leap_none',
+ }
+);
+
+stdout_is(
+ sub { $ret = run_ntp_wait(vars => [\%vars], opts => [qw(-n 1 -s 0)]) },
+ '',
+ 'prints nothing if OK'
+);
+is($ret, 0, 'succeeds if OK');
+
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => [\%vars], opts => [qw(-n 1 -s 0 -v)]) },
+ qr/OK/,
+ 'prints OK if OK and -v'
+);
+is($ret, 0, 'succeeds if OK');
+
+#Test the -n switch
+
+my @vars = (
+ {
+ status_line => {
+ leap => 'leap_alarm',
+ }
+ },
+ {
+ status_line => {
+ leap => 'leap_none',
+ }
+ },
+);
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => \@vars, opts => [qw(-n 2 -s 0 -v)]) },
+ qr/OK/,
+ '-n switch works'
+);
+is($ret, 0, 'succeeds if OK the second time');
+
+# Test the -s switch
+
+stdout_like(
+ sub { $ret = run_ntp_wait(vars => \@vars, opts => [qw(-n 2 -s 10 -v)], sleep_for => 10) },
+ qr/OK/,
+ '-s switch works'
+);
+is($ret, 0, 'suceeds if OK and -s');
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use Test::Util qw(check_help override mock_ntp_util run_mocked);
+use Test::Output;
+use Sub::Override;
+
+my $script_name = "ntpsweep/ntpsweep";
+
+my @options = (
+ [qw(host-list=str l)],
+ [qw(peers p)],
+ [qw(maxlevel=num m)],
+ [qw(strip=str s)],
+);
+
+require "./$script_name";
+
+check_help("./$script_name", @options);
+
+mock_ntp_util('ntpsweep', read_vars => 1, peers => 1, sntp_line => 1, dns => 1);
+
+my $header = <<'HEADER';
+Host st offset(s) version system processor
+--------------------------------+--+---------+-----------+------------+---------
+HEADER
+
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-l localhost)) }) },
+ $header."localhost ?\n",
+ 'no information about host'
+);
+
+# Test deprecated -h switch
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-h localhost)) }) },
+ $header."localhost ?\n",
+ '-h switch works'
+);
+
+my @vars = ({
+ processor => 'i686',
+ system => 'Linux/2.6.37.6-smp',
+ daemon_version => 'ntpd 4.2.6p3@1.2290-o Wed Jan 26 04:19:40 UTC 2011 (1)',
+});
+
+my @offset_stratum = (['0.00', 3]);
+
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-l localhost)) }, offset_stratums => \@offset_stratum ) },
+ $header.'localhost 3 0.000'.(' 'x26)."\n",
+ 'one host ok but no variables'
+);
+
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-l localhost)) }, offset_stratums => \@offset_stratum, vars => \@vars ) },
+ $header."localhost 3 0.000 4.2.6p3\@1.2 Linux/2.6.37 i686\n",
+ 'one host with ok variables'
+);
+
+## Add one peer
+my @peers = ([{ remote => 'pieskovisko.sk' }]);
+push @offset_stratum, ['0.01', 2];
+push @vars, {
+ processor => 'i686',
+ system => 'Bungalanga OS',
+ daemon_version => 'ntpd 4.1.5p3@1.2-o Wed Jan 26 04:19:40 UTC 2011 (1)',
+};
+
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-l localhost -p)) }, offset_stratums => \@offset_stratum, vars => \@vars, peers => \@peers) },
+ $header."localhost (1) 3 0.000 4.2.6p3\@1.2 Linux/2.6.37 i686\n"
+ ." pieskovisko.sk (0) 2 0.010 4.1.5p3\@1.2 Bungalanga O i686\n",
+ 'one peer'
+);
+
+# Add another peer
+push @peers, [{ remote => 'nic.nz' }];
+push @offset_stratum, ['0.04', 1];
+push @vars, {
+ processor => 'i686',
+ system => 'NIC OS',
+ daemon_version => 'ntpd 4.1.5p3@1.2-o Wed Jan 26 04:19:40 UTC 2011 (1)',
+};
+
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-l localhost -p -m 1)) }, offset_stratums => \@offset_stratum, vars => \@vars, peers => \@peers) },
+ $header."localhost (1) 3 0.000 4.2.6p3\@1.2 Linux/2.6.37 i686\n"
+ ." pieskovisko.sk (1) 2 0.010 4.1.5p3\@1.2 Bungalanga O i686\n",
+ 'one peer twice but -m 1'
+);
+
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-l localhost -p)) }, offset_stratums => \@offset_stratum, vars => \@vars, peers => \@peers) },
+ $header."localhost (1) 3 0.000 4.2.6p3\@1.2 Linux/2.6.37 i686\n"
+ ." pieskovisko.sk (1) 2 0.010 4.1.5p3\@1.2 Bungalanga O i686\n"
+ ." nic.nz (0) 1 0.040 4.1.5p3\@1.2 NIC OS i686\n",
+ 'one peer twice'
+);
+
+push @peers, [{ remote => 'localhost' }];
+push @offset_stratum, ['0.04', 1];
+push @vars, {
+ processor => 'i686',
+ system => 'NIC OS',
+ daemon_version => 'ntpd 4.1.5p3@1.2-o Wed Jan 26 04:19:40 UTC 2011 (1)',
+};
+
+stdout_is(
+ sub { run_mocked(run => sub { ntpsweep::run(qw(-l localhost -p)) }, offset_stratums => \@offset_stratum, vars => \@vars, peers => \@peers) },
+ $header."localhost (1) 3 0.000 4.2.6p3\@1.2 Linux/2.6.37 i686\n"
+ ." pieskovisko.sk (1) 2 0.010 4.1.5p3\@1.2 Bungalanga O i686\n"
+ ." nic.nz (1) 1 0.040 4.1.5p3\@1.2 NIC OS i686\n"
+ ." = localhost".(' 'x18)."\n",
+ 'loop detection'
+);
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 6;
+use Test::Command;
+use Test::Output;
+use Test::Util qw(check_help mock_ntp_util run_mocked);
+use Sub::Override;
+
+my $script_name = 'ntptrace/ntptrace';
+
+my @options = (
+ [qw(numeric n)],
+ [qw(max-hosts=num m)],
+ [qw(host=str r)],
+);
+check_help($script_name, @options);
+
+require "./$script_name";
+
+mock_ntp_util('ntptrace', read_vars => 1, dns => 1);
+
+my @vars = ({
+ version => 'ntpd 4.2.6p3@1.2290-o Wed Jan 26 04:19:40 UTC 2011 (1)',
+ processor => 'i686',
+ system => 'Linux/2.6.37.6-smp',
+ leap => '00',
+ stratum => '3',
+ precision => '-21',
+ rootdelay => '38.998',
+ rootdisp => '94.413',
+ refid => '92.240.244.202',
+ reftime => 'd5842335.00c8980f Sun Jul 7 2013 19:26:13.003',
+ clock => 'd5842501.ee752d06 Sun Jul 7 2013 19:33:53.931',
+ peer => '848',
+ tc => '9',
+ mintc => '3',
+ offset => '-23.168',
+ frequency => '-10.213',
+ sys_jitter => '14.724',
+ clk_jitter => '14.754',
+ clk_wander => '3.847',
+});
+
+stdout_is(
+ sub { run_mocked(run => sub { ntptrace::run() }, vars => [@vars,{}], hosts => [qw(localhost)]) },
+ "localhost: stratum 3, offset -0.023168, synch distance 0.113912\n",
+ 'traces single host'
+);
+
+stdout_is(
+ sub { run_mocked(run => sub { ntptrace::run(qw(-n)) }, vars => [@vars,{}]) },
+ "127.0.0.1: stratum 3, offset -0.023168, synch distance 0.113912\n",
+ '-n switch works, localhost is default'
+);
+
+#Add response to a rv peer
+push @vars, {
+ srcadr => '1.2.3.4',
+ srcport => '123',
+ dstadr => '192.168.1.11',
+ dstport => '123',
+ leap => '00',
+ stratum => '2',
+ precision => '-22',
+ rootdelay => '5.142',
+ rootdisp => '30.884',
+ refid => '195.146.149.222',
+ reftime => 'd584299f.8904b565 Sun Jul 7 2013 19:53:35.535',
+ rec => 'd5842d6b.02efea46 Sun Jul 7 2013 20:09:47.011',
+ reach => '377',
+ unreach => '0',
+ hmode => '3',
+ pmode => '4',
+ hpoll => '9',
+ ppoll => '9',
+ headway => '0',
+ flash => '00 ok',
+ keyid => '0',
+ offset => '-24.318',
+ delay => '33.499',
+ dispersion => '20.588',
+ jitter => '39.916',
+ xleave => '0.031',
+ filtdelay => ' 42.35 93.96 235.47 33.50 34.31 33.90 37.25 34.97',
+ filtoffset => ' -21.46 4.17 77.27 -24.32 -23.48 -23.17 -21.27 -25.42',
+ filtdisp => ' 0.00 8.01 15.78 23.54 31.25 39.21 47.24 55.23',
+};
+
+# Add response from the peer
+push @vars, {
+ version => 'ntpd 4.2.4p8@1.1612-o Tue Apr 19 07:08:29 UTC 2011 (1)',
+ processor => "i686",
+ system => "Linux/2.6.38-10-generic-pae",
+ leap => '00',
+ stratum => '1',
+ precision => '-20',
+ rootdelay => '0.000',
+ rootdisp => '0.348',
+ peer => '41683',
+ refid => 'CDMA',
+ reftime => 'd58443c5.cc475b06 Sun Jul 7 2013 19:45:09.797',
+ poll => '5',
+ clock => 'd58443cd.079e0276 Sun Jul 7 2013 19:45:17.029',
+ state => '4',
+ offset => '0.000',
+ frequency => '-21.795',
+ jitter => '0.001',
+ noise => '0.005',
+ stability => '0.000',
+ tai => '0',
+};
+
+stdout_is(
+ sub { run_mocked(run => sub { ntptrace::run() }, vars => \@vars, hosts => [qw(localhost kenny.oneemedia.com)]) },
+ <<'END',
+localhost: stratum 3, offset -0.023168, synch distance 0.113912
+kenny.oneemedia.com: stratum 1, offset 0.000000, synch distance 0.000348, refid 'CDMA'
+END
+ 'traced a peer up to stratum 1'
+);
+
+stdout_is(
+ sub { run_mocked(run => sub { ntptrace::run(qw(-m 1)) }, vars => \@vars, hosts => [qw(localhost)]) },
+ "localhost: stratum 3, offset -0.023168, synch distance 0.113912\n",
+ '-m switch works'
+);
+
+splice @vars, 0, 1, {
+ version => 'ntpd 4.2.6p3@1.2290-o Wed Jan 26 04:19:40 UTC 2011 (1)',
+ processor => "i686",
+ system => "Linux/2.6.37.6-smp",
+ leap => '00',
+ stratum => '3',
+ precision => '-21',
+ rootdelay => '38.998',
+ rootdisp => '94.413',
+ refid => '127.127.0.1',
+ reftime => 'd5842335.00c8980f Sun Jul 7 2013 19:26:13.003',
+ clock => 'd5842501.ee752d06 Sun Jul 7 2013 19:33:53.931',
+ peer => '848',
+ tc => '9',
+ mintc => '3',
+ offset => '-23.168',
+ frequency => '-10.213',
+ sys_jitter => '14.724',
+ clk_jitter => '14.754',
+ clk_wander => '3.847',
+};
+
+stdout_is(
+ sub { run_mocked(run => sub { ntptrace::run() }, vars => \@vars) },
+ "127.0.0.1: stratum 3, offset -0.023168, synch distance 0.113912\n",
+ 'stopped on 127.127 refid'
+);
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Test::Util qw(check_help);
+
+my $script_name = "plot_summary";
+
+my @options = (
+ [qw(directory=str)],
+ [qw(identifier=str)],
+ [qw(output-file=str)],
+ [qw(plot-term=str)],
+ [qw(dont-wait)],
+ [qw(offset-limit=float)],
+);
+
+check_help("./$script_name", @options);
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Test::Util qw(check_help);
+
+my $script_name = "summary";
+
+my @options = (
+ [qw(directory=str)],
+ [qw(end-date=num)],
+ [qw(output-directory=str)],
+ [qw(peer-dist-limit=float)],
+ [qw(skip-time-steps=float)],
+ [qw(start-date=num)],
+);
+
+check_help("./$script_name", @options);
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Test::Util qw(override);
+
+BEGIN {
+ my %test;
+
+ override('NTP::Util', open => sub {
+ is($_[1], $test{open_str}, 'open with right string')
+ if defined $test{open_str};
+ return if $test{fail_open};
+ open $_[0], '<', \$test{output};
+ });
+
+ sub test_read_vars {
+ my (%opts) = @_;
+ _parse_opts(%opts);
+ ntp_read_vars(@{ delete $opts{opts} || []});
+ }
+
+ sub test_peers {
+ my (%opts) = @_;
+ _parse_opts(%opts);
+ ntp_peers(@{ delete $opts{opts} || []});
+ }
+
+ sub test_sntp_line {
+ my (%opts) = @_;
+ _parse_opts(%opts);
+ ntp_sntp_line(@{ delete $opts{opts} || []});
+ }
+
+ sub _parse_opts {
+ my (%opts) = @_;
+ $test{fail_open} = delete $opts{fail_open} || 0;
+ $test{output} = delete $opts{output} || '' ;
+ $test{open_str} = delete $opts{open_str};
+ }
+}
+
+require_ok 'NTP::Util';
+NTP::Util->import(qw(ntp_read_vars ntp_peers ntp_sntp_line));
+
+eval {
+ test_read_vars(opts => [0, []], fail_open => 1,
+ open_str => "ntpq -n -c 'rv 0 ' |");
+} or do {
+ like($@, qr/Could not start ntpq: /, 'ntp_read_vars dies on failed execution');
+};
+
+is(
+ test_read_vars(opts => [0, []], output => 'Connection refused'),
+ undef,
+ 'returns undef when connection refused'
+);
+
+is_deeply(
+ test_read_vars(opts => [0, [qw(var1 var2 var_3 rootdisp offset)]],
+ output => "var1=foo, var_3=\"bar\"\nphase=1.00, rootdispersion=4.00\n"),
+ {
+ var1 => 'foo',
+ var_3 => 'bar',
+ var2 => undef,
+ offset => '1.00',
+ rootdisp => '4.00',
+ },
+ 'variables correctly parsed'
+);
+
+is_deeply(
+ test_read_vars(opts => [0, []],
+ output => <<'VAR_END'),
+associd=0 status=c012 leap_alarm, sync_unspec, 1 event, freq_set,
+var1=foo, var_3="bar"
+phase=1.00, rootdispersion=4.00
+VAR_END
+ {
+ var1 => 'foo',
+ var_3 => 'bar',
+ offset => '1.00',
+ rootdisp => '4.00',
+
+ status_line => {
+ leap => 'leap_alarm',
+ sync => 'sync_unspec',
+ status => 'c012'
+ }
+ },
+ 'variables correctly parsed'
+);
+
+eval {
+ test_peers(opts => ['localhost'], fail_open => 1,
+ open_str => "ntpq -np localhost |");
+} or do {
+ like($@, qr/Could not start ntpq: /, 'ntp_peers dies on failed execution');
+};
+
+is_deeply(
+ test_peers(opts => ['localhost'],
+ output => <<'PEER_END'),
+ remote refid st t when poll reach delay offset jitter
+==============================================================================
++194.160.23.2 .GPS. 1 u 188 1024 377 0.290 0.051 0.058
+-217.31.205.226 195.113.144.201 2 u 227 1024 377 6.092 -0.372 0.064
+ 147.231.19.43 .INIT. 16 u - 1024 0 0.000 0.000 4000.00
+*195.113.144.201 .GPS. 1 u 211 1024 377 5.817 0.023 0.054
+PEER_END
+ [
+ {
+ 'when' => '188',
+ 'reach' => '377',
+ 'delay' => '0.290',
+ 'st' => '1',
+ 'remote' => '+194.160.23.2',
+ 'poll' => '1024',
+ 'jitter' => '0.058',
+ 'refid' => '.GPS.',
+ 't' => 'u',
+ 'offset' => '0.051'
+ },
+ {
+ 'when' => '227',
+ 'reach' => '377',
+ 'delay' => '6.092',
+ 'st' => '2',
+ 'remote' => '-217.31.205.226',
+ 'poll' => '1024',
+ 'jitter' => '0.064',
+ 'refid' => '195.113.144.201',
+ 't' => 'u',
+ 'offset' => '-0.372'
+ },
+ {
+ 'when' => '-',
+ 'reach' => '0',
+ 'delay' => '0.000',
+ 'st' => '16',
+ 'remote' => ' 147.231.19.43',
+ 'poll' => '1024',
+ 'jitter' => '4000.00',
+ 'refid' => '.INIT.',
+ 't' => 'u',
+ 'offset' => '0.000'
+ },
+ {
+ 'when' => '211',
+ 'reach' => '377',
+ 'delay' => '5.817',
+ 'st' => '1',
+ 'remote' => '*195.113.144.201',
+ 'poll' => '1024',
+ 'jitter' => '0.054',
+ 'refid' => '.GPS.',
+ 't' => 'u',
+ 'offset' => '0.023'
+ }
+ ],
+ 'peers correctly parsed'
+);
+
+eval {
+ test_sntp_line(opts => ['localhost'], fail_open => 1,
+ open_str => "sntp localhost |");
+} or do {
+ like($@, qr/Could not start sntp: /, 'ntp_sntp_line dies on failed execution');
+};
+
+is_deeply(
+ [test_sntp_line(opts => ['localhost'],
+ output => <<'SNTP_END')],
+sntp 4.2.7p379@1.2946-o Tue Aug 27 18:55:18 UTC 2013 (4)
+Can't open KOD db file /var/db/ntp-kod for writing: Permission denied
+2013-09-19 22:49:29.381062 (-0100) +0.000007 +/- 0.077138 localhost 127.0.0.1 s4
+SNTP_END
+ ['+0.000007', '4'],
+ 'stratum and offset parsed'
+);
## non-file "-levent_core".
version.c: $(sntp_OBJECTS) ../libntp/libntp.a Makefile $(srcdir)/scm-rev
- env CSET=`cat $(srcdir)/scm-rev` $(top_builddir)/../scripts/mkver sntp
+ env CSET=`cat $(srcdir)/scm-rev` $(top_builddir)/../scripts/build/mkver sntp
version.o: version.c
env CCACHE_DISABLE=1 $(COMPILE) -c version.c -o version.o
$(srcdir)/m4/version.m4: $(srcdir)/../packageinfo.sh
TEMPDIR=`pwd` && export TEMPDIR && cd $(srcdir) && \
- ../scripts/genver m4/version.m4
+ ../scripts/build/genver m4/version.m4
$(srcdir)/include/version.def: $(srcdir)/../packageinfo.sh
TEMPDIR=`pwd` && export TEMPDIR && cd $(srcdir) && \
- ../scripts/genver include/version.def
+ ../scripts/build/genver include/version.def
$(srcdir)/include/version.texi: $(srcdir)/../packageinfo.sh
TEMPDIR=`pwd` && export TEMPDIR && cd $(srcdir) && \
- ../scripts/genver include/version.texi
+ ../scripts/build/genver include/version.texi
$(srcdir)/../COPYRIGHT:
cd .. && $(MAKE) $(AM_MAKEFLAGS) COPYRIGHT-please
$(srcdir)/invoke-sntp.texi: $(srcdir)/sntp-opts.def $(std_def_list)
$(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section sntp-opts.def
- $(top_srcdir)/../scripts/check--help $@
+ $(top_srcdir)/../scripts/build/check--help $@
$(srcdir)/sntp.html: $(srcdir)/invoke-sntp.menu $(srcdir)/invoke-sntp.texi $(srcdir)/sntp.texi $(srcdir)/include/version.texi
cd $(srcdir) && ( makeinfo --force --html --no-split -o sntp.html sntp.texi || true )
--- /dev/null
+=head1 NAME
+
+Mdoc - perl module to parse Mdoc macros
+
+=head1 SYNOPSIS
+
+ use Mdoc qw(ns pp soff son stoggle mapwords);
+
+See mdoc2man and mdoc2texi for code examples.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item def_macro( NAME, CODE, [ raw => 1, greedy => 1, concat_until => '.Xx' ] )
+
+Define new macro. The CODE reference will be called by call_macro(). You can
+have two distinct definitions for and inline macro and for a standalone macro
+(i. e. 'Pa' and '.Pa').
+
+The CODE reference is passed a list of arguments and is expected to return list
+of strings and control characters (see C<CONSTANTS>).
+
+By default the surrouding "" from arguments to macros are removed, use C<raw>
+to disable this.
+
+Normaly CODE reference is passed all arguments up to next nested macro. Set
+C<greedy> to to pass everything up to the end of the line.
+
+If the concat_until is present, the line is concated until the .Xx macro is
+found. For example the following macro definition
+
+ def_macro('.Oo', gen_encloser(qw([ ]), concat_until => '.Oc' }
+ def_macro('.Cm', sub { mapwords {'($_)'} @_ } }
+
+and the following input
+
+ .Oo
+ .Cm foo |
+ .Cm bar |
+ .Oc
+
+results in [(foo) | (bar)]
+
+=item get_macro( NAME )
+
+Returns a hash reference like:
+
+ { run => CODE, raw => [1|0], greedy => [1|0] }
+
+Where C<CODE> is the CODE reference used to define macro called C<NAME>
+
+=item parse_line( INPUT, OUTPUT_CODE, PREPROCESS_CODE )
+
+Parse a line from the C<INPUT> filehandle. If a macro was detected it returns a
+list (MACRO_NAME, @MACRO_ARGS), otherwise it calls the C<OUTPUT_CODE>, giving
+caller a chance to modify line before printing it. If C<PREPROCESS_CODE> is
+defined it calls it prior to passing argument to a macro, giving caller a
+chance to alter them. if EOF was reached undef is returned.
+
+=item call_macro( MACRO, ARGS, ... )
+
+Call macro C<MACRO> with C<ARGS>. The CODE reference for macro C<MACRO> is
+called and for all the nested macros. Every called macro returns a list which
+is appended to return value and returned when all nested macros are processed.
+Use to_string() to produce a printable string from the list.
+
+=item to_string ( LIST )
+
+Processes C<LIST> returned from call_macro() and returns formatted string.
+
+=item mapwords BLOCK ARRAY
+
+This is like perl's map only it calls BLOCK only on elements which are not
+punctuation or control characters.
+
+=item space ( ['on'|'off] )
+
+Turn spacing on or off. If called without argument it returns the current state.
+
+=item gen_encloser ( START, END )
+
+Helper function for generating macros that enclose their arguments.
+ gen_encloser(qw({ }));
+returns
+ sub { '{', ns, @_, ns, pp('}')}
+
+=item set_Bl_callback( CODE , DEFS )
+
+This module implements the Bl/El macros for you. Using set_Bl_callback you can
+provide a macro definition that should be executed on a .Bl call.
+
+=item set_El_callback( CODE , DEFS )
+
+This module implements the Bl/El macros for you. Using set_El_callback you can
+provide a macro definition that should be executed on a .El call.
+
+=item set_Re_callback( CODE )
+
+The C<CODE> is called after a Rs/Re block is done. With a hash reference as a
+parameter, describing the reference.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item ns
+
+Indicate 'no space' between to members of the list.
+
+=item pp ( STRING )
+
+The string is 'punctuation point'. It means that every punctuation
+preceeding that element is put behind it.
+
+=item soff
+
+Turn spacing off.
+
+=item son
+
+Turn spacing on.
+
+=item stoggle
+
+Toogle spacing.
+
+=item hs
+
+Print space no matter spacing mode.
+
+=back
+
+=head1 TODO
+
+* The concat_until only works with standalone macros. This means that
+ .Po blah Pc
+will hang until .Pc in encountered.
+
+* Provide default macros for Bd/Ed
+
+* The reference implementation is uncomplete
+
+=cut
+
+package Mdoc;
+use strict;
+use warnings;
+use List::Util qw(reduce);
+use Text::ParseWords qw(quotewords);
+use Carp;
+use Exporter qw(import);
+our @EXPORT_OK = qw(ns pp soff son stoggle hs mapwords gen_encloser nl);
+
+use constant {
+ ns => ['nospace'],
+ soff => ['spaceoff'],
+ son => ['spaceon'],
+ stoggle => ['spacetoggle'],
+ hs => ['hardspace'],
+};
+
+sub pp {
+ my $c = shift;
+ return ['pp', $c ];
+}
+sub gen_encloser {
+ my ($o, $c) = @_;
+ return sub { ($o, ns, @_, ns, pp($c)) };
+}
+
+sub mapwords(&@) {
+ my ($f, @l) = @_;
+ my @res;
+ for my $el (@l) {
+ local $_ = $el;
+ push @res, $el =~ /^(?:[,\.\{\}\(\):;\[\]\|])$/ || ref $el eq 'ARRAY' ?
+ $el : $f->();
+ }
+ return @res;
+}
+
+my %macros;
+
+###############################################################################
+
+# Default macro definitions start
+
+###############################################################################
+
+def_macro('Xo', sub { @_ }, concat_until => '.Xc');
+
+def_macro('.Ns', sub {ns, @_});
+def_macro('Ns', sub {ns, @_});
+
+{
+ my %reference;
+ def_macro('.Rs', sub { () } );
+ def_macro('.%A', sub {
+ if ($reference{authors}) {
+ $reference{authors} .= " and @_"
+ }
+ else {
+ $reference{authors} = "@_";
+ }
+ return ();
+ });
+ def_macro('.%T', sub { $reference{title} = "@_"; () } );
+ def_macro('.%O', sub { $reference{optional} = "@_"; () } );
+
+ sub set_Re_callback {
+ my ($sub) = @_;
+ croak 'Not a CODE reference' if not ref $sub eq 'CODE';
+ def_macro('.Re', sub {
+ my @ret = $sub->(\%reference);
+ %reference = (); @ret
+ });
+ return;
+ }
+}
+
+def_macro('.Bl', sub { die '.Bl - no list callback set' });
+def_macro('.It', sub { die '.It called outside of list context' });
+def_macro('.El', sub { die '.El requires .Bl first' });
+
+
+{
+ my $elcb = sub { () };
+
+ sub set_El_callback {
+ my ($sub) = @_;
+ croak 'Not a CODE reference' if ref $sub ne 'CODE';
+ $elcb = $sub;
+ return;
+ }
+
+ sub set_Bl_callback {
+ my ($blcb, %defs) = @_;
+ croak 'Not a CODE reference' if ref $blcb ne 'CODE';
+ def_macro('.Bl', sub {
+
+ my $orig_it = get_macro('.It');
+ my $orig_el = get_macro('.El');
+ my $orig_bl = get_macro('.Bl');
+ my $orig_elcb = $elcb;
+
+ # Restore previous .It and .El on each .El
+ def_macro('.El', sub {
+ def_macro('.El', delete $orig_el->{run}, %$orig_el);
+ def_macro('.It', delete $orig_it->{run}, %$orig_it);
+ def_macro('.Bl', delete $orig_bl->{run}, %$orig_bl);
+ my @ret = $elcb->(@_);
+ $elcb = $orig_elcb;
+ @ret
+ });
+ $blcb->(@_)
+ }, %defs);
+ return;
+ }
+}
+
+def_macro('.Sm', sub {
+ my ($arg) = @_;
+ if (defined $arg) {
+ space($arg);
+ } else {
+ space() eq 'off' ?
+ space('on') :
+ space('off');
+ }
+ ()
+} );
+def_macro('Sm', do { my $off; sub {
+ my ($arg) = @_;
+ if (defined $arg && $arg =~ /^(on|off)$/) {
+ shift;
+ if ($arg eq 'off') { soff, @_; }
+ elsif ($arg eq 'on') { son, @_; }
+ }
+ else {
+ stoggle, @_;
+ }
+}} );
+
+###############################################################################
+
+# Default macro definitions end
+
+###############################################################################
+
+sub def_macro {
+ croak 'Odd number of elements for hash argument <'.(scalar @_).'>' if @_%2;
+ my ($macro, $sub, %def) = @_;
+ croak 'Not a CODE reference' if ref $sub ne 'CODE';
+
+ $macros{ $macro } = {
+ run => $sub,
+ greedy => delete $def{greedy} || 0,
+ raw => delete $def{raw} || 0,
+ concat_until => delete $def{concat_until},
+ };
+ if ($macros{ $macro }{concat_until}) {
+ $macros{ $macros{ $macro }{concat_until} } = { run => sub { @_ } };
+ $macros{ $macro }{greedy} = 1;
+ }
+ return;
+}
+
+sub get_macro {
+ my ($macro) = @_;
+ croak "Macro <$macro> not defined" if not exists $macros{ $macro };
+ +{ %{ $macros{ $macro } } }
+}
+
+#TODO: document this
+sub parse_opts {
+ my %args;
+ my $last;
+ for (@_) {
+ if ($_ =~ /^\\?-/) {
+ s/^\\?-//;
+ $args{$_} = 1;
+ $last = _unquote($_);
+ }
+ else {
+ $args{$last} = _unquote($_) if $last;
+ undef $last;
+ }
+ }
+ return %args;
+}
+
+sub _is_control {
+ my ($el, $expected) = @_;
+ if (defined $expected) {
+ ref $el eq 'ARRAY' and $el->[0] eq $expected;
+ }
+ else {
+ ref $el eq 'ARRAY';
+ }
+}
+
+{
+ my $sep = ' ';
+
+ sub to_string {
+ if (@_ > 0) {
+ # Handle punctunation
+ my ($in_brace, @punct) = '';
+ my @new = map {
+ if (/^([\[\(])$/) {
+ ($in_brace = $1) =~ tr/([/)]/;
+ $_, ns
+ }
+ elsif (/^([\)\]])$/ && $in_brace eq $1) {
+ $in_brace = '';
+ ns, $_
+ }
+ elsif ($_ =~ /^[,\.;:\?\!\)\]]$/) {
+ push @punct, ns, $_;
+ ();
+ }
+ elsif (_is_control($_, 'pp')) {
+ $_->[1]
+ }
+ elsif (_is_control($_)) {
+ $_
+ }
+ else {
+ splice (@punct), $_;
+ }
+ } @_;
+ push @new, @punct;
+
+ # Produce string out of an array dealing with the special control characters
+ # space('off') must but one character delayed
+ my ($no_space, $space_off) = 1;
+ my $res = '';
+ while (defined(my $el = shift @new)) {
+ if (_is_control($el, 'hardspace')) { $no_space = 1; $res .= ' ' }
+ elsif (_is_control($el, 'nospace')) { $no_space = 1; }
+ elsif (_is_control($el, 'spaceoff')) { $space_off = 1; }
+ elsif (_is_control($el, 'spaceon')) { space('on'); }
+ elsif (_is_control($el, 'spacetoggle')) { space() eq 'on' ?
+ $space_off = 1 :
+ space('on') }
+ else {
+ if ($no_space) {
+ $no_space = 0;
+ $res .= "$el"
+ }
+ else {
+ $res .= "$sep$el"
+ }
+
+ if ($space_off) { space('off'); $space_off = 0; }
+ }
+ }
+ $res
+ }
+ else {
+ '';
+ }
+ }
+
+ sub space {
+ my ($arg) = @_;
+ if (defined $arg && $arg =~ /^(on|off)$/) {
+ $sep = ' ' if $arg eq 'on';
+ $sep = '' if $arg eq 'off';
+ return;
+ }
+ else {
+ return $sep eq '' ? 'off' : 'on';
+ }
+ }
+}
+
+sub _unquote {
+ my @args = @_;
+ $_ =~ s/^"([^"]+)"$/$1/g for @args;
+ wantarray ? @args : $args[0];
+}
+
+sub call_macro {
+ my ($macro, @args) = @_;
+ my @ret;
+
+ my @newargs;
+ my $i = 0;
+
+ @args = _unquote(@args) if (!$macros{ $macro }{raw});
+
+ # Call any callable macros in the argument list
+ for (@args) {
+ if ($_ =~ /^[A-Z][a-z]+$/ && exists $macros{ $_ }) {
+ push @ret, call_macro($_, @args[$i+1 .. $#args]);
+ last;
+ } else {
+ if ($macros{ $macro }{greedy}) {
+ push @ret, $_;
+ }
+ else {
+ push @newargs, $_;
+ }
+ }
+ $i++;
+ }
+
+ if ($macros{ $macro }{concat_until}) {
+ my ($n_macro, @n_args) = ('');
+ while (1) {
+ die "EOF was reached and no $macros{ $macro }{concat_until} found"
+ if not defined $n_macro;
+ ($n_macro, @n_args) = parse_line(undef, sub { push @ret, shift });
+ if ($n_macro eq $macros{ $macro }{concat_until}) {
+ push @ret, call_macro($n_macro, @n_args);
+ last;
+ }
+ else {
+ $n_macro =~ s/^\.//;
+ push @ret, call_macro($n_macro, @n_args) if exists $macros{ $n_macro };
+ }
+ }
+ }
+
+ if ($macros{ $macro }{greedy}) {
+ #print "MACROG $macro (", (join ', ', @ret), ")\n";
+ return $macros{ $macro }{run}->(@ret);
+ }
+ else {
+ #print "MACRO $macro (", (join ', ', @newargs), ")".(join ', ', @ret)."\n";
+ return $macros{ $macro }{run}->(@newargs), @ret;
+ }
+}
+
+{
+ my ($in_fh, $out_sub, $preprocess_sub);
+ sub parse_line {
+ $in_fh = $_[0] if defined $_[0] || !defined $in_fh;
+ $out_sub = $_[1] if defined $_[1] || !defined $out_sub;
+ $preprocess_sub = $_[2] if defined $_[2] || !defined $preprocess_sub;
+
+ croak 'out_sub not a CODE reference'
+ if not ref $out_sub eq 'CODE';
+ croak 'preprocess_sub not a CODE reference'
+ if defined $preprocess_sub && not ref $preprocess_sub eq 'CODE';
+
+ while (my $line = <$in_fh>) {
+ chomp $line;
+ if ($line =~ /^\.[A-z][a-z0-9]+/ || $line =~ /^\.%[A-Z]/ ||
+ $line =~ /^\.\\"/)
+ {
+ $line =~ s/ +/ /g;
+ my ($macro, @args) = quotewords(' ', 1, $line);
+ @args = grep { defined $_ } @args;
+ $preprocess_sub->(@args) if defined $preprocess_sub;
+ if ($macro && exists $macros{ $macro }) {
+ return ($macro, @args);
+ } else {
+ $out_sub->($line);
+ }
+ }
+ else {
+ $out_sub->($line);
+ }
+ }
+ return;
+ }
+}
+
+1;
+__END__
--- /dev/null
+[+: -*- Mode: nroff -*-
+
+ AutoGen5 template man
+
+## agman-cmd.tpl -- Template for command line man pages
+##
+## This file is part of AutoOpts, a companion to AutoGen.
+## AutoOpts is free software.
+## Copyright (C) 1992-2013 Bruce Korb - all rights reserved
+##
+## AutoOpts is available under any one of two licenses. The license
+## in use must be one of these two and the choice is under the control
+## of the user of the license.
+##
+## The GNU Lesser General Public License, version 3 or later
+## See the files "COPYING.lgplv3" and "COPYING.gplv3"
+##
+## The Modified Berkeley Software Distribution License
+## See the file "COPYING.mbsd"
+##
+## These files have the following sha256 sums:
+##
+## 8584710e9b04216a394078dc156b781d0b47e1729104d666658aecef8ee32e95 COPYING.gplv3
+## 4379e7444a0e2ce2b12dd6f5a52a27a4d02d39d247901d3285c88cf0d37f477b COPYING.lgplv3
+## 13aa749a5b0a454917a944ed8fffc530b784f5ead522b1aacaf4ec8aa55a6239 COPYING.mbsd
+
+# Produce a man page for section 1, 5 or 8 commands.
+# Which is selected via: -DMAN_SECTION=n
+# passed to the autogen invocation. "n" may have a suffix, if desired.
+#
+:+][+:
+
+(define head-line (lambda()
+ (sprintf ".TH %s %s \"%s\" \"%s\" \"%s\"\n.\\\"\n"
+ (get "prog-name") man-sect
+ (shell "date '+%d %b %Y'") package-text section-name) ))
+
+(define man-page #t)
+(out-push-new) :+][+:
+
+INCLUDE "mdoc-synopsis.tlib" :+][+:
+INCLUDE "cmd-doc.tlib" :+][+:
+
+INVOKE build-doc :+][+:
+
+ (shell (string-append
+ "fn='" (find-file "mdoc2man") "'\n"
+ "test -f ${fn} || die mdoc2man not found from $PWD\n"
+ "${fn} <<\\_EndOfMdoc_ || die ${fn} failed in $PWD\n"
+ (out-pop #t)
+ "\n_EndOfMdoc_" ))
+
+:+][+:
+
+(out-move (string-append (get "prog-name") "."
+ man-sect)) :+][+:
+
+agman-cmd.tpl ends here :+]
--- /dev/null
+[+: -*- Mode: nroff -*-
+
+ AutoGen5 template mdoc
+
+## agman-cmd.tpl -- Template for command line mdoc pages
+##
+## This file is part of AutoOpts, a companion to AutoGen.
+## AutoOpts is free software.
+## AutoOpts is Copyright (C) 1992-2013 by Bruce Korb - all rights reserved
+##
+## AutoOpts is available under any one of two licenses. The license
+## in use must be one of these two and the choice is under the control
+## of the user of the license.
+##
+## The GNU Lesser General Public License, version 3 or later
+## See the files "COPYING.lgplv3" and "COPYING.gplv3"
+##
+## The Modified Berkeley Software Distribution License
+## See the file "COPYING.mbsd"
+##
+## These files have the following sha256 sums:
+##
+## 8584710e9b04216a394078dc156b781d0b47e1729104d666658aecef8ee32e95 COPYING.gplv3
+## 4379e7444a0e2ce2b12dd6f5a52a27a4d02d39d247901d3285c88cf0d37f477b COPYING.lgplv3
+## 13aa749a5b0a454917a944ed8fffc530b784f5ead522b1aacaf4ec8aa55a6239 COPYING.mbsd
+
+# Produce a man page for section 1, 5 or 8 commands.
+# Which is selected via: -DMAN_SECTION=n
+# passed to the autogen invocation. "n" may have a suffix, if desired.
+#
+:+][+:
+
+(define head-line (lambda() (string-append
+ ".Dd " (shell "date '+%B %e %Y' | sed 's/ */ /g'")
+ "\n.Dt " UP-PROG-NAME " " man-sect " " section-name
+ "\n.Os " (shell "uname -sr") "\n") ))
+
+(define man-page #f) :+][+:
+
+INCLUDE "mdoc-synopsis.tlib" :+][+:
+INCLUDE "cmd-doc.tlib" :+][+:
+INVOKE build-doc :+][+:
+
+(out-move (string-append
+ (get "prog-name") "." man-sect)) :+][+:
+agmdoc-cmd.tpl ends here :+]
--- /dev/null
+[+: -*- Mode: nroff -*-
+
+ AutoGen5 template man
+
+# cmd-doc.tlib -- Template for command line man/mdoc pages
+#
+# This file is part of AutoOpts, a companion to AutoGen.
+# AutoOpts is free software.
+# Copyright (C) 1992-2013 Bruce Korb - all rights reserved
+#
+# AutoOpts is available under any one of two licenses. The license
+# in use must be one of these two and the choice is under the control
+# of the user of the license.
+#
+# The GNU Lesser General Public License, version 3 or later
+# See the files "COPYING.lgplv3" and "COPYING.gplv3"
+#
+# The Modified Berkeley Software Distribution License
+# See the file "COPYING.mbsd"
+#
+# These files have the following sha256 sums:
+#
+# 8584710e9b04216a394078dc156b781d0b47e1729104d666658aecef8ee32e95 COPYING.gplv3
+# 4379e7444a0e2ce2b12dd6f5a52a27a4d02d39d247901d3285c88cf0d37f477b COPYING.lgplv3
+# 13aa749a5b0a454917a944ed8fffc530b784f5ead522b1aacaf4ec8aa55a6239 COPYING.mbsd
+
+# Produce a man page for section 1, 5, 6 or 8 commands. Which is
+# selected via: -DMAN_SECTION=n. "n" may have a suffix, if desired.
+# These sections have default section names that may be overridden
+# with -DSECTIN_NAME=XX, also passed to the autogen invocation.
+#
+:+][+:
+
+ ;;# START-BUILDTREE-ISMS
+ ;;
+ (shell "CLexe=${AGexe%/agen5/*}/columns/columns
+ test -x \"${CLexe}\" || {
+ CLexe=${AGexe%/autogen}/columns
+ test -x \"${CLexe}\" || die 'columns program is not findable'
+ }")
+
+:+][+: # END-BUILDTREE-ISMS
+
+(shell "CLexe=`echo ${AGexe} | sed 's@/autogen@/columns@'`
+ test -x \"${CLexe}\" || CLexe=`which columns`")
+
+# END-INSTALL-ONLY-CODE :+][+:
+
+(define down-prog-name (string-downcase! (get "prog-name")))
+(define UP-PROG-NAME (get-up-name "prog-name"))
+
+(define command-doc #t)
+(define tmp-val (getenv "MAN_SECTION"))
+(define man-sect (if (exist? "cmd-section") (get "cmd-section") "1"))
+(define file-name "")
+(define sect-name "")
+(define macro-name "")
+(define tmp-str "")
+(define fname-line "")
+(define use-flags (exist? "flag.value"))
+(define named-mode (not (or use-flags (exist? "long-opts") )))
+
+(if (defined? 'tmp-val)
+ (if (string? tmp-val)
+ (set! man-sect tmp-val)))
+
+(define section-name
+ (if (=* man-sect "1") "User Commands"
+ (if (=* man-sect "5") "File Formats"
+ (if (=* man-sect "6") "Games"
+ (if (=* man-sect "8") "System Management"
+ (error
+ "the agman-cmd template only produces section 1, 5, 6 and 8 man pages")
+)))))
+(set! tmp-val (getenv "SECTION_NAME"))
+(if (defined? 'tmp-val) (if (string? tmp-val)
+ (set! section-name tmp-val) ))
+
+(define package-text "")
+(define package+version (and (exist? "package") (exist? "version")))
+
+(if (or (exist? "package") (exist? "version")) (begin
+ (set! package-text (string-append
+ (get "package")
+ (if package+version " (" "")
+ (get "version")
+ (if package+version ")" "") ))
+) )
+
+(define name-to-fname (lambda (nm)
+ (string-tr (string-downcase nm) " " "-") ))
+
+(define sect-line-fname (lambda () (begin
+ (out-push-new file-name)
+ (emit (string-append ".Sh \"" sect-name "\"\n"))
+ (string-append "mk-" macro-name) )))
+
+(make-tmp-dir)
+
+(define home-rc-files (exist? "homerc"))
+(define home-rc-text
+ "\nSee \\fBOPTION PRESETS\\fP for configuration files.")
+
+(define environ-init (exist? "environrc"))
+(define environ-text
+ "\nSee \\fBOPTION PRESETS\\fP for configuration environment variables.")
+
+(emit (head-line))
+(dne ".\\\" ") :+]
+.Sh NAME
+.Nm [+: prog-name :+]
+.Nd [+: prog-title :+]
+[+: INCLUDE "tpl-config.tlib" :+][+:#
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" B U I L D D O C
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE build-doc :+][+:
+
+(if (not command-doc) (begin
+ (set! home-rc-files #f)
+ (set! home-rc-text "")
+) ) :+][+:
+
+INVOKE doc-sections :+][+:
+INVOKE ao-sections :+][+:
+INVOKE assemble-sections :+][+:
+
+ENDDEF build-doc
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" A S S E M B L E S E C T I O N S
+.\"
+.\" Emit the files for each section that was provided, and do conversions
+.\"
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE assemble-sections :+][+:
+
+(out-push-new)
+
+:+][+:
+#.\" Insert the sections in the prescribed order
+#.\" Ensure a newline between them all. We strip blank lines,
+#.\" so extra blank lines get removed.
+#:+]
+cvt_prog='[+:
+
+ (define target-form (if man-page "man" "mdoc"))
+ (define source-form (get "option-format" "texi"))
+ (define converter (string-append source-form "2" target-form ))
+ (set! tmp-str (find-file converter))
+
+ (if (not (defined? 'tmp-str))
+ (error (string-append "cannot locate " converter)))
+ tmp-str
+:+]'
+cvt_prog=`cd \`dirname "$cvt_prog"\` >/dev/null && pwd
+ `/`basename "$cvt_prog"`
+cd $tmp_dir
+test -x "$cvt_prog" || die "'$cvt_prog' is not executable"
+{
+ list='synopsis description options option-presets'
+ for f in $list ; do cat $f ; echo ; done
+ rm -f $list name
+ list='implementation-notes environment files examples exit-status errors
+ compatibility see-also conforming-to history authors copyright bugs
+ notes'
+ for f in $list ; do cat $f ; echo ; done > .end-doc
+ rm -f $list
+ list=`ls -1 *`' .end-doc'
+ for f in $list ; do cat $f ; echo ; done
+ rm -f $list
+} 1>.doc 2>/dev/null
+[+:
+IF (exist? "doc-sub") :+][+:
+ (out-push-new (string-append tmp-dir "/.cmds")) :+][+:
+ FOR doc-sub :+][+:
+
+ IF (define field-name (get "sub-type" target-form))
+ (~~ target-form field-name) :+][+:
+
+ (set! field-name (get "sub-name"))
+ (define rep-string (string-append "<<" field-name ">>"))
+ (emit (string-substitute (get "sub-text") rep-string (get field-name)))
+ "\n"
+
+ :+][+: ENDIF :+][+:
+
+ ENDFOR doc-sub :+][+:
+
+ (out-pop)
+ (define post-proc-cmd (string-append
+ (get "doc-sub-cmd" "sed -f %s %s") " | "
+ egrep-prog " -v '^[ ]*$' | $cvt_prog"))
+ (sprintf post-proc-cmd ".cmds" ".doc")
+ :+][+:
+ELSE \:+]
+[+:(. egrep-prog):+] -v '^[ ]*$' .doc | $cvt_prog[+:
+ENDIF doc-sub exists :+][+:
+
+(shell (out-pop #t)) :+][+:
+
+ENDDEF assemble-sections
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" D O C S E C T I O N S
+.\"
+.\" Emit the files for each section that was provided.
+.\" If multiple sections exist, they get glued together with ".Pp"
+.\" between them.
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE doc-sections :+][+:
+
+FOR doc-section :+][+:
+ IF
+ (define sec-type (string-upcase (get "ds-type")))
+ (define sec-name (name-to-fname sec-type))
+ (define cvt-fn (find-file (string-append
+ (get "ds-format" "man") "2mdoc")))
+ (if (not (defined? 'cvt-fn))
+ (error (sprintf "Cannot locate converter for %s"
+ (get "ds-format" "man"))))
+
+ (define sec-file (string-append tmp-dir "/" sec-name))
+ (access? sec-file R_OK) :+][+:
+ (out-push-add sec-file)
+ (emit ".Pp\n") :+][+:
+
+ ELSE :+][+: CASE
+ (out-push-new sec-file)
+ sec-type :+][+:
+
+ == "" :+][+: (error "unnamed doc-section") :+][+:
+ *==* " " :+].Sh "[+: (. sec-type) :+]"[+:
+ * :+].Sh [+: (. sec-type) :+][+:
+ ESAC :+][+:
+ ENDIF :+]
+[+:
+ (shell (string-append
+ "fn='" cvt-fn "'\n"
+ "test -f ${fn} || die ${fn} not found from $PWD\n"
+ "${fn} <<\\_EndOfDocSection_ || die ${fn} failed in $PWD\n"
+ (get "ds-text")
+ "\n_EndOfDocSection_"
+ )) :+][+:
+
+ CASE (emit "\n") sec-type :+][+:
+ == FILES :+][+:
+ (if home-rc-files (emit home-rc-text))
+ (set! home-rc-files #f) :+][+:
+
+ == ENVIRONMENT :+][+:
+ (if environ-init (emit environ-text))
+ (set! environ-init #f) :+][+:
+ ESAC :+][+:
+
+ (out-pop)
+ :+][+:
+
+ENDFOR doc-section :+][+:
+
+ENDDEF doc-sections
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" A O S E C T I O N S
+.\"
+.\" Emit the files for the sections that these templates augment,
+.\" replace or conditionally replace
+.\"
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE ao-sections :+][+:
+ IF (. command-doc) :+][+:
+ INVOKE cond-section sec = "OPTIONS" mode = "replace" :+][+:
+ INVOKE cond-section sec = "EXIT STATUS" mode = "insert" :+][+:
+
+ IF (or home-rc-files environ-init) :+][+:
+ INVOKE cond-section sec = "OPTION PRESETS" mode = "replace" :+][+:
+
+ IF (. home-rc-files) :+][+:
+ INVOKE cond-section sec = "FILES" mode = "append" :+][+:
+ ENDIF :+][+:
+
+ IF (. environ-init) :+][+:
+ INVOKE cond-section sec = "ENVIRONMENT" mode = "append" :+][+:
+ ENDIF :+][+:
+ ENDIF :+][+:
+
+ ELSE section 5, not command :+][+:
+ INVOKE cond-section sec = "FILES" mode = "append" :+][+:
+ ENDIF section 5/not :+][+:
+
+ INVOKE cond-section sec = "SYNOPSIS" mode = "alt" :+][+:
+ INVOKE cond-section sec = "DESCRIPTION" mode = "append" :+][+:
+ INVOKE cond-section sec = "AUTHORS" mode = "alt" :+][+:
+ INVOKE cond-section sec = "BUGS" mode = "append" :+][+:
+ INVOKE cond-section sec = "NOTES" mode = "append" :+][+:
+
+IF (exist? "copyright") :+][+:
+ INVOKE cond-section sec = "COPYRIGHT" mode = "alt" :+][+:
+ENDIF :+][+:
+
+ENDDEF ao-sections
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" C O N D I T I O N A L S E C T I O N
+.\"
+.\" Figure out what to do for AutoOpts required sections, depending on "mode"
+.\" In all cases, if the file does not exist, invoke the "mk" macro to create
+.\" a new file. If it does exist, then:
+.\"
+.\" alt Alternate -- emit no text
+.\" replace throw away any pre-existing file.
+.\" append invoke the "append" macro to emit additional text
+.\" insert save the current contents, replacing the .Sh line with .Pp.
+.\" invoke the "mk" macro then emit the saved text
+.\"
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE cond-section :+][+:
+
+ IF
+ (set! sect-name (string-upcase! (string-substitute
+ (get "sec") "-" " " )))
+ (set! macro-name (string-downcase! (string-substitute
+ sect-name " " "-" )))
+ (set! file-name (string-append tmp-dir "/" macro-name))
+
+ (not (access? file-name R_OK)) :+][+:
+
+ INVOKE (sect-line-fname) :+][+:
+
+ ELSE file exists :+][+:
+
+ CASE (get "mode") :+][+:
+
+ == replace :+][+:
+ INVOKE (sect-line-fname) :+][+:
+
+ == append :+][+:
+ (out-push-add file-name) :+][+:
+ INVOKE (string-append "append-" macro-name) :+][+:
+
+ == insert :+][+:
+ (set! fname-line (shellf
+ "sed '1s/.Sh .*/.Pp/' %1$s ; rm -f %1$s" file-name)) :+][+:
+ INVOKE (sect-line-fname) :+][+:
+
+ == alt :+][+:
+ (out-push-new) :+][+:
+
+ * :+][+:
+ (error (sprintf "invalid section type: %s" (get "mode")))
+
+ :+][+:
+ ESAC :+][+:
+
+ ENDIF file existence/non-existence :+][+:
+ (out-pop) :+][+: # All paths open out :+][+:
+ENDDEF cond-section
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - D E S C R I P T I O N
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-description :+][+:
+
+ (out-push-new)
+ (emit
+ (if (exist? "prog-man-descrip")
+ (stack-join "\n.Pp\n" "prog-man-descrip")
+ (if (exist? "detail")
+ (stack-join "\n.Pp\n" "detail")
+ "There is no description for this command."
+ ) ) )
+ (shell "sed 's/^$/.sp/' <<\\_EODesc_\n" (out-pop #t) "\n_EODesc_")
+
+ :+][+:
+ INVOKE append-description :+][+:
+
+ENDDEF mk-description
+
+.\" = = = = = = = = = = = = = = = = = =
+.\" A P P E N D - D E S C R I P T I O N
+.\" = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE append-description :+][+:
+
+IF (= (get "main.main-type") "for-each"):+][+:
+
+ CASE main.handler-type :+][+:
+ ~* ^(name|file)|.*text \:+]
+.Pp
+This program will perform its function for every file named on the command
+line or every file named in a list read from stdin. The arguments or input
+names must be pre\-existing files. The input list may contain comments,
+which[+:
+
+ !E \:+]
+.Pp
+This program will perform its function for every command line argument
+or every non\-comment line in a list read from stdin.
+The input list comments[+:
+
+ * :+][+:
+ (error "the 'for-each' main has in invalid handler-type.") :+][+:
+ ESAC \:+]
+ are blank lines or lines beginning with a '[+:
+ ?% comment-char "%s" "#" :+]' character.
+[+:
+
+ENDIF - "main" is of "for-each" type :+][+:
+
+ENDDEF append-description
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - O P T I O N S
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-options
+
+:+][+:
+
+(define opt-arg "")
+(define dis-name "")
+(define opt-name "")
+(define optname-from "A-Z_^")
+(define optname-to "a-z--")
+(define cvt-cmd "")
+(define formatted-doc (exist? "option-format"))
+
+(if formatted-doc (begin
+ (out-push-new)
+ (set! cvt-cmd (string-append (get "option-format") "2mdoc"))
+) )
+
+(if (exist? "preserve-case")
+ (begin
+ (set! optname-from "_^")
+ (set! optname-to "--")
+) )
+
+(define fix-optname (lambda (o_nm) (begin
+ (set! o_nm (string-tr o_nm optname-from optname-to))
+ (set! o_nm (string-substitute o_nm "-" "\\-" ))
+ o_nm )))
+
+(if (exist? "option-info")
+ (string-append ".Pp\n" (get "option-info") "\n") )
+\:+]
+.Bl -tag[+:
+
+FOR flag :+][+:
+ IF (not (exist? "documentation")) :+][+:
+ IF (exist? "aliases") :+][+:
+ INVOKE emit-alias-opt :+][+:
+ ELSE :+][+:
+ INVOKE emit-flag-text :+][+:
+ ENDIF :+][+:
+
+ ELSE :+]
+.Ss "[+: (get "descrip" "") :+]"[+:
+(set! tmp-str (get "documentation" ""))
+(if (> (string-length tmp-str) 3) (string-append
+ "\n" tmp-str "\n" )) :+][+:
+
+ ENDIF :+][+:
+ENDFOR flag
+
+.\" = = = = = = = = = = = = = = = = =
+.\" help option
+.\" = = = = = = = = = = = = = = = = =
+
+:+]
+.It [+:
+ (define tmp-val (get "help-value" "\\&?"))
+ (if (and use-flags (> (string-length tmp-val) 0))
+ (string-append "Fl " tmp-val
+ (if (exist? "long-opts") " , Fl -help" "") )
+ (string-append (if (exist? "long-opts") "Fl -" "") "help" )
+ ) \:+]
+
+Display usage information and exit.[+:#
+
+.\" = = = = = = = = = = = = = = = = =
+.\" more-help option
+.\" = = = = = = = = = = = = = = = = = :+][+:
+
+ IF (not (exist? "no-libopts")) :+]
+.It [+:
+ (define tmp-val (get "more-help-value" "\\&!"))
+ (if (and use-flags (> (string-length tmp-val) 0))
+ (string-append "Fl " tmp-val
+ (if (exist? "long-opts") " , Fl -more-help" "") )
+ (string-append (if (exist? "long-opts") "Fl -" "") "more-help" )
+ ) \:+]
+
+Pass the extended usage information through a pager.[+:
+
+ENDIF no no-libopts
+
+.\" = = = = = = = = = = = = = = = = =
+.\" save and load configuration
+.\" = = = = = = = = = = = = = = = = = :+][+:
+
+IF (exist? "homerc") :+]
+.It [+:
+
+ IF (not (exist? "disable-save")) :+][+:
+
+ (define tmp-val (get "save-opts-value" ">"))
+ (if (and use-flags (> (string-length tmp-val) 0))
+ (string-append "Fl " tmp-val " Oo Ar cfgfile Oc"
+ (if (exist? "long-opts")
+ " , Fl -save-opts Oo Ns = Ns Ar cfgfile Oc" ) "")
+ (string-append (if (exist? "long-opts") "Fl -" "")
+ "save-opts Oo Ns = Ns Ar cfgfile Oc" )
+ ) \:+]
+
+Save the option state to \fIcfgfile\fP. The default is the \fIlast\fP
+configuration file listed in the \fBOPTION PRESETS\fP section, below.
+The command will exit after updating the config file.
+.It [+:
+ ENDIF saving not disabled :+][+:
+
+ (define tmp-val (get "load-opts-value" "<"))
+ (define tmp-str (if (exist? "long-opts") "Fl -" ""))
+
+ (if (and use-flags (> (string-length tmp-val) 0))
+ (string-append "Fl " tmp-val " Ar cfgfile"
+ (if (exist? "long-opts")
+ (string-append " , " tmp-str "load-opts Ns = Ns Ar cfgfile"
+ " , " tmp-str "no-load-opts" )
+ "") )
+ (string-append tmp-str "load-opts Ns = Ns Ar cfgfile , "
+ tmp-str "no-load-opts" )
+ ) \:+]
+
+Load options from \fIcfgfile\fP.
+The \fIno-load-opts\fP form will disable the loading
+of earlier config/rc/ini files. \fI\-\-no-load-opts\fP is handled early,
+out of order.[+:
+
+ENDIF (exist? "homerc")
+
+.\" = = = = = = = = = = = = = = = = =
+.\" version
+.\" = = = = = = = = = = = = = = = = = :+][+:
+
+IF (exist? "version") :+]
+.It [+:
+
+ (define tmp-val (get "version-value" "v"))
+ (if (and use-flags (> (string-length tmp-val) 0))
+ (string-append "Fl " tmp-val " Op Brq Ar v|c|n"
+ (if (exist? "long-opts")
+ " Fl -version Op Brq Ar v|c|n" ) "")
+ (string-append (if (exist? "long-opts") "Fl -" "")
+ "version Op Brq Ar v|c|n" )
+ ) \:+]
+
+Output version of program and exit. The default mode is `v', a simple
+version. The `c' mode will print copyright information and `n' will
+print the full copyright notice.[+:
+ENDIF :+]
+.El
+[+:
+
+(if formatted-doc
+ (shell (string-append
+ "fn='" (find-file cvt-cmd)
+ "'\ntest -f ${fn} || die '" cvt-cmd " not found'\n"
+ "${fn} <<\\_EndOfMdoc_ || die ${fn} failed in $PWD\n"
+ (out-pop #t)
+ "\n_EndOfMdoc_" )) ) :+][+:
+
+ENDDEF mk-options
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - O P T I O N - P R E S E T S
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-option-presets \:+]
+Any option that is not marked as \fInot presettable\fP may be preset
+by loading values from [+:
+ IF (. home-rc-files)
+ :+]configuration ("RC" or ".INI") file(s)[+:
+ IF (. environ-init) :+] and values from
+[+:
+ ENDIF :+][+:
+ ENDIF :+][+:
+ IF (. environ-init) :+]environment variables named:
+.nf
+ \fB[+:(. UP-PROG-NAME):+]_<option-name>\fP or \fB[+:(. UP-PROG-NAME):+]\fP
+.fi
+.ad[+:
+ IF (. home-rc-files) :+]
+The environmental presets take precedence (are processed later than)
+the configuration files.[+:
+ ENDIF :+][+:
+ ELSE :+].[+:
+ ENDIF :+][+:
+
+ CASE
+ (define rc-file
+ (get "rcfile" (string-append "." (get "prog-name") "rc")) )
+ (count "homerc") :+][+:
+
+ == "0" :+][+:
+ == "1" :+][+:
+
+ CASE homerc :+][+:
+ ~~ '\.|\$HOME' :+]
+The file "\fI[+: (string-append (get "homerc") "/" rc-file)
+:+]\fP" will be used, if present.[+:
+
+ == "" :+][+:
+
+ * :+]
+The \fIhomerc\fP file is "\fI[+:homerc:+]\fP", unless that is a directory.
+In that case, the file "\fI[+: (. rc-file) :+]\fP"
+is searched for within that directory.[+:
+ ESAC :+][+:
+
+ * :+]
+The \fIhomerc\fP files are [+:
+ FOR homerc ", " :+][+:
+ IF (last-for?) :+]and [+:
+ ENDIF :+]"\fI[+: homerc :+]\fP"[+: ENDFOR :+].
+If any of these are directories, then the file \fI[+: (. rc-file) :+]\fP
+is searched for within those directories.[+:
+ ESAC :+][+:
+
+ENDDEF mk-option-presets
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - E X I T - S T A T U S
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-exit-status \:+]
+One of the following exit values will be returned:
+.Bl -tag
+[+:
+(ag-fprintf 0 ".It 0 \" (EXIT_%s)\"\n%s\n"
+ (string->c-name! (string-upcase (get "exit-name[0]" "SUCCESS")))
+ (get "exit-desc[0]" "Successful program execution.") )
+
+(define need-ex-noinput (exist? "homerc"))
+(define need-ex-software #t)
+
+(ag-fprintf 0 ".It 1 \" (EXIT_%s)\"\n%s\n"
+ (string->c-name! (string-upcase (get "exit-name[1]" "FAILURE")))
+ (get "exit-desc[1]"
+ "The operation failed or the command syntax was not valid.")) :+][+:
+
+FOR exit-desc (for-from 2) :+][+:
+ (if (= (for-index) 66)
+ (set! need-ex-noinput #f)
+ (if (= (for-index) 70)
+ (set! need-ex-software #f) ))
+
+ (set! tmp-str (get (sprintf "exit-name[%d]" (for-index)) "* unnamed *"))
+ (sprintf ".It %d \" (EXIT_%s)\"\n%s\n"
+ (for-index)
+ (string-upcase (string->c-name! tmp-str))
+ (get "exit-desc" "")) :+][+:
+ENDFOR exit-desc :+][+:
+(if need-ex-noinput
+ (emit ".It 66 \" (EX_NOINPUT)\"
+A specified configuration file could not be loaded.\n"))
+
+(if need-ex-software
+ (emit ".It 70 \" (EX_SOFTWARE)\"
+libopts had an internal operational error. Please report
+it to autogen-users@lists.sourceforge.net. Thank you.\n"))
+
+(if (> (string-length fname-line) 1)
+ (emit fname-line)) :+]
+.El
+[+:
+
+ENDDEF mk-exit-status
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - A U T H O R S
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-authors :+][+:
+
+ (define remove-authors #t)
+
+ (set! tmp-val
+ (if (exist? "copyright.author")
+ (stack-join ",\n" "copyright.author")
+ (stack-join ",\n" "copyright.owner") ))
+
+ (if (> (string-length tmp-val) 1)
+ (string-append tmp-val "\n")
+ (delete-file file-name))
+
+ :+][+:
+
+ENDDEF mk-authors
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - B U G S
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-bugs :+][+:
+
+ (set! tmp-val (get "copyright.eaddr" (get "eaddr")))
+ (if (> (string-length tmp-val) 1)
+ (string-append "Please send bug reports to: " tmp-val "\n")
+ (delete-file file-name) )
+ :+][+:
+
+ENDDEF mk-bugs :+][+:
+
+DEFINE append-bugs :+][+:
+
+ (set! tmp-val (get "copyright.eaddr" (get "eaddr")))
+ (if (> (string-length tmp-val) 1)
+ (string-append "\n.Pp\nPlease send bug reports to: " tmp-val "\n") )
+ :+][+:
+
+ENDDEF append-bugs
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - C O P Y R I G H T (+ licensing)
+.\"
+.\" This section is guaranteed to be the last section in the man page
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-copyright \:+]
+Copyright (C) [+: copyright.date :+] [+:
+ (get "copyright.owner" (get "copyright.author" (get "copyright.eaddr")))
+ :+] all rights reserved.
+[+: CASE (get "copyright.type") :+][+:
+ = note :+][+: (get "copyright.text") :+][+:
+ == '' :+]This program has an unspecified license.[+:
+
+ * :+][+:
+ (string-append "This program is released under the terms of "
+ (license-name (get "copyright.type")) ".") :+][+:
+
+ ESAC :+]
+[+:
+ENDDEF mk-copyright
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - N O T E S
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-notes \:+]
+This manual page was \fIAutoGen\fP-erated from the \fB[+: prog-name :+]\fP
+option definitions.
+[+:
+
+ENDDEF mk-notes
+
+.\" = = = = = APPEND TO IT: :+][+:
+
+DEFINE append-notes :+]
+.Pp
+This manual page was \fIAutoGen\fP-erated from the \fB[+: prog-name :+]\fP
+option definitions.[+:
+
+ENDDEF append-notes
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - E N V I R O N M E N T
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-environment :+][+:
+ INVOKE append-environment :+][+:
+ENDDEF mk-environment
+
+.\" = = = = = APPEND TO IT: :+][+:
+
+DEFINE append-environment :+]
+[+:(. environ-text) :+][+:
+ENDDEF append-environment
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" M K - F I L E S
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE mk-files :+][+:
+ INVOKE append-files :+][+:
+ENDDEF mk-files
+
+.\" = = = = = APPEND TO IT: :+][+:
+
+DEFINE append-files :+]
+[+:(. home-rc-text) :+][+:
+ENDDEF append-files
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" E M I T A L I A S O P T
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE emit-alias-opt :+]
+.It [+:
+ IF (exist? "value") :+][+:
+ IF (exist? "long-opts") \:+]
+ Fl [+:value:+] , Fl \-[+: name :+][+:
+ ELSE \:+]
+ Fl [+:value:+][+:
+ ENDIF (exist? "long-opts") :+][+:
+
+ ELSE value does not exist -- named option only :+][+:
+
+ IF (not (exist? "long-opts")) \:+]
+ [+: name :+][+:
+ ELSE \:+]
+ Fl \-[+: (get "name") :+][+:
+ ENDIF :+][+:
+ ENDIF :+]
+This is an alias for the \fI--[+: aliases :+]\fR option.[+:
+ IF (exist? "deprecated") :+]
+.sp
+.B
+NOTE: THIS OPTION IS DEPRECATED
+[+:
+ ENDIF :+][+:
+ENDDEF emit-alias-opt
+
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+.\" E M I T F L A G T E X T
+.\" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = :+][+:
+
+DEFINE emit-flag-text :+][+:
+
+ (if (exist? "enable")
+ (set! opt-name (string-append (get "enable") "-" (get "name")))
+ (set! opt-name (get "name")) )
+ (if (exist? "disable")
+ (set! dis-name (string-append (get "disable") "-" (get "name")))
+ (set! dis-name "") )
+
+ (set! opt-name (fix-optname opt-name))
+ (if (> (string-length dis-name) 0)
+ (set! dis-name (fix-optname dis-name)) )
+
+ (if (not (exist? "arg-type"))
+ (set! opt-arg "")
+ (set! opt-arg (string-append "Ar "
+ (fix-optname (if (exist? "arg-name")
+ (get "arg-name")
+ (string-downcase! (get "arg-type")) ))
+ ))
+ )
+
+:+]
+.It [+:
+ IF (exist? "value") :+][+:
+ IF (exist? "long-opts") :+][+:
+
+ # * * * * * * * * * * * * * * * * * * * *
+ *
+ * The option has a flag value (character) AND
+ * the program uses long options
+ *
+ \:+]
+ Fl [+:value:+][+:
+ IF (not (exist? "arg-type")) :+] , Fl -[+:
+ ELSE :+] [+:(. opt-arg):+] , Fl -[+:
+ ENDIF :+][+: (. opt-name) :+] [+:
+ IF (exist? "arg-type") :+][+:
+ ? arg-optional Oo Ns = Ns
+ :+] [+: (. opt-arg) :+] [+:
+ arg-optional Oc :+][+:
+ ENDIF :+][+:
+ IF (exist? "disable") :+] , Fl -[+:(. dis-name):+][+:
+ ENDIF :+][+:
+
+ ELSE :+][+:
+
+ # * * * * * * * * * * * * * * * * * * * *
+ *
+ * The option has a flag value (character) BUT
+ * the program does _NOT_ use long options
+ *
+ \:+]
+ Fl [+:value:+] [+:
+ IF (exist? "arg-type") :+][+:
+ arg-optional Oo :+] [+:(. opt-arg):+] [+:
+ arg-optional Oc :+] [+:
+ ENDIF " :+][+:
+ ENDIF (exist? "long-opts") :+][+:
+
+
+ ELSE value does not exist -- named option only :+][+:
+
+ IF (not (exist? "long-opts")) :+][+:
+
+ # * * * * * * * * * * * * * * * * * * * *
+ *
+ * The option does not have a flag value (character).
+ * The program does _NOT_ use long options either.
+ * Special magic: All arguments are named options.
+ *
+ \:+]
+ [+: (. opt-name) :+] [+:
+ IF (exist? "arg-type") :+] [+:
+ ? arg-optional ' Oo = Ns' ' Ns = Ns '
+ :+] [+:(. opt-arg) :+] [+:
+ arg-optional Oc :+] [+:
+ ENDIF:+][+:
+ IF (exist? "disable") :+] , Fl -[+:(. dis-name):+][+:
+ ENDIF :+][+:
+
+
+ ELSE :+][+:
+ # * * * * * * * * * * * * * * * * * * * *
+ *
+ * The option does not have a flag value (character).
+ * The program, instead, only accepts long options.
+ *
+ \:+]
+ Fl -[+: (. opt-name) :+] [+:
+
+ IF (exist? "arg-type") :+][+:
+ arg-optional Oo :+] Ns = Ns [+:(. opt-arg):+] [+:
+ arg-optional Oc :+][+:
+ ENDIF :+][+:
+
+ IF (exist? "disable")
+ :+], " Fl \-[+:(. dis-name):+]"[+:
+ ENDIF :+][+:
+ ENDIF :+][+:
+ ENDIF :+]
+[+: (get "descrip" "") :+].[+:
+
+ IF (exist? "min") :+]
+This option is required to appear.[+:
+ ENDIF :+][+:
+
+ IF (exist? "max") :+]
+This option may appear [+:
+ IF % max (= "%s" "NOLIMIT")
+ :+]an unlimited number of times[+:ELSE
+ :+]up to [+: max :+] times[+:
+ ENDIF:+].[+:
+ ENDIF:+][+:
+
+ IF (exist? "disable") :+]
+The \fI[+:(. dis-name):+]\fP form will [+:
+ IF (exist? "stack-arg")
+ :+]clear the list of option arguments[+:
+ ELSE :+]disable the option[+:
+ ENDIF :+].[+:
+ ENDIF:+][+:
+
+ IF (exist? "enabled") :+]
+This option is enabled by default.[+:
+ ENDIF :+][+:
+
+ IF (exist? "no-preset") :+]
+This option may not be preset with environment variables
+or in initialization (rc) files.[+:
+ ENDIF :+][+:
+
+ IF (and (exist? "default") named-mode) :+]
+This option is the default option.[+:
+ ENDIF :+][+:
+
+ IF (exist? "equivalence") :+]
+This option is a member of the [+:equivalence:+] class of options.[+:
+ ENDIF :+][+:
+
+ IF (exist? "flags-must") :+]
+This option must appear in combination with the following options:
+[+: FOR flags-must ", " :+][+:flags-must:+][+:ENDFOR:+].[+:
+ ENDIF :+][+:
+
+ IF (exist? "flags-cant") :+]
+This option must not appear in combination with any of the following options:
+[+: FOR flags-cant ", " :+][+:flags-cant:+][+:ENDFOR:+].[+:
+ ENDIF :+][+:
+
+
+ IF (~* (get "arg-type") "key|set") :+]
+This option takes a keyword as its argument[+:
+
+ IF (=* (get "arg-type") "set")
+
+:+] list. Each entry turns on or off
+membership bits. The bits are set by name or numeric value and cleared
+by preceding the name or number with an exclamation character ('!').
+They can all be cleared with the magic name \fInone\fR and they can all be set
+with
+.IR all .
+A single option will process a list of these values.[+:
+
+ ELSE
+
+:+]. The argument sets an enumeration value that can
+be tested by comparing them against the option value macro.[+:
+
+ ENDIF
+
+:+]
+The available keywords are:
+.in +4
+.nf
+.na
+[+: (shellf "${CLexe} --indent='' --spread=1 -W50 <<_EOF_\n%s\n_EOF_"
+ (join "\n" (stack "keyword")) ) :+]
+.fi
+or their numeric equivalent.
+.in -4[+: (if (exist? "arg-default") "\n.sp" ) :+][+:
+
+ ELIF (=* (get "arg-type") "num") :+]
+This option takes an integer number as its argument.[+:
+
+ IF (exist? "arg-range") :+]
+The value of
+.[+:(. opt-arg):+]
+is constrained to being:
+.in +4
+.nf
+.na[+:FOR arg_range ", or" :+]
+[+: (shellf "
+range='%s'
+
+case \"X${range}\" in
+X'->'?* )
+ echo \"less than or equal to\" `
+ echo $range | sed 's/->//' ` ;;
+
+X?*'->' )
+ echo \"greater than or equal to\" `
+ echo $range | sed 's/->.*//' ` ;;
+
+X?*'->'?* )
+ echo \"in the range \" `
+ echo $range | sed 's/->/ through /' ` ;;
+
+X?* )
+ echo exactly $range ;;
+
+X* ) echo $range is indeterminate
+esac"
+
+(get "arg-range") )
+:+][+:
+ ENDFOR arg-range :+]
+.fi
+.in -4[+:
+
+ ENDIF arg-range exists :+][+:
+
+ ENDIF arg-type key/set/num :+][+:
+
+ IF (exist? "arg-default") :+]
+The default
+.[+: (. opt-arg) :+]
+for this option is:
+.ti +4
+ [+: (join " + " (stack "arg-default" )) :+][+:
+ ENDIF :+]
+.sp
+[+:
+ (if (exist? "doc") (string-substitute (get "doc" "") "\n\n" "\n.sp\n")
+ "This option has not been fully documented." ) :+][+:
+ IF (exist? "deprecated") :+]
+.sp
+.B
+NOTE: THIS OPTION IS DEPRECATED
+[+:
+ ENDIF :+][+:
+
+ENDDEF emit-flag-text
+
+.\" cmd-doc.tlib ends here \:+]
--- /dev/null
+[+: autogen5 template man :+][+:
+DEFINE mk-synopsis :+][+:
+ (out-push-new file-name) \:+]
+.Sh SYNOPSIS
+.Nm[+:
+
+ IF (. use-flags) :+][+:
+ IF (exist? "long-opts") :+]
+.\" Mixture of short (flag) options and long options
+.Op Fl flags
+.Op Fl flag Op Ar value
+.Op Fl \-option-name Ns Oo Oo Ns "=| " Oc Ns Ar value Oc
+[+: ELSE no long options: :+]
+.Op Fl flags
+.Op Fl flag Op Ar value
+[+: ENDIF
+ :+][+:
+ ELIF (exist? "long-opts")
+ :+]
+.Op Fl \-option-name
+.Op Fl \-option-name Ar value
+[+:
+
+ ELIF (not (exist? "argument")) :+]
+.Op Ar option\-name Ar value
+.Pp
+All arguments are named options.
+[+:
+ ENDIF :+][+:
+
+ IF (exist? "argument") :+][+:
+ argument :+][+:
+
+ IF (exist? "reorder-args") :+]
+.Pp
+Operands and options may be intermixed. They will be reordered.
+[+: ENDIF :+][+:
+
+ ELIF (or (exist? "long-opts") use-flags)
+
+:+]
+.Pp
+All arguments must be options.
+[+:
+
+ ENDIF :+][+:
+
+ IF (exist? "main") :+][+:
+ CASE main.main-type :+][+:
+ == shell-process :+]
+.Pp
+This program will emit text that is expected to be evaluated by
+a Bourne-compatible shell, thus digesting the options for the script.[+:
+
+ == shell-parser :+]
+.Pp
+This program is designed to produce output suitable for inclusion
+into a shell script that will parse the options described.[+:
+
+ == for-each :+]
+.Pp
+The operands that this program operates on may be specified either
+on the command line or read from standard input, one per line.
+In that input, leading and trailing white space is stripped,
+blank lines are ignored[+:
+
+ IF (define comment-char (get "comment-char" "#"))
+ (> (string-length comment-char) 1) \:+]
+ and lines beginning with the character
+.I [+: (substring comment-char 1 0):+]
+are treated as comments[+:
+ ENDIF :+].[+:
+
+ IF (exist? "interleaved") :+]
+Options may be interleaved with operands both on the command
+line and when operands are read from standard input.[+:
+ ENDIF interleaved
+
+:+]
+Standard input may not be a terminal.[+:
+
+ ESAC main-type :+][+:
+ ENDIF main exists :+]
+.Pp
+[+:
+
+FOR explain "\n.Pp\n" :+][+:
+ (get "explain" "") :+][+:
+ENDFOR :+][+:
+
+(out-pop) :+][+:
+ENDDEF mk-synopsis :+]
--- /dev/null
+#!/usr/bin/perl
+package mdoc2man;
+use strict;
+use warnings;
+use File::Basename;
+use lib dirname(__FILE__);
+use Mdoc qw(hs ns pp mapwords son soff stoggle gen_encloser);
+
+########
+## Basic
+########
+
+Mdoc::def_macro( '.Sh', sub { '.SH', hs, @_ }, raw => 1);
+Mdoc::def_macro( '.Ss', sub { '.SS', hs, @_ }, raw => 1);
+Mdoc::def_macro( '.Pp', sub { ".sp \\n(Ppu\n.ne 2\n" } );
+Mdoc::def_macro( '.Nd', sub { "\\- @_" } );
+
+# Macros that enclose things
+Mdoc::def_macro( '.Brq', gen_encloser(qw({ })) , greedy => 1 );
+Mdoc::def_macro( '.Op' , gen_encloser(qw([ ])) , greedy => 1 );
+Mdoc::def_macro( '.Qq' , gen_encloser(qw(" ")) , greedy => 1 );
+Mdoc::def_macro( '.Dq' , gen_encloser(qw(\*[Lq] \*[Rq])), greedy => 1 );
+Mdoc::def_macro( '.Ql' , gen_encloser(qw(\[oq] \[cq])) , greedy => 1 );
+Mdoc::def_macro( '.Sq' , gen_encloser(qw(\[oq] \[cq])) , greedy => 1 );
+Mdoc::def_macro( '.Pq' , gen_encloser(qw/( )/) , greedy => 1 );
+Mdoc::def_macro( '.D1' , sub { ".in +4\n", ns, @_ , ns , "\n.in -4" } , greedy => 1);
+
+Mdoc::def_macro( 'Oo', sub { '[', @_ } );
+Mdoc::def_macro( 'Oc', sub { ']', @_ } );
+
+Mdoc::def_macro( 'Po', sub { '(', @_} );
+Mdoc::def_macro( 'Pc', sub { ')', @_ } );
+
+Mdoc::def_macro( 'Bro', sub { '{', ns, @_ } );
+Mdoc::def_macro( 'Brc', sub { '}', @_ } );
+
+Mdoc::def_macro( '.Oo', gen_encloser(qw([ ])), concat_until => '.Oc' );
+Mdoc::def_macro( '.Bro', gen_encloser(qw({ })), concat_until => '.Brc' );
+Mdoc::def_macro( '.Po', gen_encloser(qw/( )/), concat_until => '.Pc' );
+
+Mdoc::def_macro( '.Ev', sub { @_ } );
+Mdoc::def_macro( '.An', sub { ".NOP ", @_, "\n.br" }, raw => 1 );
+Mdoc::def_macro( '.Li', sub { mapwords {"\\f[C]$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Cm', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Ic', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Fl', sub { mapwords {"\\f\\*[B-Font]\\-$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Ar', sub { mapwords {"\\f\\*[I-Font]$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Em', sub { mapwords {"\\fI$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Va', sub { mapwords {"\\fI$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Sx', sub { mapwords {"\\fI$_\\f[]"} @_ } );
+Mdoc::def_macro( '.Xr', sub { "\\fC".(shift)."\\fR(".(shift).")\\f[]", @_ } );
+Mdoc::def_macro( '.Fn', sub { "\\f\\*[B-Font]".(shift)."\\fR()\\f[]" } );
+Mdoc::def_macro( '.Fn', sub { "\\fB".(shift)."\\fR()\\f[]" } );
+Mdoc::def_macro( '.Fx', sub { "FreeBSD", @_ } );
+Mdoc::def_macro( '.Ux', sub { "UNIX", @_ } );
+
+Mdoc::def_macro( '.No', sub { ".NOP", map { ($_, ns) } @_ } );
+Mdoc::def_macro( '.Pa', sub { mapwords {"\\fI$_\\f[]"} @_; } );
+{
+ my $name;
+ Mdoc::def_macro('.Nm', sub {
+ $name = shift if (!$name);
+ "\\f\\*[B-Font]$name\\fP", @_
+ } );
+}
+
+########
+## lists
+########
+
+my %lists = (
+ bullet => sub {
+ Mdoc::def_macro('.It', sub { '.IP \fB\(bu\fP 2' });
+ },
+
+ tag => sub {
+ my (%opts) = @_;
+
+ my $width = '';
+
+ if (exists $opts{width}) {
+ $width = ' '.((length $opts{width})+1);
+ }
+
+ if (exists $opts{compact}) {
+ my $dobrns = 0;
+ Mdoc::def_macro('.It', sub {
+ my @ret = (".TP$width\n.NOP", hs);
+ if ($dobrns) {
+ ".br\n.ns\n", ns, @ret, @_;
+ }
+ else {
+ $dobrns = 1;
+ @ret, @_;
+ }
+ }, raw => 1);
+ }
+ else {
+ Mdoc::def_macro('.It', sub {
+ ".TP$width\n.NOP", hs, @_
+ }, raw => 1);
+ }
+ },
+);
+
+Mdoc::set_Bl_callback(do { my $nested = 0; sub {
+ my $type = shift;
+ my %opts = Mdoc::parse_opts(@_);
+ if (defined $type && $type =~ /-(\w+)/ && exists $lists{$1}) {
+
+ # Wrap nested lists with .RS and .RE
+ Mdoc::set_El_callback(sub {
+ return '.RE' if $nested-- > 1;
+ return '.PP';
+ });
+
+ $lists{$1}->(%opts);
+
+ if ($nested++) {
+ return ".RS";
+ }
+ else {
+ return ();
+ }
+ }
+ else {
+ die "Invalid list type <$type>";
+ }
+}}, raw => 1);
+
+# don't bother with arguments for now and do what mdoc2man'.sh' did
+
+Mdoc::def_macro('.Bd', sub { ".br\n.in +4\n.nf" } );
+Mdoc::def_macro('.Ed', sub { ".in -4\n.fi" } );
+
+Mdoc::set_Re_callback(sub {
+ my ($reference) = @_;
+ <<"REF";
+$reference->{authors},
+\\fI$reference->{title}\\fR,
+$reference->{optional}\n.PP
+REF
+});
+
+# Define all macros which have the same sub for inline and standalone macro
+for (qw(Xr Em Ar Fl Ic Cm Qq Op Nm Pa Sq Li Va Brq Pq Fx Ux)) {
+ my $m = Mdoc::get_macro(".$_");
+ Mdoc::def_macro($_, delete $m->{run}, %$m);
+}
+
+sub print_line {
+ print shift."\n";
+}
+
+sub run {
+ print <<'DEFS';
+.de1 NOP
+. it 1 an-trap
+. if \\n[.$] \,\\$*\/
+..
+.ie t \
+.ds B-Font [CB]
+.ds I-Font [CI]
+.ds R-Font [CR]
+.el \
+.ds B-Font B
+.ds I-Font I
+.ds R-Font R
+DEFS
+
+ while (my ($macro, @args) = Mdoc::parse_line(\*STDIN, \&print_line)) {
+ my @ret = Mdoc::call_macro($macro, @args);
+ print_line(Mdoc::to_string(@ret)) if @ret;
+ }
+ return 0;
+}
+
+exit run(@ARGV) unless caller;
+
+1;
+__END__
#! /usr/bin/perl
-
+package mdoc2texi;
use strict;
-
-my ($line);
-my ($bdEd);
-my ($blCf,$blEl,@blEl,$blIt,@blIt);
-my ($progName);
-my (@words,$wc);
-my ($extArg,$ns,$sm,$wantspace);
-my ($noNl);
-my ($ref,$refCount);
-my (%anchor, $aCount);
-
-$aCount = 0;
-$noNl = 0;
-$ns = 0; # .Ns (no spaces from here to first parameter)
-$sm = 1; # Spacing mode
-$extArg = 0; # Extended Arguments - disable NLs.
-$ref = 0;
-$refCount = 0;
-
-###
-#
-# We don't know what order we'll see .Sx
-#
-# Whenever we find one, we look it up.
-# If it doesn't exist we assign it an anchor name.
-# Regardless, we "return" the anchor name, as we're either going
-# to define the anchor point using '@anchor{anchor-1}' or reference
-# the anchor using something like '@xref{anchor-1,,whatever}'
-#
-###
-
-while ($line = <STDIN>)
-{
- chomp $line;
-
- $wc = 0;
-
- if ($line =~ /^\./)
- {
- $line =~ s/^\.//;
- @words = split(/\s+/, $line);
- parseMacro();
- }
- else
- {
- print $line;
- }
-
- if ($noNl)
- {
- $noNl = 0;
- }
- elsif (!$extArg)
- {
- print "\n";
- }
-}
-
-sub Anchor ($)
-{
- my $string = shift;
-
- # Look up the provided string.
- # If it's not there, bump $aCount and "add" the anchor.
- # Return the anchor.
-
- if (!exists $anchor{$string})
- {
- ++$aCount;
- $anchor{$string} = "anchor-$aCount";
- }
-
- return $anchor{$string};
-}
-
-sub Handle_An
-{
- # We should eventually support -nosplit and -split.
- # Usage: .An <author name> ...
- # .An "Joe Author" Joe Author
- # .An "Joe Author" , Joe Author,
- # .An "Joe Author" Aq user@site Joe Author <user@site>
- # .An "Joe Author" ) ) , Joe Author)),
-
- do {
- parseQuote(\@words) if ($words[0] =~ /^"/);
- print shift @words; # XXX: Spaces?
- } while scalar(@words);
-
- # Anything else should be punctuation.
- while ($_ = shift @words)
- {
- print;
- }
-
- print "\@*";
-}
-
-sub Handle_Bd
-{
- # Must end with a .Ed.
- # Bd {-literal | -filled | -unfilled | -ragged | -centered}
- # [-offset <string>] [-file <file name>] [-compact]
-
- my ($bd);
-
- if ($words[0] eq '-literal') # Literal font display.
- {
- $bd = "\@verbatim";
- $bdEd = "\@end verbatim";
- }
- elsif ($words[0] eq '-filled') # Filled display (R/L justified)
- {
- die "Handle_Bd: -filled not supported.\n";
- $bd = "\@table \@asis";
- $bdEd = "\@end table";
- }
- elsif ($words[0] eq '-unfilled') # Display as typed.
- {
- die "Handle_Bd: -unfilled not supported.\n";
- $bd = "\@table \@asis";
- $bdEd = "\@end table";
- }
- elsif ($words[0] eq '-ragged') # Left-justified only.
- {
- die "Handle_Bd: -ragged not supported.\n";
- $bd = "\@table \@asis";
- $bdEd = "\@end table";
- }
- elsif ($words[0] eq '-centered') # Center each line.
- {
- die "Handle_Bd: -centered not supported.\n";
- $bd = "\@table \@asis";
- $bdEd = "\@end table";
- }
- else
- {
- die "Handle_Bd: Unknown list type <$words[0]>\n";
- }
-
- shift @words;
-
- while ($_ = shift @words)
- {
- if (/^-file$/)
- {
- die "Handle_Bd: -file not supported.\n";
- }
- elsif (/^-offset$/)
- {
- die "Handle_Bd: -offset not supported.\n";
- $_ = shift @words;
- if (/^left$/)
- {
- }
- elsif (/^center$/)
- {
- }
- elsif (/^indent$/)
- {
- }
- elsif (/^indent-two$/)
- {
- }
- elsif (/^right$/)
- {
- }
- else
- {
- die "Handle_Bd: Unexpected value for -offset: <$_>\n";
- }
- }
- else
- {
- die "Handle_Bd: unexpected argument: <$_>\n";
- }
- }
- print $bd;
-}
-
-sub Handle_Bl
-{
- # Must end with a .El. May be nested, including inside displays.
- #
- # .Bl {-hang | -ohang | -tag | -diag | -inset} [-width <string>] \
- # [-offset <string>]
- # .Bl -column [-offset <string>] <string1> <string2> ...
- # .Bl {-item | -enum [-nested] | -bullet | -hyphen | -dash} \
- # [-offset <string>] [-compact]
- # "-offset indent" uses a standard indent.
- # -compact suppresses insertion of vertical space before the list and
- # between the list items.
- my ($inMulti);
-
- # For nesting, save needed context:
- # $blEl
- # $blIt
- unshift @blEl, $blEl;
- unshift @blIt, $blIt;
-
- $blEl = "blEl - XXX!";
- $blIt = ""; # Would undef be easier?
-
- $inMulti = 0;
- if ($words[0] eq '-hang') # hanging tags
- {
- print "\@table \@asis";
- $blEl = "\@end table";
- }
- elsif ($words[0] eq '-ohang') # tag on its own line, no indent
- {
- print "\@table \@asis";
- $blEl = "\@end table";
- }
- elsif ($words[0] eq '-tag') # like hang.
- {
- print "\@table \@asis";
- $blEl = "\@end table";
- }
- elsif ($words[0] eq '-diag') # man (4) diagnostic list - inset
- {
- print "\@table \@asis";
- $blEl = "\@end table";
- }
- elsif ($words[0] eq '-inset') # inset list - See the mdoc page.
- {
- print "\@table \@asis";
- $blEl = "\@end table";
- }
- elsif ($words[0] eq '-column') # Multiple columns
- {
- print "\@multitable\n"; # XXX Set $wc to 0?
- $blEl = "\@end multitable";
- $blCf = "\@columnfractions";
- $inMulti = 1;
- }
- elsif ($words[0] eq '-item') # Item with no list markers
- {
- print "\@table \@asis";
- $blEl = "\@end table";
- }
- elsif ($words[0] eq '-enum') # Enumerated (numbered) list
- {
- print "\@itemize \@enumerate";
- $blEl = "\@end enumerate";
- }
- elsif ($words[0] eq '-bullet') # Bullet list
- {
- print "\@itemize \@bullet";
- $blEl = "\@end itemize";
- }
- elsif ($words[0] eq '-hyphen') # dash/hyphen list
- {
- # What would be better? Maybe a 2 column table...
- print "\@itemize \@bullet";
- $blEl = "\@end itemize";
- $blIt = "-"; # @minus ?
- }
- elsif ($words[0] eq '-dash') # dash/hyphen list
- {
- # What would be better? Maybe a 2 column table...
- print "\@itemize \@bullet";
- $blEl = "\@end itemize";
- $blIt = "-"; # @minus ?
- }
- else
- {
- die "Handle_Bl: Unknown list type <$words[0]>\n";
- }
-
- shift @words;
-
- while ($_ = shift @words)
- {
- if (/^-width$/)
- {
- # Maybe some day we will do something with the value...
- parseQuote(\@words) if ($words[0] =~ /^"/);
- shift @words;
- }
- elsif (/^-offset$/)
- {
- # Maybe some day we will do something with the value...
- shift @words;
- }
- elsif (/^-compact$/)
- {
- # No argument expected
- }
- elsif ($inMulti) # -column width
- {
- # Maybe some day we will do something with the value...
- $blCf .= " .2";
- }
- else
- {
- die "Handle_Bl: unexpected argument: <$_>\n";
- }
- }
-
- if ($blCf ne "")
- {
- print $blCf; # The \n below used to be here...
- $blCf = "";
- }
-
- print "\n";
- $wc = 0;
-}
-
-sub Handle_Comment
-{
- # print STDERR "In Handle_Comment\n";
- while ($_ = shift @words)
- {
- }
-
- $noNl = 1; # No newline needed.
-}
-
-sub Handle_It
-{
- # .It Li "sntp ntpserver.somewhere"
-
- # print STDERR "Handle_It: looking at <", join(" ",@words), ">\n"; # XXX
- # die "Handle_It: \$wc was $wc, not 0.\n" if ($wc);
-
- print "\@item";
- if ($blIt ne "")
- {
- print " $blIt";
- # Assert @words is empty?
- }
- else
- {
- do
- {
- # print STDERR "Handle_It: looking at <", join(" ",@words), ">\n"; # XXX
- parseMacro();
- } while scalar(@words);
- }
-}
-
-sub Handle_D
-{
- # .D1 Fl abcdefg <tt>-abcdefg<> # 1 line of indented text
- # .Dl % ls \-l /etc <tt>% ls -l /etc<tt> # 1 indented literal text line
-
- if (/^D1$/)
- {
- print "\@example\n";
- $wc = 0;
- parseMacro();
- print "\n\@end example";
- }
- elsif (/^Dl$/)
- {
- print "\@example\n";
- while ($_ = shift @words)
- {
- s/\\//;
- print "$_ ";
- }
- print "\n\@end example";
- }
- else
- {
- die "Handle_D(): Unexpected mode: <$_>\n";
- }
-}
-
-sub Handle_Ed
-{
- print $bdEd;
-}
-
-sub Handle_El
-{
- print $blEl;
-
- $blIt = shift @blIt;
- $blEl = shift @blEl;
-}
-
-sub Handle_Em
-{
- # Usage: .Em stuff
- # .Em word <italic>word</italic>
- # .Em or Ap ing <italic>or</italic>'ing
- #
-
- print '@emph{';
- parseMacro(); # XXX: Might we get a leading space?
- print "}";
-
- # On the assumption that the rest is punctuation...
- while ($_ = shift @words)
- {
- print;
- }
-}
-
-sub Handle_ArCmFlIcLi
-{
- # .Ar wants an italic code font, texi uses @kbd for that.
- # .Cm is .Fl but no '-'.
- # Usage: .Fl <argument> ...
- #
- # .Fl -
- # .Fl cfv -cfv
- # .Fl cfv . -cfv.
- # .Cm cfv . cfv.
- # .Fl s v t -s -v -t
- # .Fl - , --,
- # .Fl xyz ) , -xyz),
- # .Fl | - |
- # .Ic "do while {...}" do while {...}
- # .Li M1 M2 ; <tt>M1 M2<tt<tt>>;
- #
- my ($dash, $didOne, $font, $fontE);
-
- $dash = (/^Fl$/) ? "-" : "";
- $font = (/^Ar$/) ? "\@kbd{" : "\@code{"; # }
- $fontE = '}';
- $didOne = 0;
-
- do {
- if ($words[0] eq '|')
- {
- print " " if $didOne && $sm && !$ns;
- print $font, $dash, $fontE, ' ' if ($dash ne "");
- print "$words[0]";
- $ns = 0;
- }
- elsif ($words[0] eq '-')
- {
- print " " if $didOne && $sm && !$ns;
- print $font, $dash, $words[0], $fontE;
- $ns = 0;
- }
- elsif ($words[0] =~ /^"/)
- {
- print " " if $didOne && $sm && !$ns;
- print $font;
- print $dash if ($dash ne ""); # Do we need this?
- parseQuote(\@words);
- print $words[0];
- print $fontE;
- $ns = 0;
- }
- elsif ($words[0] eq 'Ar') # Argument
- {
- $font = '@kbd{'; # } slanted tty
- }
- elsif ($words[0] eq 'Ic') # Interactive/internal command
- {
- $font = '@code{'; # }
- }
- elsif ($words[0] eq 'Xc')
- {
- $sm = 1;
- }
- elsif ($words[0] eq 'Xo')
- {
- $sm = 0;
- }
- elsif ($words[0] =~ /^[[:punct:]]$/)
- {
- print $words[0];
- }
- else # Should be empty or a word
- {
- print " " if $didOne && $sm && !$ns;
- print $font;
- print $dash if ($dash ne ""); # Do we need this?
- $words[0] =~ s/\\&//;
- print $words[0];
- print $fontE;
- $ns = 0;
- }
- shift @words;
- $didOne = 1;
- } while (scalar(@words) && $words[0] ne "Op");
-}
-
-sub Handle_Fn
-{
- # Usage: .Fn <function> [<parameter>] ...
- # .Fn getchar <code>getchar</code>()
- # .Fn strlen ) , <code>strlen</code>()),
- # .Fn align "char *pt" , <code>align</code(<slant>char *pt<slant>),
- #
- my ($didArg, $isOpen);
-
- print '@code{', $words[0], "}(";
- $isOpen = 1;
- shift;
-
- $didArg = 0;
- while ($_ = shift @words)
- {
- if ($words[0] =~ /^"/) {
- # assert $isOpen == 1
- if ($didArg)
- {
- print '@code{,}', (($sm) ? ' ' : ''); # Ignore $ns here
- }
- parseQuote(\@words);
- print '@emph{', $words[0], "}";
- $didArg = 1;
- $ns = 0;
- } else {
- print ")" if ($isOpen);
- $isOpen = 0;
- print $words[0];
- }
- }
-}
-
-sub Handle_Nm
-{
- # Usage: .Nm [<argument>] ...
- #
- # .Nm groff_mdoc groff_mdoc
- # .Nm \-mdoc -mdoc
- # .Nm foo ) ) , foo)),
- # .Nm : groff_mdoc:
- #
- if (!defined $progName)
- {
- if (defined $ENV{AG_DEF_PROG_NAME})
- {
- $progName = $ENV{AG_DEF_PROG_NAME};
- }
- else
- {
- $progName = "XXX Program Name";
- }
- }
-
- if ($words[0] =~ /^[\\\w]/)
- {
- $progName = shift @words;
- }
- print '@code{', $progName, '}';
-
- # Anything after this should be punctuation
-
- while ($_ = shift @words)
- {
- print;
- }
-}
-
-sub Handle_Ns
-{
- # Usage: .Pf ...
- # .Pa ntpkey_cert_ Ns Ar hostname
- #
- # Suppress whitespace between "here" and the first parameter
-
- $wc = 0; # This might be ok...
-}
-
-sub Handle_Op
-{
- # Usage: .Op [<option>] ...
- # .Op []
- # .Op Fl k [-k]
- # .Op Fl k ) . [-k]).
- # .Op Fl c Ar objfil Op Ar corfil , [ -c objfil [corfil]],
- # .Op word1 word2 [word1 word2]
- #
- # If we decide to support Oo and Oc this almost becomes recursive,
- # but we can handle that with separate Handle_Oo and Handle_Oc
- # routines.
-
- my ($op);
-
- print '[';
- $op = 1;
- do {
- # print STDERR "Handle_Op: looking at <$words[0]>\n";
- if ($op && $words[0] =~ /^(Ar|Cm|Fl|Ic)$/)
- {
- $_ = shift @words;
- Handle_ArCmFlIcLi();
- }
- elsif ($words[0] =~ /^[[:punct:]]$/)
- {
- print ']' if ($op);
- $op = 0;
- print shift @words;
- }
- else
- {
- print shift @words;
- }
- } while (@words > 0);
- print ']' if ($op);
-}
-
-sub Handle_Pa
-{
- # Usage: .Pa [<pathname>] ...
- # .Pa ~
- # .Pa /usr/share /usr/share
- # .Pa /tmp/fooXXXXX ) . /tmp/fooXXXXX).
- #
- my ($pa_path);
- if (@words == 0)
- {
- $pa_path = "~";
- }
- else
- {
- $pa_path = shift @words;
- }
-
- print '@file{',"$pa_path","}";
-}
-
-sub Handle_Pf
-{
- # Usage: .Pf ...
- # .Pf ( Fa name2 (<slant>name2
- #
- # Suppress whitespace between the first and 2nd argument.
-
- die "Handle_Pf: not done yet\n";
-}
-
-sub Handle_Q
-{
- # Usage: .Ql ...
- # .Aq ... Angle bracket: <...>
- # .Bq ... bracket: [...]
- # .Brq ... braces: {...}
- # .Dq ... double quote: <lq><lq>...<rq><rq>
- # .Eq XX YY ... Enclose String: XX...YY
- # .Pq XX ... parenthesis: (...)
- # .Ql ... Quoted literal: <lq>...<rq> or <tt>...<tt>
- # .Qq ... Straight 2ble quote: "..."
- # .Sq ... Single quote: <lq>...<rq>
- #
-
- my ($lq, $rq);
- $wc = 0;
-
- # print STDERR "Handle_Q: <", join(' ', @words), ">\n"; # XXX
-
- if (/^Aq$/) { $lq = "<"; $rq = ">"; }
- elsif (/^Bq$/) { $lq = "["; $rq = "]"; }
- elsif (/^Brq$/) { $lq = "{"; $rq = "}"; }
- elsif (/^Dq$/) { $lq = '@quotedblleft{}'; $rq = '@quotedblright{}'; }
- elsif (/^Eq$/) { $lq = shift @words; $rq = shift @words; }
- elsif (/^Pq$/) { $lq = "("; $rq = ")"; }
- elsif (/^Ql$/) { $lq = '@quoteleft{}'; $rq = '@quoteright{}'; }
- elsif (/^Qq$/) { $lq = '"'; $rq = '"'; }
- elsif (/^Sq$/) { $lq = '@quoteleft{}'; $rq = '@quoteright{}'; }
-
- print "$lq";
-
- do {
- parseMacro();
- } while (@words > 0 && $words[0] !~ /^[[:punct:]]$/);
-
- print "$rq";
- # The assumption is the rest are punctuation.
- while ($_ = shift @words)
- {
- print;
- }
-}
-
-sub Handle_Ref
-{
- # Usage:
- # .Rs Starts a reference. No arguments. Collects info.
- # Causes a line break in the SEE ALSO section. Yeah.
- # .Re Ends a reference. No arguments. Emits collected data:
- # .%A Reference author name; one name per invocation.
- # .%B Book title.
- # .%C City/Place (not implemented yet).
- # .%D Date.
- # .%I Issuer/publisher name.
- # .%J Journal name.
- # .%N Issue number.
- # .%O Optional information.
- # .%P Page Number.
- # .%Q Corporate or foreign author.
- # .%R Report name.
- # .%T Title of article. Italic.
- # .%U Optional hypertext reference.
- # .%V Volume
- #
- # Collecting during Rs and emitting during Re would make it easy
- # to be pretty about multiple authors, journals, etc.
- #
- # Remember to:
- # $noNl = 1; # No newline needed.
- # where appropriate.
-
- if (/^Rs$/)
- {
- die "Cannot nest .Rs directives.\n" if ($ref);
- ++$ref;
-
- # Assert no args?
- # Initialize.
- # Assert $refCount is 0?
- $refCount = 0;
-
- print "\@*\n";
- $extArg = 1; # HMS: give it a try...
- $wc = 0;
- }
- elsif (/^Re$/)
- {
- --$ref;
- die ".Re seen without a .Rs directive.\n" if ($ref);
-
- # Assert no args?
-
- print ".";
-
- # Cleanup.
- $extArg = 0; # HMS: give it a try...
- # Initialize.
- $refCount = 0;
- }
- elsif (/^%A$/)
- {
- print ", " if ($refCount++);
- parseMacro();
- }
- elsif (/^%O$/)
- {
- print ", " if ($refCount++);
- parseMacro();
- }
- elsif (/^%T$/)
- {
- print ", " if ($refCount++);
-
- # Use @emph{} for italics.
- $wc = 0;
- Handle_Em();
- }
- else
- {
- die "Handle_Ref: Unknown/unimplemented command in .Rs/.Rs block <$_>\n";
- }
-}
-
-sub Handle_Sec
-{
- # Usage: .Sh
- # Usage: .Ss
- # .Sh word(s)
- #
- # Might be a quoted string.
- #
- # Drops an anchor.
- my ($a, $sh);
-
- $sh =~ /Sh/;
-
- parseQuote(\@words) if ($words[0] =~ /^"/);
-
- while ($_ = shift @words)
- {
- $a .= " " if ($a ne "");
- $a .= $_;
- }
-
- print '@node ', "$a\n";
- print '@', ($sh ? "sub" : ""), "section $a\n";
- print "@anchor{$a}\n";
- $wc = 0;
-}
-
-sub Handle_Sm
-{
- # Usage: Sm [ off | on ]
-
- if (scalar(@words))
- {
- if ($words[0] eq 'off')
- {
- $sm = 0;
- }
- elsif ($words[0] eq 'on')
- {
- $sm = 1;
- }
- else
- {
- die "Handle_Sm: Unexpected argument to Sm: <$words[0]>\n";
- }
- shift @words;
- }
- else
- {
- $sm = !$sm;
- }
-}
-
-sub Handle_Sx
-{
- # Usage: .Sx <section reference> ...
- # .Sh word(s)
- #
- # Might be a quoted string.
- #
- # References an anchor
-
- my ($a);
-
- parseQuote(\@words) if ($words[0] =~ /^"/);
-
- while ($_ = shift @words)
- {
- $a .= " " if ($a ne "");
- $a .= $_;
- last if ($words[0] =~ /^[[:punct:]]$/);
- }
-
- print '@ref{',"$a","}";
-}
-
-sub Handle_Ta
-{
- # Usage: .Ta
- # .Ta
- #
- # multitable column separator
-
- print '@tab';
-}
-
-sub Handle_Ux
-{
- # Usage: .Ux ...
- # .Ux UNIX
- # .Ux FOO FOO
- #
- my ($ux_name);
- if (@words == 0)
- {
- $ux_name = "UNIX";
- }
- else
- {
- $ux_name = shift @words;
- }
-
- print '@sc{',"$ux_name","}";
- while ($_ = shift @words)
- {
- print;
- }
-}
-
-sub Handle_Xr
-{
- # Usage: .Xr <man page name> [<section>] ...
- # .Xr mdoc mdoc
- # .Xr mdoc , mdoc,
- # .Xr mdoc 7 mdoc(7)
- # .Xr xinit 1x ; xinit(1x);
- #
- # Emitting things like @uref{/man.cgi/1/ls,,ls} would be OK,
- # but we'd have to allow for changing /man.cgi/ (at least).
- # I'm OK with:
- # @code{mdoc}
- # @code{mdoc},
- # @code{mdoc(7)}
- # @code{xinit(1x)};
- #
- my ($xr_cmd, $xr_sec, $xr_punc);
- if (@words == 1)
- {
- $xr_cmd = $words[0];
- }
- elsif (@words == 2)
- {
- $xr_cmd = shift @words;
- if ($words[0] =~ /[[:punct:]]/)
- {
- $xr_punc = shift @words;
- }
- else
- {
- $xr_sec = shift @words;
- }
- }
- elsif (@words == 3)
- {
- $xr_cmd = shift @words;
- $xr_sec = shift @words;
- $xr_punc = shift @words;
- }
- else
- {
- }
-
- # HMS: do we really want 'defined' in the following tests?
- print '@code{',"$xr_cmd" if (defined $xr_cmd);
- print "($xr_sec)" if (defined $xr_sec);
- print "}" if (defined $xr_cmd);
- print "$xr_punc" if (defined $xr_punc);
-}
-
-sub parseQuote # ref to array of words
-{
- my ($waref) = @_; # word array reference
- my ($string);
-
- # print STDERR "parseQuote(): <$_", join(' ',@words), ">\n";
- # Passing in "foo" will lose...
-
- $string = shift @{$waref};
-
- until ($string =~ /\"$/) {
- $string .= " ".shift @{$waref};
- }
-
- $string =~ s/^\"(.*)\"$/$1/;
-
- unshift @{$waref}, $string;
-}
-
-sub pSp
-{
- print ' ' if $wantspace;
-}
-
-sub isPunct ($)
-{
- my $string = shift;
- my $rc;
-
- $rc = ($string =~/^(\\&)?[[:punct:]]+$/) ? 1 : 0;
- # print STDERR "isPunct($string): $rc\n";
- return $rc;
-}
-
-sub parseMacro
-{
- # print STDERR '@words = ', scalar(@words), ': ', join(' ', @words), "\n";
-
- while ($_ = shift @words)
- {
- s/^\\&//;
- $wantspace = (($wc++ && !isPunct($_) && $sm && !$ns) ? 1 : 0);
-
- if (/^\\"/) { Handle_Comment(); }
- elsif (/^"/) { parseQuote(\@words); }
- elsif (/^An$/) { pSp(); Handle_An(); }
- elsif (/^Aq$/) { pSp(); Handle_Q(); }
- elsif (/^Ar$/) { pSp(); Handle_ArCmFlIcLi(); }
- elsif (/^Bd$/) { Handle_Bd(); }
- elsif (/^Bl$/) { Handle_Bl(); }
- elsif (/^Bq$/) { pSp(); Handle_Q(); }
- elsif (/^Brq$/) { pSp(); Handle_Q(); }
- elsif (/^Cm$/) { pSp(); Handle_ArCmFlIcLi(); }
- elsif (/^D1$/) { Handle_D(); }
- elsif (/^Dl$/) { Handle_D(); }
- elsif (/^Dq$/) { pSp(); Handle_Q(); }
- elsif (/^Ed$/) { Handle_Ed(); }
- elsif (/^El$/) { Handle_El(); }
- elsif (/^Em$/) { pSp(); Handle_Em(); }
- elsif (/^Eq$/) { pSp(); Handle_Q(); }
- elsif (/^Fl$/) { pSp(); Handle_ArCmFlIcLi(); }
- elsif (/^Fn$/) { pSp(); Handle_Fn(); }
- elsif (/^Ic$/) { pSp(); Handle_ArCmFlIcLi(); }
- elsif (/^It$/) { Handle_It(); }
- elsif (/^Li$/) { pSp(); Handle_ArCmFlIcLi(); }
- elsif (/^Nm$/) { pSp(); Handle_Nm(); }
- elsif (/^Ns$/) { Handle_Ns(); }
- elsif (/^Op$/) { pSp(); Handle_Op(); }
- elsif (/^Pa$/) { pSp(); Handle_Pa(); }
- elsif (/^Pf$/) { Handle_Pf(); }
- elsif (/^Pp$/) { ; } # @* ?
- elsif (/^Pq$/) { pSp(); Handle_Q(); }
- elsif (/^Ql$/) { pSp(); Handle_Q(); }
- elsif (/^Qq$/) { pSp(); Handle_Q(); }
- elsif (/^Re$/) { Handle_Ref(); } # EOReference
- elsif (/^Rs$/) { Handle_Ref(); } # BOReference
- elsif (/^%A$/) { Handle_Ref(); }
- elsif (/^%B$/) { Handle_Ref(); }
- elsif (/^%C$/) { Handle_Ref(); }
- elsif (/^%D$/) { Handle_Ref(); }
- elsif (/^%I$/) { Handle_Ref(); }
- elsif (/^%J$/) { Handle_Ref(); }
- elsif (/^%N$/) { Handle_Ref(); }
- elsif (/^%O$/) { Handle_Ref(); }
- elsif (/^%P$/) { Handle_Ref(); }
- elsif (/^%Q$/) { Handle_Ref(); }
- elsif (/^%R$/) { Handle_Ref(); }
- elsif (/^%T$/) { Handle_Ref(); }
- elsif (/^%U$/) { Handle_Ref(); }
- elsif (/^%V$/) { Handle_Ref(); }
- elsif (/^Sh$/) { Handle_Sec(); } # Sec Header
- elsif (/^Sm$/) { Handle_Sm(); }
- elsif (/^Sq$/) { pSp(); Handle_Q(); }
- elsif (/^Ss$/) { Handle_Sec(); } # Sub Section
- elsif (/^Sx$/) { pSp(); Handle_Sx(); } # Section xref
- elsif (/^Ta$/) { pSp(); Handle_Ta(); } # pSP()?
- elsif (/^Ux$/) { pSp(); Handle_Ux(); }
- elsif (/^Xc$/) { $extArg = 0; }
- elsif (/^Xo$/) { $extArg = 1; }
- elsif (/^Xr$/) { pSp(); Handle_Xr(); }
- else { pSp(); print; $ns = 0; }
- }
- $wc = 0;
-
-}
+use warnings;
+use File::Basename qw(dirname);
+use lib dirname(__FILE__);
+use Mdoc qw(ns pp hs mapwords gen_encloser nl);
+
+# Ignore commments
+Mdoc::def_macro( '.\"', sub { () } );
+
+# Enclosers
+Mdoc::def_macro( '.An', sub { @_, ns, '@*' } );
+Mdoc::def_macro( '.Aq', gen_encloser(qw(< >)), greedy => 1);
+Mdoc::def_macro( '.Bq', gen_encloser(qw([ ])), greedy => 1);
+Mdoc::def_macro( '.Brq', gen_encloser(qw(@{ @})), greedy => 1);
+Mdoc::def_macro( '.Pq', gen_encloser(qw/( )/), greedy => 1);
+Mdoc::def_macro( '.Qq', gen_encloser(qw(" ")), greedy => 1);
+Mdoc::def_macro( '.Op', gen_encloser(qw(@code{[ ]})), greedy => 1);
+Mdoc::def_macro( '.Ql', gen_encloser(qw(@quoteleft{} @quoteright{})),
+ greedy => 1);
+Mdoc::def_macro( '.Sq', gen_encloser(qw(@quoteleft{} @quoteright{})),
+ greedy => 1);
+Mdoc::def_macro( '.Dq', gen_encloser(qw(@quotedblleft{} @quotedblright{})),
+ greedy => 1);
+Mdoc::def_macro( '.Eq', sub {
+ my ($o, $c) = (shift, pop);
+ gen_encloser($o, $c)->(@_)
+}, greedy => 1);
+Mdoc::def_macro( '.D1', sub { "\@example\n", ns, @_, ns, "\n\@end example" },
+ greedy => 1);
+Mdoc::def_macro( '.Dl', sub { "\@example\n", ns, @_, ns, "\n\@end example" },
+ greedy => 1);
+
+Mdoc::def_macro( '.Oo', gen_encloser(qw(@code{[ ]})), concat_until => '.Oc');
+Mdoc::def_macro( 'Oo', sub { '@code{[', ns, @_ } );
+Mdoc::def_macro( 'Oc', sub { @_, ns, pp(']}') } );
+
+Mdoc::def_macro( '.Bro', gen_encloser(qw(@code{@{ @}})), concat_until => '.Brc');
+Mdoc::def_macro( 'Bro', sub { '@code{@{', ns, @_ } );
+Mdoc::def_macro( 'Brc', sub { @_, ns, pp('@}}') } );
+
+Mdoc::def_macro( '.Po', gen_encloser(qw/( )/), concat_until => '.Pc');
+Mdoc::def_macro( 'Po', sub { '(', @_ } );
+Mdoc::def_macro( 'Pc', sub { @_, ')' } );
+
+Mdoc::def_macro( '.Ar', sub { mapwords {"\@kbd{$_}"} @_ } );
+Mdoc::def_macro( '.Fl', sub { mapwords {"\@code{-$_}"} @_ } );
+Mdoc::def_macro( '.Cm', sub { mapwords {"\@code{-$_}"} @_ } );
+Mdoc::def_macro( '.Ic', sub { mapwords {"\@code{$_}"} @_ } );
+Mdoc::def_macro( '.Cm', sub { mapwords {"\@code{$_}"} @_ } );
+Mdoc::def_macro( '.Li', sub { mapwords {"\@code{$_}"} @_ } );
+Mdoc::def_macro( '.Va', sub { mapwords {"\@code{$_}"} @_ } );
+Mdoc::def_macro( '.Em', sub { mapwords {"\@emph{$_}"} @_ } );
+Mdoc::def_macro( '.Fn', sub { '@code{'.(shift).'()}' } );
+Mdoc::def_macro( '.Ss', sub { "\@subsubsection", hs, @_ });
+Mdoc::def_macro( '.Sh', sub {
+ my $name = "@_";
+ "\@node", hs, "$name\n", ns, "\@subsection", hs, $name
+ });
+Mdoc::def_macro( '.Ss', sub { "\@subsubsection", hs, @_ });
+Mdoc::def_macro( '.Xr', sub { '@code{'.(shift).'('.(shift).')}', @_ } );
+Mdoc::def_macro( '.Sx', gen_encloser(qw(@ref{ })) );
+Mdoc::def_macro( '.Ux', sub { '@sc{unix}', @_ } );
+Mdoc::def_macro( '.Fx', sub { '@sc{freebsd}', @_ } );
+{
+ my $name;
+ Mdoc::def_macro('.Nm', sub {
+ $name = shift || $ENV{AG_DEF_PROG_NAME} || 'XXX' if (!$name);
+ "\@code{$name}"
+ } );
+}
+Mdoc::def_macro( '.Pa', sub { mapwords {"\@file{$_}"} @_ } );
+Mdoc::def_macro( '.Pp', sub { '' } );
+
+# Setup references
+
+Mdoc::def_macro( '.Rs', sub { "\@*\n", @_ } );
+Mdoc::set_Re_callback(sub {
+ my ($reference) = @_;
+ "@*\n", ns, $reference->{authors}, ',', "\@emph{$reference->{title}}",
+ ',', $reference->{optional}
+ });
+
+# Set up Bd/Ed
+
+my %displays = (
+ literal => [ '@verbatim', '@end verbatim' ],
+);
+
+Mdoc::def_macro( '.Bd', sub {
+ (my $type = shift) =~ s/^-//;
+ die "Not supported display type <$type>"
+ if not exists $displays{ $type };
+
+ my $orig_ed = Mdoc::get_macro('.Ed');
+ Mdoc::def_macro('.Ed', sub {
+ Mdoc::def_macro('.Ed', delete $orig_ed->{run}, %$orig_ed);
+ $displays{ $type }[1];
+ });
+ $displays{ $type }[0]
+ });
+Mdoc::def_macro('.Ed', sub { die '.Ed used but .Bd was not seen' });
+
+# Set up Bl/El
+
+my %lists = (
+ bullet => [ '@itemize @bullet', '@end itemize' ],
+ tag => [ '@table @asis', '@end table' ],
+);
+
+Mdoc::set_Bl_callback(sub {
+ my $type = shift;
+ die "Specify a list type" if not defined $type;
+ $type =~ s/^-//;
+ die "Not supported list type <$type>" if not exists $lists{ $type };
+ Mdoc::set_El_callback(sub { $lists{ $type }[1] });
+ $lists{ $type }[0]
+ });
+Mdoc::def_macro('.It', sub { '@item', hs, @_ });
+
+for (qw(Aq Bq Brq Pq Qq Ql Sq Dq Eq Ar Fl Ic Pa Op Cm Li Fx Ux Va)) {
+ my $m = Mdoc::get_macro(".$_");
+ Mdoc::def_macro($_, delete $m->{run}, %$m);
+}
+
+sub print_line {
+ my $s = shift;
+ $s =~ s/\\&//g;
+ print "$s\n";
+}
+
+sub preprocess_args {
+ $_ =~ s/([{}])/\@$1/g for @_;
+}
+
+sub run {
+ while (my ($macro, @args) = Mdoc::parse_line(\*STDIN, \&print_line,
+ \&preprocess_args)
+ ) {
+ my @ret = Mdoc::call_macro($macro, @args);
+ if (@ret) {
+ my $s = Mdoc::to_string(@ret);
+ print_line($s);
+ }
+ }
+ return 0;
+}
+
+exit run(@ARGV) unless caller;
--- /dev/null
+[= AutoGen5 template foo=(base-name) =]
+[=
+ ;;(use-modules (ice-9 regex))
+ ;;(define script-name (regexp-substitute/global #f "(-opts)" (base-name) 'pre ""))
+ ;;(shellf "cat %s" script-name)
+=]
+# DO NOT EDIT THE FOLLOWING
+#
+# It's auto generated option handling code [=
+(if (not (and (exist? "prog-name") (exist? "prog-title")))
+ (error "prog-name and prog-title are required"))
+(define prog-name (get "prog-name"))
+(if (> (string-length prog-name) 16)
+ (error (sprintf "prog-name limited to 16 characters: %s"
+ prog-name)) )
+(if (not (exist? "long-opts"))
+ (error "long-opts is required"))
+
+;; perl list containing string to initialize the option hash
+(define perl_opts "")
+;; perl list containing option definitions for Getopt::Long
+(define perl_defs " ")
+;; usage string
+(define perl_usage "")
+
+(define optname-from "A-Z_^")
+(define optname-to "a-z--")
+(define counter 0)
+
+(define q (lambda (s) (string-append "'" s "'")))
+(define qp (lambda (s) (string-append "q{" s "}")))
+
+=] [= FOR flag =][=
+
+(define optarg "") ;; the option argument for Getopt::Long
+(define opttarget "''") ;; the value of a hash key that represents option
+(define optargname "")
+(define optisarray #f)
+(define optname (string-tr! (get "name") optname-from optname-to))
+
+=][=
+;; since autoopts doesn't support float we take the combination arg-name =
+;; float and arg-type = string as float
+=][=
+IF arg-type =][=
+ CASE arg-type =][=
+ =* num =][= (set! optarg "=i") =][=
+ =* str =][=
+ (if (and (exist? "arg-name") (== (get "arg-name") "float"))
+ (set! optarg "=f")
+ (set! optarg "=s")
+ )
+ =][=
+ * =][=
+ (error (string-append "unknown arg type '"
+ (get "arg-type") "' for " (get "name"))) =][=
+ ESAC arg-type =][=
+ENDIF =][=
+
+(if (exist? "stack-arg")
+ ;; set optarget to array reference if can take more than one value
+ (if (and (exist? "max") (== (get "max") "NOLIMIT"))
+ (begin
+ (set! opttarget (string-append
+ "["
+ (if (exist? "arg-default") (q (get "arg-default")) "")
+ "]"
+ )
+ )
+ (set! optisarray #t)
+ )
+ (error "If stack-arg then max has to be NOLIMIT")
+ )
+ ;; just scalar otherwise
+ (if (exist? "arg-default") (set! opttarget (q (get "arg-default"))))
+)
+
+(set! perl_opts (string-append
+ perl_opts "'" (get "name") "' => " opttarget ",\n "))
+
+(define def_add (string-append "'" optname (if (exist? "value")
+ (string-append "|" (get "value")) "") optarg "',"))
+
+(define add_len (+ (string-length def_add) counter))
+(if (> add_len 80)
+ (begin
+ (set! perl_defs (string-append perl_defs "\n " def_add))
+ (set! counter 8)
+ )
+ (begin
+ (set! perl_defs (string-append perl_defs " " def_add))
+ (set! counter (+ counter add_len))
+ )
+)
+
+(if (exist? "arg-type")
+ (if (and (exist? "arg-name") (== (get "arg-name") "float"))
+ (set! optargname "=float")
+ (set! optargname (string-append "=" (substring (get "arg-type") 0 3)))
+ )
+ (set! optargname " ")
+)
+
+(if (not (exist? "deprecated"))
+(set! perl_usage (string-append perl_usage
+ (sprintf "\n %-28s %s"
+ (string-append (if (exist? "value") (string-append "-" (get "value")) " ") ", --" (get "name") optargname)
+ (get "descrip")))))
+(if optisarray
+ (set! perl_usage (string-append perl_usage
+ "\n - may appear multiple times"))
+)
+
+=][= ENDFOR =]
+
+use Getopt::Long qw(GetOptionsFromArray);
+Getopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always));
+
+my $usage;
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR $usage;
+ exit $ret;
+}
+
+sub paged_usage {
+ my ($ret) = @_;
+ my $pager = $ENV{PAGER} || '(less || more)';
+
+ open STDOUT, "| $pager" or die "Can't fork a pager: $!";
+ print $usage;
+
+ exit $ret;
+}
+
+sub processOptions {
+ my $args = shift;
+
+ my $opts = {
+ [= (emit perl_opts) =]'help' => '', 'more-help' => ''
+ };
+ my $argument = '[= argument =]';
+ my $ret = GetOptionsFromArray($args, $opts, (
+[= (emit perl_defs) =]
+ 'help|?', 'more-help'));
+
+ $usage = <<'USAGE';
+[= prog-name =] - [= prog-title =]
+USAGE: [= prog-name =] [ -<flag> [<val>] | --<name>[{=| }<val>] ]... [= argument =]
+[= (emit perl_usage ) =]
+ -?, --help Display usage information and exit
+ , --more-help Pass the extended usage information through a pager
+
+Options are specified by doubled hyphens and their name or by a single
+hyphen and the flag character.
+USAGE
+
+ usage(0) if $opts->{'help'};
+ paged_usage(0) if $opts->{'more-help'};[=
+ IF (exist? "argument") =]
+
+ if ($argument && $argument =~ /^[^\[]/ && !@$args) {
+ print STDERR "Not enough arguments supplied (See --help/-?)\n";
+ exit 1;
+ }[=
+ ENDIF
+ =]
+ $_[0] = $opts;
+ return $ret;
+}
+
+END { close STDOUT };
+[=
+;;(shellf "mv %s.new %s" (base-name) script-name )
+=]
dnl @synopsis AC_DEFINE_DIR(VARNAME, DIR [, DESCRIPTION])
dnl
-dnl This macro defines (with AC_DEFINE) VARNAME to the expansion of the DIR
-dnl variable, taking care of fixing up ${prefix} and such.
+dnl This macro sets VARNAME to the expansion of the DIR variable,
+dnl taking care of fixing up ${prefix} and such.
dnl
-dnl Note that the 3 argument form is only supported with autoconf 2.13 and
-dnl later (i.e. only where AC_DEFINE supports 3 arguments).
+dnl VARNAME is then offered as both an output variable and a C
+dnl preprocessor symbol.
dnl
-dnl Examples:
+dnl Example:
dnl
-dnl AC_DEFINE_DIR(DATADIR, datadir)
-dnl AC_DEFINE_DIR(PROG_PATH, bindir, [Location of installed binaries])
+dnl AC_DEFINE_DIR([DATADIR], [datadir], [Where data are placed to.])
dnl
-dnl @version $Id: acinclude.m4,v 1.3 2000/08/04 03:26:22 stenn Exp $
-dnl @author Alexandre Oliva <oliva@lsd.ic.unicamp.br>
+dnl @category Misc
+dnl @author Stepan Kasal <kasal@ucw.cz>
+dnl @author Andreas Schwab <schwab@suse.de>
+dnl @author Guido U. Draheim <guidod@gmx.de>
+dnl @author Alexandre Oliva
+dnl @version 2006-10-13
+dnl @license AllPermissive
AC_DEFUN([AC_DEFINE_DIR], [
- ac_expanded=`(
- test "x$prefix" = xNONE && prefix="$ac_default_prefix"
- test "x$exec_prefix" = xNONE && exec_prefix="${prefix}"
- eval echo \""[$]$2"\"
- )`
- ifelse([$3], [],
- AC_DEFINE_UNQUOTED([$1], ["$ac_expanded"]),
- AC_DEFINE_UNQUOTED([$1], ["$ac_expanded"], [$3]))
+ prefix_NONE=
+ exec_prefix_NONE=
+ test "x$prefix" = xNONE && prefix_NONE=yes && prefix=$ac_default_prefix
+ test "x$exec_prefix" = xNONE && exec_prefix_NONE=yes && exec_prefix=$prefix
+dnl In Autoconf 2.60, ${datadir} refers to ${datarootdir}, which in turn
+dnl refers to ${prefix}. Thus we have to use `eval' twice.
+ eval ac_define_dir="\"[$]$2\""
+ eval ac_define_dir="\"$ac_define_dir\""
+ AC_SUBST($1, "$ac_define_dir")
+ AC_DEFINE_UNQUOTED($1, "$ac_define_dir", [$3])
+ test "$prefix_NONE" && prefix=NONE
+ test "$exec_prefix_NONE" && exec_prefix=NONE
])
+
$(srcdir)/invoke-ntp-keygen.texi: $(srcdir)/ntp-keygen-opts.def $(std_def_list)
$(run_ag) -Tagtexi-cmd.tpl -DLEVEL=section ntp-keygen-opts.def
- $(top_srcdir)/scripts/check--help $@
+ $(top_srcdir)/scripts/build/check--help $@
$(srcdir)/ntp-keygen.html: $(srcdir)/ntp-keygen.texi $(top_srcdir)/sntp/include/version.texi
cd $(srcdir) && ( makeinfo --force --html --no-split -o ntp-keygen.html ntp-keygen.texi || true )
cd ../sntp && $(MAKE) $(AM_MAKEFLAGS) check-scm-rev
version.c: $(ntp_keygen_OBJECTS) ../libntp/libntp.a Makefile $(top_srcdir)/sntp/scm-rev
- env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/mkver ntp-keygen
+ env CSET=`cat $(top_srcdir)/sntp/scm-rev` $(top_builddir)/scripts/build/mkver ntp-keygen
version.o: version.c
env CCACHE_DISABLE=1 $(COMPILE) -c version.c -o version.o
projects / thirdparty / ntp.git / commitdiff
