/usr/share/common-lisp/source/pg/lowlevel.lisp is in cl-pg 1:20061216-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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
|