;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.7
;;; Reason:
;;;  Allow :stream-flavor keyword for (tcpa:define-network-service)
;;; Written 28-Aug-87 16:26:32 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Azathoth from band 2
;;; with Experimental System 123.5, 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.12, SDU ROM 102.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; GENERIC-SERVER.LISP#20 at 28-Aug-87 16:26:33
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; GENERIC-SERVER  "


(defmacro define-network-service (name protocol-name transport-protocol documentation &body keywords)
  "Causes the system to create a socket to listen on LISTEN-PORT.
TRANSPORT-PROTOCOL may be either :TCP or :UDP for stream and datagram oriented services respectively.
When somebody connects to this port a process is created in which the TOPLEVEL-FUNCTION is called
on a stream connected to the active socket.
The stream and socket are automatically closed when the function exits.
If AUTO-ENABLE? is non-NIL, this server will enabled by calls to (enable-all-network-services),
which is run whenever TCP is initialized."
  (declare (arglist name protocol-name transport-protocol documentation
		    &key toplevel-function listen-port auto-enable? stream-flavor))
  `(*define-network-service ',name ',protocol-name ',transport-protocol ',documentation ,@keywords))

(defun *define-network-service (name protocol-name transport-protocol documentation
				&key toplevel-function listen-port auto-enable? stream-flavor)
  (when (global:record-source-file-name name 'define-network-service)
    (setf (documentation name 'network-service) (or documentation name))
    (let ((service (set name (make-network-service))))
      (pushnew name *network-services*)
      (setf (network-service-name service) protocol-name)
      (setf (network-service-transport-protocol service) transport-protocol)
      (setf (network-service-listen-port service) (eval listen-port))
      (setf (network-service-toplevel-function service) toplevel-function)
      (setf (network-service-auto-enable? service) auto-enable?)
      (setf (network-service-stream-flavor service) stream-flavor)
      (setf (network-service-active-servers service) nil)
      (setf (network-service-listening-server service) nil)
      (setf (network-service-lock service) nil))
    name))

))
