From 2a74738011126c053e5baec5e33639600965682e Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Tue, 13 Jan 1998 19:20:10 +0000 Subject: [PATCH] Have the lisp connection listener search forward for an available port, and add at least some simple password protection. --- code/multi-proc.lisp | 196 +++++++++++++++++++++++-------------------- 1 file changed, 105 insertions(+), 91 deletions(-) diff --git a/code/multi-proc.lisp b/code/multi-proc.lisp index 38f70c859..875e6a126 100644 --- a/code/multi-proc.lisp +++ b/code/multi-proc.lisp @@ -3,7 +3,7 @@ ;;; This code was written by Douglas T. Crosher and has been placed in ;;; the Public domain, and is provided 'as is'. ;;; -;;; $Id: multi-proc.lisp,v 1.21 1998/01/12 16:56:55 dtc Exp $ +;;; $Id: multi-proc.lisp,v 1.22 1998/01/13 19:20:10 dtc Exp $ ;;; ;;; ********************************************************************** ;;; @@ -1441,105 +1441,119 @@ (process-idle-time process))))) +;;; Top-Level +;;; +(defun top-level () + "Top-level READ-EVAL-PRINT loop for processes." + (let ((magic-eof-cookie (cons :eof nil))) + (loop + (with-simple-restart (abort "Return to Top-Level.") + (catch 'top-level-catcher + (unix:unix-sigsetmask 0) + (let ((lisp::*in-top-level-catcher* t)) + (loop + (sys:scrub-control-stack) + (fresh-line) + (princ (if (functionp ext:*prompt*) + (funcall ext:*prompt*) + ext:*prompt*)) + (force-output) + (let ((form (read *standard-input* nil magic-eof-cookie))) + (cond ((not (eq form magic-eof-cookie)) + (let ((results + (multiple-value-list + (ext:interactive-eval form)))) + (dolist (result results) + (fresh-line) + (prin1 result)))) + (t + (throw '%end-of-the-process nil))))))))))) + ;;; Start-Lisp-Connection-Listener ;;; ;;; Create a process to listen for connections on a TCP port and start ;;; a new top-level process for each connection. ;;; (defun start-lisp-connection-listener (&optional (port 1025)) + (declare (type (unsigned-byte 16) port)) "Create a Lisp connection listener on the given port." - (labels (;; The session top level read eval. loop. - (start-top-level (fd) - (let ((stream (sys:make-fd-stream fd :input t :output t))) - (unwind-protect - (let* ((*terminal-io* stream) - (*standard-input* (make-synonym-stream - '*terminal-io*)) - (*standard-output* *standard-input*) - (*error-output* *standard-input*) - (*debug-io* *standard-input*) - (*query-io* *standard-input*) - (*trace-output* *standard-input*) - (magic-eof-cookie (cons :eof nil))) - - (ext:print-herald) - - (with-simple-restart (close "Close connection.") - (loop - (with-simple-restart (abort "Return to Top-Level.") - (catch 'top-level-catcher - (unix:unix-sigsetmask 0) - (let ((lisp::*in-top-level-catcher* t)) - (loop - (sys:scrub-control-stack) - (fresh-line) - (princ (if (functionp ext:*prompt*) - (funcall ext:*prompt*) - ext:*prompt*)) - (force-output) - (let ((form (read *standard-input* - nil magic-eof-cookie))) - (cond ((not (eq form magic-eof-cookie)) - (let ((results - (multiple-value-list - (ext:interactive-eval - form)))) - (dolist (result results) - (fresh-line) - (prin1 result)))) - (t - (throw '%end-of-the-process nil))))))))))) - (handler-case - (close stream) - (error ()))))) - ;; Turn internet address into string format - (ip-address-string (address) - (format nil "~D.~D.~D.~D" - (ldb (byte 8 24) address) - (ldb (byte 8 16) address) - (ldb (byte 8 8) address) - (ldb (byte 8 0) address))) - ;; The body of the connection listener. - (listener () - (declare (optimize (speed 3))) - (let ((fd nil)) - (unwind-protect - (progn - ;; Try to start the listener - sleep until available. - (do ((retry-wait 10 (* 2 retry-wait))) - (fd) - (declare (fixnum retry-wait)) - (handler-case - (setf fd (ext:create-inet-listener port)) - (error () - (format *error-output* - "~&Warning: unable to create listner on ~ - port ~d; retry in ~d seconds.~%" - port retry-wait) - (sleep retry-wait)))) - (loop - ;; Wait until input ready. - (process-wait-until-fd-usable fd :input) - (multiple-value-bind (new-fd remote-host) - (ext:accept-tcp-connection fd) - (let ((host-entry (ext:lookup-host-entry - remote-host))) - (make-process - #'(lambda () - (start-top-level new-fd)) - :name (format nil "Lisp session from ~A" - (if host-entry - (ext:host-entry-name host-entry) + (let ((listener-password nil)) + (labels (;; The session top level read eval. loop. + (start-top-level (fd) + (let ((stream (sys:make-fd-stream fd :input t :output t))) + (unwind-protect + (let* ((*terminal-io* stream) + (*standard-input* + (make-synonym-stream '*terminal-io*)) + (*standard-output* *standard-input*) + (*error-output* *standard-input*) + (*debug-io* *standard-input*) + (*query-io* *standard-input*) + (*trace-output* *standard-input*)) + ;; + (format t "Enter password: ") + (finish-output) + (unless (eql (read) listener-password) + (return-from start-top-level)) + (ext:print-herald) + ;; + (top-level)) + (handler-case + (close stream) + (error ()))))) + ;; + ;; Turn internet address into string format + (ip-address-string (address) + (format nil "~D.~D.~D.~D" + (ldb (byte 8 24) address) + (ldb (byte 8 16) address) + (ldb (byte 8 8) address) + (ldb (byte 8 0) address))) + ;; + ;; The body of the connection listener. + (listener () + (declare (optimize (speed 3))) + (let ((fd nil)) + (unwind-protect + (progn + ;; Start the listener. + (do () + (fd) + (handler-case + (setf fd (ext:create-inet-listener port)) + (error () (incf port)))) + + (setf (process-name *current-process*) + (format nil "Lisp connection listener on port ~d" + port)) + + (setf listener-password (random (expt 2 24))) + (format t "~&;;; Started lisp connection listener on ~ + port ~d with password ~d~%" + port listener-password) + + (loop + ;; Wait until input ready. + (process-wait-until-fd-usable fd :input) + (multiple-value-bind (new-fd remote-host) + (ext:accept-tcp-connection fd) + (let ((host-entry (ext:lookup-host-entry + remote-host))) + (make-process + #'(lambda () + (start-top-level new-fd)) + :name (format nil "Lisp session from ~A" + (if host-entry + (ext:host-entry-name + host-entry) (ip-address-string remote-host)))))))) - ;; Close the listener stream. - (when fd - (unix:unix-close fd)))))) - - ;; Make the listening thread. - (make-process - #'listener - :name (format nil "Lisp Connection Listener on port ~d" port)))) + ;; Close the listener stream. + (when fd + (unix:unix-close fd)))))) + + ;; Make the listening thread. + (make-process #'listener)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Simple Locking. -- GitLab