Commit c7aa6ad2 authored by Eric Marsden's avatar Eric Marsden

add a file that does a manual load of pg

parent a9494ec2
......@@ -82,7 +82,7 @@ Needed to define the type of objects in pg-prepare")
("money" . ,'text-parser) ; "$12.34"
("abstime" . ,'timestamp-parser)
("date" . ,'date-parser)
("timestamp" . ,'timestamp-parser)
("timestamp" . ,'timestamp-parser) ; or 'precise-timestamp-parser if you want milliseconds
("timestamptz" . ,'timestamp-parser)
("datetime" . ,'timestamp-parser)
("time" . ,'text-parser) ; preparsed "15:32:45"
......
;;; pg-tests.lisp -- incomplete test suite
;;;
;;; Author: Eric Marsden <emarsden@laas.fr>
;;; Time-stamp: <2004-03-08 emarsden>
;;
;;
;;
;; These tests assume that a table named "test" is defined in the
......@@ -17,7 +15,7 @@
;; !!! CHANGE THE VALUES HERE !!!
(defun call-with-test-connection (function)
(with-pg-connection (conn "template1" "emarsden" :host nil :port 5432)
(with-pg-connection (conn "test" "pgdotlisp" :host "melbourne" :port 5433 :password "lisp")
(funcall function conn)))
(defmacro with-test-connection ((conn) &body body)
......@@ -348,31 +346,32 @@ between files /etc/group and /tmp/group")))
(pg-exec conn "DROP TABLE foo")))
(defun test ()
(with-test-connection (conn)
(format t "Running pg.lisp tests against backend ~a~%" (pg-backend-version conn))
;; client encoding supported since PostgreSQL v7.1
(format t "Client encoding is ~A~%" (pg-client-encoding conn))
(format t "Date style is ~A~%" (pg-date-style conn))
(let ((r2 (pg-exec conn "CREATE TABLE pgltest (a int, b float, c money)"))
(r3 (pg-exec conn "INSERT INTO pgltest VALUES (3, -1234.5e67, '$123.45')"))
(r4 (pg-exec conn "DROP TABLE pgltest")))
(format t "~%==============================================~%")
(format t "status of CREATE is ~s~%" (pg-result r2 :status))
(format t "status of INSERT is ~s~%" (pg-result r3 :status))
(format t "oid of INSERT is ~s~%" (pg-result r3 :oid))
(format t "status of DROP is ~s~%" (pg-result r4 :status))
(format t "==============================================~%")))
(test-simple)
(test-insert)
(test-insert/float)
(test-date)
(test-booleans)
(test-integrity)
(test-notifications)
(test-lo)
(test-lo-read)
#+cmu (test-lo-import)
(test-pbe))
(let ((*pg-client-encoding* "UNICODE"))
(with-test-connection (conn)
(format t "Running pg.lisp tests against backend ~a~%" (pg-backend-version conn))
;; client encoding supported since PostgreSQL v7.1
(format t "Client encoding is ~A~%" (pg-client-encoding conn))
(format t "Date style is ~A~%" (pg-date-style conn))
(let ((r2 (pg-exec conn "CREATE TABLE pgltest (a int, b float, c money)"))
(r3 (pg-exec conn "INSERT INTO pgltest VALUES (3, -1234.5e67, '$123.45')"))
(r4 (pg-exec conn "DROP TABLE pgltest")))
(format t "~%==============================================~%")
(format t "status of CREATE is ~s~%" (pg-result r2 :status))
(format t "status of INSERT is ~s~%" (pg-result r3 :status))
(format t "oid of INSERT is ~s~%" (pg-result r3 :oid))
(format t "status of DROP is ~s~%" (pg-result r4 :status))
(format t "==============================================~%")))
(test-simple)
(test-insert)
(test-insert/float)
(test-date)
(test-booleans)
(test-integrity)
(test-notifications)
(test-lo)
(test-lo-read)
#+cmu (test-lo-import)
(test-pbe)))
;; EOF
......@@ -10,7 +10,7 @@
#+cmu
(defmethod perform :before ((o load-op) (c pg-component))
(ext:load-foreign "/usr/lib/libcrypt.a"))
(ext:load-foreign "/usr/lib/libcrypt.so"))
(defsystem :pg
:name "Socket-level PostgreSQL interface"
......
;;; stone-age-load.lisp
;;;
;;; Author: Eric Marsden <emarsden>
;;; Time-stamp: <2004-04-01 emarsden>
(load "defpackage.lisp")
(load (compile-file "md5.lisp"))
(load (compile-file "meta-queries.lisp"))
(load (compile-file "sysdep.lisp"))
(load (compile-file "parsers.lisp"))
(load (compile-file "utility.lisp"))
(load (compile-file "lowlevel.lisp"))
(load (compile-file "pg.lisp"))
(load (compile-file "large-object.lisp"))
(load (compile-file "v2-protocol.lisp"))
(load (compile-file "v3-protocol.lisp"))
;; EOF
;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp
;;;
;;; Author: Eric Marsden <emarsden@laas.fr>
;;; Time-stamp: <2004-04-01 emarsden>
;;; Time-stamp: <2004-04-23 emarsden>
;;
;;
......@@ -15,6 +15,13 @@
#+(and mcl (not openmcl)) (require "OPENTRANSPORT"))
(defmacro %sysdep (desc &rest forms)
(when (null forms)
(error "No system dependent code to ~A" desc))
(car forms))
#+(and cmu glibc2)
(eval-when (:compile-toplevel :load-toplevel)
(format t ";; Loading libcrypt~%")
......@@ -294,4 +301,35 @@
:transport-error e))))
;;; character encoding support
(defvar *pg-client-encoding*)
(defun convert-string-to-bytes (string &optional (encoding *pg-client-encoding*))
(declare (type string string))
(%sysdep "convert string to bytes"
#+(and clisp unicode)
(ext:convert-string-to-bytes string encoding)
#+(and acl ics)
(excl:string-to-octets string :external-format encoding)
#+(or cmu sbcl gcl ecl)
(let ((octets (make-array (length string) :element-type '(unsigned-byte 8))))
(map-into octets #'char-code string))))
(defun convert-string-from-bytes (bytes &optional (encoding *pg-client-encoding*))
(declare (type (vector (unsigned-byte 8)) bytes))
(%sysdep "convert octet-array to string"
#+(and clisp unicode)
(ext:convert-string-from-bytes bytes encoding)
#+(and acl ics)
(ext:octets-to-string bytes :external-format encoding)
;; for implementations that have no support for character
;; encoding, we assume that the encoding is an octet-for-octet
;; encoding, and convert directly
#+(or cmu sbcl gcl ecl)
(let ((string (make-string (length bytes))))
(map-into string #'code-char bytes))))
;; EOF
......@@ -7,6 +7,8 @@
(defclass pgcon-v3 (pgcon)
((parameters :accessor pgcon-parameters
:initform (list))
(encoding :accessor pgcon-encoding
:initform nil)
(sql-stream :initform nil
:accessor pgcon-sql-stream
:type (or null stream))))
......@@ -77,7 +79,9 @@
(data :initarg :data
:type (array (unsigned-byte 8) *))
(position :initform 0
:type integer)))
:type integer)
(connection :initarg :connection
:type pgcon-v3)))
(defmethod print-object ((object pg-packet) stream)
(print-unreadable-object (object stream :type t :identity t)
......@@ -159,7 +163,8 @@ but will still return them"
(packet (make-instance 'pg-packet
:type (code-char type)
:length length
:data data)))
:data data
:connection connection)))
(case (pg-packet-type packet)
(( #\E) ; error
(read-and-generate-error-response packet)
......@@ -224,16 +229,14 @@ but will still return them"
(1+ (logxor result
#xFFFFFFFF)))))
result)))
(:method ((packet pg-packet) (type (eql :cstring)))
(with-slots (data position)
packet
;; a string that does not get encoded
(:method ((packet pg-packet) (type (eql :ucstring)))
(with-slots (data position) packet
(let* ((end (position 0 data :start position))
;; end is where the 0 byte is
(result (unless (= end position)
(result (unless (eql end position)
(make-array (- end position)
:element-type 'base-char))))
;; FIXME need to handle charset encoding issues here
(when result
(loop :for i :from position :below end
:for j :from 0
......@@ -242,7 +245,22 @@ but will still return them"
(code-char
(elt data i))))
(setf position (1+ end))
result)))))
result))))
;; a string that does get encoded, if the current connection has set
;; its prefered encoding
(:method ((packet pg-packet) (type (eql :cstring)))
(with-slots (data position connection) packet
(cond ((pgcon-encoding connection)
(let* ((end (position 0 data :start position))
(result (unless (eql end position)
(convert-string-from-bytes (subseq data position end)))))
(when result (setf position (1+ end)))
result))
;; the encoding has not yet been set, so revert to :ucstring behaviour
(t
(read-from-packet packet :ucstring))))))
;; FIXME need to check all callers of this function to distinguish
;; between uses that expect charset encoding to be handled, and those
......@@ -287,10 +305,8 @@ value of the parameter"
((:byte :char) 1)
((:int16) 2)
((:int32) 4)
((:cstring
:rawdata)
(+ 1
(length value)))))))
((:cstring) (1+ (length (convert-string-to-bytes value))))
((:ucstring :rawdata) (1+ (length value)))))))
(data (make-array (- length 4)
:element-type '(unsigned-byte 8)))
(stream (pgcon-stream connection)))
......@@ -320,12 +336,9 @@ value of the parameter"
(setf (elt data (+ 2 position)) (ldb (byte 8 8) value))
(setf (elt data (+ 3 position)) (ldb (byte 8 0) value))
(incf position 4))
;; FIXME need to deal with text encoding issues here:
;; transform from the Lisp string representation to the
;; encoding selected by *PG-CLIENT-ENCODING*.
((:cstring)
(check-type value string)
((:ucstring)
(check-type value string)
(loop for char across value
do
(setf (elt data position)
......@@ -333,9 +346,17 @@ value of the parameter"
(incf position))
(setf (elt data position) 0)
(incf position))
((:cstring)
(check-type value string)
(let ((encoded (convert-string-to-bytes value)))
(replace data encoded :start1 position)
(incf position (length encoded)))
(setf (elt data position) 0)
(incf position))
((:rawdata)
(check-type value (array (unsigned-byte 8) *))
(replace data value :start1 position)
(incf position (length value)))))
......@@ -392,14 +413,14 @@ to connect to the database using a Unix socket."
(error 'authentication-failure
:reason "Kerberos5 authentication not supported"))
((3) ; AuthUnencryptedPassword
(send-packet connection #\p `((:cstring ,password)))
(send-packet connection #\p `((:ucstring ,password)))
(%flush connection))
((4) ; AuthEncryptedPassword
(let* ((salt (read-string-from-packet packet 2))
(crypted (crypt password salt)))
#+debug
(format *debug-io* "CryptAuth: Got salt of ~s~%" salt)
(send-packet connection #\p `((:cstring ,crypted)))
(send-packet connection #\p `((:ucstring ,crypted)))
(%flush connection)))
((5) ; AuthMD5Password
#+debug
......@@ -407,7 +428,7 @@ to connect to the database using a Unix socket."
(force-output *debug-io*)
(let* ((salt (read-string-from-packet packet 4))
(ciphered (md5-encode-password user password salt)))
(send-packet connection #\p `((:cstring ,ciphered)))
(send-packet connection #\p `((:ucstring ,ciphered)))
(%flush connection)))
((6) ; AuthSCMPassword
(error 'authentication-failure
......@@ -425,8 +446,8 @@ to connect to the database using a Unix socket."
(setf (pgcon-secret connection) secret)))
(( #\S)
;; Status
(let* ((parameter (read-from-packet packet :cstring))
(value (read-from-packet packet :cstring)))
(let* ((parameter (read-from-packet packet :ucstring))
(value (read-from-packet packet :ucstring)))
(push (cons parameter value) (pgcon-parameters connection))))
((#\Z)
;; Ready for Query
......@@ -435,14 +456,14 @@ to connect to the database using a Unix socket."
(char-code #\I))
(warn "~&Got status ~S but wanted I~%"
(code-char status)))
(when *pg-client-encoding*
(setf (pg-client-encoding connection) *pg-client-encoding*))
(and (not *pg-disable-type-coercion*)
(null *parsers*)
(initialize-parsers connection))
(when *pg-date-style*
(setf (pg-date-style connection) *pg-date-style*))
(when *pg-client-encoding*
(setf (pg-client-encoding connection) *pg-client-encoding*))
(return connection)))
((#\E)
;; an error, we should abort.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment