(:float4 700)
(:float8 701)))
-(defmethod clsql-base-sys:database-type-library-loaded ((database-type
+(defmethod clsql-sys:database-type-library-loaded ((database-type
(eql :postgresql-socket)))
"T if foreign library was able to be loaded successfully. Always true for
socket interface"
t)
-(defmethod clsql-base-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
+(defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
t)
(defun send-socket-value-string (socket value)
(declare (type stream socket)
(type string value))
+ #-sb-unicode
(loop for char across value
- for code = (char-code char)
- do (write-byte code socket)
- finally (write-byte 0 socket))
+ for code = (char-code char)
+ do (write-byte code socket)
+ finally (write-byte 0 socket))
+ #+sb-unicode
+ (write-sequence (sb-ext:string-to-octets value :null-terminate t) socket)
nil)
(defun send-socket-value-limstring (socket value limit)
(defun read-socket-value-string (socket)
(declare (type stream socket))
+ #-sb-unicode
(with-output-to-string (out)
(loop for code = (read-byte socket)
- until (zerop code)
- do (write-char (code-char code) out))))
+ until (zerop code)
+ do (write-char (code-char code) out)))
+ #+sb-unicode
+ (let ((bytes (make-array 64
+ :element-type '(unsigned-byte 8)
+ :adjustable t
+ :fill-pointer 0)))
+ (loop for code = (read-byte socket)
+ until (zerop code)
+ do (vector-push-extend code bytes))
+ (sb-ext:octets-to-string bytes)))
(defmacro define-message-sender (name (&rest args) &rest clauses)
(int32 key))
-(defun read-socket-sequence (string stream)
+(defun read-socket-sequence (stream length)
"KMR -- Added to support reading from binary stream into a string"
- (declare (string string)
- (stream stream)
+ (declare (stream stream)
(optimize (speed 3) (safety 0)))
- (dotimes (i (length string))
- (declare (fixnum i))
- (setf (char string i) (code-char (read-byte stream))))
- string)
+ #-sb-unicode
+ (let ((result (make-string length)))
+ (dotimes (i length result)
+ (declare (fixnum i))
+ (setf (char result i) (code-char (read-byte stream)))))
+ #+sb-unicode
+ (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
+ (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
+ (read-sequence bytes stream)
+ (sb-ext:octets-to-string bytes)))
;;; Support for encrypted password transmission
#-scl
-(eval-when (compile eval load)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *crypt-library-loaded* nil)
(unless *crypt-library-loaded*
(uffi:load-foreign-library
(uffi:find-foreign-library "libcrypt"
- '("/usr/lib/" "/usr/local/lib/" "/lib/"))
+ '(#+(or 64bit x86-64) "/usr/lib64/"
+ "/usr/lib/" "/usr/local/lib/" "/lib/"))
:supporting-libraries '("c"))
(setq *crypt-library-loaded* t)))
(in-package :postgresql-socket)
-(uffi:def-function "crypt"
+(uffi:def-function ("crypt" crypt)
((key :cstring)
(salt :cstring))
:returning :cstring)
(etypecase host
(pathname
;; Directory to unix-domain socket
- (sb-bsd-sockets:socket-connect
- (namestring
- (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
- :defaults host))))
+ (let ((sock (make-instance 'sb-bsd-sockets:local-socket
+ :type :stream)))
+ (sb-bsd-sockets:socket-connect
+ sock
+ (namestring
+ (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
+ :defaults host)))
+ sock))
(string
(let ((sock (make-instance 'sb-bsd-sockets:inet-socket
:type :stream
:protocol :tcp)))
- (sb-bsd-sockets:socket-connect
+ (sb-bsd-sockets:socket-connect
sock
(sb-bsd-sockets:host-ent-address
(sb-bsd-sockets:get-host-by-name host))
(defun encrypt-md5 (plaintext salt)
(string-downcase
(format nil "~{~2,'0X~}"
- (coerce (md5:md5sum-sequence (concatenate 'string plaintext salt)) 'list))))
+ (coerce (md5sum-sequence (concatenate 'string plaintext salt)) 'list))))
(defun reopen-postgresql-connection (connection)
"Reopen the given PostgreSQL connection. Closes any existing
(3
(send-unencrypted-password-message
socket
- (postgresql-connection-password connection)))
+ (postgresql-connection-password connection))
+ (force-output socket))
(4
- (let ((salt (make-string 2)))
- (read-socket-sequence salt socket)
+ (let ((salt (read-socket-sequence socket 2)))
(send-encrypted-password-message
socket
(crypt-password
- (postgresql-connection-password connection) salt))))
+ (postgresql-connection-password connection) salt)))
+ (force-output socket))
(5
- (let ((salt (make-string 4)))
- (read-socket-sequence salt socket)
+ (let ((salt (read-socket-sequence socket 4)))
(let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
(postgresql-connection-user connection)))
(pwd (encrypt-md5 pwd2 salt)))
(send-encrypted-password-message
socket
- (concatenate 'string "md5" pwd)))))
+ (concatenate 'string "md5" pwd))))
+ (force-output socket))
(t
(error 'postgresql-login-error
:connection connection
while (listen socket)
do
(case (read-socket-value-int8 socket)
+ (#.+ready-for-query-message+)
(#.+notice-response-message+
(let ((message (read-socket-value-string socket)))
(warn 'postgresql-warning :connection connection
(force-output (postgresql-connection-socket connection)))
(defun wait-for-query-results (connection)
- (asse
-rt (postgresql-connection-open-p connection))
+ (assert (postgresql-connection-open-p connection))
(let ((socket (postgresql-connection-socket connection))
(cursor-name nil)
(error nil))
:connection connection :message message))))
(#.+notice-response-message+
(let ((message (read-socket-value-string socket)))
- (warn 'postgresql-warning
- :connection connection :message message)))
+ (unless (eq :ignore clsql-sys:*backend-warning-behavior*)
+ (warn 'postgresql-warning
+ :connection connection :message message))))
(#.+notification-response-message+
(let ((pid (read-socket-value-int32 socket))
(message (read-socket-value-string socket)))
(:double
(read-double-from-socket socket length))
(t
- (let ((result (make-string length)))
- (read-socket-sequence result socket)
- result)))))
+ (read-socket-sequence socket length)))))
(uffi:def-constant +char-code-zero+ (char-code #\0))
(uffi:def-constant +char-code-minus+ (char-code #\-))
projects / clsql.git / blobdiff