/usr/lib/tcltk/tclws2.3.8/AOLserver.tcl is in tclws 2.3.8-1.
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 | package require Tcl 8.4
namespace eval ::WS::AOLserver {
if {![info exists logVersion]} {
variable logVersion [package require log]
}
if {![info exists wsVersion]} {
variable wsVersion [package require WS::Server]
}
namespace import -force ::log::log
}
proc ::WS::AOLserver::ReturnData {sock type data code} {
log debug "AOLserver::ReturnData returning $code $type $data"
ns_return $code $type $data
}
proc ::WS::AOLserver::AddHandler {args} {
log debug "AOLserver::AddHandler added '$args'"
}
proc ::WS::AOLserver::Init { } {
uplevel 1 {
set server [ns_info server]
set nsset [ns_configsection "ns/server/$server/module/nssock"]
set headerSet [ns_conn headers]
set host [string tolower [ns_set iget $headerSet host]]
set hostList [split $host :]
set peeraddr [ns_conn peeraddr]
if {[llength $hostList] == 1} {
set port 80
} else {
set port [lindex $hostList 1]
}
set url [lindex [split [lindex [ns_conn request] 1] ?] 0]
set urlv [split $url /]
switch -exact -- [lindex $urlv end] {
"" {
# get service description
set requestType doc
}
"wsdl" {
# return wsdl
set requestType wsdl
}
"op" {
set requestType op
}
default {
set requestType [lindex $urlv end]
}
}
set prefix [join [lrange $urlv 0 end-1] /]
set service [lindex $urlv end-1]
::log::log debug "prefix = $prefix service = $service requestType = $requestType"
}
}
proc ::WS::AOLserver::Return {} {
uplevel 1 {
set sock nosock
switch -exact -- $requestType {
doc {
::WS::Server::generateInfo $service $sock
}
wsdl {
::WS::Server::generateWsdl $service $sock
}
op {
upvar #0 Httpd$sock data
# Copy Headers/ip
set headerLength [ns_set size $headerSet]
for {set i 0} {$i < $headerLength} {incr i} {
lappend headers [ns_set key $headerSet $i] [ns_set value $headerSet $i]
}
set data(ipaddr) $peeraddr
set data(headerlist) $headers
# Get POSTed data
set length [ns_set iget $headerSet "Content-length"]
set tmpFile [ns_tmpnam]
::log::log debug "Using tmpFile = $tmpFile"
set fp [ns_openexcl $tmpFile]
fconfigure $fp -translation binary
ns_conn copy 0 $length $fp
seek $fp 0
set data(query) [read $fp]
close $fp
# Run request
::WS::Server::callOperation $service $sock
}
default {
ns_return 200 text/plain "prefix = $prefix service = $service requestType = $requestType"
}
}
}
}
package provide WS::AOLserver 2.0.0
|