17 files changed, 1573 insertions, 0 deletions

diff --git a/web/cgi/session/.htaccess b/web/cgi/session/.htaccess
new file mode 100644
index 00000000..a4f615c2
--- /dev/null
+++ b/web/cgi/session/.htaccess
@@ -0,0 +1,28 @@
+
+DirectoryIndex greeting.tcl
+
+#
+# mod_rewrite rules to coerce secure (https) access to underlying pages
+#
+
+RewriteEngine on
+
+#
+# If the server's connecting port isn't secure (https), then
+# redirect request to same location but such that the communication
+# is secure.  NOTE: this isn't as secure as turning off the unsecure
+# port because any confidential information in the request is exposed
+# in the unsuspecting request on the unsecure port.  Shouldn't really
+# be a problem since the secure content should only contain secure
+# references and the likelihood that a client mucks with the url into
+# a reference to secure content is pretty darn small.
+#
+
+RewriteCond %{SERVER_PORT} !=443
+
+#
+# Include SCRIPT_URL incase webpine package isn't in the
+# root of the server's data
+#
+RewriteRule .* https://%{SERVER_NAME}%{REQUEST_URI} [R=permanent,L]
+
diff --git a/web/cgi/session/_htaccess b/web/cgi/session/_htaccess
new file mode 100644
index 00000000..a4f615c2
--- /dev/null
+++ b/web/cgi/session/_htaccess
@@ -0,0 +1,28 @@
+
+DirectoryIndex greeting.tcl
+
+#
+# mod_rewrite rules to coerce secure (https) access to underlying pages
+#
+
+RewriteEngine on
+
+#
+# If the server's connecting port isn't secure (https), then
+# redirect request to same location but such that the communication
+# is secure.  NOTE: this isn't as secure as turning off the unsecure
+# port because any confidential information in the request is exposed
+# in the unsuspecting request on the unsecure port.  Shouldn't really
+# be a problem since the secure content should only contain secure
+# references and the likelihood that a client mucks with the url into
+# a reference to secure content is pretty darn small.
+#
+
+RewriteCond %{SERVER_PORT} !=443
+
+#
+# Include SCRIPT_URL incase webpine package isn't in the
+# root of the server's data
+#
+RewriteRule .* https://%{SERVER_NAME}%{REQUEST_URI} [R=permanent,L]
+
diff --git a/web/cgi/session/alpine.tcl b/web/cgi/session/alpine.tcl
new file mode 120000
index 00000000..5ad8d42f
--- /dev/null
+++ b/web/cgi/session/alpine.tcl
@@ -0,0 +1 @@
+../alpine.tcl
\ No newline at end of file
diff --git a/web/cgi/session/greeting.tcl b/web/cgi/session/greeting.tcl
new file mode 100755
index 00000000..a6acc1e5
--- /dev/null
+++ b/web/cgi/session/greeting.tcl
@@ -0,0 +1,395 @@
+#!./tclsh
+# $Id: greeting.tcl 1204 2009-02-02 19:54:23Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+# suck in any global config
+source ./alpine.tcl
+
+# figure out SSL defaults
+if {[info exists _wp(ssl_default)] && $_wp(ssl_default) == 0} {
+  set ssl 0
+} else {
+  set ssl 1
+  if {[info exists _wp(ssl_safe_domains)]} {
+    if {[info exists env(REMOTE_HOST)]} {
+      foreach d $_wp(ssl_safe_domains) {
+	regsub -all {\.} $d {\.} d
+	if {[regexp -nocase "$d\$" $env(REMOTE_HOST)]} {
+	  set ssl 0
+	  break
+	}
+      }
+    }
+
+    if {$ssl && [info exists env(REMOTE_ADDR)]} {
+      regexp {([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)} $env(REMOTE_ADDR) dummy a b c d
+      set h "$d.$c.$b.$a.in-addr.arpa"
+      if {[catch {exec nslookup -q=PTR $h "2&>1"} pr] == 0} {
+	foreach l [split $pr \n] {
+	  if {[regexp -nocase "^$h\[	\]*name = (.*)\$" $l dummy inaddr]} {
+	    break
+	  }
+	}
+      }
+
+      if {[info exists inaddr]} {
+	foreach d $_wp(ssl_safe_domains) {
+	  if {[set n [expr {[string length $inaddr] - [string length $d] - 1}]] > 1
+	  && [string compare [string tolower [string range $inaddr $n end]] [string tolower ".$d"]] == 0} {
+	    set ssl 0
+	    break
+	  }
+	}
+      }
+    }
+  }
+
+  if {$ssl && [info exists _wp(ssl_safe_addrs)]} {
+    set ra [split $env(REMOTE_ADDR) .]
+    foreach a $_wp(ssl_safe_addrs) {
+      if {[llength $a] == 2} {
+	set low [split [lindex $a 0] .]
+	set hi [split [lindex $a 1] .]
+
+	foreach a $ra b $low c $hi {
+	  if {$b == $c} {
+	    if {$a != $b} {
+	      break
+	    }
+	  } else {
+	    if {$a >= $b && $a <= $c} {
+	      set ssl 0
+	      break
+	    }
+	  }
+	}
+      } else {
+	foreach a [split $a .] b $ra {
+	  if {[string length $a]} {
+	    if {$a != $b} {
+	      break
+	    }
+	  } else {
+	    set $ssl 0
+	    break
+	  }
+	}
+      }
+
+      if {!$ssl} {
+	break
+      }
+    }
+  }
+}
+
+cgi_eval {
+
+  cgi_http_head {
+    WPStdHttpHdrs
+  }
+
+  cgi_html {
+
+    cgi_head {
+      WPStdHtmlHdr Logon
+      WPStdScripts $_wp(indexheight)
+
+      if {$_wp(flexserver)} {
+	cgi_javascript {
+	  cgi_put  "function bogus(f,o) {"
+	  cgi_put  " if(o.value.length == 0){"
+	  cgi_put  "  alert('What '+f+' will you be using to log in to your IMAP server?\\nPlease fill in the '+f+' field.');"
+	  cgi_put  "  o.focus();"
+	  cgi_put  "  return true;"
+	  cgi_put  " }"
+	  cgi_put  " return false;"
+	  cgi_puts "}"
+	  cgi_put  "function doSubmit() {"
+	  cgi_put  " var f = document.Login;"
+	  cgi_put  " var l = f.Server;"
+	  cgi_put  " var o = l.options\[l.selectedIndex\];"
+	  cgi_put  " if(bogus('Username',f.User) || bogus('Password',f.Pass)) return false;"
+	  cgi_put  " if(o.value < 0){"
+	  cgi_put  "  o.value = alien_server;"
+	  cgi_put  " }"
+	  cgi_put  " return true;"
+	  cgi_puts "}"
+	  cgi_put  "function customServer() {"
+	  cgi_put  " var f = document.Login;"
+	  cgi_put  " var l = f.Server;"
+	  cgi_put  " var o = l.options\[l.selectedIndex\];"
+	  if {[info exists env(REMOTE_USER)]} {
+	    cgi_put "  f.User.value = (o.value < 0) ? alien_user : def_user;"
+	    cgi_put "  f.Pass.value = (o.value < 0) ? alien_pass : def_pass;"
+	  }
+	  cgi_put  " if(o.value < 0){"
+	  cgi_put  "  if(s = prompt('IMAP Server Name (append \"/ssl\" for secure link)',o.s ? o.s : '')){"
+	  cgi_put  "   alien_server = s;"
+	  cgi_put  "   o.text = 'Your Server: '+alien_server;"
+	  cgi_put  "   f.User.onfocus = null;"
+	  cgi_put  "   f.Pass.onfocus = null;"
+	  cgi_put  "   f.User.focus();"
+	  cgi_put  "  }"
+	  cgi_put  "  else if(alien_server.length == 0){"
+	  if {[info exists env(REMOTE_USER)]} {
+	    cgi_put  "   f.User.onfocus = f.User.blur;"
+	    cgi_put  "   f.Pass.onfocus = f.Pass.blur;"
+	    cgi_put  "   f.User.value = def_user;"
+	    cgi_put  "   f.Pass.value = def_pass;"
+	  }
+	  cgi_put  "   l.selectedIndex = 0;"
+	  cgi_put  "  }"
+	  cgi_put  " }"
+	  if {[info exists env(REMOTE_USER)]} {
+	    cgi_put  " else {"
+	    cgi_put  "   f.User.onfocus = f.User.blur;"
+	    cgi_put  "   f.Pass.onfocus = f.Pass.blur;"
+	    cgi_put  " }"
+	  }
+	  cgi_puts "}"
+	  if {[info exists env(REMOTE_USER)]} {
+	    cgi_put  "var def_user = new Array('$env(REMOTE_USER)');"
+	    cgi_put  "var def_pass = new Array('x');"
+	    cgi_put  "var alien_server = '';"
+	    cgi_put  "var alien_user = '';"
+	    cgi_put  "var alien_pass = '';"
+	    cgi_put  "function customSave() {"
+	    cgi_put  " var f = document.Login;"
+	    cgi_put  " var s = f.Server.options\[f.Server.selectedIndex\];"
+	    cgi_put  " if(s.value < 0){"
+	    cgi_put  "  alien_user = f.User.value;"
+	    cgi_put  "  alien_pass = f.Pass.value;"
+	    cgi_put  " }"
+	    cgi_puts "}"
+	  }
+	}
+      }
+    }
+
+    if {[info exists env(REMOTE_USER)]} {
+      set onload ""
+    } else {
+      set onload "onLoad=document.Login.User.focus()"
+    }
+
+    cgi_body $onload {
+      if {$_wp(flexserver)} {
+	set onsubmit "onSubmit=return doSubmit()"
+      } else {
+	set onsubmit ""
+      }
+
+      cgi_form session/init method=post enctype=multipart/form-data name=Login $onsubmit {
+	cgi_javascript {
+	  cgi_puts "document.write('<input name=\"hPx\" value='+window.getDisplayHeight()+' type=hidden notab>');"
+	}
+
+	cgi_table height=100% width=100% align=center {
+
+	  cgi_table_row {
+	    cgi_table_data align=center valign=bottom height=18% colspan=8 {
+	      set intro "Welcome to $_wp(appname)"
+	      if {[info exists env(REMOTE_USER)]} {
+		set conf [subst [lindex [lindex $_wp(hosts) 0] 2]]
+		set pldap [file join $_wp(bin) $_wp(pldap)]
+		if {[catch {exec $pldap -p $conf -u $env(REMOTE_USER)} pname] == 0} {
+		  append intro ", $pname"
+		}
+	      }
+
+	      cgi_put [font size=+2 face=Helvetica [bold $intro]]
+	    }
+	  }
+
+	  cgi_table_row {
+	    cgi_table_data width=36% height=35% align=right valign=middle {
+	      cgi_put [cgi_imglink logo]
+	    }
+
+	    cgi_table_data width=5% {
+	      cgi_puts [cgi_nbspace]
+	    }
+
+	    cgi_table_data {
+	      cgi_table border=0 cellspacing=8 {
+		cgi_table_row {
+		  cgi_table_data align=right valign=bottom {
+		    cgi_puts [font size=+1 face=Helvetica "Username:"]
+		  }
+
+		  cgi_table_data align=left valign=bottom {
+		    if {[info exists env(REMOTE_USER)]} {
+		      set user "User=$env(REMOTE_USER)"
+		      set rdonly "onFocus=this.blur();"
+		    } else {
+		      set user "User="
+		      set rdonly ""
+		    }
+
+		    if {$_wp(flexserver) && [info exists env(REMOTE_USER)]} {
+		      set onblur onBlur=customSave()
+		    } else {
+		      set onblur ""
+		    }
+
+		    cgi_text $user type=text maxlength=30 tableindex=1 $rdonly $onblur
+		  }
+		}
+
+		cgi_table_row {
+		  cgi_table_data align=right valign=middle {
+		    cgi_puts [font size=+1 face=Helvetica "Password:"]
+		  }
+
+		  cgi_table_data align=left valign=middle {
+		    if {[info exists env(REMOTE_USER)]} {
+		      set pass "Pass=*"
+		      set rdonly "onFocus=this.blur();"
+		    } else {
+		      set pass "Pass="
+		      set rdonly ""
+		    }
+
+		    if {$_wp(flexserver) && [info exists env(REMOTE_USER)]} {
+		      set onblur onBlur=customSave()
+		    } else {
+		      set onblur ""
+		    }
+
+		    cgi_text $pass type=password maxlength=30 tableindex=2 $rdonly $onblur
+		  }
+		}
+
+		cgi_table_row {
+		  cgi_table_data align=right valign=middle {
+		    cgi_puts [font face=Helvetica size=+1 "Server:"]
+		  }
+
+		  cgi_table_data align=left valign=top {
+		    if {[info exists _wp(hosts)]} {
+		      if {$_wp(flexserver)} {
+			set onchange onChange=customServer()
+			if {[info exists env(REMOTE_USER)]} {
+			  set onblur onBlur=customSave()
+			} else {
+			  set onblur ""
+			}
+		      } else {
+			set onchange ""
+			set onblur ""
+		      }
+
+		      cgi_select Server align=left $onchange $onblur {
+			for {set j 0} {$j < [llength $_wp(hosts)]} {incr j} {
+			  cgi_option [lindex [lindex $_wp(hosts) $j] 0] value=$j
+			}
+
+			if {$_wp(flexserver)} {
+			  cgi_javascript {
+			    cgi_puts "document.write('<option value=\"-1\">Server of Your Choice');"
+			  }
+			}
+		      }
+		    } else {
+		      cgi_text Server= type=text maxlength=256
+		    }
+		  }
+		}
+	      }
+	    }
+	  }
+
+	  if {[info exists env(REMOTE_USER)]} {
+	    cgi_table_row {
+	      cgi_table_data align=center valign=top height=1% colspan=8 {
+		cgi_puts "Protect your privacy! When you finish, [cgi_url "completely exit your Web browser" "http://www.washington.edu/computing/web/logout.html"]."
+	      }
+	    }
+	  }
+
+	  cgi_table_row {
+	    cgi_table_data align=center valign=top colspan=8 "style=padding-bottom:10" {
+	      cgi_submit_button login=Login
+	    }
+	  }
+
+	  if {[info exists _wp(plainservpath)] && [string length $_wp(plainservpath)]} {
+	    cgi_table_row {
+	      cgi_table_data colspan=8 align=center valign=middle {
+		cgi_table border=0 width=30% {
+		  cgi_table_row {
+		    cgi_table_data rowspan=2 valign=top {
+		      if {$ssl} {
+			set checked checked
+		      } else {
+			set checked ""
+		      }
+
+		      cgi_checkbox ssl=1 $checked
+		    }
+
+		    cgi_table_data {
+		      cgi_put [cgi_font size=-1 face=Helvetica "Use [cgi_url "SSL Session Encryption" "$_wp(serverpath)/$_wp(appdir)/$_wp(ui1dir)/help/secure.html" target=_blank]"]
+		      cgi_br
+		      set t "Session encryption over low-speed connections may slow WebPine, but prevents eavesdropping. Passwords are safely encrypted though."
+
+		      cgi_division style=background-color:#eeeeee {
+			cgi_put [cgi_font size=-2 face=Helvetica $t]
+		      }
+		    }
+		  }
+		}
+	      }
+	    }
+	  } else {
+	    cgi_text ssl=1 type=hidden notab
+	  }
+
+	  if {[info exists _wp(oldserverpath)] && [regexp {^[Hh][Tt][Tt][Pp][Ss]://} $_wp(oldserverpath)]} {
+	    cgi_table_row {
+	      cgi_table_data colspan=8 align=center valign=middle {
+		cgi_division "style=\"width: 30% ; font-family: Helvetica; font-size: small ; background-color: #EEEEEE; padding: 8 2 \"" {
+		  cgi_puts "For the time being, the [cgi_url "old version" $_wp(oldserverpath)] is still available."
+		}
+	      }
+	    }
+	  }
+
+	  if {[catch {open [file join $_wp(cgipath) $_wp(motd)] r} id] == 0} {
+	    cgi_table_row {
+	      cgi_table_data colspan=8 height=20% valign=top {
+		cgi_table width=100% {
+		  cgi_table_data height=40 width=18% {
+		    # cgi_puts [cgi_imglink bang]
+		    cgi_puts [cgi_nbspace]
+		  }
+
+		  cgi_table_data {
+		    cgi_puts [font size=-1 face=Helvetica [read $id]]
+		  }
+
+		  cgi_table_data width=18% {
+		    # cgi_puts [cgi_imglink bang]
+		    cgi_puts [cgi_nbspace]
+		  }
+		}
+	      }
+	    }
+
+	    close $id
+	  }
+	}
+      }
+    }
+  }
+}
diff --git a/web/cgi/session/init.tcl b/web/cgi/session/init.tcl
new file mode 100755
index 00000000..00f0f903
--- /dev/null
+++ b/web/cgi/session/init.tcl
@@ -0,0 +1,218 @@
+#!./tclsh
+# $Id: init.tcl 1204 2009-02-02 19:54:23Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+#  init.tcl
+#
+#  Purpose: CGI script to establish foundation for webpine session
+
+# and any global config
+source ./alpine.tcl
+
+
+cgi_eval {
+  if {$_wp(debug)} {
+    cgi_debug -on
+  }
+
+  #
+  # Import username and password from pubcookie, if possible.
+  # Otherwise get it from the form that was submitted.
+  #
+  cgi_input
+
+  if {[catch {cgi_import User}] || 0 == [string length $User]} {
+    WPInfoPage "Bogus Username" \
+	"[font size=+2 "Sorry, didn't catch your [bold name]!"]" \
+	"Please click your browser's [bold Back] button to return to the [cgi_link Start], and fill in a [italic Username]..."
+    return
+  }
+  
+  if {[catch {cgi_import Pass}]} {
+    set Pass ""
+  }
+
+  if {[catch {cgi_import Server}] || 0 == [string length $Server]} {
+    WPInfoPage "Bogus Server" \
+	"[font size=+2 "Invalid Server specified"]" \
+	"Please click your browser's [bold Back] button to return to the [cgi_link Start], and fill in a [italic Server]..."
+    return
+  }
+
+  catch {cgi_import hPx}
+
+  set defconf [file join $_wp(confdir) $_wp(defconf)]
+  set confloc ""
+
+  if {[string length $Server] < 256 && 0 == [regexp {[[:cntrl:]]} $Server]} {
+    if {[info exists _wp(hosts)] && $Server >= 0 && $Server < [llength $_wp(hosts)]} {
+      set sdata [lindex $_wp(hosts) $Server]
+
+      set env(IMAP_SERVER) "[subst [lindex $sdata 1]]/user=$User"
+
+      if {[llength $sdata] > 2 && [string length [lindex $sdata 2]]} {
+	set defconf [subst [lindex $sdata 2]]
+      } else {
+	#
+	# Validate input?
+	#
+	WPInfoPage "Internal Error" \
+	    [font size=+2 "IMAP Server Mismatch"] \
+	    "Please complain to the [link Admin] and visit the [cgi_link Start] later."
+	return
+      }
+    } elseif {[regexp {/user=} $Server]} {
+      set env(IMAP_SERVER) "$Server"
+    } else {
+      set env(IMAP_SERVER) "$Server/user=$User"
+    }
+
+    set confloc "\{$env(IMAP_SERVER)\}$_wp(config)"
+
+    regexp {^[^:/]*} $env(IMAP_SERVER) env(IMAP_SERVER_BASE)
+  } else {
+    WPInfoPage "Bad Server Name" [font size=+2 "Server Name too long or has bogus characters."] \
+	"Please click your browser's [bold Back] button to return to the [cgi_link Start] to try again..."
+    return
+  }
+
+  set confloc "\{$env(IMAP_SERVER)\}$_wp(config)"
+
+  if {[catch {regexp {^[^:/]*} $env(IMAP_SERVER) env(IMAP_SERVER_BASE)}]} {
+    set env(IMAP_SERVER_BASE) ""
+  }
+
+  # in less rigid settings, it might make sense to allow
+  # for random input folder names...
+  # cgi_import Folder
+
+  #
+  # Server, folder and credentials in hand, fork the client...
+  # <OL>
+  #    <LI> The session is *assumed* to run over SSL.
+  #    <LI> The server is *assumed* to be a black box
+  #         (no, possibly hostile, user shells)
+  #    <LI> We need to run the alpine process as the given user.
+  #         Unless we bind to a specific server, http authentication
+  #         isn't sufficient as t
+  #       
+  #	 <LI> The session-id connects future requests to the newly
+  #         created alpine engine.
+  #    <LI> The auth-cookie will tell us the session-id isn't coming from
+  #         j. random cracker's client
+  # </OL>
+  #
+
+  if {[catch {exec [file join $_wp(bin) launch.tcl]} _wp(sessid)]} {
+    WPInfoPage "Internal Error" [font size=+2 $_wp(sessid)] \
+	"Please complain to the [link Admin] and visit the [cgi_link Start] later."
+    return
+  } else {
+    WPValidId $_wp(sessid)
+  }
+
+  if {[catch {cgi_import ssl}] || $ssl == 0} {
+    WPCmd set serverroot $_wp(plainservpath)
+    cgi_root $_wp(plainservpath)
+  }
+
+  # stash login credentials away for later
+  if {[catch {
+		WPCmd set nojs 1
+		WPCmd PESession creds 0 $confloc $User $Pass
+	     } result]} {
+    WPInfoPage "Initialization Failure" [font size=+2 "Initialization Failure: $result"] \
+	"Please click your browser's [bold Back] button to return to the [cgi_link Start] to try again..."
+    catch {WPCmd exit}
+    return
+  }
+
+  set cookiepath $_wp(appdir)
+
+  # stash session open parms in alpined's interpreter
+  lappend parms User
+  lappend parms $User
+  lappend parms Server
+  lappend parms $Server
+  lappend parms confloc
+  lappend parms $confloc
+  lappend parms defconf
+  lappend parms $defconf
+  lappend parms startpage
+
+  lappend parms "$_wp(appdir)/$_wp(ui2dir)/browse/0/INBOX"
+  lappend parms prunepage
+  lappend parms ""
+
+  if {[info exists hPx]} {
+    lappend parms hPx
+    lappend parms $hPx
+  }
+
+  if {[catch {WPCmd set wp_open_parms $parms} result]} {
+    WPInfoPage "Internal Error" [font size=+2 $result] \
+	"Please complain to the [link Admin] and visit the [cgi_link Start] later."
+    return
+  }
+
+  # return a page that says we're logging in the user
+  # have that page return to opening the session...
+
+  catch {WPCmd set wp_ver_dir $cookiepath}
+
+  set sessid "$_wp(sessid)@[info hostname]"
+
+  cgi_http_head {
+    WPExportCookie sessid $sessid $cookiepath
+    WPStdHttpHdrs
+  }
+
+  cgi_html {
+    cgi_head {
+      cgi_http_equiv Refresh "0; url=$_wp(serverpath)/session/logon.tcl?sessid=$sessid"
+    }
+
+    cgi_body {
+      cgi_table height="20%" {
+	cgi_table_row {
+	  cgi_table_data {
+	    cgi_puts [cgi_nbspace]
+	  }
+	}
+      }
+
+      cgi_center {
+	cgi_table border=0 width=500 cellpadding=3 {
+	  cgi_table_row {
+	    cgi_table_data align=center rowspan=2 {
+	      cgi_put [cgi_imglink logo]
+	    }
+
+	    cgi_table_data rowspan=2 {
+	      cgi_put [cgi_img [WPimg dot2] border=0 width=18]
+	    }
+
+	    cgi_table_data {
+	      cgi_puts [cgi_font size=+2 "Logging into $_wp(appname)"]
+	    }
+	  }
+
+	  cgi_table_row {
+	    cgi_table_data {
+	      cgi_puts "Please be patient!  Depending on Inbox size, server load and other factors this may take a moment [cgi_img [WPimg dotblink]]"
+	    }
+	  }
+	}
+      }
+    }
+  }
+}
diff --git a/web/cgi/session/logon.tcl b/web/cgi/session/logon.tcl
new file mode 100755
index 00000000..2d675cf1
--- /dev/null
+++ b/web/cgi/session/logon.tcl
@@ -0,0 +1,169 @@
+#!./tclsh
+# $Id: logon.tcl 1142 2008-08-13 17:22:21Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+#  logon.tcl
+#
+#  Purpose: CGI script to authenticate user based on provided
+#           credentials and launch them into the mailbox index
+
+# and any global config
+source ./alpine.tcl
+
+# don't use WPEval since it'll mask open's credential failure case
+cgi_eval {
+
+  if {$_wp(debug)} {
+    cgi_debug -on
+  }
+
+  #
+  # Import username and password from pubcookie, if possible.
+  # Otherwise get it from the form that was submitted.
+  #
+  cgi_input
+
+  if {[catch {
+	       cgi_import sessid
+	       WPValidId $sessid
+	     } result]} {
+    WPInfoPage "Web Alpine Error" [font size=+2 "$result"] \
+	       "Please complain to the [cgi_link Admin] and visit the [cgi_link Start] later."
+    return
+  }
+
+  if {[catch {WPCmd set wp_open_parms} parms]} {
+    WPInfoPage "Internal Error" [font size=+2 $parms] \
+	       "Please complain to the [link Admin] and visit the [cgi_link Start] later."
+  } else {
+    catch {WPCmd unset wp_open_parms}
+
+    foreach {p v} $parms {
+      set $p $v
+    }
+
+    if {[catch {WPCmd PESession open $User $confloc $defconf} answer]} {
+      if {0 == [string length $answer] || 0 == [string compare BADPASSWD [lindex $answer 0]]} {
+	set answer "Unknown Username or Incorrect Password"
+      }
+
+      set alerts {}
+      if {[catch {WPCmd PEInfo statmsgs} statmsgs] == 0} {
+	# display any IMAP alerts
+	foreach m $statmsgs {
+	  if {[regexp {^Alert received.*\[ALERT\] (.*)$} $m dummy a]} {
+	    if {[lsearch -exact $alerts $a] < 0} {
+	      lappend alerts $a
+	    }
+	  }
+	}
+      }
+
+      WPInfoPage "Login Failure" [font size=+2 $answer] \
+	  "Please click your browser's [bold Back] button to return to the [cgi_link Start] to try again..." \
+	  {} [join $alerts "<br>"]
+
+      # unlaunch the thing
+      catch {WPCmd PESession close}
+      catch {WPCmd exit}
+      return
+    }
+
+    # determine suitable number of index lines for the indicated display size
+    # based on:
+    #
+    #  1. a header length of 72 pixels
+    #  2. a TD font-size plus padding of 24 points
+    #
+
+    set indexheight [WPCmd PEInfo indexheight]
+    if {[string length $indexheight] == 0} { set indexheight $_wp(indexheight)}
+    if {[info exists hPx] && [regexp {^[0-9]+$} $hPx]} {
+      # "66" comes from _wp(titlethick) + _wp(titlesep) + ((index tables cellpaddings * 2) = 8) + some fudge
+      set indexlines [expr (($hPx - 66) / $indexheight) - 1]
+    }
+
+    if {[info exists indexlines] == 0 || $indexlines <= 0} {
+      set indexlines [WPCmd PEInfo indexlines]
+    }
+
+    if {$indexlines <= 0} {
+      set indexlines $_wp(indexlines)
+    }
+
+    # start with the message indicated by the
+    # 'incoming-startup-rule' in the current index
+    set firstmsg 1
+    if {![catch {WPCmd PEMailbox firstinteresting} firstint] && $firstint > 0} {
+      set messagecount [WPCmd PEMailbox messagecount]
+      for {set i 1} {$i < $messagecount} {incr i $indexlines} {
+	if {$i >= $firstint} {
+	  break
+	}
+
+	set firstmsg $i
+      }
+
+      # show whole last page
+      if {$firstmsg + $indexlines > $messagecount} {
+	if {[set n [expr ($messagecount + 1) - $indexlines]] > 0} {
+	  set firstmsg $n
+	} else {
+	  set firstmsg 1
+	}
+      }
+    }
+
+    if {[catch {WPCmd PEInfo sort} defsort]} {
+      set defsort {Date 0}
+    }
+
+    # set these in alpined's interp so they're fished out by WPImport
+    if {[catch {
+      WPCmd set sort [lindex $defsort 0]
+      WPCmd set rev [lindex $defsort 1]
+      WPCmd set ppg $indexlines
+      WPCmd set width $_wp(width)
+      WPCmd set serverid $Server} result]} {
+      WPInfoPage "Initialization Failure" [font size=+2 $result] \
+	  "Please click your browser's [bold Back] button to return to the [cgi_link Start] to try again..."
+      catch {WPCmd PESession close}
+      catch {WPCmd exit}
+      return
+    }
+
+    if {[catch {WPCmd PEMailbox uid $firstmsg} exp]} {
+      set exp 1
+    }
+
+    WPCmd set top $exp
+
+    if {[catch {WPCmd set serverroot} serverroot] == 0} {
+      cgi_root $serverroot
+    }
+
+    set startpage "[cgi_root]/${startpage}?sessid=$sessid"
+
+    if {[string length $prunepage] && [WPCmd PEInfo prunecheck] == 1} {
+      set startpage "[cgi_root]/${prunepage}cid=[WPCmd PEInfo key]&sessid=${sessid}&start=[WPPercentQuote ${startpage}]"
+    }
+
+    cgi_http_head {
+      if {[info exists env(REMOTE_USER)]} {
+	# redirect thru intermediate so session id and secured user name can get bound in uidampper
+	cgi_redirect $_wp(serverpath)/session/startup.tcl?sessid=${sessid}&page=[WPPercentQuote $startpage]
+      } else {
+	cgi_redirect $startpage
+      }
+    }
+  }
+}
diff --git a/web/cgi/session/logout.tcl b/web/cgi/session/logout.tcl
new file mode 100755
index 00000000..698e3558
--- /dev/null
+++ b/web/cgi/session/logout.tcl
@@ -0,0 +1,67 @@
+#!./tclsh
+# $Id: logout.tcl 1204 2009-02-02 19:54:23Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+# Imported args
+set logout_vars {
+  {serverid	{}	0}
+  {expinbox	{}	0}
+  {expcurrent	{}	0}
+  {cid		"Missing Command ID"}
+}
+
+# and any global config
+source ./alpine.tcl
+
+WPEval $logout_vars {
+  
+  if {$cid != [WPCmd PEInfo key]} {
+    error [list _action Logout "Invalid Operation ID" "Please close this window."]
+  }
+
+  if {$expinbox &&  [catch {WPCmd PEMailbox expunge inbox} result]} {
+    set logouterr $result
+  }
+
+  if {$expcurrent &&  [catch {WPCmd PEMailbox expunge current} result]} {
+    if {[info exists logouterr] == 0} {
+      set logouterr $result
+    }
+  }
+
+  if {[catch {WPCmd PESession close} result]} {
+    if {[info exists logouterr] == 0} {
+      set logouterr $result
+    }
+  }
+
+  if {[catch {WPCmd set wp_ver_dir} verdir]} {
+    set verdir $_wp(appdir)
+  }
+
+  catch {WPCmd exit}
+
+  cgi_http_head {
+    set parms "?verdir=${verdir}"
+
+    if {[regexp {^[0-9]+$} $serverid]} {
+      append parms "&serverid=$serverid"
+    }
+
+    if {[info exists logouterr]} {
+      append parms "&logerr=[WPPercentQuote $logouterr]"
+    }
+
+    cgi_redirect $_wp(serverpath)/$_wp(appdir)/farewell.tcl${parms}
+  }
+}
+
diff --git a/web/cgi/session/logout/alpine.tcl b/web/cgi/session/logout/alpine.tcl
new file mode 120000
index 00000000..5ad8d42f
--- /dev/null
+++ b/web/cgi/session/logout/alpine.tcl
@@ -0,0 +1 @@
+../alpine.tcl
\ No newline at end of file
diff --git a/web/cgi/session/logout/logout.tcl b/web/cgi/session/logout/logout.tcl
new file mode 100755
index 00000000..39587e4e
--- /dev/null
+++ b/web/cgi/session/logout/logout.tcl
@@ -0,0 +1,51 @@
+#!./tclsh
+
+
+#
+# and any global config
+#
+
+source ./alpine.tcl
+
+cgi_eval {
+
+  cgi_input
+
+  if {[catch {cgi_import serverid}]} {
+    set serverid 0
+  }
+  
+  catch {cgi_import logerr}
+  
+  cgi_http_head {
+    WPStdHttpHdrs
+
+    # clear cookies
+    cgi_cookie_set sessid=0 expires=now
+  }
+
+  if {[info exists env(REMOTE_USER)]} {
+    set log_text [font class=notice "Protect your privacy![cgi_nl]When you finish, [cgi_url "completely exit your Web browser" http://www.washington.edu/computing/web/logout.html class=notice]."]
+    append log_text "[cgi_nl][cgi_nl]Or you may want to:"
+    append log_text "<center><ul>"
+    if {[catch {cgi_import ppg}]} {
+      set perpage ""
+    } else {
+      set perpage "&ppg=$ppg"
+    }
+
+    append log_text "<li>[cgi_url "restart Web Alpine" "http://alpine.washington.edu"]"
+    append log_text "<li>[cgi_url "go to MyUW" "http://myuw.washington.edu"]"
+    append log_text "</ul></center>"
+    set log_url ""
+  } else {
+    set log_text "Please visit the [cgi_link Start] for a new session."
+    set log_url $_wp(serverpath)/
+  }
+
+  if {[info exists logerr] && [string length $logerr]} {
+    set log_text "[cgi_bold "Please Note"]: A problem, \"$logerr\", occurred while ending your session.<p>${log_text}"
+  }
+
+  WPInfoPage "Logged Out" "[font size=+2 face=Helvetica "Thank you for using Alpine"]" $log_text $log_url
+}
diff --git a/web/cgi/session/logout/tclsh b/web/cgi/session/logout/tclsh
new file mode 120000
index 00000000..385fc6c6
--- /dev/null
+++ b/web/cgi/session/logout/tclsh
@@ -0,0 +1 @@
+../tclsh
\ No newline at end of file
diff --git a/web/cgi/session/monitor.tcl b/web/cgi/session/monitor.tcl
new file mode 100755
index 00000000..70edf61f
--- /dev/null
+++ b/web/cgi/session/monitor.tcl
@@ -0,0 +1,282 @@
+#!./tclsh
+# $Id: monitor.tcl 1074 2008-06-04 00:08:43Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+#  monitor.tcl
+
+# read config
+source ./alpine.tcl
+
+proc nicetime {timeoutput} {
+  if {[regexp {^[0-9]+ } $timeoutput msec]} {
+    return "[format {%d.%06d} [expr {$msec / 1000000}] [expr {$msec % 1000000}]] seconds"
+  } else {
+    return $timeoutput
+  }
+}
+
+# take process snapshot
+#set cmd "/bin/ps -lC alpined --sort=cutime"
+set cmd "/bin/ps -auxww --sort=cutime"
+if {[catch "exec $cmd" result]} {
+  set prohdr "ps error: $result"
+  set proclist {}
+} else {
+  set r [split $result "\n"]
+  set prochdr [lindex $r 0]
+  set proclist [lrange $r 1 end]
+}
+
+cgi_eval {
+  cgi_html {
+    cgi_head {
+      cgi_title "Web Alpine Monitor"
+      cgi_puts  "<style type='text/css'>"
+      cgi_puts  ".monsec { text-decoration: underline ; margin: 4}"
+      cgi_puts "</style>"
+    }
+
+    cgi_body {
+      cgi_h2 "WebPine Status // [info hostname] // [clock format [clock seconds]]"
+
+      ##
+      ## system performance monitor
+      ##n
+      cgi_preformatted {
+	# simple server load
+	set cmd "/usr/ucb/uptime"
+	if {[catch "exec $cmd" result]} {
+	  cgi_puts "uptime unavailable: $result"
+	} else {
+	  cgi_puts [cgi_span class=monsec "Server uptime"]
+	  foreach l [split $result "\n"] {
+	    cgi_puts "  $l"
+	  }
+	}
+
+	cgi_br
+
+	# list alpined adapters
+	foreach l $proclist {
+	  if {[regexp $_wp(servlet) $l] || [regexp $_wp(pc_servlet) $l]} {
+	    lappend adapters $l
+	  }
+	}
+
+	cgi_puts [cgi_span class=monsec "WebPine Adapters ([llength $adapters])"]
+	cgi_puts "  $prochdr"
+	foreach l $adapters {
+	  cgi_puts "  $l"
+	}
+
+	cgi_br
+
+	# tmp disc usage
+	cgi_puts [cgi_span class=monsec "Temp Directory Usage ($_wp(tmpdir))"]
+	set cmd "/bin/df $_wp(tmpdir)"
+	if {[catch "exec $cmd" result]} {
+	  cgi_puts "usage unavailable: $result"
+	} else {
+	  foreach l [split $result "\n"] {
+	    cgi_puts "  $l"
+	  }
+	}
+
+	cgi_br 
+
+	# detach staging usage
+	cgi_puts [cgi_span class=monsec "Detach Staging Usage ($_wp(tmpdir))"]
+	set cmd "/bin/df $_wp(detachpath)"
+	if {[catch "exec $cmd" result]} {
+	  cgi_puts "usage unavailable: $result"
+	} else {
+	  foreach l [split $result "\n"] {
+	    cgi_puts "  $l"
+	  }
+	}
+
+	if {[info exists report_env]} {
+	  cgi_br
+
+	  cgi_puts [cgi_span class=monsec "Environment:"]
+
+	  set cgiv {
+	    SERVER_SOFTWARE
+	    SERVER_NAME
+	    GATEWAY_INTERFACE
+	    SERVER_PROTOCOL
+	    SERVER_PORT
+	    REQUEST_METHOD
+	    PATH_INFO
+	    PATH_TRANSLATED
+	    SCRIPT_NAME
+	    QUERY_STRING
+	    REMOTE_HOST
+	    REMOTE_ADDR
+	    AUTH_TYPE
+	    REMOTE_USER
+	    REMOTE_IDENT
+	    CONTENT_TYPE
+	    CONTENT_LENGTH
+	    HTTP_ACCEPT
+	    HTTP_USER_AGENT
+	  }
+	  foreach v $cgiv {
+	    if {[info exists env($v)]} {
+	      cgi_puts "  $v: $env($v)"
+	    }
+	  }
+	}	
+
+
+	##
+	## session specific feedback
+	##
+	if {[info exists _wp(monitors)]
+	    && [info exists env(REMOTE_USER)]
+	    && [lsearch -exact $_wp(monitors) $env(REMOTE_USER)] >= 0} {
+
+	  cgi_br
+
+	  cgi_puts [cgi_span class=monsec "Kerberos ticket cache info"]
+	  foreach l [glob "[file join $_wp(tmpdir) krb]*"] {
+	    set file [file join $_wp(tmpdir) $l]
+	    cgi_put "  [exec /bin/ls -l $file]"
+	    if {[catch {expr {[clock seconds] - [file mtime $file]}} d]} {
+	    } else {
+	      cgi_puts "  ([expr {$d / 3600}] hours, [expr {($d % 3600) / 60}] minutes old)"
+	    }
+	  }
+
+	  cgi_br
+
+	  cgi_puts [cgi_span class=monsec "uid_mapper Process"]
+	  # Condition of uid_mapper
+	  cgi_puts "  $prochdr"
+	  foreach l $proclist {
+	    if {[regexp uidmapper $l]} {
+	      lappend umlist $l
+	    }
+	  }
+
+	  if {[info exists umlist]} {
+	    foreach l $umlist {
+	      cgi_puts "  $l"
+	    }
+	  } else {
+	    cgi_puts "  HELP!!! NO UIDMAPPER RUNNING!!!"
+	  }
+
+	  cgi_br
+
+	  if {[info exists _wp(hosts)] && [llength $_wp(hosts)]} {
+	    cgi_puts [cgi_span class=monsec "Session Performance (netid: $env(REMOTE_USER))"]
+
+	    set sdata [lindex $_wp(hosts) 0]
+	    set User $env(REMOTE_USER)
+	    set env(IMAP_SERVER) "[subst [lindex $sdata 1]]/user=$env(REMOTE_USER)"
+
+	    if {[llength $sdata] > 2 && [string length [lindex $sdata 2]]} {
+	      set defconf [subst [lindex $sdata 2]]
+	      set confloc "\{$env(IMAP_SERVER)\}$_wp(config)"
+	      cgi_puts "  User Config: $confloc"
+
+	      # launch session
+	      cgi_put "  alpined Launch: "
+	      set ct [time {
+		if {[catch {exec [file join $_wp(bin) launch.tcl]} _wp(sessid)]} {
+		  set err "FAILURE: $_wp(sessid)"
+		} else {
+		  WPValidId $_wp(sessid)
+		}
+	      }]
+
+	      if {[info exists err]} {
+		cgi_puts $err
+	      } else {
+		cgi_puts [nicetime $ct]
+
+		cgi_put "  Open Inbox: "
+		set ct [time {
+		  if {[catch {WPCmd PESession open $env(REMOTE_USER) "" $confloc $defconf} answer]} {
+		    set err "FAILURE: "
+		    if {[info exists answer]} {
+		      if {[string length $answer] == 0} {
+			append err "Unknown Username or Incorrect Password"
+		      } else {
+			append err $answer
+		      }
+		    } else {
+		      append err "Unknown reason"
+		    }
+		  }
+		}]
+
+		if {[info exists err]} {
+		  cgi_puts $err
+		} else {
+		  cgi_puts [nicetime $ct]
+
+		  cgi_put "  Fetch First Message: "
+
+		  set ct [time {
+		    if {[catch {
+			         set msg [WPCmd PEMailbox first]
+			         set uid [WPCmd PEMailbox uid $msg]
+			         set txt [WPCmd PEMessage $uid text]
+			       } txt]} {
+		      set err $txt
+		    }
+		  }]
+
+		  if {[info exists err]} {
+		    cgi_puts "FAILURE: $err"
+		  } else {
+		    cgi_puts [nicetime $ct]
+
+		    cgi_put "  Fetch Last Message: "
+
+		    set ct [time {
+		      if {[catch {
+				    set msg [WPCmd PEMailbox last]
+				    set uid [WPCmd PEMailbox uid $msg]
+				    set txt [WPCmd PEMessage $uid text]
+				  } txt]} {
+			set err $txt
+		      }
+		    }]
+
+		    if {[info exists err]} {
+		      cgi_puts "FAILURE: $err"
+		    } else {
+		      cgi_puts [nicetime $ct]
+		    }
+		  }
+		}
+
+		set ct [time {
+		  catch {WPCmd PESession close}
+		  catch {WPCmd exit}
+		}]
+
+		cgi_puts "  Close Session: [nicetime $ct]"
+	      }
+	    } else {
+	      cgi_puts "Invalid host configuration"
+	    }
+
+	  }
+	}
+      }
+    }
+  }
+}
\ No newline at end of file
diff --git a/web/cgi/session/queryauth.tcl b/web/cgi/session/queryauth.tcl
new file mode 100755
index 00000000..27e10c97
--- /dev/null
+++ b/web/cgi/session/queryauth.tcl
@@ -0,0 +1,120 @@
+#!./tclsh
+# $Id: queryauth.tcl 1204 2009-02-02 19:54:23Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+#  queryauth.tcl
+#
+#  Purpose:  CGI script to generate html form used to ask for authentication
+#            credentials
+
+# input:
+set query_vars {
+  {cid		"Missing Command ID"}
+  {authcol	"Missing Authenticaion Collection"}
+  {authfolder	"Missing Authentication Folder"}
+  {authpage	"No Post Authorization Instructions"}
+  {authcancel	"No Auth Cancel Instructions"}
+  {authuser	""	""}
+  {reason	""	""}
+}
+
+#  Output:
+#
+#	HTML/Javascript/CSS data representing the message specified
+#	by the 'uid' argument
+
+
+# inherit global config
+source ./alpine.tcl
+source ../$_wp(appdir)/$_wp(ui1dir)/cmdfunc.tcl
+
+
+set query_menu {
+  {
+    {}
+    {
+      {
+	# * * * * Help * * * *
+	cgi_put "Get Help"
+      }
+    }
+  }
+}
+
+
+WPEval $query_vars {
+
+  if {$cid != [WPCmd PEInfo key]} {
+    error [list _action open "Invalid Operation ID" "Click Back button to try again."]
+  }
+
+  cgi_http_head {
+    WPStdHttpHdrs
+  }
+
+  cgi_html {
+    cgi_head {
+      WPStdHtmlHdr "Authentication Credentials"
+      WPStyleSheets
+    }
+
+    if {[string length $authuser]} {
+      set onload "onLoad=document.auth.pass.focus()"
+    } else {
+      set onload "onLoad=document.auth.user.focus()"
+    }
+
+    cgi_body BGCOLOR="$_wp(bordercolor)" $onload {
+      cgi_form $_wp(serverpath)/session/setauth.tcl method=post enctype=multipart/form-data name=auth target=_top {
+	cgi_text "sessid=$sessid" type=hidden notab
+	cgi_text "cid=$cid" type=hidden notab
+	cgi_text "authcol=$authcol" type=hidden notab
+	cgi_text "authfolder=$authfolder" type=hidden notab
+	cgi_text "authpage=$authpage" type=hidden notab
+	cgi_text "authcancel=$authcancel" type=hidden notab
+
+	cgi_table border=0 cellspacing=0 cellpadding=2 width="100%" height="100%" {
+	  cgi_table_row {
+	    eval {
+	      cgi_table_data $_wp(menuargs) {
+		WPTFCommandMenu query_menu {}
+	      }
+	    }
+
+	    cgi_table_data valign=top class=dialog {
+	      cgi_division align=center class=dialog "style=\"padding:30 12%\"" {
+		if {[info exists reason] && [string compare BADPASSWD [string range $reason 0 8]]} {
+		  cgi_puts $reason
+		} else {
+		  cgi_puts "Login Required"
+		}
+	      }
+
+	      cgi_center {
+		cgi_puts [cgi_font size=+1 class=dialog "Username: "]
+		cgi_text user=$authuser maxlength=30 size=25%
+		cgi_br
+		cgi_br
+		cgi_puts [cgi_font size=+1 class=dialog "Password: "]
+		cgi_text pass= type=password maxlength=30 size=25%
+		cgi_br
+		cgi_br
+		cgi_submit_button auths=Login
+		cgi_submit_button cancel=Cancel
+	      }
+	    }
+	  }
+	}
+      }
+    }
+  }
+}
diff --git a/web/cgi/session/setauth.tcl b/web/cgi/session/setauth.tcl
new file mode 100755
index 00000000..c2da7a6b
--- /dev/null
+++ b/web/cgi/session/setauth.tcl
@@ -0,0 +1,68 @@
+#!./tclsh
+# $Id: setauth.tcl 764 2007-10-23 23:44:49Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+#  setauth.tcl
+#
+#  Purpose:  CGI script to generate html form used to ask for authentication
+#            credentials
+
+#  Input:
+set auth_vars {
+  {cid		"Missing Command ID"}
+  {authcol	"No Authorization Collection"}
+  {authfolder	"No Authorization Folder"}
+  {authpage	"No Post Authorization Instructions"}
+  {authcancel	"No Auth Cancel Instructions"}
+  {auths	""	0}
+  {user		""	0}
+  {pass		""	0}
+  {cancel	""	0}
+}
+
+#  Output:
+#
+#	Redirect to specified post-authentication page
+
+# inherit global config
+source ./alpine.tcl
+
+
+WPEval $auth_vars {
+
+  if {$cid != [WPCmd PEInfo key]} {
+    error [list _action open "Invalid Operation ID" "Click Back button to try again."]
+  }
+
+  # if NOT cancelled
+  if {[string compare $auths "Login"] == 0
+      && [string length $user]
+      && [catch {WPCmd PESession creds $authcol $authfolder $user $pass}] == 0} {
+    set redirect $authpage
+  } else {
+    set redirect $authcancel
+  }
+
+  cgi_http_head {
+    # redirect to the place we stuffed the export info.  use the ip address
+    # to foil spilling any session cookies or the like
+
+    if {[info exists env(SERVER_PROTOCOL)] && [regexp {[Hh][Tt][Tt][PP]/([0-9]+)\.([0-9]+)} $env(SERVER_PROTOCOL) m vmaj vmin] && $vmaj >= 1 && $vmin >= 1} {
+      cgi_puts "Status: 303 Temporary Redirect"
+    } else {
+      cgi_puts "Status: 302 Redirected"
+    }
+
+    cgi_puts "URI: $redirect"
+    cgi_puts "Location: $redirect"
+  }
+}
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"
+}
diff --git a/web/cgi/session/setpassphrase.tcl b/web/cgi/session/setpassphrase.tcl
new file mode 100755
index 00000000..b4d25e26
--- /dev/null
+++ b/web/cgi/session/setpassphrase.tcl
@@ -0,0 +1,52 @@
+#!./tclsh
+# $Id: setpassphrase.tcl 1142 2008-08-13 17:22:21Z hubert@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
+#
+# ========================================================================
+
+#  setpassphrase.tcl
+#
+#  Purpose:  CGI script to accept user passphrase
+#            via xmlHttpRequest
+
+#  Input:
+set auth_vars {
+  {auths	""	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 passphrase"
+
+if {[string compare $auths "Smime"] != 0
+    || [string length $pass] == 0
+    || [catch {WPCmd PESession setpassphrase $pass} answer]} {
+  cgi_puts "Cannot accept passphrase: $answer"
+}
diff --git a/web/cgi/session/startup.tcl b/web/cgi/session/startup.tcl
new file mode 100755
index 00000000..9e3feec8
--- /dev/null
+++ b/web/cgi/session/startup.tcl
@@ -0,0 +1,33 @@
+#!./tclsh
+# $Id: startup.tcl 764 2007-10-23 23:44:49Z hubert@u.washington.edu $
+# ========================================================================
+# Copyright 2006 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
+#
+# ========================================================================
+
+# read config
+source ./alpine.tcl
+
+# Input: page
+
+# Output: redirection to given page
+
+cgi_eval {
+  cgi_input
+
+  if {[catch {cgi_import page}]} {
+      WPInfoPage "Bogus Page Request" \
+	  "[font size=+2 "Invalid Page Request!"]" \
+	  "Please click your browser's [bold Back] button to return to the [cgi_link Start]"
+  } else {
+    cgi_http_head {
+      cgi_redirect $page
+    }
+  }
+}
\ No newline at end of file
diff --git a/web/cgi/session/tclsh b/web/cgi/session/tclsh
new file mode 120000
index 00000000..385fc6c6
--- /dev/null
+++ b/web/cgi/session/tclsh
@@ -0,0 +1 @@
+../tclsh
\ No newline at end of file