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 (defparameter +postgres-external-format+ :utf8)
24 (uffi:def-enum pgsql-ftype
32 (defmethod clsql-sys:database-type-library-loaded ((database-type
33 (eql :postgresql-socket)))
34 "T if foreign library was able to be loaded successfully. Always true for
38 (defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
44 (defmacro define-message-constants (description &rest clauses)
45 (assert (evenp (length clauses)))
46 (loop with seen-characters = nil
47 for (name char) on clauses by #'cddr
48 for char-code = (char-code char)
49 for doc-string = (format nil "~A (~:C): ~A" description char name)
50 if (member char seen-characters)
51 do (error "Duplicate message type ~@C for group ~A" char description)
54 `(defconstant ,name ,char-code ,doc-string)
56 and do (push char seen-characters)
58 (return `(progn ,@result-clauses))))
60 (eval-when (:compile-toplevel :load-toplevel :execute)
61 (define-message-constants "Backend Message Constants"
62 +ascii-row-message+ #\D
63 +authentication-message+ #\R
64 +backend-key-message+ #\K
65 +binary-row-message+ #\B
66 +completed-response-message+ #\C
67 +copy-in-response-message+ #\G
68 +copy-out-response-message+ #\H
69 +cursor-response-message+ #\P
70 +empty-query-response-message+ #\I
71 +error-response-message+ #\E
72 +function-response-message+ #\V
73 +notice-response-message+ #\N
74 +notification-response-message+ #\A
75 +ready-for-query-message+ #\Z
76 +row-description-message+ #\T))
79 (declaim (inline read-byte write-byte))
81 (defun send-socket-value-int32 (socket value)
82 (declare (type stream socket)
83 (type (unsigned-byte 32) value))
84 (write-byte (ldb (byte 8 24) value) socket)
85 (write-byte (ldb (byte 8 16) value) socket)
86 (write-byte (ldb (byte 8 8) value) socket)
87 (write-byte (ldb (byte 8 0) value) socket)
90 (defun send-socket-value-int16 (socket value)
91 (declare (type stream socket)
92 (type (unsigned-byte 16) value))
93 (write-byte (ldb (byte 8 8) value) socket)
94 (write-byte (ldb (byte 8 0) value) socket)
97 (defun send-socket-value-int8 (socket value)
98 (declare (type stream socket)
99 (type (unsigned-byte 8) value))
100 (write-byte (ldb (byte 8 0) value) socket)
103 (defun send-socket-value-char-code (socket value)
104 (declare (type stream socket)
105 (type character value))
106 (write-byte (ldb (byte 8 0) (char-code value)) socket)
109 (defun send-socket-value-string (socket value)
110 (declare (type stream socket)
113 (loop for char across value
114 for code = (char-code char)
115 do (write-byte code socket)
116 finally (write-byte 0 socket))
118 (write-sequence (sb-ext:string-to-octets value
119 :external-format +postgres-external-format+
124 (defun send-socket-value-limstring (socket value limit)
125 (declare (type stream socket)
128 (let ((length (length value)))
129 (dotimes (i (min length limit))
130 (let ((code (char-code (char value i))))
131 (write-byte code socket)))
132 (dotimes (i (- limit length))
133 (write-byte 0 socket)))
137 (defun read-socket-value-int32 (socket)
138 (declare (type stream socket))
139 (declare (optimize (speed 3)))
141 (declare (type (unsigned-byte 32) result))
142 (setf (ldb (byte 8 24) result) (read-byte socket))
143 (setf (ldb (byte 8 16) result) (read-byte socket))
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-int16 (socket)
149 (declare (type stream socket))
151 (declare (type (unsigned-byte 16) result))
152 (setf (ldb (byte 8 8) result) (read-byte socket))
153 (setf (ldb (byte 8 0) result) (read-byte socket))
156 (defun read-socket-value-int8 (socket)
157 (declare (type stream socket))
160 (defun read-socket-value-string (socket)
161 (declare (type stream socket))
163 (with-output-to-string (out)
164 (loop for code = (read-byte socket)
166 do (write-char (code-char code) out)))
168 (let ((bytes (make-array 64
169 :element-type '(unsigned-byte 8)
172 (loop for code = (read-byte socket)
174 do (vector-push-extend code bytes))
175 (sb-ext:octets-to-string bytes
176 :external-format +postgres-external-format+)))
179 (defmacro define-message-sender (name (&rest args) &rest clauses)
180 (let ((socket-var (gensym))
182 (dolist (clause clauses)
183 (let* ((type (first clause))
184 (fn (intern (concatenate 'string (symbol-name '#:send-socket-value-)
185 (symbol-name type)))))
186 (push `(,fn ,socket-var ,@(rest clause)) body)))
187 `(defun ,name (,socket-var ,@args)
190 (define-message-sender send-startup-message
191 (database user &optional (command-line "") (backend-tty ""))
193 (int32 #x00020000) ; Version 2.0
194 (limstring database 64)
196 (limstring command-line 64)
197 (limstring "" 64) ; Unused
198 (limstring backend-tty 64))
200 (define-message-sender send-terminate-message ()
203 (define-message-sender send-unencrypted-password-message (password)
204 (int32 (+ 5 (length password)))
207 (define-message-sender send-query-message (query)
211 (define-message-sender send-encrypted-password-message (crypted-password)
212 (int32 (+ 5 (length crypted-password)))
213 (string crypted-password))
215 (define-message-sender send-cancel-request (pid key)
217 (int32 80877102) ; Magic
222 (defun read-socket-sequence (stream length &optional (allow-wide t))
223 (declare (stream stream)
224 (optimize (speed 3) (safety 0)))
226 (let ((result (make-string length)))
227 (dotimes (i length result)
229 (setf (char result i) (code-char (read-byte stream)))))
231 (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
232 (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
233 (read-sequence bytes stream)
235 (sb-ext:octets-to-string bytes :external-format +postgres-external-format+)
236 (map 'string #'code-char bytes))))
238 ;;; Support for encrypted password transmission
241 (eval-when (:compile-toplevel :load-toplevel :execute)
242 (defvar *crypt-library-loaded* nil)
244 (unless *crypt-library-loaded*
245 (uffi:load-foreign-library
246 (uffi:find-foreign-library "libcrypt"
247 '(#+(or 64bit x86-64) "/usr/lib64/"
248 "/usr/lib/" "/usr/local/lib/" "/lib/"))
249 :supporting-libraries '("c"))
250 (setq *crypt-library-loaded* t)))
252 (in-package :postgresql-socket)
254 (uffi:def-function ("crypt" crypt)
259 (defun crypt-password (password salt)
260 "Encrypt a password for transmission to a PostgreSQL server."
261 (uffi:with-cstring (password-cstring password)
262 (uffi:with-cstring (salt-cstring salt)
263 (uffi:convert-from-cstring
264 (crypt password-cstring salt-cstring)))))
267 ;;;; Condition hierarchy
269 (define-condition postgresql-condition (condition)
270 ((connection :initarg :connection :reader postgresql-condition-connection)
271 (message :initarg :message :reader postgresql-condition-message))
274 (format stream "~@<~A occurred on connection ~A. ~:@_Reason: ~A~:@>"
276 (postgresql-condition-connection c)
277 (postgresql-condition-message c)))))
279 (define-condition postgresql-error (error postgresql-condition)
282 (define-condition postgresql-fatal-error (postgresql-error)
285 (define-condition postgresql-login-error (postgresql-fatal-error)
288 (define-condition postgresql-warning (warning postgresql-condition)
291 (define-condition postgresql-notification (postgresql-condition)
295 (format stream "~@<Asynchronous notification on connection ~A: ~:@_~A~:@>"
296 (postgresql-condition-connection c)
297 (postgresql-condition-message c)))))
301 (defstruct postgresql-connection
313 (defstruct postgresql-cursor
320 (defconstant +postgresql-server-default-port+ 5432
321 "Default port of PostgreSQL server.")
323 (defvar *postgresql-server-socket-timeout* 60
324 "Timeout in seconds for reads from the PostgreSQL server.")
327 (defun open-postgresql-socket (host port)
330 ;; Directory to unix-domain socket
331 (ext:connect-to-unix-socket
333 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
336 (ext:connect-to-inet-socket host port))))
339 (defun open-postgresql-socket (host port)
342 ;; Directory to unix-domain socket
343 (let ((sock (make-instance 'sb-bsd-sockets:local-socket
345 (sb-bsd-sockets:socket-connect
348 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
352 (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
355 (sb-bsd-sockets:socket-connect
357 (sb-bsd-sockets:host-ent-address
358 (sb-bsd-sockets:get-host-by-name host))
363 (defun open-postgresql-socket-stream (host port)
364 (system:make-fd-stream
365 (open-postgresql-socket host port)
366 :input t :output t :element-type '(unsigned-byte 8)
368 :timeout *postgresql-server-socket-timeout*))
372 (defun open-postgresql-socket-stream (host port)
373 (sb-bsd-sockets:socket-make-stream
374 (open-postgresql-socket host port) :input t :output t
375 :element-type '(unsigned-byte 8)))
379 (defun open-postgresql-socket-stream (host port)
382 (let ((path (namestring
383 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
385 (socket:make-socket :type :stream :address-family :file
387 :remote-filename path :local-filename path)))
389 (socket:with-pending-connect
390 (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed"))
391 (socket:make-socket :type :stream :address-family :internet
392 :remote-port port :remote-host host
393 :connect :active :nodelay t))))))
396 (defun open-postgresql-socket-stream (host port)
399 (let ((path (namestring
400 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
402 (ccl:make-socket :type :stream :address-family :file
404 :remote-filename path :local-filename path)))
406 (ccl:make-socket :type :stream :address-family :internet
407 :remote-port port :remote-host host
408 :connect :active :nodelay t))))
411 (defun open-postgresql-socket-stream (host port)
414 (error "File sockets not supported on Lispworks."))
416 (comm:open-tcp-stream host port :direction :io :element-type '(unsigned-byte 8)
417 :read-timeout *postgresql-server-socket-timeout*))
422 (defun open-postgresql-socket-stream (host port)
425 (error "Not supported"))
427 (socket:socket-connect
429 :element-type '(unsigned-byte 8)
430 :timeout *postgresql-server-socket-timeout*))))
433 ;;; Interface Functions
435 (defun open-postgresql-connection (&key (host (cmucl-compat:required-argument))
436 (port +postgresql-server-default-port+)
437 (database (cmucl-compat:required-argument))
438 (user (cmucl-compat:required-argument))
439 options tty password)
440 "Open a connection to a PostgreSQL server with the given parameters.
441 Note that host, database and user arguments must be supplied.
443 If host is a pathname, it is assumed to name a directory containing
444 the local unix-domain sockets of the server, with port selecting which
445 of those sockets to open. If host is a string, it is assumed to be
446 the name of the host running the PostgreSQL server. In that case a
447 TCP connection to the given port on that host is opened in order to
448 communicate with the server. In either case the port argument
449 defaults to `+postgresql-server-default-port+'.
451 Password is the clear-text password to be passed in the authentication
452 phase to the server. Depending on the server set-up, it is either
453 passed in the clear, or encrypted via crypt and a server-supplied
454 salt. In that case the alien function specified by `*crypt-library*'
455 and `*crypt-function-name*' is used for encryption.
457 Note that all the arguments (including the clear-text password
458 argument) are stored in the `postgresql-connection' structure, in
459 order to facilitate automatic reconnection in case of communication
461 (reopen-postgresql-connection
462 (make-postgresql-connection :host host :port port
463 :options (or options "") :tty (or tty "")
464 :database database :user user
465 :password (or password ""))))
467 (defun encrypt-md5 (plaintext salt)
469 (format nil "~{~2,'0X~}"
470 (coerce (md5sum-sequence (concatenate 'string plaintext salt)) 'list))))
472 (defun reopen-postgresql-connection (connection)
473 "Reopen the given PostgreSQL connection. Closes any existing
474 connection, if it is still open."
475 (when (postgresql-connection-open-p connection)
476 (close-postgresql-connection connection))
477 (let ((socket (open-postgresql-socket-stream
478 (postgresql-connection-host connection)
479 (postgresql-connection-port connection))))
482 (setf (postgresql-connection-socket connection) socket)
483 (send-startup-message socket
484 (postgresql-connection-database connection)
485 (postgresql-connection-user connection)
486 (postgresql-connection-options connection)
487 (postgresql-connection-tty connection))
488 (force-output socket)
490 (case (read-socket-value-int8 socket)
491 (#.+authentication-message+
492 (case (read-socket-value-int32 socket)
495 (error 'postgresql-login-error
496 :connection connection
498 "Postmaster expects unsupported Kerberos authentication."))
500 (send-unencrypted-password-message
502 (postgresql-connection-password connection))
503 (force-output socket))
505 (let ((salt (read-socket-sequence socket 2 nil)))
506 (send-encrypted-password-message
509 (postgresql-connection-password connection) salt)))
510 (force-output socket))
512 (let ((salt (read-socket-sequence socket 4 nil)))
513 (let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
514 (postgresql-connection-user connection)))
515 (pwd (encrypt-md5 pwd2 salt)))
516 (send-encrypted-password-message
518 (concatenate 'string "md5" pwd))))
519 (force-output socket))
521 (error 'postgresql-login-error
522 :connection connection
524 "Postmaster expects unknown authentication method."))))
525 (#.+error-response-message+
526 (let ((message (read-socket-value-string socket)))
527 (error 'postgresql-login-error
528 :connection connection :message message)))
530 (error 'postgresql-login-error
531 :connection connection
533 "Received garbled message from Postmaster"))))
534 ;; Start backend communication
535 (force-output socket)
537 (case (read-socket-value-int8 socket)
538 (#.+backend-key-message+
539 (setf (postgresql-connection-pid connection)
540 (read-socket-value-int32 socket)
541 (postgresql-connection-key connection)
542 (read-socket-value-int32 socket)))
543 (#.+ready-for-query-message+
546 (#.+error-response-message+
547 (let ((message (read-socket-value-string socket)))
548 (error 'postgresql-login-error
549 :connection connection
551 (#.+notice-response-message+
552 (let ((message (read-socket-value-string socket)))
553 (warn 'postgresql-warning :connection connection
556 (error 'postgresql-login-error
557 :connection connection
559 "Received garbled message from Postmaster")))))
563 (defun close-postgresql-connection (connection &optional abort)
566 (send-terminate-message (postgresql-connection-socket connection))))
567 (close (postgresql-connection-socket connection)))
569 (defun postgresql-connection-open-p (connection)
570 (let ((socket (postgresql-connection-socket connection)))
571 (and socket (streamp socket) (open-stream-p socket))))
573 (defun ensure-open-postgresql-connection (connection)
574 (unless (postgresql-connection-open-p connection)
575 (reopen-postgresql-connection connection)))
577 (defun process-async-messages (connection)
578 (assert (postgresql-connection-open-p connection))
579 ;; Process any asnychronous messages
580 (loop with socket = (postgresql-connection-socket connection)
581 while (listen socket)
583 (case (read-socket-value-int8 socket)
584 (#.+ready-for-query-message+)
585 (#.+notice-response-message+
586 (let ((message (read-socket-value-string socket)))
587 (warn 'postgresql-warning :connection connection
589 (#.+notification-response-message+
590 (let ((pid (read-socket-value-int32 socket))
591 (message (read-socket-value-string socket)))
592 (when (= pid (postgresql-connection-pid connection))
593 (signal 'postgresql-notification :connection connection
596 (close-postgresql-connection connection)
597 (error 'postgresql-fatal-error :connection connection
598 :message "Received garbled message from backend")))))
600 (defun start-query-execution (connection query)
601 (ensure-open-postgresql-connection connection)
602 (process-async-messages connection)
603 (send-query-message (postgresql-connection-socket connection) query)
604 (force-output (postgresql-connection-socket connection)))
606 (defun wait-for-query-results (connection)
607 (assert (postgresql-connection-open-p connection))
608 (let ((socket (postgresql-connection-socket connection))
612 (case (read-socket-value-int8 socket)
613 (#.+completed-response-message+
614 (return (values :completed (read-socket-value-string socket))))
615 (#.+cursor-response-message+
616 (setq cursor-name (read-socket-value-string socket)))
617 (#.+row-description-message+
618 (let* ((count (read-socket-value-int16 socket))
623 (read-socket-value-string socket)
624 (read-socket-value-int32 socket)
625 (read-socket-value-int16 socket)
626 (read-socket-value-int32 socket)))))
629 (make-postgresql-cursor :connection connection
632 (#.+copy-in-response-message+
634 (#.+copy-out-response-message+
636 (#.+ready-for-query-message+
640 (#.+error-response-message+
641 (let ((message (read-socket-value-string socket)))
643 (make-condition 'postgresql-error
644 :connection connection :message message))))
645 (#.+notice-response-message+
646 (let ((message (read-socket-value-string socket)))
647 (unless (eq :ignore clsql-sys:*backend-warning-behavior*)
648 (warn 'postgresql-warning
649 :connection connection :message message))))
650 (#.+notification-response-message+
651 (let ((pid (read-socket-value-int32 socket))
652 (message (read-socket-value-string socket)))
653 (when (= pid (postgresql-connection-pid connection))
654 (signal 'postgresql-notification :connection connection
657 (close-postgresql-connection connection)
658 (error 'postgresql-fatal-error :connection connection
659 :message "Received garbled message from backend"))))))
661 (defun read-null-bit-vector (socket count)
662 (let ((result (make-array count :element-type 'bit)))
663 (dotimes (offset (ceiling count 8))
664 (loop with byte = (read-byte socket)
665 for index from (* offset 8) below (min count (* (1+ offset) 8))
666 for weight downfrom 7
667 do (setf (aref result index) (ldb (byte 1 weight) byte))))
671 (defun read-field (socket type)
672 (let ((length (- (read-socket-value-int32 socket) 4)))
675 (read-integer-from-socket socket length))
677 (read-double-from-socket socket length))
679 (read-socket-sequence socket length)))))
681 (uffi:def-constant +char-code-zero+ (char-code #\0))
682 (uffi:def-constant +char-code-minus+ (char-code #\-))
683 (uffi:def-constant +char-code-plus+ (char-code #\+))
684 (uffi:def-constant +char-code-period+ (char-code #\.))
685 (uffi:def-constant +char-code-lower-e+ (char-code #\e))
686 (uffi:def-constant +char-code-upper-e+ (char-code #\E))
688 (defun read-integer-from-socket (socket length)
689 (declare (fixnum length))
693 (first-char (read-byte socket))
695 (declare (fixnum first-char))
696 (decf length) ;; read first char
698 ((= first-char +char-code-minus+)
700 ((= first-char +char-code-plus+)
703 (setq val (- first-char +char-code-zero+))))
709 (- (read-byte socket) +char-code-zero+))))
714 (defmacro ascii-digit (int)
715 (let ((offset (gensym)))
716 `(let ((,offset (- ,int +char-code-zero+)))
717 (declare (fixnum ,int ,offset))
718 (if (and (>= ,offset 0)
723 (defun read-double-from-socket (socket length)
724 (declare (fixnum length))
725 (let ((before-decimal 0)
732 (char (read-byte socket)))
733 (declare (fixnum char exponent decimal-count))
734 (decf length) ;; already read first character
736 ((= char +char-code-minus+)
738 ((= char +char-code-plus+)
740 ((= char +char-code-period+)
743 (setq before-decimal (ascii-digit char))
744 (unless before-decimal
745 (error "Unexpected value"))))
749 (setq char (read-byte socket))
750 ;; (format t "~&len:~D, i:~D, char:~D, minusp:~A, decimalp:~A" length i char minusp decimalp)
751 (let ((weight (ascii-digit char)))
753 ((and weight (not decimalp)) ;; before decimal point
754 (setq before-decimal (+ weight (* 10 before-decimal))))
755 ((and weight decimalp) ;; after decimal point
756 (setq after-decimal (+ weight (* 10 after-decimal)))
757 (incf decimal-count))
758 ((and (= char +char-code-period+))
760 ((or (= char +char-code-lower-e+) ;; E is for exponent
761 (= char +char-code-upper-e+))
762 (setq exponent (read-integer-from-socket socket (- length i 1)))
763 (setq exponent (or exponent 0))
766 (break "Unexpected value"))
769 (setq result (* (+ (coerce before-decimal 'double-float)
771 (expt 10 (- decimal-count))))
779 (defun read-double-from-socket (socket length)
780 (let ((result (make-string length)))
781 (read-socket-sequence result socket)
782 (let ((*read-default-float-format* 'double-float))
783 (read-from-string result))))
785 (defun read-cursor-row (cursor types)
786 (let* ((connection (postgresql-cursor-connection cursor))
787 (socket (postgresql-connection-socket connection))
788 (fields (postgresql-cursor-fields cursor)))
789 (assert (postgresql-connection-open-p connection))
791 (let ((code (read-socket-value-int8 socket)))
793 (#.+ascii-row-message+
795 (loop with count = (length fields)
796 with null-vector = (read-null-bit-vector socket count)
798 for null-bit across null-vector
800 for null-p = (zerop null-bit)
805 (read-field socket (nth i types)))))
806 (#.+binary-row-message+
808 (#.+completed-response-message+
809 (return (values nil (read-socket-value-string socket))))
810 (#.+error-response-message+
811 (let ((message (read-socket-value-string socket)))
812 (error 'postgresql-error
813 :connection connection :message message)))
814 (#.+notice-response-message+
815 (let ((message (read-socket-value-string socket)))
816 (warn 'postgresql-warning
817 :connection connection :message message)))
818 (#.+notification-response-message+
819 (let ((pid (read-socket-value-int32 socket))
820 (message (read-socket-value-string socket)))
821 (when (= pid (postgresql-connection-pid connection))
822 (signal 'postgresql-notification :connection connection
825 (close-postgresql-connection connection)
826 (error 'postgresql-fatal-error :connection connection
827 :message "Received garbled message from backend")))))))
829 (defun map-into-indexed (result-seq func seq)
830 (dotimes (i (length seq))
832 (setf (elt result-seq i)
833 (funcall func (elt seq i) i)))
836 (defun copy-cursor-row (cursor sequence types)
837 (let* ((connection (postgresql-cursor-connection cursor))
838 (socket (postgresql-connection-socket connection))
839 (fields (postgresql-cursor-fields cursor)))
840 (assert (= (length fields) (length sequence)))
842 (let ((code (read-socket-value-int8 socket)))
844 (#.+ascii-row-message+
847 (let* ((count (length sequence))
848 (null-vector (read-null-bit-vector socket count)))
851 (if (zerop (elt null-vector i))
852 (setf (elt sequence i) nil)
853 (let ((value (read-field socket (nth i types))))
854 (setf (elt sequence i) value)))))
857 #'(lambda (null-bit i)
860 (read-field socket (nth i types))))
861 (read-null-bit-vector socket (length sequence)))))
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 skip-cursor-row (cursor)
886 (let* ((connection (postgresql-cursor-connection cursor))
887 (socket (postgresql-connection-socket connection))
888 (fields (postgresql-cursor-fields cursor)))
890 (let ((code (read-socket-value-int8 socket)))
892 (#.+ascii-row-message+
893 (loop for null-bit across
894 (read-null-bit-vector socket (length fields))
896 (unless (zerop null-bit)
897 (let* ((length (read-socket-value-int32 socket)))
898 (loop repeat (- length 4) do (read-byte socket)))))
900 (#.+binary-row-message+
902 (#.+completed-response-message+
903 (return (values nil (read-socket-value-string socket))))
904 (#.+error-response-message+
905 (let ((message (read-socket-value-string socket)))
906 (error 'postgresql-error
907 :connection connection :message message)))
908 (#.+notice-response-message+
909 (let ((message (read-socket-value-string socket)))
910 (warn 'postgresql-warning
911 :connection connection :message message)))
912 (#.+notification-response-message+
913 (let ((pid (read-socket-value-int32 socket))
914 (message (read-socket-value-string socket)))
915 (when (= pid (postgresql-connection-pid connection))
916 (signal 'postgresql-notification :connection connection
919 (close-postgresql-connection connection)
920 (error 'postgresql-fatal-error :connection connection
921 :message "Received garbled message from backend")))))))
923 (defun run-query (connection query &optional (result-types nil))
924 (start-query-execution connection query)
925 (multiple-value-bind (status cursor)
926 (wait-for-query-results connection)
927 (assert (eq status :cursor))
928 (loop for row = (read-cursor-row cursor result-types)
932 (wait-for-query-results connection))))
935 (declaim (ext:maybe-inline read-byte write-byte))