;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.20
;;; Reason:
;;;  QFILE loses a chaos packet every time it receives a simple transaction packet
;;; Written 30-Sep-87 12:40:40 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.19, 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.CHAOS; QFILE.LISP#378 at 30-Sep-87 12:40:41
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN HOST-CHAOS-INTERRUPT-FUNCTION (REASON CONN &REST IGNORE)
  (DECLARE (SPECIAL HOST-UNIT))
  (CASE REASON
    (:INPUT
     (DO ((PKT (CHAOS:GET-NEXT-PKT CONN T)
	       (CHAOS:GET-NEXT-PKT CONN T))
	  (STRING) (TEM))
	 ((NULL PKT))
       (SETQ STRING (CHAOS:PKT-STRING PKT))
       (SELECT (CHAOS:PKT-OPCODE PKT)
	 (%QFILE-ASYNCHRONOUS-MARK-OPCODE
	  (SETQ STRING (NSUBSTRING STRING
				   (1+ (STRING-SEARCH-CHAR #/SPACE (CHAOS:PKT-STRING PKT)))))
	  (DO ((DATA-CONNS (QFILE-HOST-UNIT-DATA-CONNECTIONS HOST-UNIT) (CDR DATA-CONNS))
	       (HANDLE-LEN (OR (STRING-SEARCH-CHAR #/SPACE STRING)
			       (STRING-LENGTH STRING)))
	       (STREAM))
	      ((NULL DATA-CONNS) (CHAOS:RETURN-PKT PKT))
	    (WHEN (STRING-EQUAL STRING (DATA-HANDLE (CAR DATA-CONNS) :OUTPUT)
				:END2 HANDLE-LEN)
	      (SETQ STREAM (DATA-STREAM (CAR DATA-CONNS) :OUTPUT))
	      (SEND STREAM :ASYNC-MARK PKT)
	      (RETURN NIL))))
	 (%QFILE-COMMAND-OPCODE
	  (SETQ STRING (SUBSTRING STRING 0 (STRING-SEARCH-CHAR #/SPACE STRING)))
	  (SETQ TEM (SYS:ASSOC-EQUAL STRING *QFILE-PENDING-TRANSACTIONS*))
	  (COND ((NULL TEM)
		 (PROCESS-RUN-FUNCTION
		   "QFILE Protocol Error"
		   #'(LAMBDA (PKT)
		       (UNWIND-PROTECT
			 (FERROR NIL "QFILE protocol violated, unknown transaction id in ~S"
				 (CHAOS:PKT-STRING PKT))
			 (CHAOS:RETURN-PKT PKT)))
		   PKT))
		((QFILE-TRANSACTION-ID-SIMPLE-P TEM)
		 ;;If simple transaction, make sure no error
		 (LET ((STRING (NSUBSTRING (CHAOS:PKT-STRING PKT)
					   (1+ (STRING-SEARCH-CHAR #/SPACE
								   (CHAOS:PKT-STRING PKT)))))
		       (FROM))
		   (SETQ FROM (1+ (STRING-SEARCH-SET '(#/SPACE #/NEWLINE) STRING)))
		   ;; If simple transaction fails, barf in another process
		   (OR (NOT (STRING-EQUAL "ERROR" STRING
					  :START2 FROM
					  :END2 (STRING-SEARCH-SET '(#/SPACE #/NEWLINE)
								   STRING FROM)))
		       (PROCESS-RUN-FUNCTION "QFILE Protocol Error"
					     'QFILE-PROCESS-ERROR-NEW
					     (COPY-SEQ STRING))))
		 (SETQ *QFILE-PENDING-TRANSACTIONS* (DELQ TEM *QFILE-PENDING-TRANSACTIONS*))
		 (chaos:return-pkt pkt))
		(T (SETF (QFILE-TRANSACTION-ID-PKT TEM) PKT))))
	 (%QFILE-NOTIFICATION-OPCODE
	  (UNWIND-PROTECT
	      (TV:NOTIFY NIL "File server ~A: ~A" (QFILE-HOST-UNIT-HOST HOST-UNIT) STRING)
	    (CHAOS:RETURN-PKT PKT)))
	 (OTHERWISE (CHAOS:RETURN-PKT PKT)))))))

))