/usr/share/tcltk/tcllib1.18/httpd/scgi-app.tcl is in tcllib 1.18-dfsg-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | ###
# Author: Sean Woods, yoda@etoyoc.com
###
# This file provides the "application" side of the SCGI protocol
###
package require html
package require TclOO
package require httpd 4.0
namespace eval ::scgi {}
tool::class create ::scgi::reply {
superclass ::httpd::reply
###
# A modified dispatch method from a standard HTTP reply
# Unlike in HTTP, our headers were spoon fed to use from
# the server
###
method dispatch {newsock datastate} {
my query_headers replace $datastate
my variable chan rawrequest dipatched_time
set chan $newsock
chan event $chan readable {}
chan configure $chan -translation {auto crlf} -buffering line
set dispatched_time [clock seconds]
try {
# Dispatch to the URL implementation.
my content
} on error {err info} {
puts stderr $::errorInfo
my error 500 $err
} finally {
my output
}
}
method EncodeStatus {status} {
return "Status: $status"
}
}
tool::class create scgi::app {
superclass ::httpd::server
property socket buffersize 32768
property socket blocking 0
property socket translation {binary binary}
property reply_class ::scgi::reply
method connect {sock ip port} {
###
# If an IP address is blocked
# send a "go to hell" message
###
if {[my validation Blocked_IP $sock $ip]} {
catch {close $sock}
return
}
set query {
REQUEST_URI {NOT_POPULATED}
}
try {
chan configure $sock \
-blocking 1 \
-translation {binary binary} \
-buffersize 4096 \
-buffering none
# Read the SCGI request on byte at a time until we reach a ":"
set size {}
while 1 {
set char [read $sock 1]
if {[chan eof $sock]} {
catch {close $sock}
return
}
if {$char eq ":"} break
append size $char
}
# With length in hand, read the netstring encoded headers
set inbuffer [read $sock [expr $size+1]]
chan configure $sock -blocking 0 -buffersize 4096 -buffering full
set query [lrange [split [string range $inbuffer 0 end-1] \0] 0 end-1]
set reply [my dispatch $query]
dict with query {}
if {[llength $reply]} {
if {[dict exists $reply class]} {
set class [dict get $reply class]
} else {
set class [my cget reply_class]
}
set pageobj [$class create [namespace current]::reply::[::tool::uuid_short] [self]]
if {[dict exists $reply mixin]} {
oo::objdefine $pageobj mixin [dict get $reply mixin]
}
$pageobj dispatch $sock $reply
my log HttpAccess $REQUEST_URI
} else {
try {
my log HttpMissing $REQUEST_URI
puts $sock "Status: 404 NOT FOUND"
dict with query {}
set body [subst [my template notfound]]
puts $sock "Content-length: [string length $body]"
puts $sock
puts $sock $body
} on error {err errdat} {
puts stderr "FAILED ON 404: $err"
} finally {
catch {close $sock}
}
}
} on error {err errdat} {
try {
puts stderr $::errorInfo
puts $sock "Status: 505 INTERNAL ERROR"
dict with query {}
set body [subst [my template internal_error]]
puts $sock "Content-length: [string length $body]"
puts $sock
puts $sock $body
my log HttpError $REQUEST_URI
} on error {err errdat} {
puts stderr "FAILED ON 505: $err $::errorInfo"
} finally {
catch {close $sock}
}
}
}
}
package provide scgi::app 0.1
|