From f1a0eab11547b6adc4f54ef8006c1d277555ed20 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 22 Nov 2004 20:08:46 +0000
Subject: [PATCH] Add procedure to get user's password.

---
 v7/src/xdoc/db.scm   | 17 ++++++++++++++++-
 v7/src/xdoc/xdoc.pkg |  3 ++-
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/v7/src/xdoc/db.scm b/v7/src/xdoc/db.scm
index d372f9748..392876a42 100644
--- 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 a19869fe6..0275f956c 100644
--- 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?
-- 
2.25.1