Resetting Time from Network.

[ESC@STONY-BROOK.SCRC.Symbolics.COM (Eric S. Crawley)]

Here is a pair of quick hacks that I have used to find and fix lispms with the
wrong time.  It's not pretty but it works. There is a network server on the
lispm to reset the time. Note that embedded hosts (UX400S and MacIvory) ALWAYS
get their time from the host that they are embedded into at boot time but will
supply the time they get to the network and set their time from the network
when the :reset-time server is invoked.

BTW, the bug with net:print-host-times has been fixed for 8.0.

(defun find-hosts-with-bad-time (&optional (hosts (net:get-local-lispms)))
  (neti:keeping-namespace-server
    (let ((chaos:*host-connect-timeout* 200.))
      (loop for host in hosts
	    as now = (time:get-universal-time)
	    as host-time = (with-specific-service-triple
			     (host :time :chaos-simple :time-simple)
			     (condition-case ()
				  (neti:invoke-service-on-host :time host)
				(net:host-not-responding
				  (format t "~&~A not responding" host)
				  nil)
				(net:connection-refused
				  (format t "~&~A connection refused" host)
				  nil)))
	    when host-time
	      do
		(let ((difference (if ( now host-time)
				      (time:time-difference now host-time)
				      (time:time-difference host-time now))))
		  (when (> difference (* 10 60))	;10 minutes off
		    (format t "~&Host ~A says that the time is " host)
		    (time:print-universal-time host-time)
		    (format t " when the local host says the time is ")
		    (time:print-universal-time now)))))))

(defun reset-time (&optional (hosts (neti:get-local-lispms)))
  (neti:keeping-namespace-server
    (loop for host in hosts
	  do
      (when (symbolp host)
	(setq host (net:parse-host host)))
      (with-specific-service-triple
	(host :reset-time-server :chaos-simple :reset-time-server)
	(format t "~&~A " host)
	(condition-case (error)
	     (neti:invoke-service-on-host :reset-time-server host)
	   (net:host-not-responding (format t "Not Responding"))
	   (net:connection-refused (format t "Connection Refused")))))))

;;; This subverts the namespace system to force the use of a specific service triple
(defmacro with-specific-service-triple ((host service medium protocol
					      &optional (check-timestamp t)) &body body)
  (let ((host-sym (gensym))
	(time-stamp (gensym))
	(plist (gensym)))
    `(let* ((,host-sym (net:parse-host ,host))
	    ;; A crock to find the current timestamp of the host to see if it has been locally
	    ;; edited.
	    (,time-stamp (second (second (first (symbol-value-in-instance
						  ,host-sym
						  'neti:validation-timestamps)))))
	    (,plist (send ,host-sym :plist)))
       (when (or (not ,check-timestamp)
		 ( ,time-stamp -2)
		 (y-or-n-p
		   "~A has been locally modified.  This function will revert the changes.  Do you wish to continue? "
		   ,host-sym))
	 (loop for (serv med prot) in (getf ,plist :service)
	       when (eq serv ,service)
		 do (zl:delq (list serv med prot) (getf ,plist :service)))
	 (setf (getf ,plist :service)
	       (push (list ,service ,medium ,protocol) (getf ,plist :service)))
	 (net:update-object-permanently
	   :host
	   (Send (send ,host-sym :primary-name) :namespace)
	   (send ,host-sym :primary-name)
	   ,plist
	   T)					;Only change this locally!
	 (unwind-protect
	     (progn ,@body)
	   (send ,host-sym :check-validity nil t))))))