;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.91
;;; Reason:
;;;  The :listen method for an tcp-stream (actually, for a buffered stream, the no-hang
;;;  version of :next-input-buffer) ends up calling :handle-all-replies, which can
;;;  throw you into the error handler if it detects a send-timeout.  If you are using
;;;  the :listen in a process-wait function, you get an error in the scheduler, which
;;;  is fatal.  The solution is to detect the timeout in :handle-reply, and for the
;;;  listen method to return T if a timeout occurs, but don't enter the error handler
;;;  until a blocking method (:next-input-buffer or :tyi) is called.
;;; Written 3-Nov-87 15:08:45 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.90, 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, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:08:52
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defflavor tcp-stream-mixin
	 ((socket nil)				;The tcp-socket
	  (open nil)				;T if user has issued open
	  (closing nil)				;T if remote side has closed
	  (auto-push nil)			;T if open with auto-push
	  (bytes-read 0)			;total bytes read on this socket
	  (bytes-written 0)			;total bytes written on this socket
	  (timeout nil)				;T if send timed out
	  )
	 ()
  (:method-combination (:daemon-with-or :base-flavor-last :listen))
  (:gettable-instance-variables socket)
  (:inittable-instance-variables socket auto-push)
  )

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:08:56
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-stream-mixin :open) (&optional keyword &rest args)
  (setq args (copy-list args))
  (let* ((host-list (member :remote-address args :test #'eq))
	 (host (second host-list))
	 (user-timeout (member :send-timeout args :test #'eq))
	 (current-timeout (* 30 60))
	 (open-socket (null args)))
    (when host-list
      (setf (second host-list) (parse-internet-address (second host-list))))
    (setq args (append args `(:auto-push ,auto-push)))
    (if user-timeout
	(setq current-timeout (second user-timeout))
      (setq args (append args `(:send-timeout ,current-timeout))))
    (when (null socket)
      (setq socket (make-tcp-socket :keyword keyword)))
    (setq closing nil)
    (cond (open-socket				;Is socket already open?
	   (setq open t)
	   (send self :build-buffers)
	   self)
	  (t					;If user specified open keywords, open socket
	   (loop
	     (setq open (apply socket :open args))
	     (if (tcp:tcp-user-active socket)
		 (ecase (send self :handle-replies)
		   (:open			;All is well!
		    (return self))
		   (:unreachable
		    (cerror "Try again." "Remote Host ~S is unreachable" host))
		   (:reset
		    (cerror "Try again." "Connection refused by ~S" host))
		   (:timeout
		    (setq open nil)
		    (send socket :abort)
		    (incf current-timeout current-timeout)
		    (cerror (format nil "Try again with timeout of ~D ticks." current-timeout) "Connection timed out")
		    (let ((user-timeout (member :send-timeout args :test #'eq)))
		      (setf (second user-timeout) current-timeout))))
	       (return self)))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:01
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-stream-mixin :handle-replies) (&optional no-hang-p)
  (loop
    (cond ((send socket :listen)					;Activity on the socket
	   (let ((item (send socket :read-data)))
	     (case (first item)
	       (:open
		(send self :build-buffers)
		(return :open))
	       (:write-reply
		(incf bytes-written (fill-pointer (second item)))
		(send self :write-reply (second item))
		(return :write-reply))
	       (:data
		(incf bytes-read (fill-pointer (second item)))
		(send self :read-reply (second item))
		(when (eq (third item) :eof)
		  (setq closing t))
		(return :read-reply))
	       (:closing						;Remote side has closed
		(setq closing t)
		(return :remote-close))
	       (:reset
		(setq closing t)
		(setq open nil)
		(dolist (b (third item))
		  (send self :write-reply b))
		;;(cerror "Continue, treating as end-of-file" "Connection reset remotely")
		(return :reset))
	       (:close							;Socket closed out from under us
		(setq closing t)
		(setq open nil)
		;;(cerror "Continue, treating as end-of-file" "Connection reset locally")
		(return :local-close))
	       ((:network-unreachable :host-unreachable :protocol-unreachable :port-unreachable)
		(setq closing t)
		(setq open nil)
		(send socket :abort)
		(return :unreachable))
	       (:timeout
		(setq timeout t)
		(return :timeout))
	       (otherwise
		;;Ignore it
		))))
	  (no-hang-p							;No activity and no-hang
	   (return nil))
	  (t								;No activity -- wait
	   (wait-for-reply socket)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:09
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-stream-mixin :send-timeout) (&aux ok)
  (unwind-protect
      (progn (cerror "Reset timeout and continue" "Send timed out")
	     (funcall socket :reset-timeout)
	     (setq timeout nil)
	     (setq ok t))
    (unless ok
      (funcall socket :abort)
      (setq open nil))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:14
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-stream-mixin :handle-all-replies) ()
  (do ((count 0 (1+ count))
       (event (send self :handle-replies t)
	      (send self :handle-replies t)))
      ((null event)
       (plusp count))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#44 at 3-Nov-87 15:31:49
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "

(defmethod (tcp-stream-mixin :or :listen) ()
  (or timeout closing))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:17
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :next-input-buffer) (&optional no-hang-p)
  (declare (values buffer start end))
  (loop
    (cond ((not (fifo-empty-p input-buffer-fifo))
	   (let ((buffer (pop-fifo input-buffer-fifo)))
	     (return (values buffer 0 (fill-pointer buffer)))))
	  ((send self :handle-all-replies))
	  ((not open)
	   (return nil))
	  (closing
	   (return nil))
	  (no-hang-p
	   (return nil))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (wait-for-reply socket)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:21
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-buffered-stream :new-output-buffer) ()
  (declare (values buffer start end))
  (loop
    (cond (output-buffer-list
	   (return (values (pop output-buffer-list) 0 output-buffer-size)))
	  ((send self :handle-all-replies))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (wait-for-reply socket)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:26
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-unbuffered-stream :tyi) (&optional eof)
  (loop
    (cond (untyi-char
	   (return (prog1 untyi-char (setq untyi-char nil))))
	  (tyi-buffer
	   (let* ((buffer tyi-buffer)
		  (byte (aref buffer 0)))
	     (setq tyi-buffer nil)
	     (send socket :receive buffer)
	     (return byte)))
	  ((or closing (not open))
	   (if eof
	       (global:signal 'sys:end-of-file :format-string "End of File on TCP stream")
	     (return nil)))
	  ((send self :handle-all-replies))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (wait-for-reply socket)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:28
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-unbuffered-stream :listen) ()
  (loop
    (cond (untyi-char
	   (return t))
	  (tyi-buffer
	   (return t))
	  ((or closing (not open))
	   (return t))
	  ((send self :handle-all-replies))
	  (timeout
	   (return t))
	  (t
	   (return nil)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:32
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-unbuffered-stream :tyi-no-hang) (&optional eof)
  (loop
    (cond (untyi-char
	   (return (prog1 untyi-char (setq untyi-char nil))))
	  (tyi-buffer
	   (let* ((buffer tyi-buffer)
		  (byte (aref buffer 0)))
	     (setq tyi-buffer nil)
	     (send socket :receive buffer)
	     (return byte)))
	  ((or closing (not open))
	   (if eof
	       (global:signal 'sys:end-of-file :format-string "End of File on TCP stream")
	     (return nil)))
	  ((send self :handle-all-replies))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (return nil)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#43 at 3-Nov-87 15:09:36
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "


(defmethod (tcp-unbuffered-stream :tyo) (byte)
  (loop
    (cond ((not open)
	   (return nil))
	  (tyo-buffer
	   (let ((buffer tyo-buffer))
	     (setq tyo-buffer nil)
	     (setf (aref buffer 0) byte)
	     (setf (fill-pointer buffer) 1)
	     (send socket :write-data buffer)
	     (return t)))
	  ((send self :handle-all-replies))
	  (timeout
	   (send self :send-timeout))
	  (t
	   (wait-for-reply socket)))))

))