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
10 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
11 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
13 ;;;; CLSQL users are granted the rights to distribute and use this software
14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
16 ;;;; *************************************************************************
18 (in-package #:postgresql-socket)
20 (uffi:def-enum pgsql-ftype
28 (defmethod clsql-sys:database-type-library-loaded ((database-type
29 (eql :postgresql-socket)))
30 "T if foreign library was able to be loaded successfully. Always true for
34 (defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
40 (defmacro define-message-constants (description &rest clauses)
41 (assert (evenp (length clauses)))
42 (loop with seen-characters = nil
43 for (name char) on clauses by #'cddr
44 for char-code = (char-code char)
45 for doc-string = (format nil "~A (~:C): ~A" description char name)
46 if (member char seen-characters)
47 do (error "Duplicate message type ~@C for group ~A" char description)
50 `(defconstant ,name ,char-code ,doc-string)
52 and do (push char seen-characters)
54 (return `(progn ,@result-clauses))))
56 (eval-when (:compile-toplevel :load-toplevel :execute)
57 (define-message-constants "Backend Message Constants"
58 +ascii-row-message+ #\D
59 +authentication-message+ #\R
60 +backend-key-message+ #\K
61 +binary-row-message+ #\B
62 +completed-response-message+ #\C
63 +copy-in-response-message+ #\G
64 +copy-out-response-message+ #\H
65 +cursor-response-message+ #\P
66 +empty-query-response-message+ #\I
67 +error-response-message+ #\E
68 +function-response-message+ #\V
69 +notice-response-message+ #\N
70 +notification-response-message+ #\A
71 +ready-for-query-message+ #\Z
72 +row-description-message+ #\T))
75 (declaim (inline read-byte write-byte))
77 (defun send-socket-value-int32 (socket value)
78 (declare (type stream socket)
79 (type (unsigned-byte 32) value))
80 (write-byte (ldb (byte 8 24) value) socket)
81 (write-byte (ldb (byte 8 16) value) socket)
82 (write-byte (ldb (byte 8 8) value) socket)
83 (write-byte (ldb (byte 8 0) value) socket)
86 (defun send-socket-value-int16 (socket value)
87 (declare (type stream socket)
88 (type (unsigned-byte 16) value))
89 (write-byte (ldb (byte 8 8) value) socket)
90 (write-byte (ldb (byte 8 0) value) socket)
93 (defun send-socket-value-int8 (socket value)
94 (declare (type stream socket)
95 (type (unsigned-byte 8) value))
96 (write-byte (ldb (byte 8 0) value) socket)
99 (defun send-socket-value-char-code (socket value)
100 (declare (type stream socket)
101 (type character value))
102 (write-byte (ldb (byte 8 0) (char-code value)) socket)
105 (defun send-socket-value-string (socket value)
106 (declare (type stream socket)
109 (loop for char across value
110 for code = (char-code char)
111 do (write-byte code socket)
112 finally (write-byte 0 socket))
114 (write-sequence (sb-ext:string-to-octets value :null-terminate t) socket)
117 (defun send-socket-value-limstring (socket value limit)
118 (declare (type stream socket)
121 (let ((length (length value)))
122 (dotimes (i (min length limit))
123 (let ((code (char-code (char value i))))
124 (write-byte code socket)))
125 (dotimes (i (- limit length))
126 (write-byte 0 socket)))
130 (defun read-socket-value-int32 (socket)
131 (declare (type stream socket))
132 (declare (optimize (speed 3)))
134 (declare (type (unsigned-byte 32) result))
135 (setf (ldb (byte 8 24) result) (read-byte socket))
136 (setf (ldb (byte 8 16) result) (read-byte socket))
137 (setf (ldb (byte 8 8) result) (read-byte socket))
138 (setf (ldb (byte 8 0) result) (read-byte socket))
141 (defun read-socket-value-int16 (socket)
142 (declare (type stream socket))
144 (declare (type (unsigned-byte 16) result))
145 (setf (ldb (byte 8 8) result) (read-byte socket))
146 (setf (ldb (byte 8 0) result) (read-byte socket))
149 (defun read-socket-value-int8 (socket)
150 (declare (type stream socket))
153 (defun read-socket-value-string (socket)
154 (declare (type stream socket))
156 (with-output-to-string (out)
157 (loop for code = (read-byte socket)
159 do (write-char (code-char code) out)))
161 (let ((bytes (make-array 64
162 :element-type '(unsigned-byte 8)
165 (loop for code = (read-byte socket)
167 do (vector-push-extend code bytes))
168 (sb-ext:octets-to-string bytes)))
171 (defmacro define-message-sender (name (&rest args) &rest clauses)
172 (let ((socket-var (gensym))
174 (dolist (clause clauses)
175 (let* ((type (first clause))
176 (fn (intern (concatenate 'string (symbol-name '#:send-socket-value-)
177 (symbol-name type)))))
178 (push `(,fn ,socket-var ,@(rest clause)) body)))
179 `(defun ,name (,socket-var ,@args)
182 (define-message-sender send-startup-message
183 (database user &optional (command-line "") (backend-tty ""))
185 (int32 #x00020000) ; Version 2.0
186 (limstring database 64)
188 (limstring command-line 64)
189 (limstring "" 64) ; Unused
190 (limstring backend-tty 64))
192 (define-message-sender send-terminate-message ()
195 (define-message-sender send-unencrypted-password-message (password)
196 (int32 (+ 5 (length password)))
199 (define-message-sender send-query-message (query)
203 (define-message-sender send-encrypted-password-message (crypted-password)
204 (int32 (+ 5 (length crypted-password)))
205 (string crypted-password))
207 (define-message-sender send-cancel-request (pid key)
209 (int32 80877102) ; Magic
214 (defun read-socket-sequence (stream length &optional (allow-wide t))
215 (declare (stream stream)
216 (optimize (speed 3) (safety 0)))
218 (let ((result (make-string length)))
219 (dotimes (i length result)
221 (setf (char result i) (code-char (read-byte stream)))))
223 (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
224 (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
225 (read-sequence bytes stream)
227 (sb-ext:octets-to-string bytes)
228 (map 'string #'code-char bytes))))
230 ;;; Support for encrypted password transmission
233 (eval-when (:compile-toplevel :load-toplevel :execute)
234 (defvar *crypt-library-loaded* nil)
236 (unless *crypt-library-loaded*
237 (uffi:load-foreign-library
238 (uffi:find-foreign-library "libcrypt"
239 '(#+(or 64bit x86-64) "/usr/lib64/"
240 "/usr/lib/" "/usr/local/lib/" "/lib/"))
241 :supporting-libraries '("c"))
242 (setq *crypt-library-loaded* t)))
244 (in-package :postgresql-socket)
246 (uffi:def-function ("crypt" crypt)
251 (defun crypt-password (password salt)
252 "Encrypt a password for transmission to a PostgreSQL server."
253 (uffi:with-cstring (password-cstring password)
254 (uffi:with-cstring (salt-cstring salt)
255 (uffi:convert-from-cstring
256 (crypt password-cstring salt-cstring)))))
259 ;;;; Condition hierarchy
261 (define-condition postgresql-condition (condition)
262 ((connection :initarg :connection :reader postgresql-condition-connection)
263 (message :initarg :message :reader postgresql-condition-message))
266 (format stream "~@<~A occurred on connection ~A. ~:@_Reason: ~A~:@>"
268 (postgresql-condition-connection c)
269 (postgresql-condition-message c)))))
271 (define-condition postgresql-error (error postgresql-condition)
274 (define-condition postgresql-fatal-error (postgresql-error)
277 (define-condition postgresql-login-error (postgresql-fatal-error)
280 (define-condition postgresql-warning (warning postgresql-condition)
283 (define-condition postgresql-notification (postgresql-condition)
287 (format stream "~@<Asynchronous notification on connection ~A: ~:@_~A~:@>"
288 (postgresql-condition-connection c)
289 (postgresql-condition-message c)))))
293 (defstruct postgresql-connection
305 (defstruct postgresql-cursor
312 (defconstant +postgresql-server-default-port+ 5432
313 "Default port of PostgreSQL server.")
315 (defvar *postgresql-server-socket-timeout* 60
316 "Timeout in seconds for reads from the PostgreSQL server.")
319 (defun open-postgresql-socket (host port)
322 ;; Directory to unix-domain socket
323 (ext:connect-to-unix-socket
325 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
328 (ext:connect-to-inet-socket host port))))
331 (defun open-postgresql-socket (host port)
334 ;; Directory to unix-domain socket
335 (let ((sock (make-instance 'sb-bsd-sockets:local-socket
337 (sb-bsd-sockets:socket-connect
340 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
344 (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
347 (sb-bsd-sockets:socket-connect
349 (sb-bsd-sockets:host-ent-address
350 (sb-bsd-sockets:get-host-by-name host))
355 (defun open-postgresql-socket-stream (host port)
356 (system:make-fd-stream
357 (open-postgresql-socket host port)
358 :input t :output t :element-type '(unsigned-byte 8)
360 :timeout *postgresql-server-socket-timeout*))
364 (defun open-postgresql-socket-stream (host port)
365 (sb-bsd-sockets:socket-make-stream
366 (open-postgresql-socket host port) :input t :output t
367 :element-type '(unsigned-byte 8)))
371 (defun open-postgresql-socket-stream (host port)
374 (let ((path (namestring
375 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
377 (socket:make-socket :type :stream :address-family :file
379 :remote-filename path :local-filename path)))
381 (socket:with-pending-connect
382 (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed"))
383 (socket:make-socket :type :stream :address-family :internet
384 :remote-port port :remote-host host
385 :connect :active :nodelay t))))))
388 (defun open-postgresql-socket-stream (host port)
391 (let ((path (namestring
392 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
394 (ccl:make-socket :type :stream :address-family :file
396 :remote-filename path :local-filename path)))
398 (ccl:make-socket :type :stream :address-family :internet
399 :remote-port port :remote-host host
400 :connect :active :nodelay t))))
403 (defun open-postgresql-socket-stream (host port)
406 (error "File sockets not supported on Lispworks."))
408 (comm:open-tcp-stream host port :direction :io :element-type '(unsigned-byte 8)
409 :read-timeout *postgresql-server-socket-timeout*))
414 (defun open-postgresql-socket-stream (host port)
417 (error "Not supported"))
419 (socket:socket-connect
421 :element-type '(unsigned-byte 8)
422 :timeout *postgresql-server-socket-timeout*))))
425 ;;; Interface Functions
427 (defun open-postgresql-connection (&key (host (cmucl-compat:required-argument))
428 (port +postgresql-server-default-port+)
429 (database (cmucl-compat:required-argument))
430 (user (cmucl-compat:required-argument))
431 options tty password)
432 "Open a connection to a PostgreSQL server with the given parameters.
433 Note that host, database and user arguments must be supplied.
435 If host is a pathname, it is assumed to name a directory containing
436 the local unix-domain sockets of the server, with port selecting which
437 of those sockets to open. If host is a string, it is assumed to be
438 the name of the host running the PostgreSQL server. In that case a
439 TCP connection to the given port on that host is opened in order to
440 communicate with the server. In either case the port argument
441 defaults to `+postgresql-server-default-port+'.
443 Password is the clear-text password to be passed in the authentication
444 phase to the server. Depending on the server set-up, it is either
445 passed in the clear, or encrypted via crypt and a server-supplied
446 salt. In that case the alien function specified by `*crypt-library*'
447 and `*crypt-function-name*' is used for encryption.
449 Note that all the arguments (including the clear-text password
450 argument) are stored in the `postgresql-connection' structure, in
451 order to facilitate automatic reconnection in case of communication
453 (reopen-postgresql-connection
454 (make-postgresql-connection :host host :port port
455 :options (or options "") :tty (or tty "")
456 :database database :user user
457 :password (or password ""))))
459 (defun encrypt-md5 (plaintext salt)
461 (format nil "~{~2,'0X~}"
462 (coerce (md5sum-sequence (concatenate 'string plaintext salt)) 'list))))
464 (defun reopen-postgresql-connection (connection)
465 "Reopen the given PostgreSQL connection. Closes any existing
466 connection, if it is still open."
467 (when (postgresql-connection-open-p connection)
468 (close-postgresql-connection connection))
469 (let ((socket (open-postgresql-socket-stream
470 (postgresql-connection-host connection)
471 (postgresql-connection-port connection))))
474 (setf (postgresql-connection-socket connection) socket)
475 (send-startup-message socket
476 (postgresql-connection-database connection)
477 (postgresql-connection-user connection)
478 (postgresql-connection-options connection)
479 (postgresql-connection-tty connection))
480 (force-output socket)
482 (case (read-socket-value-int8 socket)
483 (#.+authentication-message+
484 (case (read-socket-value-int32 socket)
487 (error 'postgresql-login-error
488 :connection connection
490 "Postmaster expects unsupported Kerberos authentication."))
492 (send-unencrypted-password-message
494 (postgresql-connection-password connection))
495 (force-output socket))
497 (let ((salt (read-socket-sequence socket 2 nil)))
498 (send-encrypted-password-message
501 (postgresql-connection-password connection) salt)))
502 (force-output socket))
504 (let ((salt (read-socket-sequence socket 4 nil)))
505 (let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
506 (postgresql-connection-user connection)))
507 (pwd (encrypt-md5 pwd2 salt)))
508 (send-encrypted-password-message
510 (concatenate 'string "md5" pwd))))
511 (force-output socket))
513 (error 'postgresql-login-error
514 :connection connection
516 "Postmaster expects unknown authentication method."))))
517 (#.+error-response-message+
518 (let ((message (read-socket-value-string socket)))
519 (error 'postgresql-login-error
520 :connection connection :message message)))
522 (error 'postgresql-login-error
523 :connection connection
525 "Received garbled message from Postmaster"))))
526 ;; Start backend communication
527 (force-output socket)
529 (case (read-socket-value-int8 socket)
530 (#.+backend-key-message+
531 (setf (postgresql-connection-pid connection)
532 (read-socket-value-int32 socket)
533 (postgresql-connection-key connection)
534 (read-socket-value-int32 socket)))
535 (#.+ready-for-query-message+
538 (#.+error-response-message+
539 (let ((message (read-socket-value-string socket)))
540 (error 'postgresql-login-error
541 :connection connection
543 (#.+notice-response-message+
544 (let ((message (read-socket-value-string socket)))
545 (warn 'postgresql-warning :connection connection
548 (error 'postgresql-login-error
549 :connection connection
551 "Received garbled message from Postmaster")))))
555 (defun close-postgresql-connection (connection &optional abort)
558 (send-terminate-message (postgresql-connection-socket connection))))
559 (close (postgresql-connection-socket connection)))
561 (defun postgresql-connection-open-p (connection)
562 (let ((socket (postgresql-connection-socket connection)))
563 (and socket (streamp socket) (open-stream-p socket))))
565 (defun ensure-open-postgresql-connection (connection)
566 (unless (postgresql-connection-open-p connection)
567 (reopen-postgresql-connection connection)))
569 (defun process-async-messages (connection)
570 (assert (postgresql-connection-open-p connection))
571 ;; Process any asnychronous messages
572 (loop with socket = (postgresql-connection-socket connection)
573 while (listen socket)
575 (case (read-socket-value-int8 socket)
576 (#.+ready-for-query-message+)
577 (#.+notice-response-message+
578 (let ((message (read-socket-value-string socket)))
579 (warn 'postgresql-warning :connection connection
581 (#.+notification-response-message+
582 (let ((pid (read-socket-value-int32 socket))
583 (message (read-socket-value-string socket)))
584 (when (= pid (postgresql-connection-pid connection))
585 (signal 'postgresql-notification :connection connection
588 (close-postgresql-connection connection)
589 (error 'postgresql-fatal-error :connection connection
590 :message "Received garbled message from backend")))))
592 (defun start-query-execution (connection query)
593 (ensure-open-postgresql-connection connection)
594 (process-async-messages connection)
595 (send-query-message (postgresql-connection-socket connection) query)
596 (force-output (postgresql-connection-socket connection)))
598 (defun wait-for-query-results (connection)
599 (assert (postgresql-connection-open-p connection))
600 (let ((socket (postgresql-connection-socket connection))
604 (case (read-socket-value-int8 socket)
605 (#.+completed-response-message+
606 (return (values :completed (read-socket-value-string socket))))
607 (#.+cursor-response-message+
608 (setq cursor-name (read-socket-value-string socket)))
609 (#.+row-description-message+
610 (let* ((count (read-socket-value-int16 socket))
615 (read-socket-value-string socket)
616 (read-socket-value-int32 socket)
617 (read-socket-value-int16 socket)
618 (read-socket-value-int32 socket)))))
621 (make-postgresql-cursor :connection connection
624 (#.+copy-in-response-message+
626 (#.+copy-out-response-message+
628 (#.+ready-for-query-message+
632 (#.+error-response-message+
633 (let ((message (read-socket-value-string socket)))
635 (make-condition 'postgresql-error
636 :connection connection :message message))))
637 (#.+notice-response-message+
638 (let ((message (read-socket-value-string socket)))
639 (unless (eq :ignore clsql-sys:*backend-warning-behavior*)
640 (warn 'postgresql-warning
641 :connection connection :message message))))
642 (#.+notification-response-message+
643 (let ((pid (read-socket-value-int32 socket))
644 (message (read-socket-value-string socket)))
645 (when (= pid (postgresql-connection-pid connection))
646 (signal 'postgresql-notification :connection connection
649 (close-postgresql-connection connection)
650 (error 'postgresql-fatal-error :connection connection
651 :message "Received garbled message from backend"))))))
653 (defun read-null-bit-vector (socket count)
654 (let ((result (make-array count :element-type 'bit)))
655 (dotimes (offset (ceiling count 8))
656 (loop with byte = (read-byte socket)
657 for index from (* offset 8) below (min count (* (1+ offset) 8))
658 for weight downfrom 7
659 do (setf (aref result index) (ldb (byte 1 weight) byte))))
663 (defun read-field (socket type)
664 (let ((length (- (read-socket-value-int32 socket) 4)))
667 (read-integer-from-socket socket length))
669 (read-double-from-socket socket length))
671 (read-socket-sequence socket length)))))
673 (uffi:def-constant +char-code-zero+ (char-code #\0))
674 (uffi:def-constant +char-code-minus+ (char-code #\-))
675 (uffi:def-constant +char-code-plus+ (char-code #\+))
676 (uffi:def-constant +char-code-period+ (char-code #\.))
677 (uffi:def-constant +char-code-lower-e+ (char-code #\e))
678 (uffi:def-constant +char-code-upper-e+ (char-code #\E))
680 (defun read-integer-from-socket (socket length)
681 (declare (fixnum length))
685 (first-char (read-byte socket))
687 (declare (fixnum first-char))
688 (decf length) ;; read first char
690 ((= first-char +char-code-minus+)
692 ((= first-char +char-code-plus+)
695 (setq val (- first-char +char-code-zero+))))
701 (- (read-byte socket) +char-code-zero+))))
706 (defmacro ascii-digit (int)
707 (let ((offset (gensym)))
708 `(let ((,offset (- ,int +char-code-zero+)))
709 (declare (fixnum ,int ,offset))
710 (if (and (>= ,offset 0)
715 (defun read-double-from-socket (socket length)
716 (declare (fixnum length))
717 (let ((before-decimal 0)
724 (char (read-byte socket)))
725 (declare (fixnum char exponent decimal-count))
726 (decf length) ;; already read first character
728 ((= char +char-code-minus+)
730 ((= char +char-code-plus+)
732 ((= char +char-code-period+)
735 (setq before-decimal (ascii-digit char))
736 (unless before-decimal
737 (error "Unexpected value"))))
741 (setq char (read-byte socket))
742 ;; (format t "~&len:~D, i:~D, char:~D, minusp:~A, decimalp:~A" length i char minusp decimalp)
743 (let ((weight (ascii-digit char)))
745 ((and weight (not decimalp)) ;; before decimal point
746 (setq before-decimal (+ weight (* 10 before-decimal))))
747 ((and weight decimalp) ;; after decimal point
748 (setq after-decimal (+ weight (* 10 after-decimal)))
749 (incf decimal-count))
750 ((and (= char +char-code-period+))
752 ((or (= char +char-code-lower-e+) ;; E is for exponent
753 (= char +char-code-upper-e+))
754 (setq exponent (read-integer-from-socket socket (- length i 1)))
755 (setq exponent (or exponent 0))
758 (break "Unexpected value"))
761 (setq result (* (+ (coerce before-decimal 'double-float)
763 (expt 10 (- decimal-count))))
771 (defun read-double-from-socket (socket length)
772 (let ((result (make-string length)))
773 (read-socket-sequence result socket)
774 (let ((*read-default-float-format* 'double-float))
775 (read-from-string result))))
777 (defun read-cursor-row (cursor types)
778 (let* ((connection (postgresql-cursor-connection cursor))
779 (socket (postgresql-connection-socket connection))
780 (fields (postgresql-cursor-fields cursor)))
781 (assert (postgresql-connection-open-p connection))
783 (let ((code (read-socket-value-int8 socket)))
785 (#.+ascii-row-message+
787 (loop with count = (length fields)
788 with null-vector = (read-null-bit-vector socket count)
790 for null-bit across null-vector
792 for null-p = (zerop null-bit)
797 (read-field socket (nth i types)))))
798 (#.+binary-row-message+
800 (#.+completed-response-message+
801 (return (values nil (read-socket-value-string socket))))
802 (#.+error-response-message+
803 (let ((message (read-socket-value-string socket)))
804 (error 'postgresql-error
805 :connection connection :message message)))
806 (#.+notice-response-message+
807 (let ((message (read-socket-value-string socket)))
808 (warn 'postgresql-warning
809 :connection connection :message message)))
810 (#.+notification-response-message+
811 (let ((pid (read-socket-value-int32 socket))
812 (message (read-socket-value-string socket)))
813 (when (= pid (postgresql-connection-pid connection))
814 (signal 'postgresql-notification :connection connection
817 (close-postgresql-connection connection)
818 (error 'postgresql-fatal-error :connection connection
819 :message "Received garbled message from backend")))))))
821 (defun map-into-indexed (result-seq func seq)
822 (dotimes (i (length seq))
824 (setf (elt result-seq i)
825 (funcall func (elt seq i) i)))
828 (defun copy-cursor-row (cursor sequence types)
829 (let* ((connection (postgresql-cursor-connection cursor))
830 (socket (postgresql-connection-socket connection))
831 (fields (postgresql-cursor-fields cursor)))
832 (assert (= (length fields) (length sequence)))
834 (let ((code (read-socket-value-int8 socket)))
836 (#.+ascii-row-message+
839 (let* ((count (length sequence))
840 (null-vector (read-null-bit-vector socket count)))
843 (if (zerop (elt null-vector i))
844 (setf (elt sequence i) nil)
845 (let ((value (read-field socket (nth i types))))
846 (setf (elt sequence i) value)))))
849 #'(lambda (null-bit i)
852 (read-field socket (nth i types))))
853 (read-null-bit-vector socket (length sequence)))))
854 (#.+binary-row-message+
856 (#.+completed-response-message+
857 (return (values nil (read-socket-value-string socket))))
858 (#.+error-response-message+
859 (let ((message (read-socket-value-string socket)))
860 (error 'postgresql-error
861 :connection connection :message message)))
862 (#.+notice-response-message+
863 (let ((message (read-socket-value-string socket)))
864 (warn 'postgresql-warning
865 :connection connection :message message)))
866 (#.+notification-response-message+
867 (let ((pid (read-socket-value-int32 socket))
868 (message (read-socket-value-string socket)))
869 (when (= pid (postgresql-connection-pid connection))
870 (signal 'postgresql-notification :connection connection
873 (close-postgresql-connection connection)
874 (error 'postgresql-fatal-error :connection connection
875 :message "Received garbled message from backend")))))))
877 (defun skip-cursor-row (cursor)
878 (let* ((connection (postgresql-cursor-connection cursor))
879 (socket (postgresql-connection-socket connection))
880 (fields (postgresql-cursor-fields cursor)))
882 (let ((code (read-socket-value-int8 socket)))
884 (#.+ascii-row-message+
885 (loop for null-bit across
886 (read-null-bit-vector socket (length fields))
888 (unless (zerop null-bit)
889 (let* ((length (read-socket-value-int32 socket)))
890 (loop repeat (- length 4) do (read-byte socket)))))
892 (#.+binary-row-message+
894 (#.+completed-response-message+
895 (return (values nil (read-socket-value-string socket))))
896 (#.+error-response-message+
897 (let ((message (read-socket-value-string socket)))
898 (error 'postgresql-error
899 :connection connection :message message)))
900 (#.+notice-response-message+
901 (let ((message (read-socket-value-string socket)))
902 (warn 'postgresql-warning
903 :connection connection :message message)))
904 (#.+notification-response-message+
905 (let ((pid (read-socket-value-int32 socket))
906 (message (read-socket-value-string socket)))
907 (when (= pid (postgresql-connection-pid connection))
908 (signal 'postgresql-notification :connection connection
911 (close-postgresql-connection connection)
912 (error 'postgresql-fatal-error :connection connection
913 :message "Received garbled message from backend")))))))
915 (defun run-query (connection query &optional (result-types nil))
916 (start-query-execution connection query)
917 (multiple-value-bind (status cursor)
918 (wait-for-query-results connection)
919 (assert (eq status :cursor))
920 (loop for row = (read-cursor-row cursor result-types)
924 (wait-for-query-results connection))))
927 (declaim (ext:maybe-inline read-byte write-byte))