1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
;;; lowlevel.lisp -- lowlevel network
;;;
;;; Author: Eric Marsden <emarsden>
;;; Time-stamp: <2005-07-17 emarsden>
(in-package :postgresql)
;; read an integer in network byte order
(defun %read-net-int8 (stream)
"Reads an integer BYTES bytes long from the STREAM.
The signed integer is presumed to be in network order.
Returns the integer."
(let ((result (read-byte stream)))
(when (= 1 (ldb (byte 1 7) result))
;; negative
(setf result (-
(1+ (logxor result
#xFF)))))
result))
(defun %read-net-int16 (stream)
"Reads an integer BYTES bytes long from the STREAM.
The signed integer is presumed to be in network order.
Returns the integer."
(let ((result (+ (* 256 (read-byte stream))
(read-byte stream))))
(when (= 1 (ldb (byte 1 15) result))
;; negative
(setf result (-
(1+ (logxor result
#xFFFF)))))
result))
(defun %read-net-int32 (stream)
"Reads an integer BYTES bytes long from the STREAM.
The signed integer is presumed to be in network order.
Returns the integer."
(let ((result (+ (* 256 256 256 (read-byte stream))
(* 256 256 (read-byte stream))
(* 256 (read-byte stream))
(read-byte stream))))
(when (= 1 (ldb (byte 1 31) result))
;; negative
(setf result (-
(1+ (logxor result
#xFFFFFFFF)))))
result))
#-cmu
(defun %read-bytes (stream howmany)
"Reads HOWMANY bytes from the STREAM.
Returns the array of "
(declare (type stream stream))
(let ((v (make-array howmany :element-type '(unsigned-byte 8))))
(read-sequence v stream)
v))
;; There is a bug in CMUCL's implementation of READ-SEQUENCE on
;; network streams, which can return without reading to the end of the
;; sequence when it has to wait for data. It confuses the end-of-file
;; condition with no-more-data-currently-available. This workaround is
;; thanks to Wayne Iba.
#+cmu
(defun %read-bytes (stream howmany)
"Reads HOWMANY bytes from the STREAM.
Returns the array of "
(declare (type stream stream))
(let ((v (make-array howmany :element-type '(unsigned-byte 8))))
(do ((continue-at (read-sequence v stream :start 0 :end howmany)
(read-sequence v stream :start continue-at :end howmany)))
((= continue-at howmany))
)
v))
(defun %read-chars (stream howmany)
(declare (type fixnum howmany))
(let ((bytes (%read-bytes stream howmany))
(str (make-string howmany)))
(dotimes (i howmany)
(setf (aref str i) (code-char (aref bytes i))))
str))
(defun %read-cstring (stream maxbytes)
"Read a null-terminated string from CONNECTION."
(declare (type fixnum maxbytes))
(let ((chars nil))
(do ((b (read-byte stream nil nil) (read-byte stream nil nil))
(i 0 (+ i 1)))
((or (= i maxbytes) ; reached allowed length
(null b) ; eof
(zerop b)) ; end of string
(concatenate 'string (nreverse chars)))
(push (code-char b) chars))))
;; read an integer in network byte order
(defun read-net-int (connection bytes)
(do ((i bytes (- i 1))
(stream (pgcon-stream connection))
(accum 0))
((zerop i) accum)
(setq accum (+ (* 256 accum) (read-byte stream)))))
(defun send-string (connection str &optional pad-to)
(let* ((stream (pgcon-stream connection))
(len (length str))
(v (make-array len :element-type '(unsigned-byte 8))))
;; convert the string to a vector of bytes
(dotimes (i len)
(setf (aref v i) (char-code (aref str i))))
(write-sequence v stream)
;; pad if necessary
(when pad-to
(write-sequence (make-array (- pad-to len)
:initial-element 0
:element-type '(unsigned-byte 8))
stream))))
(defun send-octets (connection buffer)
(declare (type (vector (unsigned-byte 8) *) buffer))
(write-sequence buffer (pgcon-stream connection)))
;; highest order bits first
(defun send-int (connection int bytes)
(declare (type fixnum int bytes))
(let ((v (make-array bytes :element-type '(unsigned-byte 8)))
(stream (pgcon-stream connection)))
(do ((i (- bytes 1) (- i 1)))
((< i 0))
(setf (aref v i) (rem int 256))
(setq int (floor int 256)))
(write-sequence v stream)))
(defun %send-net-int (stream int bytes)
(declare (type stream stream)
(type fixnum int bytes))
(let ((v (make-array bytes :element-type '(unsigned-byte 8))))
(loop for offset from (* 8 (1- bytes)) downto 0 by 8
for data = (ldb (byte 8 offset) int)
for i from 0
do
(setf (aref v i) data))
#+debug
(format t "~&writing: ~S~%" v)
(write-sequence v stream)))
(defun %send-cstring (stream str)
"Sends a null-terminated string to CONNECTION"
(let* ((len (length str))
(v (make-array len :element-type '(unsigned-byte 8))))
;; convert the string to a vector of bytes
(dotimes (i len)
(setf (aref v i) (char-code (aref str i))))
(write-sequence v stream)
(write-byte 0 stream)))
(declaim (inline %flush))
(defun %flush (connection)
(force-output (pgcon-stream connection)))
;; EOF
|
