April 2004 - pg-cvs@common-lisp.net - mailman3.common-lisp.net

[pg-cvs] CVS update: pg/v3-protocol.lisp
by Eric Marsden 22 Apr '04

22 Apr '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv6507 Modified Files: v3-protocol.lisp Log Message: Comment-only patch: mark the places in the v3-protocol code where charset encoding problems will have to be addressed. It's probably not worth going through the v2-protocol code to fix these issues, since it has too many places where READ-CSTRING is confused with READ-OCTET-ARRAY. Date: Thu Apr 22 13:00:12 2004 Author: emarsden Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.10 pg/v3-protocol.lisp:1.11 --- pg/v3-protocol.lisp:1.10 Wed Apr 21 15:27:46 2004 +++ pg/v3-protocol.lisp Thu Apr 22 13:00:12 2004 @@ -233,6 +233,7 @@ (result (unless (= 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 @@ -243,6 +244,9 @@ (setf position (1+ end)) result))))) +;; FIXME need to check all callers of this function to distinguish +;; between uses that expect charset encoding to be handled, and those +;; that really want READ-OCTET-ARRAY-FROM-PACKET (defgeneric read-string-from-packet (packet length) (:documentation "Reads an array of LENGTH bytes from the packet") @@ -316,6 +320,9 @@ (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)

1 0

[pg-cvs] CVS update: pg/defpackage.lisp
by Eric Marsden 22 Apr '04

22 Apr '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv5065 Modified Files: defpackage.lisp Log Message: - export the *PG-CLIENT-ENCODING* variable from the PG package Date: Thu Apr 22 12:57:39 2004 Author: emarsden Index: pg/defpackage.lisp diff -u pg/defpackage.lisp:1.3 pg/defpackage.lisp:1.4 --- pg/defpackage.lisp:1.3 Tue Mar 9 11:27:20 2004 +++ pg/defpackage.lisp Thu Apr 22 12:57:39 2004 @@ -8,6 +8,7 @@ (:export #:pg-connect #:pg-exec #:pg-result #:pg-disconnect #:pgcon-sql-stream #:*pg-disable-type-coercion* + #:*pg-client-encoding* #:pg-databases #:pg-tables #:pg-columns #:pg-backend-version #:pg-date-style

1 0

[pg-cvs] CVS update: pg/v3-protocol.lisp
by Eric Marsden 21 Apr '04

21 Apr '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv23077 Modified Files: v3-protocol.lisp Log Message: A provisional fix for large object support: the test case (whose large-object component only runs on CMUCL) was resetting the connection during the IMPORT/EXPORT test, due to an unexpected #\V packet (FunctionCallResponse) in DO-FOLLOWUP-QUERY. It's still not clear why a FunctionCallResponse should be received anywhere other than in FN. This test is currently failing due to CR -> "\012" corruption that I haven't debugged. Date: Wed Apr 21 15:27:47 2004 Author: emarsden Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.9 pg/v3-protocol.lisp:1.10 --- pg/v3-protocol.lisp:1.9 Thu Apr 1 13:35:19 2004 +++ pg/v3-protocol.lisp Wed Apr 21 15:27:46 2004 @@ -579,8 +579,14 @@ ;; PortalSuspend ;; we're done in any case: (return result)) - ((#\2 - ;; BindComplete + ((#\V) + ;; FunctionCallResponse -- not clear why we would get these here instead of in FN + (let* ((length (read-from-packet packet :int32)) + (response (unless (= length -1) + (read-string-from-packet packet length)))) + (setf (pgresult-status result) response))) + ((#\2 + ;; BindComplete #\1 ;; ParseComplete #\3 @@ -709,7 +715,7 @@ :for packet = (read-packet connection) :do (case (pg-packet-type packet) - ((#\V) + ((#\V) ; FunctionCallResponse (let* ((length (read-from-packet packet :int32)) (data (unless (= length -1) (if integer-result

1 0

[pg-cvs] CVS update: pg/parsers.lisp
by Eric Marsden 21 Apr '04

21 Apr '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv13664 Modified Files: parsers.lisp Log Message: >From Sven Van Caekenberghe: - fix to PARSE-TIMESTAMP when no milliseconds are present - make use of :start and :end arguments to PARSE-INTEGER to reduce consing Date: Wed Apr 21 15:23:18 2004 Author: emarsden Index: pg/parsers.lisp diff -u pg/parsers.lisp:1.2 pg/parsers.lisp:1.3 --- pg/parsers.lisp:1.2 Mon Mar 8 09:37:36 2004 +++ pg/parsers.lisp Wed Apr 21 15:23:18 2004 @@ -1,7 +1,6 @@ ;;; parsers.lisp -- type coercion support ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-05 emarsden> ;; ;; ;; When returning data from a SELECT statement, PostgreSQL starts by @@ -100,11 +99,15 @@ ;; FIXME switch to a specialized float parser (defun float-parser (str) (declare (type simple-string str)) - (let ((*read-eval* nil)) (read-from-string str))) -;; FIXME this may need support for charset decoding +;; here we are assuming that the value of *PG-CLIENT-ENCODING* is +;; compatible with the encoding that the CL implementation uses for +;; strings. The backend should convert all values belonging to one of +;; the text data types from the table's internal representation to +;; that requested by the client, so here we don't need to do any +;; conversion. (defun text-parser (str) str) (defun bool-parser (str) @@ -116,18 +119,20 @@ (defun parse-timestamp (str) (declare (type simple-string str)) - (let* ((year (parse-integer (subseq str 0 4))) - (month (parse-integer (subseq str 5 7))) - (day (parse-integer (subseq str 8 10))) - (hours (parse-integer (subseq str 11 13))) - (minutes (parse-integer (subseq str 14 16))) - (seconds (parse-integer (subseq str 17 19))) - (start-tz (if (eql #\+ (char str (- (length str) 3))) - (- (length str) 3))) + (let* ((year (parse-integer str :start 0 :end 4)) + (month (parse-integer str :start 5 :end 7)) + (day (parse-integer str :start 8 :end 10)) + (hours (parse-integer str :start 11 :end 13)) + (minutes (parse-integer str :start 14 :end 16)) + (seconds (parse-integer str :start 17 :end 19)) + (length (length str)) + (start-tz (if (eql #\+ (char str (- length 3))) + (- length 3))) (tz (when start-tz - (parse-integer (subseq str start-tz)))) - (milliseconds (if (eql (char str 19) #\.) - (parse-integer (subseq str 20 start-tz)) 0))) + (parse-integer str :start start-tz))) + (milliseconds (if (and (< 19 length) (eql (char str 19) #\.)) + (parse-integer str :start 20 :end start-tz) + 0))) (values year month day hours minutes seconds milliseconds tz))) ;; format for abstime/timestamp etc with ISO output syntax is @@ -151,10 +156,10 @@ ;; An interval is what you get when you subtract two timestamps. We ;; convert to a number of seconds. (defun interval-parser (str) - (let* ((hours (parse-integer (subseq str 0 2))) - (minutes (parse-integer (subseq str 3 5))) - (seconds (parse-integer (subseq str 6 8))) - (milliseconds (parse-integer (subseq str 9)))) + (let* ((hours (parse-integer str :start 0 :end 2)) + (minutes (parse-integer str :start 3 :end 5)) + (seconds (parse-integer str :start 6 :end 8)) + (milliseconds (parse-integer str :start 9))) (+ (/ milliseconds (expt 10.0 (- (length str) 9))) seconds (* 60 minutes) @@ -165,22 +170,22 @@ ;;; "1999-01-02 00:00:00+01" ;; which we convert to a CL universal time (defun isodate-parser (str) - (let ((year (parse-integer (subseq str 0 4))) - (month (parse-integer (subseq str 5 7))) - (day (parse-integer (subseq str 8 10))) - (hours (parse-integer (subseq str 11 13))) - (minutes (parse-integer (subseq str 14 16))) - (seconds (parse-integer (subseq str 17 19))) - (tz (parse-integer (subseq str 19 22)))) + (let ((year (parse-integer str :start 0 :end 4)) + (month (parse-integer str :start 5 :end 7)) + (day (parse-integer str :start 8 :end 10)) + (hours (parse-integer str :start 11 :end 13)) + (minutes (parse-integer str :start 14 :end 16)) + (seconds (parse-integer str :start 17 :end 19)) + (tz (parse-integer str :start 19 :end 22))) (encode-universal-time seconds minutes hours day month year tz))) ;; format for date with ISO output syntax is ;;; "1999-01-02" ;; which we convert to a CL universal time (defun date-parser (str) - (let ((year (parse-integer (subseq str 0 4))) - (month (parse-integer (subseq str 5 7))) - (day (parse-integer (subseq str 8 10)))) + (let ((year (parse-integer str :start 0 :end 4)) + (month (parse-integer str :start 5 :end 7)) + (day (parse-integer str :start 8 :end 10))) (encode-universal-time 0 0 0 day month year))) (defun initialize-parsers (connection) @@ -204,6 +209,8 @@ oid))))) tuples))) +;; FIXME should perhaps resignal parse errors as a condition derived +;; from POSTGRESQL-ERROR (defun parse (str oid) (declare (type simple-string str)) (let ((parser (assoc oid *parsers* :test #'eql)))

1 0

[pg-cvs] CVS update: pg/md5.lisp
by Eric Marsden 20 Apr '04

20 Apr '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv25733 Added Files: md5.lisp Log Message: - imported file, with some minor changes to Pierre Mai's original code to improve portability (mostly adding EVAL-WHEN clauses). Date: Tue Apr 20 08:59:06 2004 Author: emarsden

1 0

[pg-cvs] CVS update: pg/README pg/pg.asd pg/sysdep.lisp pg/v2-protocol.lisp pg/v3-protocol.lisp
by Eric Marsden 01 Apr '04

01 Apr '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv23682 Modified Files: README pg.asd sysdep.lisp v2-protocol.lisp v3-protocol.lisp Log Message: - add md5 authentication (thanks to Brian Mastenbrook). Uses Pierre Mai's portable md5.lisp library, that has been added to the project (with extra EVAL-WHENness to please OpenMCL and ACL). Tested with CMUCL, SBCL, OpenMCL, CLISP, ACL 6.1. ABCL does not compile md5.lisp, probably for more EVAL-WHEN reasons. Only tested with PostgreSQL version 7.4. Date: Thu Apr 1 13:35:19 2004 Author: emarsden Index: pg/README diff -u pg/README:1.2 pg/README:1.3 --- pg/README:1.2 Mon Mar 8 10:01:53 2004 +++ pg/README Thu Apr 1 13:35:19 2004 @@ -1,8 +1,8 @@ pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp Author: Eric Marsden <emarsden(a)laas.fr> - Time-stamp: <2004-03-08 emarsden> - Version: 0.21 + Time-stamp: <2004-04-01 emarsden> + Version: 0.22 Copyright (C) 1999,2000,2001,2002,2003,2004 Eric Marsden @@ -206,15 +206,19 @@ pg.lisp is able to use the crypt authentication method to avoid sending the password in cleartext over the wire (this assumes access - to the `crypt' function via the FFI). It does not support the - Kerberos authentication method, nor OpenSSL connections (though this - should not be difficult if your Common Lisp implementation is able to - open SSL streams). However, it is possible to use the port forwarding - capabilities of ssh to establish a connection to the backend over - TCP/IP, which provides both a secure authentication mechanism and - encryption (and optionally compression) of data passing through the - tunnel. Here's how to do it (thanks to Gene Selkov, Jr. - <selkovjr(a)mcs.anl.gov> for the description): + to the `crypt' function via the FFI -- see sysdep.lisp). It can also + use md5 passwords (which are used with the WITH ENCRYPTED PASSWORD + form of the CREATE USER command), thanks to Pierre Mai's portable md5 + library. It does not support the Kerberos authentication method, nor + OpenSSL connections (though this should not be difficult if your + Common Lisp implementation is able to open SSL streams). + + It is also possible to use the port forwarding capabilities of ssh to + establish a connection to the backend over TCP/IP, which provides + both a secure authentication mechanism and encryption (and optionally + compression) of data passing through the tunnel. Here's how to do it + (thanks to Gene Selkov, Jr. <selkovjr(a)mcs.anl.gov> for the + description): 1. Establish a tunnel to the backend machine, like this: @@ -244,8 +248,11 @@ * CMUCL 18d and 18e on Solaris/SPARC and Linux/x86 * CLISP 2.30 on LinuxPPC and SPARC + * OpenMCL 0.13.x and 0.14.x on LinuxPPC + * Armed Bear Common Lisp * ACL 6.1 trial/x86 - * PostgreSQL 6.5, 7.0, 7.1.2, 7.2, 7.3, 7.4 + * Lispworks 4.3 on Linux and Windows + * PostgreSQL versions 6.5, 7.0, 7.1.2, 7.2, 7.3, 7.4 You may be interested in using "pg-psql" by Harley Gorrell, which Index: pg/pg.asd diff -u pg/pg.asd:1.4 pg/pg.asd:1.5 --- pg/pg.asd:1.4 Mon Mar 8 10:01:53 2004 +++ pg/pg.asd Thu Apr 1 13:35:19 2004 @@ -17,7 +17,8 @@ :author "Eric Marsden" :version "0.21" :components ((:file "defpackage") - (:pg-component "sysdep" :depends-on ("defpackage")) + (:file "md5") + (:pg-component "sysdep" :depends-on ("defpackage" "md5")) (:file "meta-queries" :depends-on ("defpackage")) (:file "parsers" :depends-on ("defpackage")) (:file "utility" :depends-on ("defpackage")) Index: pg/sysdep.lisp diff -u pg/sysdep.lisp:1.4 pg/sysdep.lisp:1.5 --- pg/sysdep.lisp:1.4 Wed Mar 17 13:13:10 2004 +++ pg/sysdep.lisp Thu Apr 1 13:35:19 2004 @@ -1,7 +1,7 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-17 emarsden> +;;; Time-stamp: <2004-04-01 emarsden> ;; ;; @@ -11,7 +11,7 @@ #+allegro (require :socket) #+lispworks (require "comm") #+cormanlisp (require :sockets) - #+sbcl (progn (require :asdf) (require :sb-bsd-sockets)) + #+sbcl (progn (require :asdf) (require :sb-bsd-sockets) (require :sb-md5)) #+(and mcl (not openmcl)) (require "OPENTRANSPORT")) @@ -33,6 +33,18 @@ (defun crypt (key salt) (declare (ignore salt)) key) + + +(defun md5-digest (string &rest strings) + (declare (type simple-string string)) + (let ((vec (md5:md5sum-sequence + (apply #'concatenate 'string string strings)))) + (format nil "~(~{~2,'0X~}~)" (coerce vec 'list)))) + +(defun md5-encode-password (user password salt) + (concatenate 'string "md5" + (md5-digest (md5-digest password user) salt))) + ;; this is a little fiddly, because CLISP can be built without support Index: pg/v2-protocol.lisp diff -u pg/v2-protocol.lisp:1.3 pg/v2-protocol.lisp:1.4 --- pg/v2-protocol.lisp:1.3 Mon Mar 8 13:12:45 2004 +++ pg/v2-protocol.lisp Thu Apr 1 13:35:19 2004 @@ -1,7 +1,6 @@ ;;; v2-protocol.lisp -- frontend/backend protocol prior to PostgreSQL 7.4 ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-08 emarsden> (in-package :postgresql) @@ -27,7 +26,6 @@ (send-string connection dbname +SM_DATABASE+) (send-string connection user user-packet-length) (%flush connection) - #+cmu (ext:finalize connection (lambda () (pg-disconnect connection))) (loop (case (read-byte stream) ;; ErrorResponse @@ -58,10 +56,21 @@ (crypted (crypt password salt))) #+debug (format *debug-io* "Got salt of ~s~%" salt) - (send-int connection (+ 5 (length crypted)) 4) + (send-int connection (+ 4 (length crypted) 1) 4) (send-string connection crypted) (send-int connection 0 1) (%flush connection))) + ((5) ; AuthMD5Password + #+debug + (format *debug-io* "MD5Auth: got salt of ~s~%" salt) + (force-output *debug-io*) + (let* ((salt (%read-chars stream 4)) + (ciphered (md5-encode-password user password salt))) + (send-int connection (+ 4 (length ciphered) 1) 4) + (send-string connection ciphered) + (send-int connection 0 1) + (%flush connection))) + ((1) ; AuthKerberos4 (error 'authentication-failure :reason "Kerberos4 authentication not supported")) Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.8 pg/v3-protocol.lisp:1.9 --- pg/v3-protocol.lisp:1.8 Sat Mar 20 16:48:41 2004 +++ pg/v3-protocol.lisp Thu Apr 1 13:35:19 2004 @@ -248,8 +248,10 @@ "Reads an array of LENGTH bytes from the packet") (:method ((packet pg-packet) (length (eql -1))) nil) + (:method ((packet pg-packet) (length (eql 0))) + nil) (:method ((packet pg-packet) (length integer)) - (when (<= length 0) + (when (< length 0) (error "length cannot be negative. is: ~S" length)) (let ((result (make-array length @@ -383,22 +385,23 @@ (error 'authentication-failure :reason "Kerberos5 authentication not supported")) ((3) ; AuthUnencryptedPassword - (send-packet connection - #\p - `((:cstring ,password))) + (send-packet connection #\p `((:cstring ,password))) (%flush connection)) ((4) ; AuthEncryptedPassword (let* ((salt (read-string-from-packet packet 2)) (crypted (crypt password salt))) #+debug - (format *debug-io* "Got salt of ~s~%" salt) - (send-packet connection - #\p - `((:cstring ,crypted))) + (format *debug-io* "CryptAuth: Got salt of ~s~%" salt) + (send-packet connection #\p `((:cstring ,crypted))) (%flush connection))) ((5) ; AuthMD5Password - (error 'authentication-failure - :reason "MD5 authentication not supported")) + #+debug + (format *debug-io* "MD5Auth: got salt of ~s~%" salt) + (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))) + (%flush connection))) ((6) ; AuthSCMPassword (error 'authentication-failure :reason "SCM authentication not supported"))

1 0