;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.14
;;; Reason:
;;;  If si:user-id is not NIL (user is logged in), yet the login time from si:login-history
;;;  is NIL (no login time), rwho-server broke trying to construct a packet to send.
;;; Written 18-Sep-87 16:52:49 by naha at site LMI Cambridge
;;; while running on Love from band 1
;;; with Experimental System 123.13, Experimental Local-File 73.0, Experimental FILE-Server 22.0, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Site Data Editor 6.0, microcode 1754, SDU Boot Tape 3.13, SDU ROM 102.



; From modified file DJ: L.NETWORK.IP-TCP.SERVER; UDP-RWHO-SERVER.LISP#27 at 18-Sep-87 16:52:53
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; UDP-RWHO-SERVER  "


(defun build-rwho-packet (packet)
  (setf (rwho-vers packet) RWHO-VERSION-NUMBER)
  (setf (rwho-type packet) RWHO-STATUS-TYPE)
  (setf (rwho-pad packet) 0)
  (setf (rwho-send-time packet) (fudge-ut-to-unix (get-universal-time)))
  (setf (rwho-recv-time packet) 0)
  (setf (rwho-hostname packet) (send si:local-host :name))
  (set-rwho-load-average packet 0 0)
  (set-rwho-load-average packet 1 0)
  (set-rwho-load-average packet 2 0)
  (setf (rwho-boot-time packet) (fudge-ut-to-unix time:*ut-at-boot-time*))
  (cond ((zerop (length si:user-id))		;not logged in
	 (setf (fill-pointer packet) rwho-utmp-offset))
	(t
	 (set-rwho-utmp-ttyname packet rwho-utmp-offset "LISPM")
	 (set-rwho-utmp-userid packet rwho-utmp-offset si:user-id)
	 (let ((login-time (fourth (first si:login-history))))
	   (set-rwho-utmp-time-logged-in packet
					 rwho-utmp-offset
					 (if login-time
					     (fudge-ut-to-unix (time:parse-universal-time login-time))
					   (rwho-send-time packet))))
	 (let ((idle (floor (time-difference (zl:time) tv:kbd-last-activity-time) 60)))
	   (set-rwho-utmp-idle-time packet rwho-utmp-offset idle))
	 (setf (fill-pointer packet) (+ rwho-utmp-offset rwho-utmp-entry-length))))
  packet)


))