[pg-cvs] CVS update: pg/README pg/pg.asd pg/sysdep.lisp pg/v2-protocol.lisp pg/v3-protocol.lisp
Eric Marsden
emarsden at common-lisp.net
Thu Apr 1 18:35:19 UTC 2004
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 at 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 at 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 at 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 at 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 at 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"))
More information about the Pg-cvs
mailing list