1 files changed, 58 insertions, 0 deletions
diff --git a/web/cgi/session/setauth2.tcl b/web/cgi/session/setauth2.tcl
new file mode 100755
index 00000000..ccb4ce17
--- /dev/null
+++ b/web/cgi/session/setauth2.tcl
@@ -0,0 +1,58 @@
+#!./tclsh
+# $Id: setauth2.tcl 391 2007-01-25 03:53:59Z mikes@u.washington.edu $
+# ========================================================================
+# Copyright 2008 University of Washington
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# ========================================================================
+
+#  setauth2.tcl
+#
+#  Purpose:  CGI script to accept user authorization
+#            credentials via xmlHttpRequest
+
+#  Input:
+set auth_vars {
+  {c		"No Authorization Collection"}
+  {f		"No Authorization Folder"}
+  {auths	""	0}
+  {user		""	0}
+  {pass		""	0}
+  {cancel	""	0}
+}
+
+#  Output:
+#
+
+# inherit global config
+source ./alpine.tcl
+
+# Import data validate it and get session id
+if {[catch {WPGetInputAndID sessid}]} {
+  return
+}
+
+# grok parameters
+foreach item $auth_vars {
+  if {[catch {eval WPImport $item} errstr]} {
+    WPInfoPage "Web Alpine Error" [font size=+2 $errstr] "Please close this window."
+    return
+  }
+}
+
+cgi_puts "Content-type: text/html; charset=\"UTF-8\"\n"
+set answer "Problem setting authorization credentials"
+
+
+if {[string compare $auths "Login"] == 0
+    && [string length $user]
+    && [catch {WPCmd PESession creds $c $f $user $pass} answer] == 0} {
+  cgi_puts "$answer"
+} else {
+  cgi_puts "Cannot accept login: $answer"
+}