diff options
author | Eduardo Chappa <echappa@gmx.com> | 2013-02-03 00:59:38 -0700 |
---|---|---|
committer | Eduardo Chappa <echappa@gmx.com> | 2013-02-03 00:59:38 -0700 |
commit | 094ca96844842928810f14844413109fc6cdd890 (patch) | |
tree | e60efbb980f38ba9308ccb4fb2b77b87bbc115f3 /web/cgi/session/setauth.tcl | |
download | alpine-094ca96844842928810f14844413109fc6cdd890.tar.xz |
Initial Alpine Version
Diffstat (limited to 'web/cgi/session/setauth.tcl')
-rwxr-xr-x | web/cgi/session/setauth.tcl | 68 |
1 files changed, 68 insertions, 0 deletions
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" + } +} |