Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Updated to use centralized function for logging in Rivet/Starkit |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: | 361a6aeaca57084897a7097685c5e4a80b4f4873 |
| User & Date: | rkeene 2011-11-22 11:07:15 |
Context
|
2012-05-12
| ||
| 18:22 | Updated ignores check-in: 4f298b4068 user: rkeene tags: trunk | |
|
2011-11-22
| ||
| 11:07 | Updated to use centralized function for logging in Rivet/Starkit check-in: 361a6aeaca user: rkeene tags: trunk | |
|
2011-07-08
| ||
| 13:42 | Updated to try hardre to compile librivetparser check-in: 24c1357b4e user: rkeene tags: trunk | |
Changes
Changes to rivet-starkit/main.tcl.
719 720 721 722 723 724 725 726 727 728 729 730 731 732 ... 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 ... 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 ... 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 .... 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 .... 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 .... 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 .... 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 .... 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 .... 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 |
}
return $retval
}
return "unknown"
}
proc print_help {} {
tcl_puts "Usage: [file tail [info nameofexecutable]] {--server \[--address <address>\]"
tcl_puts " \[--port <port>\] \[--foreground {yes|no}\] \[--init <scp>\]"
tcl_puts " \[--logfile {-|<file>}\] \[--errorlog {-|<file>}\] \[--maxthreads <num>\]"
tcl_puts " \[--sslport <port>\] \[--sslcert <file>\] \[--sslkey <file>\]"
tcl_puts " \[--sslcafile <file>\] \[--sslcadir <dir>\] \[--sslreqcert {yes|no}\]"
................................................................................
}
proc rivet_cgi_tls_callback {logfd elogfd mode args} {
switch -- $mode {
"error" {
foreach {chan msg} $args break
if {$elogfd != ""} {
tcl_puts $elogfd "($chan) TLS error: $msg"
}
return 1
}
"verify" {
foreach {chan depth cert rc err} $args break
# Only care about client certificates, all others follow normal rules
................................................................................
if {$depth != 0} {
return $rc
}
if {$rc != "1"} {
# Do not note that this certificate is valid, but return OK
if {$elogfd != ""} {
tcl_puts $elogfd "($chan) Invalid cert $cert: $err"
}
set ::rivet_cgi_tls_verified($chan) 0
return 1
}
if {![info exists ::rivet_cgi_tls_verified($chan)]} {
................................................................................
if {![info exists ::rivetstarkit::threadinfo]} {
array set ::rivetstarkit::threadinfo {}
}
unset -nocomplain threadId
foreach {thread isInUse} [array get ::rivetstarkit::threadinfo] {
if {!$isInUse} {
tcl_puts $elogfd "Using existing thread: $thread"
set threadId $thread
break
}
}
# If none found, make sure we haven't exceeded the maximum number of threads
if {![info exists threadId]} {
set numthreads [llength [thread::names]]
if {$numthreads > $maxthreads} {
tcl_puts $elogfd "Exceeded maximum number of threads ($maxthreads): $numthreads, closing socket!"
unset -nocomplain ::rivet_cgi_tls_verified($sock)
close $sock
return
}
}
# If none found, create one...
if {![info exists threadId]} {
# Create an empty interpreter in a new thread
set threadId [thread::create]
tcl_puts $elogfd "Creating thread: $threadId"
# Load the needed packages in the new thread
thread::send $threadId [list package require tclrivet]
thread::send $threadId [list set ::rivet::parsestack [info script]]
# Copy the appropriate namespaces to the new thread
foreach ns [list ::rivetstarkit] {
................................................................................
thread::send $threadId [list set $var [set $var]]
} else {
thread::send $threadId [list unset -nocomplain $var]
}
}
# Copy the appropriate procedures to the new thread
foreach proc [list rivet_cgi_server_request_data rivet_cgi_server_request call_page] {
if {[namespace qualifiers $var] != ""} {
thread::send $threadId [list namespace eval [namespace qualifiers $var] ""]
}
set procargs [list]
foreach arg [info args $proc] {
if {[info default $proc $arg defval]} {
................................................................................
lappend procargs $arg
}
}
thread::send $threadId [list proc $proc $procargs [info body $proc]]
}
tcl_puts $elogfd " ... done creating thread ($threadId)"
}
# Mark the specified thread as in-use
set ::rivetstarkit::threadinfo($threadId) 1
# Perform the bottom-half of the processing (we are required to re-enter the event loop)
after idle [list rivet_cgi_server_request $hostport $logfd $elogfd "thread-parent" 0 $httpmode $sock $addr $port $threadId]
................................................................................
}
"thread-parent" {
set pmodel "thread"
# Transfer the socket to the thread, and specify our thread Id
thread::transfer $threadId $sock
tcl_puts $elogfd "Calling child thread to handle request ($threadId) in background"
thread::send -async $threadId [list rivet_cgi_server_request $hostport "" "" "thread-child" 0 $httpmode $sock $addr $port [thread::id]]
tcl_puts $elogfd " ... done ($threadId)."
return
}
"thread-child" {
set pmodel "thread"
set parentThreadId $threadId
unset threadId
................................................................................
unset -nocomplain ::rivet_cgi_tls_verified($sock)
catch {
close $sock
}
} err]} {
if {$elogfd != ""} {
tcl_puts $elogfd "Error while installing callback: \"$err\""
}
}
switch -- $pmodel {
"fork" {
exit
}
"thread" {
# Mark the thread as free
if {$elogfd != ""} {
tcl_puts $elogfd "Marking thread as free ([thread::id])"
}
thread::send -async $parentThreadId [list set ::rivetstarkit::threadinfo([thread::id]) 0]
if {$elogfd != ""} {
tcl_puts $elogfd " ... done ([thread::id])."
}
}
}
}
proc rivet_cgi_server_request_data {sock addr hostport logfd elogfd pmodel} {
if {[catch {
array set sockinfo $::rivetstarkit::sockinfo($sock)
................................................................................
if {[catch {
if {$pmodel == "flat"} {
set result [call_page [array get myenv] 1]
} else {
set result [call_page [array get myenv] 0]
}
if {$logfd != ""} {
tcl_puts $logfd "$addr - - \[[clock format [clock seconds] -format {%d/%b/%Y:%H:%M:%S %z}]\] \"$sockinfo(requestline)\" 200 0 \"-\" \"$ua\""
flush $logfd
}
} err]} {
if {$logfd != ""} {
tcl_puts $logfd "$addr - - \[[clock format [clock seconds] -format {%d/%b/%Y:%H:%M:%S %z}]\] \"$sockinfo(requestline)\" 500 0 \"-\" \"$ua\" \"Error: [join [split $err {"\n}]]\""
flush $logfd
}
if {$elogfd != ""} {
tcl_puts $elogfd "($sock/$addr/[pid]) $err"
tcl_puts $elogfd "($sock/$addr/[pid]) $::errorInfo"
flush $elogfd
}
}
# Cleanup
unset sockinfo
set sockinfo(state) NEW
if {$headers(CONNECTION) != "keep-alive" || $result != "keep-alive"} {
................................................................................
}
}
set ::rivetstarkit::sockinfo($sock) [array get sockinfo]
}] == "1"} {
# In case of error, abort.
set ::rivetstarkit::finished($sock) 1
if {$elogfd != ""} {
tcl_puts $elogfd "($sock/$addr/[pid]) $::errorInfo"
flush $elogfd
}
}
}
# Determine if we are being called as a CGI, or from the command line
if {![info exists ::env(GATEWAY_INTERFACE)]} {
set cmd [lindex $argv 0]
|
> > > > > > > > > > > > < | < < | < | | | | | | | > < | < < | < < | < < | < < < | < | < < | | < < < | < < |
719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 ... 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 ... 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 .... 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 .... 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 .... 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 .... 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 .... 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 .... 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 .... 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 |
} return $retval } return "unknown" } proc ::rivetstarkit::puts_log {logfd msg} { if {$logfd == ""} { return } catch { tcl_puts $logfd $msg flush $logfd } } proc print_help {} { tcl_puts "Usage: [file tail [info nameofexecutable]] {--server \[--address <address>\]" tcl_puts " \[--port <port>\] \[--foreground {yes|no}\] \[--init <scp>\]" tcl_puts " \[--logfile {-|<file>}\] \[--errorlog {-|<file>}\] \[--maxthreads <num>\]" tcl_puts " \[--sslport <port>\] \[--sslcert <file>\] \[--sslkey <file>\]" tcl_puts " \[--sslcafile <file>\] \[--sslcadir <dir>\] \[--sslreqcert {yes|no}\]" ................................................................................ } proc rivet_cgi_tls_callback {logfd elogfd mode args} { switch -- $mode { "error" { foreach {chan msg} $args break ::rivetstarkit::puts_log $elogfd "($chan) TLS error: $msg" return 1 } "verify" { foreach {chan depth cert rc err} $args break # Only care about client certificates, all others follow normal rules ................................................................................ if {$depth != 0} { return $rc } if {$rc != "1"} { # Do not note that this certificate is valid, but return OK ::rivetstarkit::puts_log $elogfd "($chan) Invalid cert $cert: $err" set ::rivet_cgi_tls_verified($chan) 0 return 1 } if {![info exists ::rivet_cgi_tls_verified($chan)]} { ................................................................................ if {![info exists ::rivetstarkit::threadinfo]} { array set ::rivetstarkit::threadinfo {} } unset -nocomplain threadId foreach {thread isInUse} [array get ::rivetstarkit::threadinfo] { if {!$isInUse} { ::rivetstarkit::puts_log $elogfd "Using existing thread: $thread" set threadId $thread break } } # If none found, make sure we haven't exceeded the maximum number of threads if {![info exists threadId]} { set numthreads [llength [thread::names]] if {$numthreads > $maxthreads} { ::rivetstarkit::puts_log $elogfd "Exceeded maximum number of threads ($maxthreads): $numthreads, closing socket!" unset -nocomplain ::rivet_cgi_tls_verified($sock) close $sock return } } # If none found, create one... if {![info exists threadId]} { # Create an empty interpreter in a new thread set threadId [thread::create] ::rivetstarkit::puts_log $elogfd "Creating thread: $threadId" # Load the needed packages in the new thread thread::send $threadId [list package require tclrivet] thread::send $threadId [list set ::rivet::parsestack [info script]] # Copy the appropriate namespaces to the new thread foreach ns [list ::rivetstarkit] { ................................................................................ thread::send $threadId [list set $var [set $var]] } else { thread::send $threadId [list unset -nocomplain $var] } } # Copy the appropriate procedures to the new thread foreach proc [list rivet_cgi_server_request_data rivet_cgi_server_request call_page ::rivetstarkit::puts_log] { if {[namespace qualifiers $var] != ""} { thread::send $threadId [list namespace eval [namespace qualifiers $var] ""] } set procargs [list] foreach arg [info args $proc] { if {[info default $proc $arg defval]} { ................................................................................ lappend procargs $arg } } thread::send $threadId [list proc $proc $procargs [info body $proc]] } ::rivetstarkit::puts_log $elogfd " ... done creating thread ($threadId)" } # Mark the specified thread as in-use set ::rivetstarkit::threadinfo($threadId) 1 # Perform the bottom-half of the processing (we are required to re-enter the event loop) after idle [list rivet_cgi_server_request $hostport $logfd $elogfd "thread-parent" 0 $httpmode $sock $addr $port $threadId] ................................................................................ } "thread-parent" { set pmodel "thread" # Transfer the socket to the thread, and specify our thread Id thread::transfer $threadId $sock ::rivetstarkit::puts_log $elogfd "Calling child thread to handle request ($threadId) in background" thread::send -async $threadId [list rivet_cgi_server_request $hostport "" "" "thread-child" 0 $httpmode $sock $addr $port [thread::id]] ::rivetstarkit::puts_log $elogfd " ... done ($threadId)." return } "thread-child" { set pmodel "thread" set parentThreadId $threadId unset threadId ................................................................................ unset -nocomplain ::rivet_cgi_tls_verified($sock) catch { close $sock } } err]} { ::rivetstarkit::puts_log $elogfd "Error while installing callback: \"$err\"" } switch -- $pmodel { "fork" { exit } "thread" { # Mark the thread as free ::rivetstarkit::puts_log $elogfd "Marking thread as free ([thread::id])" thread::send -async $parentThreadId [list set ::rivetstarkit::threadinfo([thread::id]) 0] ::rivetstarkit::puts_log $elogfd " ... done ([thread::id])." } } } proc rivet_cgi_server_request_data {sock addr hostport logfd elogfd pmodel} { if {[catch { array set sockinfo $::rivetstarkit::sockinfo($sock) ................................................................................ if {[catch { if {$pmodel == "flat"} { set result [call_page [array get myenv] 1] } else { set result [call_page [array get myenv] 0] } ::rivetstarkit::puts_log $logfd "$addr - - \[[clock format [clock seconds] -format {%d/%b/%Y:%H:%M:%S %z}]\] \"$sockinfo(requestline)\" 200 0 \"-\" \"$ua\"" } err]} { ::rivetstarkit::puts_log $logfd "$addr - - \[[clock format [clock seconds] -format {%d/%b/%Y:%H:%M:%S %z}]\] \"$sockinfo(requestline)\" 500 0 \"-\" \"$ua\" \"Error: [join [split $err {"\n}]]\"" ::rivetstarkit::puts_log $elogfd "($sock/$addr/[pid]) $err" ::rivetstarkit::puts_log $elogfd "($sock/$addr/[pid]) $::errorInfo" } # Cleanup unset sockinfo set sockinfo(state) NEW if {$headers(CONNECTION) != "keep-alive" || $result != "keep-alive"} { ................................................................................ } } set ::rivetstarkit::sockinfo($sock) [array get sockinfo] }] == "1"} { # In case of error, abort. set ::rivetstarkit::finished($sock) 1 ::rivetstarkit::puts_log $elogfd "($sock/$addr/[pid]) $::errorInfo" } } # Determine if we are being called as a CGI, or from the command line if {![info exists ::env(GATEWAY_INTERFACE)]} { set cmd [lindex $argv 0] |