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(a)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)
