Commit 7dedc3f7 authored by james's avatar james
Browse files

Flushed old READ-CHAR implementation in favor of new simple READ-CHAR and

complex READ-COMMAND which reads a telnet command into a single sequence and
returns it. Not finished with READ-COMMAND yet.

Also redid READ-CHAR, UNREAD-CHAR to use CL functions directly on stream
rather than maintaining our own character unread mechanism. Will make
PEEK-CHAR implementation much simpler too.

Probably the READ-CHAR should become %READ-CHAR and then a new READ-CHAR which
does command processing can wrap around it. Or different names perhaps, but
the user shouldn't need to call READ-COMMAND and PROCESS-TELNET-COMMAND
directly.
parent 2b66d4ac
;;;; ltelnetd.lisp -- Lisp Telnet daemon.
;;;;
;;;; $Id: ltelnetd.lisp,v 1.3 2004/01/23 08:45:28 james Exp $
;;;; $Id: ltelnetd.lisp,v 1.4 2004/01/24 11:08:26 james Exp $
;;;;
;;;; Copyfnord (K) 3170 James A. Crippen <james@unlambda.com>,
;;;; Martin Rydstrom <rydis@cd.chalmers.se>
......@@ -306,65 +306,6 @@ in LISTENER."
(socket-close (telnet-listener-socket listener))
(setf (telnet-listener-threads listener) nil
(telnet-listener-master-thread listener) nil))
;;
;;;;;; Telnet Stream
;;
;;; TELNET-STREAM isn't a real stream. It merely pretends to be one by
;;; implementing all the applicable stream functions, and functions as a
;;; wrapper around whatever stream has been created from the socket.
(defclass telnet-stream ()
((stream :accessor telnet-stream-stream :type (or file-stream null))
(unread-chars :accessor telnet-stream-unread-chars)
(transmit-mode :initform :character :type (member :character :line)
:accessor telnet-stream-transmit-mode)
(command-mode :initform nil :type (member nil t)
:accessor telnet-stream-command-mode)
(remote-echo :initform t :type (member nil t)
:accessor telnet-stream-remote-echo)
(local-suppress-go-ahead :initform nil :type (member nil t)
:accessor telnet-stream-local-suppress-go-ahead)
(remote-suppress-go-ahead :initform nil :type (member nil t)
:accessor telnet-stream-remote-suppress-go-ahead)
(resume-buffer :initform nil :accessor telnet-stream-resume-buffer)
(resume-urgent-length :initform nil :accessor telnet-stream-urgent-length)
(naws-support-function :initform nil :type (or function null)
:accessor telnet-stream-naws-support-function)))
;;; NOTE: READ-CHAR and PROCESS-TELNET-COMMAND are incestuous.
(defmethod read-char ((stream telnet-stream) &optional eof-error-p eof-value recursive-p)
(declare (ignore eof-error-p eof-value recursive-p)) ;FIXME: Use these instead of ignoring.
(let* ((unread-chars (telnet-stream-unread-chars stream))
(strm (telnet-stream-stream stream))
(char (if unread-chars
(let ((c (car unread-chars)))
(setf unread-chars (cdr unread-chars))
c)
(read-char strm)))) ;read from the real stream
;; If we read IAC then process the command. If that command returns IAC
;; then we return IAC (ie, IAC was escaped). Otherwise just return the
;; char.
(if (not (char-equal char +iac+))
char
(let ((foo (process-telnet-command stream)))
(if (char-equal foo +iac+)
foo
;; Our READ-CHAR, so we get any additional UNREAD-CHARS.
(read-char stream))))))
(defmethod discard-char ((stream telnet-stream))
"Silently discards a character from STREAM. Returns NIL."
(let* ((unread-chars (telnet-stream-unread-chars stream))
(strm (telnet-stream-stream stream)))
(if unread-chars
(setf unread-chars (cdr unread-chars))
(read-char strm)))
(values))
(defmethod unread-char (character (stream telnet-stream))
(push character (telnet-stream-unread-chars stream)))
;;
......@@ -431,6 +372,68 @@ in LISTENER."
(defconstant +opt-is+ (code-char 0) "IS")
;;
;;;;;; Telnet Stream
;;
;;; TELNET-STREAM isn't a real stream. It merely pretends to be one by
;;; implementing all the applicable stream functions, and functions as a
;;; wrapper around whatever stream has been created from the socket.
(defclass telnet-stream ()
((stream :accessor telnet-stream-stream :type (or file-stream null))
(transmit-mode :initform :character :type (member :character :line)
:accessor telnet-stream-transmit-mode)
(command-mode :initform nil :type (member nil t)
:accessor telnet-stream-command-mode)
(remote-echo :initform t :type (member nil t)
:accessor telnet-stream-remote-echo)
(local-suppress-go-ahead :initform nil :type (member nil t)
:accessor telnet-stream-local-suppress-go-ahead)
(remote-suppress-go-ahead :initform nil :type (member nil t)
:accessor telnet-stream-remote-suppress-go-ahead)
(resume-buffer :initform nil :accessor telnet-stream-resume-buffer)
(resume-urgent-length :initform nil :accessor telnet-stream-urgent-length)
(naws-support-function :initform nil :type (or function null)
:accessor telnet-stream-naws-support-function)))
(defmethod read-char ((stream telnet-stream) &optional eof-error-p eof-value recursive-p)
"Read a character from the telnet-stream STREAM."
(cl:read-char (telnet-stream-stream stream) eof-error-p eof-value recursive-p))
(defmethod discard-char ((stream telnet-stream))
"Silently discards a character from STREAM. Always returns T."
(cl:read-char (telnet-stream-stream stream))
(values t))
(defmethod unread-char (char (stream telnet-stream))
"Unread a character CHAR from the telnet-stream STREAM."
(cl:unread-char char (telnet-stream-stream stream)))
(defmethod peek-char (peek-type (stream telnet-stream) eof-error-p eof-value recursive-p)
(cl:peek-char peek-type (telnet-stream-stream stream) eof-error-p eof-value recursive-p))
(defmethod read-command ((stream telnet-stream))
"Reads a command sequence from STREAM and returns it. If no IAC is found then
NIL is returned.
A command sequence may be a simple IAC FOO command, a subnegotiation sequence
begun with IAC SB FOO and ending with IAC SE, or an option with IAC {DO,DONT,
WILL,WONT} FOO."
(if (not (eql (peek-char stream) +iac+))
;; No IAC so lose.
(return-from read-command nil)
(flet ((read-subnegotiation (c s)
)
(read-option (c s)
))
(let ((command-string (vector (read-char stream) (read-char stream))))
(case (char 2 command-string)
(+sb+ (read-subnegotiation command-string stream))
((+cmd-will+ +cmd-wont+ +cmd-do+ +cmd-dont+)
(read-option command-string stream))
(t (return-from read-command command-string)))))))
;;
;;;;;; Command and Option Handling.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment