Fixed up Unix sockets a bit.
[lisp-utils.git] / net-ecl.lisp
1 (in-package :common-net)
2
3 (require :sb-bsd-sockets)
4
5 ;;; Gray stream methods
6
7 ;; Redefine stream-socket with Gray superclasses. I know it's ugly,
8 ;; but I just don't know of a better way to do it.
9 (defclass stream-socket (socket gray:fundamental-input-stream gray:fundamental-output-stream)
10   ((mode :initform :byte)
11    (byte-buffer :initform (make-array '(16) :element-type '(unsigned-byte 8) :adjustable t)
12                 :type (array (unsigned-byte 8)))
13    (byte-read-pos :initform 0 :type integer)
14    (byte-write-pos :initform 0 :type integer)
15    (char-buffer :initform (make-array '(16) :element-type 'character :adjustable t :fill-pointer 0)
16                 :type (array character))
17    (char-read-pos :initform 0 :type integer)
18    encoder decoder))
19
20 (macrolet ((simple (name)
21              `(defmethod
22                   ,(intern (symbol-name name) (find-package :gray)) ((socket stream-socket))
23                 (,(intern (concatenate 'string "GRAY-" (symbol-name name)) (symbol-package 'stream-socket)) socket)))
24            (simple-null (name)
25              `(defmethod
26                   ,(intern (symbol-name name) (find-package :gray)) ((socket stream-socket))
27                 nil)))
28   (simple stream-element-type)
29   (simple open-stream-p)
30   (simple stream-read-byte)
31   (simple stream-read-char)
32   (simple stream-read-char-no-hang)
33   (simple stream-peek-char)
34   (simple stream-listen)
35   (simple-null stream-line-column)
36   (simple-null stream-finish-output)
37   (simple-null stream-force-output)
38   (simple-null stream-clear-output))
39
40 (defmethod gray:stream-write-byte ((socket stream-socket) byte)
41   (gray-stream-write-char socket byte))
42
43 (defmethod gray:stream-unread-char ((socket stream-socket) char)
44   (gray-stream-unread-char socket char))
45
46 (defmethod gray:stream-write-char ((socket stream-socket) char)
47   (gray-stream-write-char socket char))
48
49 (defmethod gray:close ((socket stream-socket) &key abort)
50   (declare (ignore abort))
51   (prog1
52       (call-next-method)
53     (close-socket socket)))
54
55 (defmethod gray:stream-start-line-p ((socket stream-socket))
56   (eql (gray:stream-line-column socket) 0))
57
58 (defmethod gray:stream-fresh-line ((socket stream-socket))
59   (unless (gray:stream-start-line-p socket)
60     (gray:stream-terpri socket)
61     t))
62
63 (defmethod gray:stream-write-string ((socket stream-socket) string &optional (start 0) (end (length string)))
64   (gray:stream-write-sequence socket string start end))
65
66 (defmethod gray:stream-terpri ((socket stream-socket))
67   (gray:stream-write-char socket #\newline))
68
69 (defmethod gray:stream-read-sequence ((socket stream-socket) seq &optional (start 0) (end (length seq)))
70   (gray-stream-read-sequence socket seq start end))
71
72 (defmethod gray:stream-write-sequence ((socket stream-socket) seq &optional (start 0) (end (length seq)))
73   (gray-stream-write-sequence socket seq start end))
74
75 ;;; Error cover-up
76
77 (defmethod sb-bsd-sockets:socket-name ((sk sb-bsd-sockets:local-socket))
78   (simple-network-error "ECL does not support reading the name of Unix sockets."))