interfaces/postgresql-socket/postgresql-socket-api.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   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
   9 ;;;;
  10 ;;;; Date Started:  Feb 2002
  11 ;;;;
  12 ;;;; $Id: postgresql-socket-api.cl,v 1.2 2002/03/24 04:01:26 kevin Exp $
  13 ;;;;
  14 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  15 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
  16 ;;;;
  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 ;;;; *************************************************************************
  21
  22
  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
  30 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  31 (in-package :postgresql-socket)
  32
  33
  34 (defmethod database-type-library-loaded ((database-type
  35                                           (eql :postgresql-socket)))
  36   "T if foreign library was able to be loaded successfully. Always true for
  37 socket interface"
  38   t)
  39
  40
  41 ;;; Message I/O stuff
  42
  43 (defmacro define-message-constants (description &rest clauses)
  44   (assert (evenp (length clauses)))
  45   (loop with seen-characters = nil
  46         for (name char) on clauses by #'cddr
  47         for char-code = (char-code char)
  48         for doc-string = (format nil "~A (~:C): ~A" description char name)
  49         if (member char seen-characters)
  50         do (error "Duplicate message type ~@C for group ~A" char description)
  51         else
  52         collect
  53         `(defconstant ,name ,char-code ,doc-string)
  54         into result-clauses
  55         and do (push char seen-characters)
  56       finally
  57         (return `(progn ,@result-clauses))))
  58
  59 (eval-when (:compile-toplevel :load-toplevel :execute)
  60 (define-message-constants "Backend Message Constants"
  61   +ascii-row-message+ #\D
  62   +authentication-message+ #\R
  63   +backend-key-message+ #\K
  64   +binary-row-message+ #\B
  65   +completed-response-message+ #\C
  66   +copy-in-response-message+ #\G
  67   +copy-out-response-message+ #\H
  68   +cursor-response-message+ #\P
  69   +empty-query-response-message+ #\I
  70   +error-response-message+ #\E
  71   +function-response-message+ #\V
  72   +notice-response-message+ #\N
  73   +notification-response-message+ #\A
  74   +ready-for-query-message+ #\Z
  75   +row-description-message+ #\T))
  76
  77 (defgeneric send-socket-value (type socket value))
  78
  79 (defmethod send-socket-value ((type (eql 'int32)) socket (value integer))
  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))
  84
  85 (defmethod send-socket-value ((type (eql 'int16)) socket (value integer))
  86   (write-byte (ldb (byte 8 8) value) socket)
  87   (write-byte (ldb (byte 8 0) value) socket))
  88
  89 (defmethod send-socket-value ((type (eql 'int8)) socket (value integer))
  90   (write-byte (ldb (byte 8 0) value) socket))
  91
  92 (defmethod send-socket-value ((type (eql 'string)) socket (value string))
  93   (loop for char across value
  94         for code = (char-code char)
  95         do (write-byte code socket)
  96         finally (write-byte 0 socket)))
  97
  98 (defmethod send-socket-value ((type (eql 'limstring)) socket (value string))
  99   (loop for char across value
 100         for code = (char-code char)
 101         do (write-byte code socket)))
 102
 103 (defmethod send-socket-value ((type (eql 'byte)) socket (value integer))
 104   (write-byte value socket))
 105
 106 (defmethod send-socket-value ((type (eql 'byte)) socket (value character))
 107   (write-byte (char-code value) socket))
 108
 109 (defmethod send-socket-value ((type (eql 'byte)) socket value)
 110   (write-sequence value socket))
 111
 112 (defgeneric read-socket-value (type socket))
 113
 114 (defmethod read-socket-value ((type (eql 'int32)) socket)
 115   (let ((result 0))
 116     (setf (ldb (byte 8 24) result) (read-byte socket))
 117     (setf (ldb (byte 8 16) result) (read-byte socket))
 118     (setf (ldb (byte 8 8) result) (read-byte socket))
 119     (setf (ldb (byte 8 0) result) (read-byte socket))
 120     result))
 121
 122 (defmethod read-socket-value ((type (eql 'int16)) socket)
 123   (let ((result 0))
 124     (setf (ldb (byte 8 8) result) (read-byte socket))
 125     (setf (ldb (byte 8 0) result) (read-byte socket))
 126     result))
 127
 128 (defmethod read-socket-value ((type (eql 'int8)) socket)
 129   (read-byte socket))
 130
 131 (defmethod read-socket-value ((type (eql 'string)) socket)
 132   (with-output-to-string (out)
 133     (loop for code = (read-byte socket)
 134           until (zerop code)
 135           do (write-char (code-char code) out))))
 136
 137 (defgeneric skip-socket-value (type socket))
 138
 139 (defmethod skip-socket-value ((type (eql 'int32)) socket)
 140   (dotimes (i 4) (read-byte socket)))
 141
 142 (defmethod skip-socket-value ((type (eql 'int16)) socket)
 143   (dotimes (i 2) (read-byte socket)))
 144
 145 (defmethod skip-socket-value ((type (eql 'int8)) socket)
 146   (read-byte socket))
 147
 148 (defmethod skip-socket-value ((type (eql 'string)) socket)
 149   (loop until (zerop (read-byte socket))))
 150
 151 (defmacro define-message-sender (name (&rest args) &rest clauses)
 152   (loop with socket-var = (gensym)
 153         for (type value) in clauses
 154         collect
 155         `(send-socket-value ',type ,socket-var ,value)
 156         into body
 157       finally
 158         (return
 159           `(defun ,name (,socket-var ,@args)
 160              ,@body))))
 161
 162 (defun pad-limstring (string limit)
 163   (let ((result (make-string limit :initial-element #\NULL)))
 164     (loop for char across string
 165           for index from 0 below limit
 166           do (setf (char result index) char))
 167     result))
 168
 169 (define-message-sender send-startup-message
 170     (database user &optional (command-line "") (backend-tty ""))
 171   (int32 296)                           ; Length
 172   (int32 #x00020000)                    ; Version 2.0
 173   (limstring (pad-limstring database 64))
 174   (limstring (pad-limstring user 32))
 175   (limstring (pad-limstring command-line 64))
 176   (limstring (pad-limstring "" 64))     ; Unused
 177   (limstring (pad-limstring backend-tty 64)))
 178
 179 (define-message-sender send-terminate-message ()
 180   (byte #\X))
 181
 182 (define-message-sender send-unencrypted-password-message (password)
 183   (int32 (+ 5 (length password)))
 184   (string password))
 185
 186 (define-message-sender send-query-message (query)
 187   (byte #\Q)
 188   (string query))
 189
 190 (define-message-sender send-encrypted-password-message (crypted-password)
 191   (int32 (+ 5 (length crypted-password)))
 192   (string crypted-password))
 193
 194 (define-message-sender send-cancel-request (pid key)
 195   (int32 16)                            ; Length
 196   (int32 80877102)                      ; Magic
 197   (int32 pid)
 198   (int32 key))
 199
 200
 201 (defun read-socket-sequence (string stream)
 202 "KMR -- Added to support reading from binary stream into a string"
 203   (declare (optimize (speed 3) (safety 0)))
 204   (dotimes (i (length string))
 205     (declare (fixnum i))
 206     (setf (char string i) (code-char (read-byte stream))))
 207   string)
 208
 209
 210 ;;; Support for encrypted password transmission
 211
 212 (defconstant +crypt-library+ "/usr/lib/libcrypt.so"
 213   "Name of the shared library to load in order to access the crypt
 214 function named by `*crypt-function-name*'.")
 215
 216 (defvar *crypt-library-loaded* nil)
 217
 218 (defun crypt-password (password salt)
 219   "Encrypt a password for transmission to a PostgreSQL server."
 220   (unless *crypt-library-loaded*
 221     (uffi:load-foreign-library +crypt-library+ :supporting-libaries '("c"))
 222     (eval (uffi:def-function "crypt"
 223               ((key :cstring)
 224                (salt :cstring))
 225             :returning :cstring))
 226     (setq *crypt-library-loaded* t))
 227    (uffi:with-cstring (password-cstring password)
 228      (uffi:with-cstring (salt-cstring salt)
 229        (uffi:convert-from-cstring (crypt password-cstring salt-cstring)))))
 230 ;;; Condition hierarchy
 231
 232 (define-condition postgresql-condition (condition)
 233   ((connection :initarg :connection :reader postgresql-condition-connection)
 234    (message :initarg :message :reader postgresql-condition-message))
 235   (:report
 236    (lambda (c stream)
 237      (format stream "~@<~A occurred on connection ~A. ~:@_Reason: ~A~:@>"
 238              (type-of c)
 239              (postgresql-condition-connection c)
 240              (postgresql-condition-message c)))))
 241
 242 (define-condition postgresql-error (error postgresql-condition)
 243   ())
 244
 245 (define-condition postgresql-fatal-error (postgresql-error)
 246   ())
 247
 248 (define-condition postgresql-login-error (postgresql-fatal-error)
 249   ())
 250
 251 (define-condition postgresql-warning (warning postgresql-condition)
 252   ())
 253
 254 (define-condition postgresql-notification (postgresql-condition)
 255   ()
 256   (:report
 257    (lambda (c stream)
 258      (format stream "~@<Asynchronous notification on connection ~A: ~:@_~A~:@>"
 259              (postgresql-condition-connection c)
 260              (postgresql-condition-message c)))))
 261
 262 ;;; Structures
 263
 264 (defstruct postgresql-connection
 265   host
 266   port
 267   database
 268   user
 269   password
 270   options
 271   tty
 272   socket
 273   pid
 274   key)
 275
 276 (defstruct postgresql-cursor
 277   connection
 278   name
 279   fields)
 280
 281 ;;; Socket stuff
 282
 283 (defconstant +postgresql-server-default-port+ 5432
 284   "Default port of PostgreSQL server.")
 285
 286 (defvar *postgresql-server-socket-timeout* 60
 287   "Timeout in seconds for reads from the PostgreSQL server.")
 288
 289
 290 #+cmu
 291 (defun open-postgresql-socket (host port)
 292   (etypecase host
 293     (pathname
 294      ;; Directory to unix-domain socket
 295      (ext:connect-to-unix-socket
 296       (namestring
 297        (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
 298                       :defaults host))))
 299     (string
 300      (ext:connect-to-inet-socket host port))))
 301
 302 #+cmu
 303 (defun open-postgresql-socket-stream (host port)
 304   (system:make-fd-stream
 305    (open-postgresql-socket host port)
 306    :input t :output t :element-type '(unsigned-byte 8)
 307    :buffering :none
 308    :timeout *postgresql-server-socket-timeout*))
 309
 310 #+allegro
 311 (defun open-postgresql-socket-stream (host port)
 312   (etypecase host
 313     (pathname
 314      (let ((path (namestring
 315                   (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
 316                                  :defaults host))))
 317        (socket:make-socket :type :stream :address-family :file
 318                            :connect :active
 319                            :remote-filename path :local-filename path)))
 320     (string
 321      (socket:with-pending-connect
 322          (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed"))
 323            (socket:make-socket :type :stream :address-family :internet
 324                                :remote-port port :remote-host host
 325                                :connect :active :nodelay t))))
 326     ))
 327
 328 #+lispworks
 329 (defun open-postgresql-socket-stream (host port)
 330   (etypecase host
 331     (pathname
 332      (error "File sockets not supported on Lispworks."))
 333     (string
 334      (comm:open-tcp-stream host port :direction :io :element-type '(unsigned-byte 8)
 335                            :read-timeout *postgresql-server-socket-timeout*))
 336     ))
 337
 338 ;;; Interface Functions
 339
 340 (defun open-postgresql-connection (&key (host (cmucl-compat:required-argument))
 341                                         (port +postgresql-server-default-port+)
 342                                         (database (cmucl-compat:required-argument))
 343                                         (user (cmucl-compat:required-argument))
 344                                         options tty password)
 345   "Open a connection to a PostgreSQL server with the given parameters.
 346 Note that host, database and user arguments must be supplied.
 347
 348 If host is a pathname, it is assumed to name a directory containing
 349 the local unix-domain sockets of the server, with port selecting which
 350 of those sockets to open.  If host is a string, it is assumed to be
 351 the name of the host running the PostgreSQL server.  In that case a
 352 TCP connection to the given port on that host is opened in order to
 353 communicate with the server.  In either case the port argument
 354 defaults to `+postgresql-server-default-port+'.
 355
 356 Password is the clear-text password to be passed in the authentication
 357 phase to the server.  Depending on the server set-up, it is either
 358 passed in the clear, or encrypted via crypt and a server-supplied
 359 salt.  In that case the alien function specified by `*crypt-library*'
 360 and `*crypt-function-name*' is used for encryption.
 361
 362 Note that all the arguments (including the clear-text password
 363 argument) are stored in the `postgresql-connection' structure, in
 364 order to facilitate automatic reconnection in case of communication
 365 troubles."
 366   (reopen-postgresql-connection
 367    (make-postgresql-connection :host host :port port
 368                                :options (or options "") :tty (or tty "")
 369                                :database database :user user
 370                                :password (or password ""))))
 371
 372 (defun reopen-postgresql-connection (connection)
 373   "Reopen the given PostgreSQL connection.  Closes any existing
 374 connection, if it is still open."
 375   (when (postgresql-connection-open-p connection)
 376     (close-postgresql-connection connection))
 377   (let ((socket (open-postgresql-socket-stream
 378                   (postgresql-connection-host connection)
 379                   (postgresql-connection-port connection))))
 380     (unwind-protect
 381          (progn
 382            (setf (postgresql-connection-socket connection) socket)
 383            (send-startup-message socket
 384                                  (postgresql-connection-database connection)
 385                                  (postgresql-connection-user connection)
 386                                  (postgresql-connection-options connection)
 387                                  (postgresql-connection-tty connection))
 388            (force-output socket)
 389            (loop
 390                (case (read-socket-value 'int8 socket)
 391                  (#.+authentication-message+
 392                   (case (read-socket-value 'int32 socket)
 393                     (0 (return))
 394                     ((1 2)
 395                      (error 'postgresql-login-error
 396                             :connection connection
 397                             :message
 398                             "Postmaster expects unsupported Kerberos authentication."))
 399                     (3
 400                      (send-unencrypted-password-message
 401                       socket
 402                       (postgresql-connection-password connection)))
 403                     (4
 404                      (let ((salt (make-string 2)))
 405                        (read-socket-sequence salt socket)
 406                        (send-encrypted-password-message
 407                         socket
 408                         (crypt-password
 409                          (postgresql-connection-password connection) salt))))
 410                     (t
 411                      (error 'postgresql-login-error
 412                             :connection connection
 413                             :message
 414                             "Postmaster expects unknown authentication method."))))
 415                  (#.+error-response-message+
 416                   (let ((message (read-socket-value 'string socket)))
 417                     (error 'postgresql-login-error
 418                            :connection connection :message message)))
 419                  (t
 420                   (error 'postgresql-login-error
 421                          :connection connection
 422                          :message
 423                          "Received garbled message from Postmaster"))))
 424            ;; Start backend communication
 425            (force-output socket)
 426            (loop
 427                (case (read-socket-value 'int8 socket)
 428                  (#.+backend-key-message+
 429                   (setf (postgresql-connection-pid connection)
 430                         (read-socket-value 'int32 socket)
 431                         (postgresql-connection-key connection)
 432                         (read-socket-value 'int32 socket)))
 433                  (#.+ready-for-query-message+
 434                   (setq socket nil)
 435                   (return connection))
 436                  (#.+error-response-message+
 437                   (let ((message (read-socket-value 'string socket)))
 438                     (error 'postgresql-login-error
 439                            :connection connection
 440                            :message message)))
 441                  (#.+notice-response-message+
 442                   (let ((message (read-socket-value 'string socket)))
 443                     (warn 'postgresql-warning :connection connection
 444                           :message message)))
 445                  (t
 446                   (error 'postgresql-login-error
 447                          :connection connection
 448                          :message
 449                          "Received garbled message from Postmaster")))))
 450       (when socket
 451         (close socket)))))
 452
 453 (defun close-postgresql-connection (connection &optional abort)
 454   (unless abort
 455     (ignore-errors
 456       (send-terminate-message (postgresql-connection-socket connection))))
 457   (close (postgresql-connection-socket connection)))
 458
 459 (defun postgresql-connection-open-p (connection)
 460   (let ((socket (postgresql-connection-socket connection)))
 461     (and socket (streamp socket) (open-stream-p socket))))
 462
 463 (defun ensure-open-postgresql-connection (connection)
 464   (unless (postgresql-connection-open-p connection)
 465     (reopen-postgresql-connection connection)))
 466
 467 (defun process-async-messages (connection)
 468   (assert (postgresql-connection-open-p connection))
 469   ;; Process any asnychronous messages
 470   (loop with socket = (postgresql-connection-socket connection)
 471         while (listen socket)
 472         do
 473         (case (read-socket-value 'int8 socket)
 474           (#.+notice-response-message+
 475            (let ((message (read-socket-value 'string socket)))
 476              (warn 'postgresql-warning :connection connection
 477                    :message message)))
 478           (#.+notification-response-message+
 479            (let ((pid (read-socket-value 'int32 socket))
 480                  (message (read-socket-value 'string socket)))
 481              (when (= pid (postgresql-connection-pid connection))
 482                (signal 'postgresql-notification :connection connection
 483                        :message message))))
 484           (t
 485            (close-postgresql-connection connection)
 486            (error 'postgresql-fatal-error :connection connection
 487                   :message "Received garbled message from backend")))))
 488
 489 (defun start-query-execution (connection query)
 490   (ensure-open-postgresql-connection connection)
 491   (process-async-messages connection)
 492   (send-query-message (postgresql-connection-socket connection) query)
 493   (force-output (postgresql-connection-socket connection)))
 494
 495 (defun wait-for-query-results (connection)
 496   (assert (postgresql-connection-open-p connection))
 497   (let ((socket (postgresql-connection-socket connection))
 498         (cursor-name nil)
 499         (error nil))
 500     (loop
 501         (case (read-socket-value 'int8 socket)
 502           (#.+completed-response-message+
 503            (return (values :completed (read-socket-value 'string socket))))
 504           (#.+cursor-response-message+
 505            (setq cursor-name (read-socket-value 'string socket)))
 506           (#.+row-description-message+
 507            (let* ((count (read-socket-value 'int16 socket))
 508                   (fields
 509                    (loop repeat count
 510                      collect
 511                      (list
 512                       (read-socket-value 'string socket)
 513                       (read-socket-value 'int32 socket)
 514                       (read-socket-value 'int16 socket)
 515                       (read-socket-value 'int32 socket)))))
 516              (return
 517                (values :cursor
 518                        (make-postgresql-cursor :connection connection
 519                                                :name cursor-name
 520                                                :fields fields)))))
 521           (#.+copy-in-response-message+
 522            (return :copy-in))
 523           (#.+copy-out-response-message+
 524            (return :copy-out))
 525           (#.+ready-for-query-message+
 526            (when error
 527              (error error))
 528            (return nil))
 529           (#.+error-response-message+
 530            (let ((message (read-socket-value 'string socket)))
 531              (setq error
 532                    (make-condition 'postgresql-error
 533                                    :connection connection :message message))))
 534           (#.+notice-response-message+
 535            (let ((message (read-socket-value 'string socket)))
 536              (warn 'postgresql-warning
 537                    :connection connection :message message)))
 538           (#.+notification-response-message+
 539            (let ((pid (read-socket-value 'int32 socket))
 540                  (message (read-socket-value 'string socket)))
 541              (when (= pid (postgresql-connection-pid connection))
 542                (signal 'postgresql-notification :connection connection
 543                        :message message))))
 544           (t
 545            (close-postgresql-connection connection)
 546            (error 'postgresql-fatal-error :connection connection
 547                   :message "Received garbled message from backend"))))))
 548
 549 (defun read-null-bit-vector (socket count)
 550   (let ((result (make-array count :element-type 'bit)))
 551     (dotimes (offset (ceiling count 8))
 552       (loop with byte = (read-byte socket)
 553             for index from (* offset 8) below (min count (* (1+ offset) 8))
 554             for weight downfrom 7
 555             do (setf (aref result index) (ldb (byte 1 weight) byte))))
 556     result))
 557
 558 (defun read-cursor-row (cursor)
 559   (let* ((connection (postgresql-cursor-connection cursor))
 560          (socket (postgresql-connection-socket connection))
 561          (fields (postgresql-cursor-fields cursor)))
 562     (assert (postgresql-connection-open-p connection))
 563     (loop
 564         (let ((code (read-socket-value 'int8 socket)))
 565           (case code
 566             (#.+ascii-row-message+
 567              (return
 568                (loop with count = (length fields)
 569                      with null-vector = (read-null-bit-vector socket count)
 570                      repeat count
 571                      for null-bit across null-vector
 572                      for null-p = (zerop null-bit)
 573                      if null-p
 574                      collect nil
 575                      else
 576                      collect
 577                      (let* ((length (read-socket-value 'int32 socket))
 578                             (result (make-string (- length 4))))
 579                        (read-socket-sequence result socket)
 580                        result))))
 581             (#.+binary-row-message+
 582              (error "NYI"))
 583             (#.+completed-response-message+
 584              (return (values nil (read-socket-value 'string socket))))
 585             (#.+error-response-message+
 586              (let ((message (read-socket-value 'string socket)))
 587                (error 'postgresql-error
 588                       :connection connection :message message)))
 589             (#.+notice-response-message+
 590              (let ((message (read-socket-value 'string socket)))
 591                (warn 'postgresql-warning
 592                      :connection connection :message message)))
 593             (#.+notification-response-message+
 594              (let ((pid (read-socket-value 'int32 socket))
 595                    (message (read-socket-value 'string socket)))
 596                (when (= pid (postgresql-connection-pid connection))
 597                  (signal 'postgresql-notification :connection connection
 598                          :message message))))
 599             (t
 600              (close-postgresql-connection connection)
 601              (error 'postgresql-fatal-error :connection connection
 602                     :message "Received garbled message from backend")))))))
 603
 604 (defun copy-cursor-row (cursor sequence)
 605   (let* ((connection (postgresql-cursor-connection cursor))
 606          (socket (postgresql-connection-socket connection))
 607          (fields (postgresql-cursor-fields cursor)))
 608     (assert (= (length fields) (length sequence)))
 609     (loop
 610         (let ((code (read-socket-value 'int8 socket)))
 611           (case code
 612             (#.+ascii-row-message+
 613              (return
 614                (map-into
 615                 sequence
 616                 #'(lambda (null-bit)
 617                     (if (zerop null-bit)
 618                         nil
 619                         (let* ((length (read-socket-value 'int32 socket))
 620                                (result (make-string (- length 4))))
 621                           (read-socket-sequence result socket)
 622                           result)))
 623                 (read-null-bit-vector socket (length sequence)))))
 624             (#.+binary-row-message+
 625              (error "NYI"))
 626             (#.+completed-response-message+
 627              (return (values nil (read-socket-value 'string socket))))
 628             (#.+error-response-message+
 629              (let ((message (read-socket-value 'string socket)))
 630                (error 'postgresql-error
 631                       :connection connection :message message)))
 632             (#.+notice-response-message+
 633              (let ((message (read-socket-value 'string socket)))
 634                (warn 'postgresql-warning
 635                      :connection connection :message message)))
 636             (#.+notification-response-message+
 637              (let ((pid (read-socket-value 'int32 socket))
 638                    (message (read-socket-value 'string socket)))
 639                (when (= pid (postgresql-connection-pid connection))
 640                  (signal 'postgresql-notification :connection connection
 641                          :message message))))
 642             (t
 643              (close-postgresql-connection connection)
 644              (error 'postgresql-fatal-error :connection connection
 645                     :message "Received garbled message from backend")))))))
 646
 647 (defun skip-cursor-row (cursor)
 648   (let* ((connection (postgresql-cursor-connection cursor))
 649          (socket (postgresql-connection-socket connection))
 650          (fields (postgresql-cursor-fields cursor)))
 651     (loop
 652         (let ((code (read-socket-value 'int8 socket)))
 653           (case code
 654             (#.+ascii-row-message+
 655              (loop for null-bit across
 656                    (read-null-bit-vector socket (length fields))
 657                    do
 658                    (unless (zerop null-bit)
 659                      (let* ((length (read-socket-value 'int32 socket)))
 660                        (loop repeat (- length 4) do (read-byte socket)))))
 661              (return t))
 662             (#.+binary-row-message+
 663              (error "NYI"))
 664             (#.+completed-response-message+
 665              (return (values nil (read-socket-value 'string socket))))
 666             (#.+error-response-message+
 667              (let ((message (read-socket-value 'string socket)))
 668                (error 'postgresql-error
 669                       :connection connection :message message)))
 670             (#.+notice-response-message+
 671              (let ((message (read-socket-value 'string socket)))
 672                (warn 'postgresql-warning
 673                      :connection connection :message message)))
 674             (#.+notification-response-message+
 675              (let ((pid (read-socket-value 'int32 socket))
 676                    (message (read-socket-value 'string socket)))
 677                (when (= pid (postgresql-connection-pid connection))
 678                  (signal 'postgresql-notification :connection connection
 679                          :message message))))
 680             (t
 681              (close-postgresql-connection connection)
 682              (error 'postgresql-fatal-error :connection connection
 683                     :message "Received garbled message from backend")))))))
 684
 685 (defun run-query (connection query)
 686   (start-query-execution connection query)
 687   (multiple-value-bind (status cursor)
 688       (wait-for-query-results connection)
 689     (assert (eq status :cursor))
 690     (loop for row = (read-cursor-row cursor)
 691           while row
 692           collect row
 693           finally
 694           (wait-for-query-results connection))))