Author: ehuelsmann Date: Sat May 13 03:56:53 2006 New Revision: 151
Modified: trunk/cl-irc.asd trunk/package.lisp trunk/protocol.lisp trunk/utility.lisp trunk/variable.lisp Log: Resolve issue #2: Start guessing the message encoding.
On some lisps, reading character data mismatching the stream external format would break server communication.
Modified: trunk/cl-irc.asd ============================================================================== --- trunk/cl-irc.asd (original) +++ trunk/cl-irc.asd Sat May 13 03:56:53 2006 @@ -16,7 +16,7 @@ :version "0.5.2" :licence "MIT" :description "Common Lisp interface to the IRC protocol" - :depends-on (:split-sequence :trivial-sockets) + :depends-on (:split-sequence :trivial-sockets :flexi-streams) :properties ((#:author-email . "cl-irc-devel@common-lisp.net") (#:date . "$Date$") ((#:albert #:output-dir) . "doc/api-doc/")
Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Sat May 13 03:56:53 2006 @@ -41,6 +41,7 @@ :user-count :users :network-stream + :output-stream :client-stream :channels :add-hook
Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Sat May 13 03:56:53 2006 @@ -117,7 +117,11 @@ (network-stream :initarg :network-stream :accessor network-stream - :documentation "Stream used to talk to the IRC server.") + :documentation "Stream used to talk binary to the IRC server.") + (output-stream + :initarg :output-stream + :accessor output-stream + :documentation "Stream used to send messages to the IRC server") (server-capabilities :initform *default-isupport-values* :accessor server-capabilities @@ -186,12 +190,18 @@ (user nil) (server-name "") (network-stream nil) + (outgoing-external-format *default-outgoing-external-format*) (client-stream t) (hooks nil)) - (let ((connection (make-instance connection-type + (let* ((output-stream (flexi-streams:make-flexi-stream + network-stream + :element-type 'character + :external-format (external-format-fixup outgoing-external-format))) + (connection (make-instance connection-type :user user :server-name server-name :network-stream network-stream + :output-stream output-stream :client-stream client-stream))) (dolist (hook hooks) (add-hook connection (car hook) (cadr hook))) @@ -292,13 +302,40 @@ (defun read-message-loop (connection) (loop while (read-message connection)))
+(defun try-decode-line (line external-formats) + (loop for external-format in external-formats + for decoded = nil + for error = nil + do (multiple-value-setq (decoded error) + (handler-case + (flexi-streams:with-input-from-sequence (in line) + (let ((flexi (flexi-streams:make-flexi-stream in +;; :element-type 'character + :external-format + (external-format-fixup external-format)))) + (read-line flexi nil nil))) + (flexi-streams:flexi-stream-encoding-error () + nil))) + if decoded + do (return decoded))) + (defmethod read-irc-message ((connection connection)) "Read and parse an IRC-message from the `connection'." (handler-case - (let ((message (create-irc-message - (read-line (network-stream connection) t)))) - (setf (connection message) connection) - message) + (multiple-value-bind + (buf buf-len) + ;; Note: we cannot use read-line here (or any other + ;; character based functions), since they may cause conversion + (read-sequence-until (network-stream connection) + (make-array 1024 + :element-type '(unsigned-byte 8) + :fill-pointer t) + '(13 10)) + (setf (fill-pointer buf) buf-len) + (print buf) + (let* ((message (create-irc-message (try-decode-line buf *default-incoming-external-formats*)))) + (setf (connection message) connection) + message)) (end-of-file ()))) ;; satisfy read-message-loop assumption of nil when no more messages
@@ -307,8 +344,8 @@ "Turn the arguments into a valid IRC message and send it to the server, via the `connection'." (let ((raw-message (apply #'make-irc-message command arguments))) - (write-sequence raw-message (network-stream connection)) - (force-output (network-stream connection)) + (write-sequence raw-message (output-stream connection)) + (force-output (output-stream connection)) raw-message))
(defmethod get-hooks ((connection connection) (class symbol))
Modified: trunk/utility.lisp ============================================================================== --- trunk/utility.lisp (original) +++ trunk/utility.lisp Sat May 13 03:56:53 2006 @@ -54,9 +54,8 @@ parameters." (let ((*print-circle* nil)) (format nil - "~A~{ ~A~}~@[ :~A~]~A~A" - command (butlast arguments) (car (last arguments)) - #\Return #\Linefeed))) + "~A~{ ~A~}~@[ :~A~]~%" + command (butlast arguments) (car (last arguments)))))
(defun make-ctcp-message (string) "Return a valid IRC CTCP message, as a string, composed by @@ -104,7 +103,45 @@
(defun socket-connect (server port) "Create a socket connected to `server':`port' and return stream for it." - (trivial-sockets:open-stream server port)) + (trivial-sockets:open-stream server port :element-type '(unsigned-byte 8))) + +(defun external-format-fixup (format) + (let ((new-format (copy-list format))) + (setf (getf (cdr new-format) :eol-style) :crlf) + new-format)) + +(defun read-byte-no-hang (stream &optional eof-error-p eof-value) + (declare (optimize (speed 3) (debug 0) (safety 0))) + (when (listen stream) + (read-byte stream eof-error-p eof-value))) + +(defun read-sequence-until (stream target limit &key non-blocking) + "Reads data from `stream' into `target' until the subsequence +`limit' is reached or `target' is not large enough to hold the data." + (let ((read-fun (if (subtypep (stream-element-type stream) 'integer) + (if non-blocking #'read-byte-no-hang #'read-byte) + (if non-blocking #'read-char-no-hang #'read-char))) + (limit-pos 0) + (targ-max (1- (length target))) + (limit-max (length limit)) + (limit-cur 0) + (targ-cur -1)) + (declare (optimize (speed 3) (debug 0))) + ;; In SBCL read-char is a buffered operations (depending on + ;; stream creation parameters), so this loop should be quite efficient + ;; For others, if this becomes an efficiency problem, please report... + (loop for next-elt = (funcall read-fun stream nil nil) + if (null next-elt) + do (return (values target targ-cur t)) + else do + (setf (elt target (incf targ-cur)) next-elt) + (if (eql next-elt (elt limit limit-cur)) + (incf limit-cur) + (setf limit-cur 0)) + + if (or (= targ-cur targ-max) + (= limit-cur limit-max)) + do (return (values target (1+ targ-cur) nil)))))
(defun substring (string start &optional end) (let* ((end-index (if end end (length string)))
Modified: trunk/variable.lisp ============================================================================== --- trunk/variable.lisp (original) +++ trunk/variable.lisp Sat May 13 03:56:53 2006 @@ -41,6 +41,25 @@ ("PREFIX" ,*default-isupport-PREFIX*) ("TARGMAX")))
+(defparameter *default-outgoing-external-format* '(:utf-8) + "The external-format we use to encode outgoing messages. This + should be an external format spec that flexi-streams accepts. + + :eol-style will always be overridden to be :crlf as required + by the IRC protocol.") + +(defparameter *default-incoming-external-formats* '((:utf-8 :eol-style :crlf) + (:latin1 :eol-style :crlf)) + "The external-formats we use to decode incoming messages. This should + be a list of external format specs that flexi-streams accepts. + + The external formats are tried in order, until one decodes the + message without encoding errors. Note that the last external + format should be a single-byte one with most or even all valid + codepoints (such as latin-1). + + :eol-style will always be overridden to be :crlf as required by the + IRC protocol.")
(defvar *dcc-connections* nil)