From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 22 Nov 2004 20:08:46 +0000 (+0000)
Subject: Add procedure to get user's password.
X-Git-Tag: 20090517-FFI~1445
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f1a0eab11547b6adc4f54ef8006c1d277555ed20;p=mit-scheme.git

Add procedure to get user's password.
---

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?