1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: postgresql-socket-api.lisp
6 ;;;; Purpose: Low-level PostgreSQL interface using sockets
7 ;;;; Authors: Kevin M. Rosenberg based on original code by Pierre R. Mai
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
13 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
15 ;;;; CLSQL users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
18 ;;;; *************************************************************************
20 (in-package #:postgresql-socket)
22 (uffi:def-enum pgsql-ftype
30 (defmethod clsql-sys:database-type-library-loaded ((database-type
31 (eql :postgresql-socket)))
32 "T if foreign library was able to be loaded successfully. Always true for
36 (defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
42 (defmacro define-message-constants (description &rest clauses)
43 (assert (evenp (length clauses)))
44 (loop with seen-characters = nil
45 for (name char) on clauses by #'cddr
46 for char-code = (char-code char)
47 for doc-string = (format nil "~A (~:C): ~A" description char name)
48 if (member char seen-characters)
49 do (error "Duplicate message type ~@C for group ~A" char description)
52 `(defconstant ,name ,char-code ,doc-string)
54 and do (push char seen-characters)
56 (return `(progn ,@result-clauses))))
58 (eval-when (:compile-toplevel :load-toplevel :execute)
59 (define-message-constants "Backend Message Constants"
60 +ascii-row-message+ #\D
61 +authentication-message+ #\R
62 +backend-key-message+ #\K
63 +binary-row-message+ #\B
64 +completed-response-message+ #\C
65 +copy-in-response-message+ #\G
66 +copy-out-response-message+ #\H
67 +cursor-response-message+ #\P
68 +empty-query-response-message+ #\I
69 +error-response-message+ #\E
70 +function-response-message+ #\V
71 +notice-response-message+ #\N
72 +notification-response-message+ #\A
73 +ready-for-query-message+ #\Z
74 +row-description-message+ #\T))
77 (declaim (inline read-byte write-byte))
79 (defun send-socket-value-int32 (socket value)
80 (declare (type stream socket)
81 (type (unsigned-byte 32) value))
82 (write-byte (ldb (byte 8 24) value) socket)
83 (write-byte (ldb (byte 8 16) value) socket)
84 (write-byte (ldb (byte 8 8) value) socket)
85 (write-byte (ldb (byte 8 0) value) socket)
88 (defun send-socket-value-int16 (socket value)
89 (declare (type stream socket)
90 (type (unsigned-byte 16) value))
91 (write-byte (ldb (byte 8 8) value) socket)
92 (write-byte (ldb (byte 8 0) value) socket)
95 (defun send-socket-value-int8 (socket value)
96 (declare (type stream socket)
97 (type (unsigned-byte 8) value))
98 (write-byte (ldb (byte 8 0) value) socket)
101 (defun send-socket-value-char-code (socket value)
102 (declare (type stream socket)
103 (type character value))
104 (write-byte (ldb (byte 8 0) (char-code value)) socket)
107 (defun send-socket-value-string (socket value)
108 (declare (type stream socket)
111 (loop for char across value
112 for code = (char-code char)
113 do (write-byte code socket)
114 finally (write-byte 0 socket))
116 (write-sequence (sb-ext:string-to-octets value :null-terminate t) socket)
119 (defun send-socket-value-limstring (socket value limit)
120 (declare (type stream socket)
123 (let ((length (length value)))
124 (dotimes (i (min length limit))
125 (let ((code (char-code (char value i))))
126 (write-byte code socket)))
127 (dotimes (i (- limit length))
128 (write-byte 0 socket)))
132 (defun read-socket-value-int32 (socket)
133 (declare (type stream socket))
134 (declare (optimize (speed 3)))
136 (declare (type (unsigned-byte 32) result))
137 (setf (ldb (byte 8 24) result) (read-byte socket))
138 (setf (ldb (byte 8 16) result) (read-byte socket))
139 (setf (ldb (byte 8 8) result) (read-byte socket))
140 (setf (ldb (byte 8 0) result) (read-byte socket))
143 (defun read-socket-value-int16 (socket)
144 (declare (type stream socket))
146 (declare (type (unsigned-byte 16) result))
147 (setf (ldb (byte 8 8) result) (read-byte socket))
148 (setf (ldb (byte 8 0) result) (read-byte socket))
151 (defun read-socket-value-int8 (socket)
152 (declare (type stream socket))
155 (defun read-socket-value-string (socket)
156 (declare (type stream socket))
158 (with-output-to-string (out)
159 (loop for code = (read-byte socket)
161 do (write-char (code-char code) out)))
163 (let ((bytes (make-array 64
164 :element-type '(unsigned-byte 8)
167 (loop for code = (read-byte socket)
169 do (vector-push-extend code bytes))
170 (sb-ext:octets-to-string bytes)))
173 (defmacro define-message-sender (name (&rest args) &rest clauses)
174 (let ((socket-var (gensym))
176 (dolist (clause clauses)
177 (let* ((type (first clause))
178 (fn (intern (concatenate 'string (symbol-name '#:send-socket-value-)
179 (symbol-name type)))))
180 (push `(,fn ,socket-var ,@(rest clause)) body)))
181 `(defun ,name (,socket-var ,@args)
184 (define-message-sender send-startup-message
185 (database user &optional (command-line "") (backend-tty ""))
187 (int32 #x00020000) ; Version 2.0
188 (limstring database 64)
190 (limstring command-line 64)
191 (limstring "" 64) ; Unused
192 (limstring backend-tty 64))
194 (define-message-sender send-terminate-message ()
197 (define-message-sender send-unencrypted-password-message (password)
198 (int32 (+ 5 (length password)))
201 (define-message-sender send-query-message (query)
205 (define-message-sender send-encrypted-password-message (crypted-password)
206 (int32 (+ 5 (length crypted-password)))
207 (string crypted-password))
209 (define-message-sender send-cancel-request (pid key)
211 (int32 80877102) ; Magic
216 (defun read-socket-sequence (stream length)
217 "KMR -- Added to support reading from binary stream into a string"
218 (declare (stream stream)
219 (optimize (speed 3) (safety 0)))
221 (let ((result (make-string length)))
222 (dotimes (i length result)
224 (setf (char result i) (code-char (read-byte stream)))))
226 (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
227 (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
228 (read-sequence bytes stream)
229 (sb-ext:octets-to-string bytes)))
232 ;;; Support for encrypted password transmission
235 (eval-when (:compile-toplevel :load-toplevel :execute)
236 (defvar *crypt-library-loaded* nil)
238 (unless *crypt-library-loaded*
239 (uffi:load-foreign-library
240 (uffi:find-foreign-library "libcrypt"
241 '(#+(or 64bit x86-64) "/usr/lib64/"
242 "/usr/lib/" "/usr/local/lib/" "/lib/"))
243 :supporting-libraries '("c"))
244 (setq *crypt-library-loaded* t)))
246 (in-package :postgresql-socket)
248 (uffi:def-function ("crypt" crypt)
253 (defun crypt-password (password salt)
254 "Encrypt a password for transmission to a PostgreSQL server."
255 (uffi:with-cstring (password-cstring password)
256 (uffi:with-cstring (salt-cstring salt)
257 (uffi:convert-from-cstring
258 (crypt password-cstring salt-cstring)))))
261 ;;;; Condition hierarchy
263 (define-condition postgresql-condition (condition)
264 ((connection :initarg :connection :reader postgresql-condition-connection)
265 (message :initarg :message :reader postgresql-condition-message))
268 (format stream "~@<~A occurred on connection ~A. ~:@_Reason: ~A~:@>"
270 (postgresql-condition-connection c)
271 (postgresql-condition-message c)))))
273 (define-condition postgresql-error (error postgresql-condition)
276 (define-condition postgresql-fatal-error (postgresql-error)
279 (define-condition postgresql-login-error (postgresql-fatal-error)
282 (define-condition postgresql-warning (warning postgresql-condition)
285 (define-condition postgresql-notification (postgresql-condition)
289 (format stream "~@<Asynchronous notification on connection ~A: ~:@_~A~:@>"
290 (postgresql-condition-connection c)
291 (postgresql-condition-message c)))))
295 (defstruct postgresql-connection
307 (defstruct postgresql-cursor
314 (defconstant +postgresql-server-default-port+ 5432
315 "Default port of PostgreSQL server.")
317 (defvar *postgresql-server-socket-timeout* 60
318 "Timeout in seconds for reads from the PostgreSQL server.")
321 (defun open-postgresql-socket (host port)
324 ;; Directory to unix-domain socket
325 (ext:connect-to-unix-socket
327 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
330 (ext:connect-to-inet-socket host port))))
333 (defun open-postgresql-socket (host port)
336 ;; Directory to unix-domain socket
337 (let ((sock (make-instance 'sb-bsd-sockets:local-socket
339 (sb-bsd-sockets:socket-connect
342 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
346 (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
349 (sb-bsd-sockets:socket-connect
351 (sb-bsd-sockets:host-ent-address
352 (sb-bsd-sockets:get-host-by-name host))
357 (defun open-postgresql-socket-stream (host port)
358 (system:make-fd-stream
359 (open-postgresql-socket host port)
360 :input t :output t :element-type '(unsigned-byte 8)
362 :timeout *postgresql-server-socket-timeout*))
366 (defun open-postgresql-socket-stream (host port)
367 (sb-bsd-sockets:socket-make-stream
368 (open-postgresql-socket host port) :input t :output t
369 :element-type '(unsigned-byte 8)))
373 (defun open-postgresql-socket-stream (host port)
376 (let ((path (namestring
377 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
379 (socket:make-socket :type :stream :address-family :file
381 :remote-filename path :local-filename path)))
383 (socket:with-pending-connect
384 (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed"))
385 (socket:make-socket :type :stream :address-family :internet
386 :remote-port port :remote-host host
387 :connect :active :nodelay t))))))
390 (defun open-postgresql-socket-stream (host port)
393 (let ((path (namestring
394 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
396 (ccl:make-socket :type :stream :address-family :file
398 :remote-filename path :local-filename path)))
400 (ccl:make-socket :type :stream :address-family :internet
401 :remote-port port :remote-host host
402 :connect :active :nodelay t))))
405 (defun open-postgresql-socket-stream (host port)
408 (error "File sockets not supported on Lispworks."))
410 (comm:open-tcp-stream host port :direction :io :element-type '(unsigned-byte 8)
411 :read-timeout *postgresql-server-socket-timeout*))
414 ;;; Interface Functions
416 (defun open-postgresql-connection (&key (host (cmucl-compat:required-argument))
417 (port +postgresql-server-default-port+)
418 (database (cmucl-compat:required-argument))
419 (user (cmucl-compat:required-argument))
420 options tty password)
421 "Open a connection to a PostgreSQL server with the given parameters.
422 Note that host, database and user arguments must be supplied.
424 If host is a pathname, it is assumed to name a directory containing
425 the local unix-domain sockets of the server, with port selecting which
426 of those sockets to open. If host is a string, it is assumed to be
427 the name of the host running the PostgreSQL server. In that case a
428 TCP connection to the given port on that host is opened in order to
429 communicate with the server. In either case the port argument
430 defaults to `+postgresql-server-default-port+'.
432 Password is the clear-text password to be passed in the authentication
433 phase to the server. Depending on the server set-up, it is either
434 passed in the clear, or encrypted via crypt and a server-supplied
435 salt. In that case the alien function specified by `*crypt-library*'
436 and `*crypt-function-name*' is used for encryption.
438 Note that all the arguments (including the clear-text password
439 argument) are stored in the `postgresql-connection' structure, in
440 order to facilitate automatic reconnection in case of communication
442 (reopen-postgresql-connection
443 (make-postgresql-connection :host host :port port
444 :options (or options "") :tty (or tty "")
445 :database database :user user
446 :password (or password ""))))
448 (defun encrypt-md5 (plaintext salt)
450 (format nil "~{~2,'0X~}"
451 (coerce (md5sum-sequence (concatenate 'string plaintext salt)) 'list))))
453 (defun reopen-postgresql-connection (connection)
454 "Reopen the given PostgreSQL connection. Closes any existing
455 connection, if it is still open."
456 (when (postgresql-connection-open-p connection)
457 (close-postgresql-connection connection))
458 (let ((socket (open-postgresql-socket-stream
459 (postgresql-connection-host connection)
460 (postgresql-connection-port connection))))
463 (setf (postgresql-connection-socket connection) socket)
464 (send-startup-message socket
465 (postgresql-connection-database connection)
466 (postgresql-connection-user connection)
467 (postgresql-connection-options connection)
468 (postgresql-connection-tty connection))
469 (force-output socket)
471 (case (read-socket-value-int8 socket)
472 (#.+authentication-message+
473 (case (read-socket-value-int32 socket)
476 (error 'postgresql-login-error
477 :connection connection
479 "Postmaster expects unsupported Kerberos authentication."))
481 (send-unencrypted-password-message
483 (postgresql-connection-password connection))
484 (force-output socket))
486 (let ((salt (read-socket-sequence socket 2)))
487 (send-encrypted-password-message
490 (postgresql-connection-password connection) salt)))
491 (force-output socket))
493 (let ((salt (read-socket-sequence socket 4)))
494 (let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
495 (postgresql-connection-user connection)))
496 (pwd (encrypt-md5 pwd2 salt)))
497 (send-encrypted-password-message
499 (concatenate 'string "md5" pwd))))
500 (force-output socket))
502 (error 'postgresql-login-error
503 :connection connection
505 "Postmaster expects unknown authentication method."))))
506 (#.+error-response-message+
507 (let ((message (read-socket-value-string socket)))
508 (error 'postgresql-login-error
509 :connection connection :message message)))
511 (error 'postgresql-login-error
512 :connection connection
514 "Received garbled message from Postmaster"))))
515 ;; Start backend communication
516 (force-output socket)
518 (case (read-socket-value-int8 socket)
519 (#.+backend-key-message+
520 (setf (postgresql-connection-pid connection)
521 (read-socket-value-int32 socket)
522 (postgresql-connection-key connection)
523 (read-socket-value-int32 socket)))
524 (#.+ready-for-query-message+
527 (#.+error-response-message+
528 (let ((message (read-socket-value-string socket)))
529 (error 'postgresql-login-error
530 :connection connection
532 (#.+notice-response-message+
533 (let ((message (read-socket-value-string socket)))
534 (warn 'postgresql-warning :connection connection
537 (error 'postgresql-login-error
538 :connection connection
540 "Received garbled message from Postmaster")))))
544 (defun close-postgresql-connection (connection &optional abort)
547 (send-terminate-message (postgresql-connection-socket connection))))
548 (close (postgresql-connection-socket connection)))
550 (defun postgresql-connection-open-p (connection)
551 (let ((socket (postgresql-connection-socket connection)))
552 (and socket (streamp socket) (open-stream-p socket))))
554 (defun ensure-open-postgresql-connection (connection)
555 (unless (postgresql-connection-open-p connection)
556 (reopen-postgresql-connection connection)))
558 (defun process-async-messages (connection)
559 (assert (postgresql-connection-open-p connection))
560 ;; Process any asnychronous messages
561 (loop with socket = (postgresql-connection-socket connection)
562 while (listen socket)
564 (case (read-socket-value-int8 socket)
565 (#.+ready-for-query-message+)
566 (#.+notice-response-message+
567 (let ((message (read-socket-value-string socket)))
568 (warn 'postgresql-warning :connection connection
570 (#.+notification-response-message+
571 (let ((pid (read-socket-value-int32 socket))
572 (message (read-socket-value-string socket)))
573 (when (= pid (postgresql-connection-pid connection))
574 (signal 'postgresql-notification :connection connection
577 (close-postgresql-connection connection)
578 (error 'postgresql-fatal-error :connection connection
579 :message "Received garbled message from backend")))))
581 (defun start-query-execution (connection query)
582 (ensure-open-postgresql-connection connection)
583 (process-async-messages connection)
584 (send-query-message (postgresql-connection-socket connection) query)
585 (force-output (postgresql-connection-socket connection)))
587 (defun wait-for-query-results (connection)
588 (assert (postgresql-connection-open-p connection))
589 (let ((socket (postgresql-connection-socket connection))
593 (case (read-socket-value-int8 socket)
594 (#.+completed-response-message+
595 (return (values :completed (read-socket-value-string socket))))
596 (#.+cursor-response-message+
597 (setq cursor-name (read-socket-value-string socket)))
598 (#.+row-description-message+
599 (let* ((count (read-socket-value-int16 socket))
604 (read-socket-value-string socket)
605 (read-socket-value-int32 socket)
606 (read-socket-value-int16 socket)
607 (read-socket-value-int32 socket)))))
610 (make-postgresql-cursor :connection connection
613 (#.+copy-in-response-message+
615 (#.+copy-out-response-message+
617 (#.+ready-for-query-message+
621 (#.+error-response-message+
622 (let ((message (read-socket-value-string socket)))
624 (make-condition 'postgresql-error
625 :connection connection :message message))))
626 (#.+notice-response-message+
627 (let ((message (read-socket-value-string socket)))
628 (unless (eq :ignore clsql-sys:*backend-warning-behavior*)
629 (warn 'postgresql-warning
630 :connection connection :message message))))
631 (#.+notification-response-message+
632 (let ((pid (read-socket-value-int32 socket))
633 (message (read-socket-value-string socket)))
634 (when (= pid (postgresql-connection-pid connection))
635 (signal 'postgresql-notification :connection connection
638 (close-postgresql-connection connection)
639 (error 'postgresql-fatal-error :connection connection
640 :message "Received garbled message from backend"))))))
642 (defun read-null-bit-vector (socket count)
643 (let ((result (make-array count :element-type 'bit)))
644 (dotimes (offset (ceiling count 8))
645 (loop with byte = (read-byte socket)
646 for index from (* offset 8) below (min count (* (1+ offset) 8))
647 for weight downfrom 7
648 do (setf (aref result index) (ldb (byte 1 weight) byte))))
652 (defun read-field (socket type)
653 (let ((length (- (read-socket-value-int32 socket) 4)))
656 (read-integer-from-socket socket length))
658 (read-double-from-socket socket length))
660 (read-socket-sequence socket length)))))
662 (uffi:def-constant +char-code-zero+ (char-code #\0))
663 (uffi:def-constant +char-code-minus+ (char-code #\-))
664 (uffi:def-constant +char-code-plus+ (char-code #\+))
665 (uffi:def-constant +char-code-period+ (char-code #\.))
666 (uffi:def-constant +char-code-lower-e+ (char-code #\e))
667 (uffi:def-constant +char-code-upper-e+ (char-code #\E))
669 (defun read-integer-from-socket (socket length)
670 (declare (fixnum length))
674 (first-char (read-byte socket))
676 (declare (fixnum first-char))
677 (decf length) ;; read first char
679 ((= first-char +char-code-minus+)
681 ((= first-char +char-code-plus+)
684 (setq val (- first-char +char-code-zero+))))
690 (- (read-byte socket) +char-code-zero+))))
695 (defmacro ascii-digit (int)
696 (let ((offset (gensym)))
697 `(let ((,offset (- ,int +char-code-zero+)))
698 (declare (fixnum ,int ,offset))
699 (if (and (>= ,offset 0)
704 (defun read-double-from-socket (socket length)
705 (declare (fixnum length))
706 (let ((before-decimal 0)
713 (char (read-byte socket)))
714 (declare (fixnum char exponent decimal-count))
715 (decf length) ;; already read first character
717 ((= char +char-code-minus+)
719 ((= char +char-code-plus+)
721 ((= char +char-code-period+)
724 (setq before-decimal (ascii-digit char))
725 (unless before-decimal
726 (error "Unexpected value"))))
730 (setq char (read-byte socket))
731 ;; (format t "~&len:~D, i:~D, char:~D, minusp:~A, decimalp:~A" length i char minusp decimalp)
732 (let ((weight (ascii-digit char)))
734 ((and weight (not decimalp)) ;; before decimal point
735 (setq before-decimal (+ weight (* 10 before-decimal))))
736 ((and weight decimalp) ;; after decimal point
737 (setq after-decimal (+ weight (* 10 after-decimal)))
738 (incf decimal-count))
739 ((and (= char +char-code-period+))
741 ((or (= char +char-code-lower-e+) ;; E is for exponent
742 (= char +char-code-upper-e+))
743 (setq exponent (read-integer-from-socket socket (- length i 1)))
744 (setq exponent (or exponent 0))
747 (break "Unexpected value"))
750 (setq result (* (+ (coerce before-decimal 'double-float)
752 (expt 10 (- decimal-count))))
760 (defun read-double-from-socket (socket length)
761 (let ((result (make-string length)))
762 (read-socket-sequence result socket)
763 (let ((*read-default-float-format* 'double-float))
764 (read-from-string result))))
766 (defun read-cursor-row (cursor types)
767 (let* ((connection (postgresql-cursor-connection cursor))
768 (socket (postgresql-connection-socket connection))
769 (fields (postgresql-cursor-fields cursor)))
770 (assert (postgresql-connection-open-p connection))
772 (let ((code (read-socket-value-int8 socket)))
774 (#.+ascii-row-message+
776 (loop with count = (length fields)
777 with null-vector = (read-null-bit-vector socket count)
779 for null-bit across null-vector
781 for null-p = (zerop null-bit)
786 (read-field socket (nth i types)))))
787 (#.+binary-row-message+
789 (#.+completed-response-message+
790 (return (values nil (read-socket-value-string socket))))
791 (#.+error-response-message+
792 (let ((message (read-socket-value-string socket)))
793 (error 'postgresql-error
794 :connection connection :message message)))
795 (#.+notice-response-message+
796 (let ((message (read-socket-value-string socket)))
797 (warn 'postgresql-warning
798 :connection connection :message message)))
799 (#.+notification-response-message+
800 (let ((pid (read-socket-value-int32 socket))
801 (message (read-socket-value-string socket)))
802 (when (= pid (postgresql-connection-pid connection))
803 (signal 'postgresql-notification :connection connection
806 (close-postgresql-connection connection)
807 (error 'postgresql-fatal-error :connection connection
808 :message "Received garbled message from backend")))))))
810 (defun map-into-indexed (result-seq func seq)
811 (dotimes (i (length seq))
813 (setf (elt result-seq i)
814 (funcall func (elt seq i) i)))
817 (defun copy-cursor-row (cursor sequence types)
818 (let* ((connection (postgresql-cursor-connection cursor))
819 (socket (postgresql-connection-socket connection))
820 (fields (postgresql-cursor-fields cursor)))
821 (assert (= (length fields) (length sequence)))
823 (let ((code (read-socket-value-int8 socket)))
825 (#.+ascii-row-message+
828 (let* ((count (length sequence))
829 (null-vector (read-null-bit-vector socket count)))
832 (if (zerop (elt null-vector i))
833 (setf (elt sequence i) nil)
834 (let ((value (read-field socket (nth i types))))
835 (setf (elt sequence i) value)))))
838 #'(lambda (null-bit i)
841 (read-field socket (nth i types))))
842 (read-null-bit-vector socket (length sequence)))))
843 (#.+binary-row-message+
845 (#.+completed-response-message+
846 (return (values nil (read-socket-value-string socket))))
847 (#.+error-response-message+
848 (let ((message (read-socket-value-string socket)))
849 (error 'postgresql-error
850 :connection connection :message message)))
851 (#.+notice-response-message+
852 (let ((message (read-socket-value-string socket)))
853 (warn 'postgresql-warning
854 :connection connection :message message)))
855 (#.+notification-response-message+
856 (let ((pid (read-socket-value-int32 socket))
857 (message (read-socket-value-string socket)))
858 (when (= pid (postgresql-connection-pid connection))
859 (signal 'postgresql-notification :connection connection
862 (close-postgresql-connection connection)
863 (error 'postgresql-fatal-error :connection connection
864 :message "Received garbled message from backend")))))))
866 (defun skip-cursor-row (cursor)
867 (let* ((connection (postgresql-cursor-connection cursor))
868 (socket (postgresql-connection-socket connection))
869 (fields (postgresql-cursor-fields cursor)))
871 (let ((code (read-socket-value-int8 socket)))
873 (#.+ascii-row-message+
874 (loop for null-bit across
875 (read-null-bit-vector socket (length fields))
877 (unless (zerop null-bit)
878 (let* ((length (read-socket-value-int32 socket)))
879 (loop repeat (- length 4) do (read-byte socket)))))
881 (#.+binary-row-message+
883 (#.+completed-response-message+
884 (return (values nil (read-socket-value-string socket))))
885 (#.+error-response-message+
886 (let ((message (read-socket-value-string socket)))
887 (error 'postgresql-error
888 :connection connection :message message)))
889 (#.+notice-response-message+
890 (let ((message (read-socket-value-string socket)))
891 (warn 'postgresql-warning
892 :connection connection :message message)))
893 (#.+notification-response-message+
894 (let ((pid (read-socket-value-int32 socket))
895 (message (read-socket-value-string socket)))
896 (when (= pid (postgresql-connection-pid connection))
897 (signal 'postgresql-notification :connection connection
900 (close-postgresql-connection connection)
901 (error 'postgresql-fatal-error :connection connection
902 :message "Received garbled message from backend")))))))
904 (defun run-query (connection query &optional (result-types nil))
905 (start-query-execution connection query)
906 (multiple-value-bind (status cursor)
907 (wait-for-query-results connection)
908 (assert (eq status :cursor))
909 (loop for row = (read-cursor-row cursor result-types)
913 (wait-for-query-results connection))))
916 (declaim (ext:maybe-inline read-byte write-byte))