;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 124.73 ;;; Reason: ;;; UDP, UDP-STREAM, UDP-RWHO-SERVER fixes: ;;; - When a UDP socket is already in use, properly print the port number in the error ;;; - UDP-STREAM's :read-packet function will optionally return the exact packet it ;;; received rather than always copying the data ;;; - UDP Rwho Server uses this feature and no longer throws away a UDP buffer every ;;; time it receives a packet ;;; Written 18-Jun-88 13:13:38 by pld (Peter L. DeWolf) at site Gigamos Cambridge ;;; while running on Cthulhu from band 1 ;;; with Experimental System 124.65, Experimental Local-File 74.2, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, microcode 1760, SDU Boot Tape 3.14, SDU ROM 8, the old ones. (when tcpa:*udp-rwho-server-process* (send tcpa:*udp-rwho-server-process* :arrest-reason :not-running)) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP-STREAM.LISP#20 at 18-Jun-88 13:31:30 #10R UDP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP-STREAM  " (defmethod (udp-stream :read-packet) (&optional pkt (start 0) end) (declare (values packet length remote-port remote-address)) (loop (unless open (return nil)) (let ((blip (pop-fifo packet-list))) (when blip (let* ((data (first blip)) (data-length (length data))) (cond (pkt ;User gave us a packet (unless end (setq end (array-length pkt))) (setq data-length (min data-length (- end start))) (copy-array-portion data 0 data-length pkt start end) (send socket :receive data)) (t ;User wants the real packet we received (send socket :receive (get-udp-buffer)))) (return (values (or pkt data) data-length (third blip) (second blip)))))) (send self :handle-replies))) )) ; From modified file DJ: L.NETWORK.IP-TCP.SERVER; UDP-RWHO-SERVER.LISP#33 at 18-Jun-88 13:16:11 #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 insert-rwho-packet (remote-address buffer) (let ((elt (assoc remote-address *udp-rwho-server-packets*))) (cond (elt (udp:free-udp-buffer (cdr elt)) (setf (cdr elt) buffer)) (t (push (cons remote-address buffer) *udp-rwho-server-packets*)))) (sort *udp-rwho-server-packets* #'string-lessp :key #'(lambda (elt) (rwho-hostname (cdr elt))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.SERVER; UDP-RWHO-SERVER.LISP#33 at 18-Jun-88 13:16:18 #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 udp-rwho-server-process () (loop (process-wait "UDP Enable" #'(lambda () (and udp:*udp-stream* (udp:udp-enabled udp:*udp-stream*)))) (with-open-stream (stream (send (make-instance 'udp:udp-stream) :open "RWHO Server" :local-port (sym ipport-whoserver))) (broadcast-rwho-packet stream) (loop (unless (time-lessp (zl:time) *udp-rwho-server-next-broadcast-time*) (broadcast-rwho-packet stream)) (when (send stream :listen) (multiple-value-bind (packet length remote-port remote-address) (send stream :read-packet) (declare (ignore length)) (declare (ignore remote-port)) (unless packet ;;socket closed, UDP shut down, whatever... (return nil)) (setf (rwho-recv-time packet) (fudge-ut-to-unix (get-universal-time))) (insert-rwho-packet remote-address packet))) (process-wait "RWHO Packet Send/Recv" #'(lambda (s) (or (send s :listen) (not (time-lessp (zl:time) *udp-rwho-server-next-broadcast-time*)))) stream))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#114 at 18-Jun-88 13:33:54 #10R UDP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  " (defop (udp-socket :open) (&key local-port remote-port remote-address (initial-gauges nil ig-p) &aux parsed-remote-address) (unless (udp-user-enabled self) (when (udp-enabled *udp-stream*) (assert (or (setq parsed-remote-address nil) ;This branch always fails, but reinitializes local (cond ((null remote-port) ;;If no remote-port, must be no remote-address (null remote-address)) ((setq parsed-remote-address (parse-internet-address remote-address)) ;;If have a remote-port, remote-address must be valid AND remote-port must be valid (typep remote-port '(unsigned-byte 16))) (t ;;If have a remote-port and remote-address invalid, error nil))) (remote-port remote-address) "~[REMOTE-PORT ~D out of range~;REMOTE-ADDRESS ~S unknown~;REMOTE-PORT and REMOTE-ADDRESS must be both nil or both non-nil~]" (cond ((null remote-port) 2) (parsed-remote-address 0) (t 1)) (if parsed-remote-address remote-port remote-address)) (if local-port (assert (and (typep local-port '(unsigned-byte 16)) (unused-local-port local-port remote-port)) (local-port) "LOCAL-PORT ~D is ~:[out of range~;already in use~]" local-port (typep local-port '(unsigned-byte 16))) (setq local-port (assign-local-port))) (setf (udp-user-local-port self) local-port) (setf (udp-user-remote-port self) remote-port) (setf (udp-user-remote-address self) parsed-remote-address) (setf (udp-user-packet-list self) (make-fifo)) (array-initialize (udp-user-statistics-block self) 0) (setf (udp-user-gauge-name self) (format nil "UDP ~D" (udp-user-local-port self))) (dolist (g (udp-user-inactive-gauges self)) (send (cdr g) :set-margin-name (udp-user-gauge-name self))) (when ig-p ;;If initial-gauges specified, NIL means no gauges, T means default, anything else specifies gauges ;;The reason to add no gauges is to have the statistics block looked at by the clock function (if (eq initial-gauges t) (setq initial-gauges '(:apr :aps :abr :abs))) (set-gauges (udp-user-statistics-block self) (locf (udp-user-active-gauges self)) (locf (udp-user-inactive-gauges self)) (udp-user-gauge-name self) initial-gauges) (add-network-statistics-block (udp-user-statistics-block self))) (do ((blip (pop-fifo (udp-user-packet-list self)) (pop-fifo (udp-user-packet-list self)))) ((null blip)) (unless (eq (first blip) :close) (free-ip-header (second blip))) (if (eq (first blip) :data) (free-udp-buffer (third blip)))) (push (cons local-port self) (udp-user-socket-alist *udp-stream*)) local-port))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#114 at 18-Jun-88 13:39:26 #10R UDP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  " (defun free-udp-buffer (udp) (push (original-array udp) *free-udp-buffers*) nil) )) (when tcpa:*udp-rwho-server-process* (tcpa:initialize-udp-rwho-server-process))