#!/usr/local/bin/tclsh8.0
proc outputHeader { } {
puts "Content-type: text/html\n\n "
}
proc outputFooter {} {
puts ""
}
proc getid.outputButton { capaid argumentsVar } {
global machine
upvar $argumentsVar arguments
puts ""
}
proc getid.main {argumentsVar} {
global config classList
upvar $argumentsVar arguments
outputHeader
if { [array names classList $arguments(CLASS).path] != "" } {
set pwd [pwd]
catch {cd $classList($arguments(CLASS).path)} error
# puts "hey :$error:"
catch {set result [exec $config(webpage) -getid $arguments(SNUM) \
$arguments(SETID) $arguments(CAPAID) ]} error
# puts "hey :$error:"
# puts "hey :$error:$result:"
switch $result {
InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
InvalidOldCapaID -
NotFound { puts "The provided old CAPAID ($arguments(CAPAID)) is not a valid CAPAID for any set previous to the requested set $arguments(SETID)." }
NotOpen { puts "The set requested, $arguments(SETID), is not open." }
default { puts "Your CAPAID is $result for Set $arguments(SETID) in class $arguments(CLASS)."; getid.outputButton $result arguments}
}
cd $pwd
} else {
puts "Invalid request. Class $arguments(CLASS) not found."
}
outputFooter
}
proc capaid.outputButton { capaid argumentsVar } {
global machine
upvar $argumentsVar arguments
puts ""
}
proc capaid.main {argumentsVar} {
global config classList
upvar $argumentsVar arguments
outputHeader
if { [array names classList $arguments(CLASS).path] != "" } {
set pwd [pwd]
catch {cd $classList($arguments(CLASS).path)} error
# puts "hey :$error:"
catch {set result [exec $config(webpage) -getid $arguments(SNUM) \
$arguments(SETID)]} error
# puts "hey :$error:"
# puts "hey :$error:$result:"
switch $result {
InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
InvalidOldCapaID -
NotFound { puts "The provided Student Number $arguments(SNUM) is not a valid for $arguments(CLASS)." }
NotOpen { puts "The set requested, $arguments(SETID), is not open." }
default { puts "Your CAPAID is $result for Set $arguments(SETID) in class $arguments(CLASS)."; capaid.outputButton $result arguments}
}
cd $pwd
} else {
puts "Invalid request. Class $arguments(CLASS) not found."
}
outputFooter
}
proc emailid.sendmail { what who argumentsVar } {
global config
upvar $argumentsVar arguments
if { $who == "" } {
puts "There is no e-mail address available for this student. Please contact you r instructor to obtain your CAPAID."
} else {
set mailID [open "|$config(mail) -s \"Requested CAPAID\" $who" w]
puts $mailID "The CAPAID you requested for class $arguments(CLASS), set number $arguments(SETID) is $what."
close $mailID
puts "Your CAPAID has been mailed to your university e-mail account."
}
}
proc emailid.main {argumentsVar} {
global classList config
upvar $argumentsVar arguments
outputHeader
if { [array names classList $arguments(CLASS).path] != "" } {
set pwd [pwd]
if {[catch {cd $classList($arguments(CLASS).path)} error ]} {
puts $error; return
}
if {[catch {set result [exec $config(webpage) -emailcapaid $arguments(SNUM) \
$arguments(SETID) ]} error ]} {
puts $error; return
}
cd $pwd
switch $result {
InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
NotOpen { puts "The set requested, $arguments(SETID), is not yet open for access." }
NotFound { puts "Unable to find student number $arguments(SNUM) in classlist."}
default {
if { [catch { eval "emailid.sendmail $result arguments" } error ] } {
puts "$error:There is no e-mail address available for this student. Please contact your instructor to obtain your CAPAID."
}
}
}
} else {
puts "Invalid request. Class $arguments(CLASS) not found."
}
outputFooter
}
proc getSettings { } {
global classList
set confID [open "class.conf"]
set aline [gets $confID]
while {![eof $confID]} {
set class [lindex $aline 0]
set path [lindex $aline 1]
set classList($class.path) [file join $path $class]
set aline [gets $confID]
}
}
proc ids.main {} {
global env
getSettings
set request [string trim [read file0]]
foreach {var value} [split $request "&="] {set arguments($var) [string trim $value]}
catch {set arguments(SETID) [string trimleft $arguments(SETID) 0]}
catch {set logFileId [open ids.log "a"]} error
set b [split $request "&="]
if { [catch {lappend b $env(REMOTE_HOST)}]} {
if { [catch {lappend b $env(REMOTE_ADDR)}] } {
lappend b UNKNOWN
}
}
puts $logFileId "[clock format [clock seconds]] $b"
close $logFileId
$arguments(TYPE).main arguments
}
proc optionlist { match } {
global env
set request ""
catch {puts $env(QUERY_STRING)}
catch {set request [string trim $env(QUERY_STRING)]}
if { $request == "" } {
set arguments(CLASS) ""
} else {
foreach {var value} [split $request "&="] {set arguments($var) [string trim $value]}
}
set confID [open "class.conf"]
set aline [gets $confID]
while {!([eof $confID] && ($aline == ""))} {
set type [lindex $aline 3]
if { [lsearch $type $match] != -1 } {
set classname [lindex $aline 0]
if { [string toupper $classname] == [string toupper $arguments(CLASS)] } {
puts "