Add procedure to get user's password.

diff --git a/v7/src/xdoc/db.scm b/v7/src/xdoc/db.scm
index d372f9748a1cd2392453e2b6e7815a66d4f3cdeb..392876a4253622f0d3cd4b4ceea451d0448a71aa 100644 (file)
--- a/v7/src/xdoc/db.scm
+++ b/v7/src/xdoc/db.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: db.scm,v 1.3 2004/11/22 19:45:23 cph Exp $
+$Id: db.scm,v 1.4 2004/11/22 20:08:42 cph Exp $
 
 Copyright 2003,2004 Massachusetts Institute of Technology
 
@@ -615,6 +615,21 @@ USA.
                    ")")
        #t)))
 
+(define (db-get-user-password user-name)
+  (let ((result
+        (db-run-query "SELECT enabled_p, password"
+                      " FROM users"
+                      " WHERE user_name = " (db-quote user-name))))
+    (if (> (pgsql-n-tuples result) 0)
+       (let ((password
+              (and (string=? (pgsql-get-value result 0 0) "t")
+                   (pgsql-get-value result 0 1))))
+         (pgsql-clear result)
+         password)
+       (begin
+         (pgsql-clear result)
+         #f))))
+
 (define (db-change-user-password user-name password)
   (guarantee-known-user user-name)
   (db-run-cmd "UPDATE users"

diff --git a/v7/src/xdoc/xdoc.pkg b/v7/src/xdoc/xdoc.pkg
index a19869fe692296ce134bacaa76d8e2d654569c19..0275f956c2057e0768c23a881ab02af521a2001f 100644 (file)
--- a/v7/src/xdoc/xdoc.pkg
+++ b/v7/src/xdoc/xdoc.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xdoc.pkg,v 1.2 2004/11/22 19:45:27 cph Exp $
+$Id: xdoc.pkg,v 1.3 2004/11/22 20:08:46 cph Exp $
 
 Copyright 2004 Massachusetts Institute of Technology
 
@@ -191,6 +191,7 @@ USA.
          db-get-persistent-value
          db-get-ps-structure
          db-get-saved-output
+         db-get-user-password
          db-intern-global-value!
          db-intern-persistent-value!
          db-known-user?