[comp.lang.perl] Setting your system time

worley@compass.com (Dale Worley) (09/14/90)

I've written the following script to call the National Bureau of
Standards and find out what time it is.  If you want it to, it will
call adjtime() to set your system clock to match the NBS.  No more
clock drift!

Dale Worley		Compass, Inc.			worley@compass.com
--
If the United States were really a democracy, we would have concentration
camps for AIDS patients.

#! /usr/local/bin/perl

# Script to call up the NBS and find out what time it is.

# Number of seconds to wait for output from NBS before disconnecting
$wait_for_output = 60;
# NBS phone number
$nbs_phone = "1-202-653-0351";
# Un*x date 0 is JD 2440578.  NBS JD's are mod 100000.
$epoch = 40587;
# Maximum number of seconds to alter clock
$max_change = 5 * 60;
# adjtime program name - if undefined, uses kernel adjtime() call
# $adjtime_prog = "date -a";

# Get options	-a call adjtime	-l log Kermit output
do "/compass/c/worley/perl-3.0/lib/getopt.pl";
do Getopt('');

do "/compass/c/worley/perl-3.0/sys/syscall.h";

sub printable_time {
  local($t) = @_;
  local($sec, $min, $hour, $mday, $mon, $year) = gmtime($t);

  sprintf("%d %s %d %02d:%02d:%02d GMT",
	$mday, ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
		"Sep", "Oct", "Nov", "Dec")[$mon], $year + 1900,
	$hour, $min, $sec);
}

# Write script file
$script_file_name = "/tmp/$$script";
open(SCRIPT_FILE, ">" . $script_file_name);
print SCRIPT_FILE "set line /dev/cua4\n";
print SCRIPT_FILE "set speed 9600\n";
print SCRIPT_FILE "set modem hayes\n";
print SCRIPT_FILE "dial $nbs_phone\n";
print SCRIPT_FILE "connect\n";
print SCRIPT_FILE "quit\n";
close SCRIPT_FILE;

# Set up pipes
pipe(KERMIT_INPUT_R, KERMIT_INPUT_W);
pipe(KERMIT_OUTPUT_R, KERMIT_OUTPUT_W);

# Spawn process to call the NBS
$call_process = fork();
# die "Can't fork process" if $! != 0;
if ($call_process == 0) {
  # This is the child process
  close STDIN;
  open(STDIN, "<&KERMIT_INPUT_R");
  close STDOUT;
  open(STDOUT, ">&KERMIT_OUTPUT_W");
  exec "kermit";
  die "Can't exec kermit";
}

# Close input end of pipe in this process so when Kermit exits we see EOF.
close KERMIT_OUTPUT_W;

# Spawn process to send timeout signal to call process
$timeout_process = fork();
# die "Can't fork process" if $! != 0;
if ($timeout_process == 0) {
  # This is the child process
  # Start Kermit
  select(KERMIT_INPUT_W); $| = 1;
  print KERMIT_INPUT_W "take $script_file_name\n";
  # Wait and then send disconnect sequence
  sleep $wait_for_output;
  print KERMIT_INPUT_W "c";
  # In case of emergency, kill the Kermit if it doesn't shut down nicely.
  sleep 60;
  kill 9, $call_process;
  exit;
}

# Read and analyze the output of the call
# A time is "good" if it and the previous two times are a sequence separated by
# 1 sec each.
# The last good time seen
$t_good = -1;
# The previous two times
$t1 = -1;
$t2 = -1;
read_output: while (<KERMIT_OUTPUT_R>) {
	# Echo if requested
	if ($opt_l) {
		print $_;
	}
	# remove the newline
	chop;
	# remove any CRs
	s/\015//g;
	# select only lines with the right format
	if (/(\d{5}) \d{3} (\d\d)(\d\d)(\d\d) UTC/) {
		$t2 = $t1;
		$t1 = $t0;
		# get the time in Un*x format
		$t0 = ((($1 - $epoch) * 24 + $2) * 60 + $3) * 60 + $4;
		# see if it is good
		if ($t0 == $t1 + 1 && $t1 == $t2 + 1) {
			$t_good = $t0;
			$current_time = time;
		}
	}
}

# Print error if we couldn't get the time.
if ($t_good == -1) {
	print "Unable to acquire time from NBS.\n";
	exit(1);
}

$d = $t_good - $current_time;

print "NBS time is ", &printable_time($t_good), ".\n";
print "System time is ", &printable_time($current_time), ".\n";
printf "Difference is %+d seconds.\n", $d;

if ($opt_a) {
	if ($d == 0) {
	} elsif ($d >= -$max_change && $d <= $max_change) {
		if (defined($adjtime_prog)) {
			system("$adjtime_prog $d");
		} else {
			$t = pack("ll", $d, 0);
			syscall(&SYS_adjtime, $t, $t);
		}
		if ($! != 0) {
			print "ajdtime() failed: $!\n";
			exit(1);
		}
		print "Clock being changed by $d seconds.\n";
	} else {
		print "Difference is too large to adjtime.\n";
		print "(Max allowed is $max_change seconds.)\n";
		exit(1);
	}
}

unlink($script_file_name);

exit(0);