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)
110 (loop for char across value
111 for code = (char-code char)
112 do (write-byte code socket)
113 finally (write-byte 0 socket))
116 (defun send-socket-value-limstring (socket value limit)
117 (declare (type stream socket)
120 (let ((length (length value)))
121 (dotimes (i (min length limit))
122 (let ((code (char-code (char value i))))
123 (write-byte code socket)))
124 (dotimes (i (- limit length))
125 (write-byte 0 socket)))
129 (defun read-socket-value-int32 (socket)
130 (declare (type stream socket))
131 (declare (optimize (speed 3)))
133 (declare (type (unsigned-byte 32) result))
134 (setf (ldb (byte 8 24) result) (read-byte socket))
135 (setf (ldb (byte 8 16) result) (read-byte socket))
136 (setf (ldb (byte 8 8) result) (read-byte socket))
137 (setf (ldb (byte 8 0) result) (read-byte socket))
140 (defun read-socket-value-int16 (socket)
141 (declare (type stream socket))
143 (declare (type (unsigned-byte 16) result))
144 (setf (ldb (byte 8 8) result) (read-byte socket))
145 (setf (ldb (byte 8 0) result) (read-byte socket))
148 (defun read-socket-value-int8 (socket)
149 (declare (type stream socket))
152 (defun read-socket-value-string (socket)
153 (declare (type stream socket))
154 (with-output-to-string (out)
155 (loop for code = (read-byte socket)
157 do (write-char (code-char code) out))))
160 (defmacro define-message-sender (name (&rest args) &rest clauses)
161 (let ((socket-var (gensym))
163 (dolist (clause clauses)
164 (let* ((type (first clause))
165 (fn (intern (concatenate 'string (symbol-name '#:send-socket-value-)
166 (symbol-name type)))))
167 (push `(,fn ,socket-var ,@(rest clause)) body)))
168 `(defun ,name (,socket-var ,@args)
171 (define-message-sender send-startup-message
172 (database user &optional (command-line "") (backend-tty ""))
174 (int32 #x00020000) ; Version 2.0
175 (limstring database 64)
177 (limstring command-line 64)
178 (limstring "" 64) ; Unused
179 (limstring backend-tty 64))
181 (define-message-sender send-terminate-message ()
184 (define-message-sender send-unencrypted-password-message (password)
185 (int32 (+ 5 (length password)))
188 (define-message-sender send-query-message (query)
192 (define-message-sender send-encrypted-password-message (crypted-password)
193 (int32 (+ 5 (length crypted-password)))
194 (string crypted-password))
196 (define-message-sender send-cancel-request (pid key)
198 (int32 80877102) ; Magic
203 (defun read-socket-sequence (string stream)
204 "KMR -- Added to support reading from binary stream into a string"
205 (declare (string string)
207 (optimize (speed 3) (safety 0)))
208 (dotimes (i (length string))
210 (setf (char string i) (code-char (read-byte stream))))
214 ;;; Support for encrypted password transmission
217 (eval-when (:compile-toplevel :load-toplevel :execute)
218 (defvar *crypt-library-loaded* nil)
220 (unless *crypt-library-loaded*
221 (uffi:load-foreign-library
222 (uffi:find-foreign-library "libcrypt"
223 '(#+64bit "/usr/lib64/"
224 "/usr/lib/" "/usr/local/lib/" "/lib/"))
225 :supporting-libraries '("c"))
226 (setq *crypt-library-loaded* t)))
228 (in-package :postgresql-socket)
230 (uffi:def-function ("crypt" crypt)
235 (defun crypt-password (password salt)
236 "Encrypt a password for transmission to a PostgreSQL server."
237 (uffi:with-cstring (password-cstring password)
238 (uffi:with-cstring (salt-cstring salt)
239 (uffi:convert-from-cstring
240 (crypt password-cstring salt-cstring)))))
243 ;;;; Condition hierarchy
245 (define-condition postgresql-condition (condition)
246 ((connection :initarg :connection :reader postgresql-condition-connection)
247 (message :initarg :message :reader postgresql-condition-message))
250 (format stream "~@<~A occurred on connection ~A. ~:@_Reason: ~A~:@>"
252 (postgresql-condition-connection c)
253 (postgresql-condition-message c)))))
255 (define-condition postgresql-error (error postgresql-condition)
258 (define-condition postgresql-fatal-error (postgresql-error)
261 (define-condition postgresql-login-error (postgresql-fatal-error)
264 (define-condition postgresql-warning (warning postgresql-condition)
267 (define-condition postgresql-notification (postgresql-condition)
271 (format stream "~@<Asynchronous notification on connection ~A: ~:@_~A~:@>"
272 (postgresql-condition-connection c)
273 (postgresql-condition-message c)))))
277 (defstruct postgresql-connection
289 (defstruct postgresql-cursor
296 (defconstant +postgresql-server-default-port+ 5432
297 "Default port of PostgreSQL server.")
299 (defvar *postgresql-server-socket-timeout* 60
300 "Timeout in seconds for reads from the PostgreSQL server.")
303 (defun open-postgresql-socket (host port)
306 ;; Directory to unix-domain socket
307 (ext:connect-to-unix-socket
309 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
312 (ext:connect-to-inet-socket host port))))
315 (defun open-postgresql-socket (host port)
318 ;; Directory to unix-domain socket
319 (sb-bsd-sockets:socket-connect
321 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
324 (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
327 (sb-bsd-sockets:socket-connect
329 (sb-bsd-sockets:host-ent-address
330 (sb-bsd-sockets:get-host-by-name host))
335 (defun open-postgresql-socket-stream (host port)
336 (system:make-fd-stream
337 (open-postgresql-socket host port)
338 :input t :output t :element-type '(unsigned-byte 8)
340 :timeout *postgresql-server-socket-timeout*))
344 (defun open-postgresql-socket-stream (host port)
345 (sb-bsd-sockets:socket-make-stream
346 (open-postgresql-socket host port) :input t :output t
347 :element-type '(unsigned-byte 8)))
351 (defun open-postgresql-socket-stream (host port)
354 (let ((path (namestring
355 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
357 (socket:make-socket :type :stream :address-family :file
359 :remote-filename path :local-filename path)))
361 (socket:with-pending-connect
362 (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed"))
363 (socket:make-socket :type :stream :address-family :internet
364 :remote-port port :remote-host host
365 :connect :active :nodelay t))))))
368 (defun open-postgresql-socket-stream (host port)
371 (let ((path (namestring
372 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
374 (ccl:make-socket :type :stream :address-family :file
376 :remote-filename path :local-filename path)))
378 (ccl:make-socket :type :stream :address-family :internet
379 :remote-port port :remote-host host
380 :connect :active :nodelay t))))
383 (defun open-postgresql-socket-stream (host port)
386 (error "File sockets not supported on Lispworks."))
388 (comm:open-tcp-stream host port :direction :io :element-type '(unsigned-byte 8)
389 :read-timeout *postgresql-server-socket-timeout*))
392 ;;; Interface Functions
394 (defun open-postgresql-connection (&key (host (cmucl-compat:required-argument))
395 (port +postgresql-server-default-port+)
396 (database (cmucl-compat:required-argument))
397 (user (cmucl-compat:required-argument))
398 options tty password)
399 "Open a connection to a PostgreSQL server with the given parameters.
400 Note that host, database and user arguments must be supplied.
402 If host is a pathname, it is assumed to name a directory containing
403 the local unix-domain sockets of the server, with port selecting which
404 of those sockets to open. If host is a string, it is assumed to be
405 the name of the host running the PostgreSQL server. In that case a
406 TCP connection to the given port on that host is opened in order to
407 communicate with the server. In either case the port argument
408 defaults to `+postgresql-server-default-port+'.
410 Password is the clear-text password to be passed in the authentication
411 phase to the server. Depending on the server set-up, it is either
412 passed in the clear, or encrypted via crypt and a server-supplied
413 salt. In that case the alien function specified by `*crypt-library*'
414 and `*crypt-function-name*' is used for encryption.
416 Note that all the arguments (including the clear-text password
417 argument) are stored in the `postgresql-connection' structure, in
418 order to facilitate automatic reconnection in case of communication
420 (reopen-postgresql-connection
421 (make-postgresql-connection :host host :port port
422 :options (or options "") :tty (or tty "")
423 :database database :user user
424 :password (or password ""))))
426 (defun encrypt-md5 (plaintext salt)
428 (format nil "~{~2,'0X~}"
429 (coerce (md5:md5sum-sequence (concatenate 'string plaintext salt)) 'list))))
431 (defun reopen-postgresql-connection (connection)
432 "Reopen the given PostgreSQL connection. Closes any existing
433 connection, if it is still open."
434 (when (postgresql-connection-open-p connection)
435 (close-postgresql-connection connection))
436 (let ((socket (open-postgresql-socket-stream
437 (postgresql-connection-host connection)
438 (postgresql-connection-port connection))))
441 (setf (postgresql-connection-socket connection) socket)
442 (send-startup-message socket
443 (postgresql-connection-database connection)
444 (postgresql-connection-user connection)
445 (postgresql-connection-options connection)
446 (postgresql-connection-tty connection))
447 (force-output socket)
449 (case (read-socket-value-int8 socket)
450 (#.+authentication-message+
451 (case (read-socket-value-int32 socket)
454 (error 'postgresql-login-error
455 :connection connection
457 "Postmaster expects unsupported Kerberos authentication."))
459 (send-unencrypted-password-message
461 (postgresql-connection-password connection))
462 (force-output socket))
464 (let ((salt (make-string 2)))
465 (read-socket-sequence salt socket)
466 (send-encrypted-password-message
469 (postgresql-connection-password connection) salt)))
470 (force-output socket))
472 (let ((salt (make-string 4)))
473 (read-socket-sequence salt socket)
474 (let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
475 (postgresql-connection-user connection)))
476 (pwd (encrypt-md5 pwd2 salt)))
477 (send-encrypted-password-message
479 (concatenate 'string "md5" pwd))))
480 (force-output socket))
482 (error 'postgresql-login-error
483 :connection connection
485 "Postmaster expects unknown authentication method."))))
486 (#.+error-response-message+
487 (let ((message (read-socket-value-string socket)))
488 (error 'postgresql-login-error
489 :connection connection :message message)))
491 (error 'postgresql-login-error
492 :connection connection
494 "Received garbled message from Postmaster"))))
495 ;; Start backend communication
496 (force-output socket)
498 (case (read-socket-value-int8 socket)
499 (#.+backend-key-message+
500 (setf (postgresql-connection-pid connection)
501 (read-socket-value-int32 socket)
502 (postgresql-connection-key connection)
503 (read-socket-value-int32 socket)))
504 (#.+ready-for-query-message+
507 (#.+error-response-message+
508 (let ((message (read-socket-value-string socket)))
509 (error 'postgresql-login-error
510 :connection connection
512 (#.+notice-response-message+
513 (let ((message (read-socket-value-string socket)))
514 (warn 'postgresql-warning :connection connection
517 (error 'postgresql-login-error
518 :connection connection
520 "Received garbled message from Postmaster")))))
524 (defun close-postgresql-connection (connection &optional abort)
527 (send-terminate-message (postgresql-connection-socket connection))))
528 (close (postgresql-connection-socket connection)))
530 (defun postgresql-connection-open-p (connection)
531 (let ((socket (postgresql-connection-socket connection)))
532 (and socket (streamp socket) (open-stream-p socket))))
534 (defun ensure-open-postgresql-connection (connection)
535 (unless (postgresql-connection-open-p connection)
536 (reopen-postgresql-connection connection)))
538 (defun process-async-messages (connection)
539 (assert (postgresql-connection-open-p connection))
540 ;; Process any asnychronous messages
541 (loop with socket = (postgresql-connection-socket connection)
542 while (listen socket)
544 (case (read-socket-value-int8 socket)
545 (#.+notice-response-message+
546 (let ((message (read-socket-value-string socket)))
547 (warn 'postgresql-warning :connection connection
549 (#.+notification-response-message+
550 (let ((pid (read-socket-value-int32 socket))
551 (message (read-socket-value-string socket)))
552 (when (= pid (postgresql-connection-pid connection))
553 (signal 'postgresql-notification :connection connection
556 (close-postgresql-connection connection)
557 (error 'postgresql-fatal-error :connection connection
558 :message "Received garbled message from backend")))))
560 (defun start-query-execution (connection query)
561 (ensure-open-postgresql-connection connection)
562 (process-async-messages connection)
563 (send-query-message (postgresql-connection-socket connection) query)
564 (force-output (postgresql-connection-socket connection)))
566 (defun wait-for-query-results (connection)
567 (assert (postgresql-connection-open-p connection))
568 (let ((socket (postgresql-connection-socket connection))
572 (case (read-socket-value-int8 socket)
573 (#.+completed-response-message+
574 (return (values :completed (read-socket-value-string socket))))
575 (#.+cursor-response-message+
576 (setq cursor-name (read-socket-value-string socket)))
577 (#.+row-description-message+
578 (let* ((count (read-socket-value-int16 socket))
583 (read-socket-value-string socket)
584 (read-socket-value-int32 socket)
585 (read-socket-value-int16 socket)
586 (read-socket-value-int32 socket)))))
589 (make-postgresql-cursor :connection connection
592 (#.+copy-in-response-message+
594 (#.+copy-out-response-message+
596 (#.+ready-for-query-message+
600 (#.+error-response-message+
601 (let ((message (read-socket-value-string socket)))
603 (make-condition 'postgresql-error
604 :connection connection :message message))))
605 (#.+notice-response-message+
606 (let ((message (read-socket-value-string socket)))
607 (unless (eq :ignore clsql-sys:*backend-warning-behavior*)
608 (warn 'postgresql-warning
609 :connection connection :message message))))
610 (#.+notification-response-message+
611 (let ((pid (read-socket-value-int32 socket))
612 (message (read-socket-value-string socket)))
613 (when (= pid (postgresql-connection-pid connection))
614 (signal 'postgresql-notification :connection connection
617 (close-postgresql-connection connection)
618 (error 'postgresql-fatal-error :connection connection
619 :message "Received garbled message from backend"))))))
621 (defun read-null-bit-vector (socket count)
622 (let ((result (make-array count :element-type 'bit)))
623 (dotimes (offset (ceiling count 8))
624 (loop with byte = (read-byte socket)
625 for index from (* offset 8) below (min count (* (1+ offset) 8))
626 for weight downfrom 7
627 do (setf (aref result index) (ldb (byte 1 weight) byte))))
631 (defun read-field (socket type)
632 (let ((length (- (read-socket-value-int32 socket) 4)))
635 (read-integer-from-socket socket length))
637 (read-double-from-socket socket length))
639 (let ((result (make-string length)))
640 (read-socket-sequence result socket)
643 (uffi:def-constant +char-code-zero+ (char-code #\0))
644 (uffi:def-constant +char-code-minus+ (char-code #\-))
645 (uffi:def-constant +char-code-plus+ (char-code #\+))
646 (uffi:def-constant +char-code-period+ (char-code #\.))
647 (uffi:def-constant +char-code-lower-e+ (char-code #\e))
648 (uffi:def-constant +char-code-upper-e+ (char-code #\E))
650 (defun read-integer-from-socket (socket length)
651 (declare (fixnum length))
655 (first-char (read-byte socket))
657 (declare (fixnum first-char))
658 (decf length) ;; read first char
660 ((= first-char +char-code-minus+)
662 ((= first-char +char-code-plus+)
665 (setq val (- first-char +char-code-zero+))))
671 (- (read-byte socket) +char-code-zero+))))
676 (defmacro ascii-digit (int)
677 (let ((offset (gensym)))
678 `(let ((,offset (- ,int +char-code-zero+)))
679 (declare (fixnum ,int ,offset))
680 (if (and (>= ,offset 0)
685 (defun read-double-from-socket (socket length)
686 (declare (fixnum length))
687 (let ((before-decimal 0)
694 (char (read-byte socket)))
695 (declare (fixnum char exponent decimal-count))
696 (decf length) ;; already read first character
698 ((= char +char-code-minus+)
700 ((= char +char-code-plus+)
702 ((= char +char-code-period+)
705 (setq before-decimal (ascii-digit char))
706 (unless before-decimal
707 (error "Unexpected value"))))
711 (setq char (read-byte socket))
712 ;; (format t "~&len:~D, i:~D, char:~D, minusp:~A, decimalp:~A" length i char minusp decimalp)
713 (let ((weight (ascii-digit char)))
715 ((and weight (not decimalp)) ;; before decimal point
716 (setq before-decimal (+ weight (* 10 before-decimal))))
717 ((and weight decimalp) ;; after decimal point
718 (setq after-decimal (+ weight (* 10 after-decimal)))
719 (incf decimal-count))
720 ((and (= char +char-code-period+))
722 ((or (= char +char-code-lower-e+) ;; E is for exponent
723 (= char +char-code-upper-e+))
724 (setq exponent (read-integer-from-socket socket (- length i 1)))
725 (setq exponent (or exponent 0))
728 (break "Unexpected value"))
731 (setq result (* (+ (coerce before-decimal 'double-float)
733 (expt 10 (- decimal-count))))
741 (defun read-double-from-socket (socket length)
742 (let ((result (make-string length)))
743 (read-socket-sequence result socket)
744 (let ((*read-default-float-format* 'double-float))
745 (read-from-string result))))
747 (defun read-cursor-row (cursor types)
748 (let* ((connection (postgresql-cursor-connection cursor))
749 (socket (postgresql-connection-socket connection))
750 (fields (postgresql-cursor-fields cursor)))
751 (assert (postgresql-connection-open-p connection))
753 (let ((code (read-socket-value-int8 socket)))
755 (#.+ascii-row-message+
757 (loop with count = (length fields)
758 with null-vector = (read-null-bit-vector socket count)
760 for null-bit across null-vector
762 for null-p = (zerop null-bit)
767 (read-field socket (nth i types)))))
768 (#.+binary-row-message+
770 (#.+completed-response-message+
771 (return (values nil (read-socket-value-string socket))))
772 (#.+error-response-message+
773 (let ((message (read-socket-value-string socket)))
774 (error 'postgresql-error
775 :connection connection :message message)))
776 (#.+notice-response-message+
777 (let ((message (read-socket-value-string socket)))
778 (warn 'postgresql-warning
779 :connection connection :message message)))
780 (#.+notification-response-message+
781 (let ((pid (read-socket-value-int32 socket))
782 (message (read-socket-value-string socket)))
783 (when (= pid (postgresql-connection-pid connection))
784 (signal 'postgresql-notification :connection connection
787 (close-postgresql-connection connection)
788 (error 'postgresql-fatal-error :connection connection
789 :message "Received garbled message from backend")))))))
791 (defun map-into-indexed (result-seq func seq)
792 (dotimes (i (length seq))
794 (setf (elt result-seq i)
795 (funcall func (elt seq i) i)))
798 (defun copy-cursor-row (cursor sequence types)
799 (let* ((connection (postgresql-cursor-connection cursor))
800 (socket (postgresql-connection-socket connection))
801 (fields (postgresql-cursor-fields cursor)))
802 (assert (= (length fields) (length sequence)))
804 (let ((code (read-socket-value-int8 socket)))
806 (#.+ascii-row-message+
809 (let* ((count (length sequence))
810 (null-vector (read-null-bit-vector socket count)))
813 (if (zerop (elt null-vector i))
814 (setf (elt sequence i) nil)
815 (let ((value (read-field socket (nth i types))))
816 (setf (elt sequence i) value)))))
819 #'(lambda (null-bit i)
822 (read-field socket (nth i types))))
823 (read-null-bit-vector socket (length sequence)))))
824 (#.+binary-row-message+
826 (#.+completed-response-message+
827 (return (values nil (read-socket-value-string socket))))
828 (#.+error-response-message+
829 (let ((message (read-socket-value-string socket)))
830 (error 'postgresql-error
831 :connection connection :message message)))
832 (#.+notice-response-message+
833 (let ((message (read-socket-value-string socket)))
834 (warn 'postgresql-warning
835 :connection connection :message message)))
836 (#.+notification-response-message+
837 (let ((pid (read-socket-value-int32 socket))
838 (message (read-socket-value-string socket)))
839 (when (= pid (postgresql-connection-pid connection))
840 (signal 'postgresql-notification :connection connection
843 (close-postgresql-connection connection)
844 (error 'postgresql-fatal-error :connection connection
845 :message "Received garbled message from backend")))))))
847 (defun skip-cursor-row (cursor)
848 (let* ((connection (postgresql-cursor-connection cursor))
849 (socket (postgresql-connection-socket connection))
850 (fields (postgresql-cursor-fields cursor)))
852 (let ((code (read-socket-value-int8 socket)))
854 (#.+ascii-row-message+
855 (loop for null-bit across
856 (read-null-bit-vector socket (length fields))
858 (unless (zerop null-bit)
859 (let* ((length (read-socket-value-int32 socket)))
860 (loop repeat (- length 4) do (read-byte socket)))))
862 (#.+binary-row-message+
864 (#.+completed-response-message+
865 (return (values nil (read-socket-value-string socket))))
866 (#.+error-response-message+
867 (let ((message (read-socket-value-string socket)))
868 (error 'postgresql-error
869 :connection connection :message message)))
870 (#.+notice-response-message+
871 (let ((message (read-socket-value-string socket)))
872 (warn 'postgresql-warning
873 :connection connection :message message)))
874 (#.+notification-response-message+
875 (let ((pid (read-socket-value-int32 socket))
876 (message (read-socket-value-string socket)))
877 (when (= pid (postgresql-connection-pid connection))
878 (signal 'postgresql-notification :connection connection
881 (close-postgresql-connection connection)
882 (error 'postgresql-fatal-error :connection connection
883 :message "Received garbled message from backend")))))))
885 (defun run-query (connection query &optional (result-types nil))
886 (start-query-execution connection query)
887 (multiple-value-bind (status cursor)
888 (wait-for-query-results connection)
889 (assert (eq status :cursor))
890 (loop for row = (read-cursor-row cursor result-types)
894 (wait-for-query-results connection))))
897 (declaim (ext:maybe-inline read-byte write-byte))