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@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@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@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@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@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"))