1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: postgresql-socket.cl
6 ;;;; Purpose: Low-level PostgreSQL interface using sockets
7 ;;;; Programmers: Kevin M. Rosenberg based on
8 ;;;; Original code by Pierre R. Mai
10 ;;;; Date Started: Feb 2002
12 ;;;; $Id: postgresql-socket-api.cl,v 1.1 2002/09/18 07:43:41 kevin Exp $
14 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
15 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
17 ;;;; CLSQL users are granted the rights to distribute and use this software
18 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
19 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
20 ;;;; *************************************************************************
23 ;;;; Changes by Kevin Rosenberg
24 ;;;; - Added socket open functions for Allegro and Lispworks
25 ;;;; - Changed CMUCL FFI to UFFI
26 ;;;; - Added necessary (force-output) for socket streams on
27 ;;;; Allegro and Lispworks
28 ;;;; - Added initialization variable
29 ;;;; - Added field type processing
32 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
33 (in-package :postgresql-socket)
35 (uffi:def-enum pgsql-ftype
43 (defmethod database-type-library-loaded ((database-type
44 (eql :postgresql-socket)))
45 "T if foreign library was able to be loaded successfully. Always true for
52 (defmacro define-message-constants (description &rest clauses)
53 (assert (evenp (length clauses)))
54 (loop with seen-characters = nil
55 for (name char) on clauses by #'cddr
56 for char-code = (char-code char)
57 for doc-string = (format nil "~A (~:C): ~A" description char name)
58 if (member char seen-characters)
59 do (error "Duplicate message type ~@C for group ~A" char description)
62 `(defconstant ,name ,char-code ,doc-string)
64 and do (push char seen-characters)
66 (return `(progn ,@result-clauses))))
68 (eval-when (:compile-toplevel :load-toplevel :execute)
69 (define-message-constants "Backend Message Constants"
70 +ascii-row-message+ #\D
71 +authentication-message+ #\R
72 +backend-key-message+ #\K
73 +binary-row-message+ #\B
74 +completed-response-message+ #\C
75 +copy-in-response-message+ #\G
76 +copy-out-response-message+ #\H
77 +cursor-response-message+ #\P
78 +empty-query-response-message+ #\I
79 +error-response-message+ #\E
80 +function-response-message+ #\V
81 +notice-response-message+ #\N
82 +notification-response-message+ #\A
83 +ready-for-query-message+ #\Z
84 +row-description-message+ #\T))
86 (defgeneric send-socket-value (type socket value))
88 (defmethod send-socket-value ((type (eql 'int32)) socket (value integer))
89 (write-byte (ldb (byte 8 24) value) socket)
90 (write-byte (ldb (byte 8 16) value) socket)
91 (write-byte (ldb (byte 8 8) value) socket)
92 (write-byte (ldb (byte 8 0) value) socket))
94 (defmethod send-socket-value ((type (eql 'int16)) socket (value integer))
95 (write-byte (ldb (byte 8 8) value) socket)
96 (write-byte (ldb (byte 8 0) value) socket))
98 (defmethod send-socket-value ((type (eql 'int8)) socket (value integer))
99 (write-byte (ldb (byte 8 0) value) socket))
101 (defmethod send-socket-value ((type (eql 'string)) socket (value string))
102 (loop for char across value
103 for code = (char-code char)
104 do (write-byte code socket)
105 finally (write-byte 0 socket)))
107 (defmethod send-socket-value ((type (eql 'limstring)) socket (value string))
108 (loop for char across value
109 for code = (char-code char)
110 do (write-byte code socket)))
112 (defmethod send-socket-value ((type (eql 'byte)) socket (value integer))
113 (write-byte value socket))
115 (defmethod send-socket-value ((type (eql 'byte)) socket (value character))
116 (write-byte (char-code value) socket))
118 (defmethod send-socket-value ((type (eql 'byte)) socket value)
119 (write-sequence value socket))
121 (defgeneric read-socket-value (type socket))
123 (defmethod read-socket-value ((type (eql 'int32)) socket)
125 (setf (ldb (byte 8 24) result) (read-byte socket))
126 (setf (ldb (byte 8 16) result) (read-byte socket))
127 (setf (ldb (byte 8 8) result) (read-byte socket))
128 (setf (ldb (byte 8 0) result) (read-byte socket))
131 (defmethod read-socket-value ((type (eql 'int16)) socket)
133 (setf (ldb (byte 8 8) result) (read-byte socket))
134 (setf (ldb (byte 8 0) result) (read-byte socket))
137 (defmethod read-socket-value ((type (eql 'int8)) socket)
140 (defmethod read-socket-value ((type (eql 'string)) socket)
141 (with-output-to-string (out)
142 (loop for code = (read-byte socket)
144 do (write-char (code-char code) out))))
146 (defgeneric skip-socket-value (type socket))
148 (defmethod skip-socket-value ((type (eql 'int32)) socket)
149 (dotimes (i 4) (read-byte socket)))
151 (defmethod skip-socket-value ((type (eql 'int16)) socket)
152 (dotimes (i 2) (read-byte socket)))
154 (defmethod skip-socket-value ((type (eql 'int8)) socket)
157 (defmethod skip-socket-value ((type (eql 'string)) socket)
158 (loop until (zerop (read-byte socket))))
160 (defmacro define-message-sender (name (&rest args) &rest clauses)
161 (loop with socket-var = (gensym)
162 for (type value) in clauses
164 `(send-socket-value ',type ,socket-var ,value)
168 `(defun ,name (,socket-var ,@args)
171 (defun pad-limstring (string limit)
172 (let ((result (make-string limit :initial-element #\NULL)))
173 (loop for char across string
174 for index from 0 below limit
175 do (setf (char result index) char))
178 (define-message-sender send-startup-message
179 (database user &optional (command-line "") (backend-tty ""))
181 (int32 #x00020000) ; Version 2.0
182 (limstring (pad-limstring database 64))
183 (limstring (pad-limstring user 32))
184 (limstring (pad-limstring command-line 64))
185 (limstring (pad-limstring "" 64)) ; Unused
186 (limstring (pad-limstring backend-tty 64)))
188 (define-message-sender send-terminate-message ()
191 (define-message-sender send-unencrypted-password-message (password)
192 (int32 (+ 5 (length password)))
195 (define-message-sender send-query-message (query)
199 (define-message-sender send-encrypted-password-message (crypted-password)
200 (int32 (+ 5 (length crypted-password)))
201 (string crypted-password))
203 (define-message-sender send-cancel-request (pid key)
205 (int32 80877102) ; Magic
210 (defun read-socket-sequence (string stream)
211 "KMR -- Added to support reading from binary stream into a string"
212 (declare (optimize (speed 3) (safety 0))
214 (dotimes (i (length string))
216 (setf (char string i) (code-char (read-byte stream))))
220 ;;; Support for encrypted password transmission
222 (defvar *crypt-library-loaded* nil)
224 (defun crypt-password (password salt)
225 "Encrypt a password for transmission to a PostgreSQL server."
226 (unless *crypt-library-loaded*
227 (uffi:load-foreign-library
228 (uffi:find-foreign-library "libcrypt"
229 '("/usr/lib/" "/usr/local/lib/" "/lib/"))
230 :supporting-libaries '("c"))
231 (eval '(uffi:def-function "crypt"
234 :returning :cstring))
235 (setq *crypt-library-loaded* t))
236 (uffi:with-cstring (password-cstring password)
237 (uffi:with-cstring (salt-cstring salt)
238 (uffi:convert-from-cstring
239 (funcall (fdefinition 'crypt) password-cstring salt-cstring)))))
240 ;;; Condition hierarchy
242 (define-condition postgresql-condition (condition)
243 ((connection :initarg :connection :reader postgresql-condition-connection)
244 (message :initarg :message :reader postgresql-condition-message))
247 (format stream "~@<~A occurred on connection ~A. ~:@_Reason: ~A~:@>"
249 (postgresql-condition-connection c)
250 (postgresql-condition-message c)))))
252 (define-condition postgresql-error (error postgresql-condition)
255 (define-condition postgresql-fatal-error (postgresql-error)
258 (define-condition postgresql-login-error (postgresql-fatal-error)
261 (define-condition postgresql-warning (warning postgresql-condition)
264 (define-condition postgresql-notification (postgresql-condition)
268 (format stream "~@<Asynchronous notification on connection ~A: ~:@_~A~:@>"
269 (postgresql-condition-connection c)
270 (postgresql-condition-message c)))))
274 (defstruct postgresql-connection
286 (defstruct postgresql-cursor
293 (defconstant +postgresql-server-default-port+ 5432
294 "Default port of PostgreSQL server.")
296 (defvar *postgresql-server-socket-timeout* 60
297 "Timeout in seconds for reads from the PostgreSQL server.")
301 (defun open-postgresql-socket (host port)
304 ;; Directory to unix-domain socket
305 (ext:connect-to-unix-socket
307 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
310 (ext:connect-to-inet-socket host port))))
313 (defun open-postgresql-socket-stream (host port)
314 (system:make-fd-stream
315 (open-postgresql-socket host port)
316 :input t :output t :element-type '(unsigned-byte 8)
318 :timeout *postgresql-server-socket-timeout*))
321 (defun open-postgresql-socket-stream (host port)
324 (let ((path (namestring
325 (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
327 (socket:make-socket :type :stream :address-family :file
329 :remote-filename path :local-filename path)))
331 (socket:with-pending-connect
332 (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed"))
333 (socket:make-socket :type :stream :address-family :internet
334 :remote-port port :remote-host host
335 :connect :active :nodelay t))))
339 (defun open-postgresql-socket-stream (host port)
342 (error "File sockets not supported on Lispworks."))
344 (comm:open-tcp-stream host port :direction :io :element-type '(unsigned-byte 8)
345 :read-timeout *postgresql-server-socket-timeout*))
348 ;;; Interface Functions
350 (defun open-postgresql-connection (&key (host (cmucl-compat:required-argument))
351 (port +postgresql-server-default-port+)
352 (database (cmucl-compat:required-argument))
353 (user (cmucl-compat:required-argument))
354 options tty password)
355 "Open a connection to a PostgreSQL server with the given parameters.
356 Note that host, database and user arguments must be supplied.
358 If host is a pathname, it is assumed to name a directory containing
359 the local unix-domain sockets of the server, with port selecting which
360 of those sockets to open. If host is a string, it is assumed to be
361 the name of the host running the PostgreSQL server. In that case a
362 TCP connection to the given port on that host is opened in order to
363 communicate with the server. In either case the port argument
364 defaults to `+postgresql-server-default-port+'.
366 Password is the clear-text password to be passed in the authentication
367 phase to the server. Depending on the server set-up, it is either
368 passed in the clear, or encrypted via crypt and a server-supplied
369 salt. In that case the alien function specified by `*crypt-library*'
370 and `*crypt-function-name*' is used for encryption.
372 Note that all the arguments (including the clear-text password
373 argument) are stored in the `postgresql-connection' structure, in
374 order to facilitate automatic reconnection in case of communication
376 (reopen-postgresql-connection
377 (make-postgresql-connection :host host :port port
378 :options (or options "") :tty (or tty "")
379 :database database :user user
380 :password (or password ""))))
382 (defun reopen-postgresql-connection (connection)
383 "Reopen the given PostgreSQL connection. Closes any existing
384 connection, if it is still open."
385 (when (postgresql-connection-open-p connection)
386 (close-postgresql-connection connection))
387 (let ((socket (open-postgresql-socket-stream
388 (postgresql-connection-host connection)
389 (postgresql-connection-port connection))))
392 (setf (postgresql-connection-socket connection) socket)
393 (send-startup-message socket
394 (postgresql-connection-database connection)
395 (postgresql-connection-user connection)
396 (postgresql-connection-options connection)
397 (postgresql-connection-tty connection))
398 (force-output socket)
400 (case (read-socket-value 'int8 socket)
401 (#.+authentication-message+
402 (case (read-socket-value 'int32 socket)
405 (error 'postgresql-login-error
406 :connection connection
408 "Postmaster expects unsupported Kerberos authentication."))
410 (send-unencrypted-password-message
412 (postgresql-connection-password connection)))
414 (let ((salt (make-string 2)))
415 (read-socket-sequence salt socket)
416 (send-encrypted-password-message
419 (postgresql-connection-password connection) salt))))
421 (error 'postgresql-login-error
422 :connection connection
424 "Postmaster expects unknown authentication method."))))
425 (#.+error-response-message+
426 (let ((message (read-socket-value 'string socket)))
427 (error 'postgresql-login-error
428 :connection connection :message message)))
430 (error 'postgresql-login-error
431 :connection connection
433 "Received garbled message from Postmaster"))))
434 ;; Start backend communication
435 (force-output socket)
437 (case (read-socket-value 'int8 socket)
438 (#.+backend-key-message+
439 (setf (postgresql-connection-pid connection)
440 (read-socket-value 'int32 socket)
441 (postgresql-connection-key connection)
442 (read-socket-value 'int32 socket)))
443 (#.+ready-for-query-message+
446 (#.+error-response-message+
447 (let ((message (read-socket-value 'string socket)))
448 (error 'postgresql-login-error
449 :connection connection
451 (#.+notice-response-message+
452 (let ((message (read-socket-value 'string socket)))
453 (warn 'postgresql-warning :connection connection
456 (error 'postgresql-login-error
457 :connection connection
459 "Received garbled message from Postmaster")))))
463 (defun close-postgresql-connection (connection &optional abort)
466 (send-terminate-message (postgresql-connection-socket connection))))
467 (close (postgresql-connection-socket connection)))
469 (defun postgresql-connection-open-p (connection)
470 (let ((socket (postgresql-connection-socket connection)))
471 (and socket (streamp socket) (open-stream-p socket))))
473 (defun ensure-open-postgresql-connection (connection)
474 (unless (postgresql-connection-open-p connection)
475 (reopen-postgresql-connection connection)))
477 (defun process-async-messages (connection)
478 (assert (postgresql-connection-open-p connection))
479 ;; Process any asnychronous messages
480 (loop with socket = (postgresql-connection-socket connection)
481 while (listen socket)
483 (case (read-socket-value 'int8 socket)
484 (#.+notice-response-message+
485 (let ((message (read-socket-value 'string socket)))
486 (warn 'postgresql-warning :connection connection
488 (#.+notification-response-message+
489 (let ((pid (read-socket-value 'int32 socket))
490 (message (read-socket-value 'string socket)))
491 (when (= pid (postgresql-connection-pid connection))
492 (signal 'postgresql-notification :connection connection
495 (close-postgresql-connection connection)
496 (error 'postgresql-fatal-error :connection connection
497 :message "Received garbled message from backend")))))
499 (defun start-query-execution (connection query)
500 (ensure-open-postgresql-connection connection)
501 (process-async-messages connection)
502 (send-query-message (postgresql-connection-socket connection) query)
503 (force-output (postgresql-connection-socket connection)))
505 (defun wait-for-query-results (connection)
506 (assert (postgresql-connection-open-p connection))
507 (let ((socket (postgresql-connection-socket connection))
511 (case (read-socket-value 'int8 socket)
512 (#.+completed-response-message+
513 (return (values :completed (read-socket-value 'string socket))))
514 (#.+cursor-response-message+
515 (setq cursor-name (read-socket-value 'string socket)))
516 (#.+row-description-message+
517 (let* ((count (read-socket-value 'int16 socket))
522 (read-socket-value 'string socket)
523 (read-socket-value 'int32 socket)
524 (read-socket-value 'int16 socket)
525 (read-socket-value 'int32 socket)))))
528 (make-postgresql-cursor :connection connection
531 (#.+copy-in-response-message+
533 (#.+copy-out-response-message+
535 (#.+ready-for-query-message+
539 (#.+error-response-message+
540 (let ((message (read-socket-value 'string socket)))
542 (make-condition 'postgresql-error
543 :connection connection :message message))))
544 (#.+notice-response-message+
545 (let ((message (read-socket-value 'string socket)))
546 (warn 'postgresql-warning
547 :connection connection :message message)))
548 (#.+notification-response-message+
549 (let ((pid (read-socket-value 'int32 socket))
550 (message (read-socket-value 'string socket)))
551 (when (= pid (postgresql-connection-pid connection))
552 (signal 'postgresql-notification :connection connection
555 (close-postgresql-connection connection)
556 (error 'postgresql-fatal-error :connection connection
557 :message "Received garbled message from backend"))))))
559 (defun read-null-bit-vector (socket count)
560 (let ((result (make-array count :element-type 'bit)))
561 (dotimes (offset (ceiling count 8))
562 (loop with byte = (read-byte socket)
563 for index from (* offset 8) below (min count (* (1+ offset) 8))
564 for weight downfrom 7
565 do (setf (aref result index) (ldb (byte 1 weight) byte))))
569 (defun read-field (socket type)
570 (let ((length (- (read-socket-value 'int32 socket) 4)))
573 (read-integer-from-socket socket length))
575 (read-double-from-socket socket length))
577 (let ((result (make-string length)))
578 (read-socket-sequence result socket)
581 (uffi:def-constant +char-code-zero+ (char-code #\0))
582 (uffi:def-constant +char-code-minus+ (char-code #\-))
583 (uffi:def-constant +char-code-plus+ (char-code #\+))
584 (uffi:def-constant +char-code-period+ (char-code #\.))
585 (uffi:def-constant +char-code-lower-e+ (char-code #\e))
586 (uffi:def-constant +char-code-upper-e+ (char-code #\E))
588 (defun read-integer-from-socket (socket length)
589 (declare (fixnum length))
593 (first-char (read-byte socket))
595 (declare (fixnum first-char))
596 (decf length) ;; read first char
598 ((= first-char +char-code-minus+)
600 ((= first-char +char-code-plus+)
603 (setq val (- first-char +char-code-zero+))))
609 (- (read-byte socket) +char-code-zero+))))
614 (defmacro ascii-digit (int)
615 (let ((offset (gensym)))
616 `(let ((,offset (- ,int +char-code-zero+)))
617 (declare (fixnum ,int ,offset))
618 (if (and (>= ,offset 0)
623 (defun read-double-from-socket (socket length)
624 (declare (fixnum length))
625 (let ((before-decimal 0)
632 (char (read-byte socket)))
633 (declare (fixnum char exponent decimal-count))
634 (decf length) ;; already read first character
636 ((= char +char-code-minus+)
638 ((= char +char-code-plus+)
640 ((= char +char-code-period+)
643 (setq before-decimal (ascii-digit char))
644 (unless before-decimal
645 (error "Unexpected value"))))
649 (setq char (read-byte socket))
650 ;; (format t "~&len:~D, i:~D, char:~D, minusp:~A, decimalp:~A" length i char minusp decimalp)
651 (let ((weight (ascii-digit char)))
653 ((and weight (not decimalp)) ;; before decimal point
654 (setq before-decimal (+ weight (* 10 before-decimal))))
655 ((and weight decimalp) ;; after decimal point
656 (setq after-decimal (+ weight (* 10 after-decimal)))
657 (incf decimal-count))
658 ((and (= char +char-code-period+))
660 ((or (= char +char-code-lower-e+) ;; E is for exponent
661 (= char +char-code-upper-e+))
662 (setq exponent (read-integer-from-socket socket (- length i 1)))
663 (setq exponent (or exponent 0))
666 (break "Unexpected value"))
669 (setq result (* (+ (coerce before-decimal 'double-float)
671 (expt 10 (- decimal-count))))
679 (defun read-double-from-socket (socket length)
680 (let ((result (make-string length)))
681 (read-socket-sequence result socket)
682 (let ((*read-default-float-format* 'double-float))
683 (read-from-string result))))
685 (defun read-cursor-row (cursor types)
686 (let* ((connection (postgresql-cursor-connection cursor))
687 (socket (postgresql-connection-socket connection))
688 (fields (postgresql-cursor-fields cursor)))
689 (assert (postgresql-connection-open-p connection))
691 (let ((code (read-socket-value 'int8 socket)))
693 (#.+ascii-row-message+
695 (loop with count = (length fields)
696 with null-vector = (read-null-bit-vector socket count)
698 for null-bit across null-vector
700 for null-p = (zerop null-bit)
705 (read-field socket (nth i types)))))
706 (#.+binary-row-message+
708 (#.+completed-response-message+
709 (return (values nil (read-socket-value 'string socket))))
710 (#.+error-response-message+
711 (let ((message (read-socket-value 'string socket)))
712 (error 'postgresql-error
713 :connection connection :message message)))
714 (#.+notice-response-message+
715 (let ((message (read-socket-value 'string socket)))
716 (warn 'postgresql-warning
717 :connection connection :message message)))
718 (#.+notification-response-message+
719 (let ((pid (read-socket-value 'int32 socket))
720 (message (read-socket-value 'string socket)))
721 (when (= pid (postgresql-connection-pid connection))
722 (signal 'postgresql-notification :connection connection
725 (close-postgresql-connection connection)
726 (error 'postgresql-fatal-error :connection connection
727 :message "Received garbled message from backend")))))))
729 (defun map-into-indexed (result-seq func seq)
730 (dotimes (i (length seq))
732 (setf (elt result-seq i)
733 (funcall func (elt seq i) i)))
736 (defun copy-cursor-row (cursor sequence types)
737 (let* ((connection (postgresql-cursor-connection cursor))
738 (socket (postgresql-connection-socket connection))
739 (fields (postgresql-cursor-fields cursor)))
740 (assert (= (length fields) (length sequence)))
742 (let ((code (read-socket-value 'int8 socket)))
744 (#.+ascii-row-message+
747 (let* ((count (length sequence))
748 (null-vector (read-null-bit-vector socket count)))
751 (if (zerop (elt null-vector i))
752 (setf (elt sequence i) nil)
753 (let ((value (read-field socket (nth i types))))
754 (setf (elt sequence i) value)))))
757 #'(lambda (null-bit i)
760 (read-field socket (nth i types))))
761 (read-null-bit-vector socket (length sequence)))))
762 (#.+binary-row-message+
764 (#.+completed-response-message+
765 (return (values nil (read-socket-value 'string socket))))
766 (#.+error-response-message+
767 (let ((message (read-socket-value 'string socket)))
768 (error 'postgresql-error
769 :connection connection :message message)))
770 (#.+notice-response-message+
771 (let ((message (read-socket-value 'string socket)))
772 (warn 'postgresql-warning
773 :connection connection :message message)))
774 (#.+notification-response-message+
775 (let ((pid (read-socket-value 'int32 socket))
776 (message (read-socket-value 'string socket)))
777 (when (= pid (postgresql-connection-pid connection))
778 (signal 'postgresql-notification :connection connection
781 (close-postgresql-connection connection)
782 (error 'postgresql-fatal-error :connection connection
783 :message "Received garbled message from backend")))))))
785 (defun skip-cursor-row (cursor)
786 (let* ((connection (postgresql-cursor-connection cursor))
787 (socket (postgresql-connection-socket connection))
788 (fields (postgresql-cursor-fields cursor)))
790 (let ((code (read-socket-value 'int8 socket)))
792 (#.+ascii-row-message+
793 (loop for null-bit across
794 (read-null-bit-vector socket (length fields))
796 (unless (zerop null-bit)
797 (let* ((length (read-socket-value 'int32 socket)))
798 (loop repeat (- length 4) do (read-byte socket)))))
800 (#.+binary-row-message+
802 (#.+completed-response-message+
803 (return (values nil (read-socket-value 'string socket))))
804 (#.+error-response-message+
805 (let ((message (read-socket-value 'string socket)))
806 (error 'postgresql-error
807 :connection connection :message message)))
808 (#.+notice-response-message+
809 (let ((message (read-socket-value 'string socket)))
810 (warn 'postgresql-warning
811 :connection connection :message message)))
812 (#.+notification-response-message+
813 (let ((pid (read-socket-value 'int32 socket))
814 (message (read-socket-value 'string socket)))
815 (when (= pid (postgresql-connection-pid connection))
816 (signal 'postgresql-notification :connection connection
819 (close-postgresql-connection connection)
820 (error 'postgresql-fatal-error :connection connection
821 :message "Received garbled message from backend")))))))
823 (defun run-query (connection query &optional (types nil))
824 (start-query-execution connection query)
825 (multiple-value-bind (status cursor)
826 (wait-for-query-results connection)
827 (assert (eq status :cursor))
828 (loop for row = (read-cursor-row cursor types)
832 (wait-for-query-results connection))))