I would like to debug a handler function which is defined by
sys:add-fd-handler in CMUCL. As example I took the nice port forwarder
program tcp-forwarder.lisp shown below. If a breakpoint is defined in
the function input-handler, it is not possible to enter anything at
the debugger prompt, because the breakpoint is hit over and over
again (this applies to the SLIME debugger and also to the CMUCL
command line). Is it possible to somehow block handler execution while
at the debugger prompt to analyze a single handler call?
The source considered is:
;;; tcp-forwarder.lisp --- forward TCP connnections using SERVE-EVENT
;;;
;;; Author: Eric Marsden <········@mail.dotcom.fr>
;;; Time-stamp: <2001-04-12 emarsden>
;;
;;
;; This program is a port forwarder, or redirector. It redirects TCP
;; connections to another port on another machine. The program can
;; handle multiple concurrent connections.
;;
;; Note the use of CMUCL's SERVE-EVENT facility to handle several
;; concurrent connections without using any multithreading.
;; Source: http://www.chez.com/emarsden/downloads/tcp-forwarder.lisp
(use-package :unix)
(defparameter +target-host+ "localhost")
(defparameter +target-port+ 23)
(defparameter +source-port+ 10000)
(defvar *read-buffer* (make-string 1024))
(defvar *forwarded-fds* (make-hash-table))
(defun input-handler (from-fd)
(break "input-handler")
(declare (type integer from-fd))
(let ((to-fd (gethash from-fd *forwarded-fds*)))
(unless to-fd
(format *debug-io* "Not a forwarded descriptor: ~d~%" from-fd)
(throw 'forwarder-loop nil))
(multiple-value-bind (count err)
(unix-read from-fd (sys:vector-sap *read-buffer*) 100)
(when (or (null count) (zerop count))
(unless count
(format *debug-io* "Error reading from file descriptor ~d:
~a"
from-fd (get-unix-error-msg err)))
(unix-close from-fd)
(unix-close to-fd)
(sys:invalidate-descriptor from-fd)
(sys:invalidate-descriptor to-fd)
(remhash from-fd *forwarded-fds*)
(remhash to-fd *forwarded-fds*)
(return-from input-handler))
(unix-write to-fd (sys:vector-sap *read-buffer*) 0 count))))
(defun accept-handler (fd)
(let ((to-fd (ext:connect-to-inet-socket +target-host+
+target-port+))
(from-fd (ext:accept-tcp-connection fd)))
(setf (gethash to-fd *forwarded-fds*) from-fd)
(setf (gethash from-fd *forwarded-fds*) to-fd)
(sys:add-fd-handler from-fd :input #'input-handler)
(sys:add-fd-handler to-fd :input #'input-handler)))
(defun forward ()
(system:default-interrupt SIGPIPE)
(let ((fd (ext:create-inet-listener +source-port+)))
(sys:add-fd-handler fd :input #'accept-handler)
(loop (catch 'forwarder-loop (sys:serve-all-events 1)))))
(forward)