Tcl Library Source Code

Check-in [7b4c25cd6e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Modifications to the httpd module: httpd::reply object in order to simplify the code inside of httpd::server and give developers more rope to hang themselves. The httpd::reply method now uses one general purpose dispatch public method, with all of the application specific wulu magic now confined to a new private method Dispatch Folded the functions of the former reply::dispatch method into the new public dispatch method, and eliminated reply::dispatch. Replaced http::reply.scgi with a mixin that swaps that one function that is different between them. httpd::server no longer looks for an alternate reply class. It is now assumed that every reply will be httpd::reply, and that the dispatch method will be able to sort out what behaviors get mixed in. Simplified the implementation of ::httpd::plugin.dict_dispatch Added a new method to the Uri ensemble: uri::direct which automates the process of producing simple dynamic content cases. Formalized the arguments for uri::add Moved the headers parsing out of the body of Connect and into a dedicated method ServerHeaders. Added a call to Dispatch_Local to the default dispatch method.
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256:7b4c25cd6e71149ecb9df999a983495787a2359a929a12023bd006985fc8ccb9
User & Date: hypnotoad 2018-09-11 17:13:19
Context
2018-09-11
17:18
Httpd module: Removed a puts statement injected during debugging. Fixing a typo in logging check-in: c14446b881 user: hypnotoad tags: hypnotoad
17:13
Modifications to the httpd module: httpd::reply object in order to simplify the code inside of httpd::server and give developers more rope to hang themselves. The httpd::reply method now uses one general purpose dispatch public method, with all of the application specific wulu magic now confined to a new private method Dispatch Folded the functions of the former reply::dispatch method into the new public dispatch method, and eliminated reply::dispatch. Replaced http::reply.scgi with a mixin that swaps that one function that is different between them. httpd::server no longer looks for an alternate reply class. It is now assumed that every reply will be httpd::reply, and that the dispatch method will be able to sort out what behaviors get mixed in. Simplified the implementation of ::httpd::plugin.dict_dispatch Added a new method to the Uri ensemble: uri::direct which automates the process of producing simple dynamic content cases. Formalized the arguments for uri::add Moved the headers parsing out of the body of Connect and into a dedicated method ServerHeaders. Added a call to Dispatch_Local to the default dispatch method. check-in: 7b4c25cd6e user: hypnotoad tags: hypnotoad
2018-09-08
18:56
Pulling changes from trunk check-in: 57af8b6c63 user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/httpd/build/dispatch.tcl.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    chan event $chan readable {}
    try {
      my request dispatch $datastate
      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan







|

<
<

<







23
24
25
26
27
28
29
30
31


32

33
34
35
36
37
38
39
    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method Dispatch {} {
    my variable chan


    try {

      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan

Changes to modules/httpd/build/file.tcl.

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method dispatch {newsock datastate} {
    my variable reply_body reply_file reply_chan chan
    try {
      my request dispatch $datastate
      set chan $newsock
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line

      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }







|


<
<
<
<
<







102
103
104
105
106
107
108
109
110
111





112
113
114
115
116
117
118
        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method Dispatch {} {
    my variable reply_body reply_file reply_chan chan
    try {





      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }

Changes to modules/httpd/build/plugin.tcl.

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
    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {

    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]
    foreach {host pattern info} [my uri patterns] {

      if {![string match $host $vhost]} continue

      if {![string match $pattern $uri]} continue
      set buffer $data
      foreach {f v} $info {
        dict set buffer $f $v
      }
      return $buffer

    }
    return {}
  }

  Ensemble uri::patterns {} {
    my variable url_patterns url_stream
    if {![info exists url_stream]} {
      set url_stream {}
      foreach {host hostpat} $url_patterns {
        foreach {pattern info} $hostpat {
          lappend url_stream $host $pattern $info
        }
      }
    }
    return $url_stream
  }

  Ensemble uri::add args {
    my variable url_patterns url_stream
    unset -nocomplain url_stream
    switch [llength $args] {
      2 {
        set vhosts *
        lassign $args patterns info
      }
      3 {
        lassign $args vhosts patterns info
      }
      default {
        error "Usage: add_url ?vhosts? prefix info"
      }
    }
    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }















}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body







>


<
>

>
|
|
|
|
|
|
>




<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {
    my variable url_patterns
    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]

    foreach {host hostpat} $url_patterns {
      if {![string match $host $vhost]} continue
      foreach {pattern info} $hostpat {
        if {![string match $pattern $uri]} continue
        set buffer $data
        foreach {f v} $info {
          dict set buffer $f $v
        }
        return $buffer
      }
    }
    return {}
  }














  Ensemble uri::add {vhosts patterns info} {
    my variable url_patterns













    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }

  Ensemble uri::direct {vhosts patterns info body} {
    my variable url_patterns url_stream
    set body {}
    if {[dict exists $info superclass]} {
      append body \n "superclass {*}[dict get $info superclass]"
      dict unset info superclass
    }
    append body \n [list method content {} $body]
    set class [namespace current]::${vhosts}/${patterns}
    set class [string map $class {* %} $class]
    ::clay::define $class $body
    dict set info mixin content $class
    my uri add $vhosts $patterns $info
  }
}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body

Changes to modules/httpd/build/proxy.tcl.

151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method dispatch {newsock datastate} {
    try {
      my request dispatch $datastate
      my variable sock chan
      set chan $newsock
      chan configure $chan -translation {auto crlf} -buffering line
      # Initialize the reply
      my reset
      # Invoke the URL implementation.
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput







|
<
<
|
<
<
<
<
<
<
<
<
<







151
152
153
154
155
156
157
158


159









160
161
162
163
164
165
166
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method Dispatch {} {


    my variable sock chan









    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput

Changes to modules/httpd/build/reply.tcl.

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
...
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
262
263
264
265
266
267
268



269
270
271
272
273
274
275
...
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    try {
      my request dispatch $datastate
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line














      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
















      my error 500 $err [dict get $errdat -errorinfo]
    } finally {
      my DoOutput
    }
  }







  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }




  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }
      dispatch {
        set request [my clay get dict/ request]
        foreach datastate $args {
          foreach {f v} $datastate {
            if {[string index $f end] eq "/"} {
              my clay merge $f $v
            } else {
              my clay set $f $v
            }
            if {$f eq "http"} {
              foreach {ff vf} $v {
                dict set request $ff $vf
              }
            }
          }
        }
        my Log_Dispatched
      }
      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}







|






|

<
<
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

<



>
>
>
>
>
>







 







<







 







>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
...
152
153
154
155
156
157
158

159
160
161
162
163
164
165
...
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
335
336
337
338
339
340
341


















342
343
344
345
346
347
348
  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get HTTP_REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan request
    set chan $newsock


    chan event $chan readable {}
    chan configure $chan -translation {auto crlf} -buffering line

    if {[dict exists $datastate mixin]} {
      set mixinmap [dict get $datastate mixin]
    } else {
      set mixinmap {}
    }
    foreach item [dict keys $datastate MIXIN_*] {
      set slot [string range $item 6 end]
      dict set mixinmap [string tolower $slot] [dict get $datastate $item]
    }
    my clay mixinmap {*}$mixinmap
    if {[dict exists $datastate delegate]} {
      my clay delegate {*}[dict get $datastate delegate]
    }
    my reset



    set request [my clay get dict/ request]
    foreach {f v} $datastate {
      if {[string index $f end] eq "/"} {
        my clay merge $f $v
      } else {
        my clay set $f $v
      }
      if {$f eq "http"} {
        foreach {ff vf} $v {
          dict set request $ff $vf
        }
      }
    }
    my Session_Load
    my Log_Dispatched
    if {[catch {my Dispatch} err errdat]} {
      my error 500 $err [dict get $errdat -errorinfo]

      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.
    my content
    my DoOutput
  }

  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }

  # Manage session data
  method Session_Load {} {}

  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }


















      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}

Changes to modules/httpd/build/scgi.tcl.

1
2
3







4
5

6
7
8
9
10
11
12
..
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
...
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191


192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
###
# Return data from an SCGI process
###







::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}

::clay::define ::httpd::reply.scgi {
  superclass ::httpd::reply

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}

  clay set reply_class ::httpd::reply.scgi

  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }


    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}
      catch {chan close $sock}
      return
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
      return
    }
  }
}



>
>
>
>
>
>
>


>







 







<
<
<
<
<
<
<
<










<
<







 







<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>






<
<
<
<
<
<
<
<
<





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
97
98
99
100
101
102
103








104
105
106
107
108
109
110
111
112
113


114
115
116
117
118
119
120
...
164
165
166
167
168
169
170





171













172
173
174
175
176
177
178
179









180
181
182
183
184
###
# Return data from an SCGI process
###
::clay::define ::httpd::protocol.scgi {

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}









###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}



  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]













      dict set reply mixin protocol ::httpd::protocol.scgi
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}









      catch {chan close $sock}
      return
    }
  }
}

Changes to modules/httpd/build/server.tcl.

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
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
...
180
181
182
183
184
185
186




187
188
189
190
191
192
193
      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }



































  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 line]
      set mimetxt [my HttpHeaders $sock]

      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]
      dict set query http HTTP_HOST {}
      dict set query http CONTENT_LENGTH 0
      foreach {f v} [my MimeParse $mimetxt] {
        set fld [string toupper [string map {- _} $f]]
        if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
          set qfld $fld
        } else {
          set qfld HTTP_$fld
        }
        dict set query http $qfld $v
      }
      dict set query UUID $uuid
      dict set query http UUID $uuid
      dict set query http REMOTE_ADDR     $ip
      dict set query http REMOTE_HOST     [my HostName $ip]
      dict set query http REQUEST_METHOD  [lindex $line 0]
      set uriinfo [::uri::split [lindex $line 1]]
      dict set query uriinfo $uriinfo
      dict set query http REQUEST_URI     [lindex $line 1]
      dict set query http REQUEST_PATH    [dict get $uriinfo path]
      dict set query http REQUEST_VERSION [lindex [split [lindex $line end] /] end]
      dict set query http DOCUMENT_ROOT   [my clay get server/ doc_root]
      dict set query http QUERY_STRING    [dict get $uriinfo query]
      dict set query http REQUEST_RAW     $line
      dict set query http SERVER_PORT     [my port_listening]
      dict set query http SERVER_NAME     [my clay get server/ name]
      dict set query http SERVER_PROTOCOL [my clay get server/ protocol]
      dict set query http SERVER_SOFTWARE [my clay get server/ string]
      # REMOTE_USER AUTH_TYPE
      # GATEWAY_INTERFACE
      # SERVER_HTTPS_PORT
      #SERVER_NAME
      #SERVER_SOFTWARE

      if {[string match 127.* $ip]} {
        dict set query http LOCALHOST [expr {[lindex [split [dict getnull $query HTTP_HOST] :] 0] eq "localhost"}]
      }
      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {
      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {




    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>













|

>


<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>







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
...
120
121
122
123
124
125
126





127




















128
129
130
131
132
133
134
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }

  method ServerHeaders {ip http_request mimetxt} {
    set result {}
    dict set result HTTP_HOST {}
    dict set result CONTENT_LENGTH 0
    foreach {f v} [my MimeParse $mimetxt] {
      set fld [string toupper [string map {- _} $f]]
      if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
        set qfld $fld
      } else {
        set qfld HTTP_$fld
      }
      dict set result $qfld $v
    }
    dict set result REMOTE_ADDR     $ip
    dict set result REMOTE_HOST     [my HostName $ip]
    dict set result REQUEST_METHOD  [lindex $http_request 0]
    set uriinfo [::uri::split [lindex $http_request 1]]
    dict set result uriinfo $uriinfo
    dict set result REQUEST_URI     [lindex $http_request 1]
    dict set result REQUEST_PATH    [dict get $uriinfo path]
    dict set result REQUEST_VERSION [lindex [split [lindex $http_request end] /] end]
    dict set result DOCUMENT_ROOT   [my clay get server/ doc_root]
    dict set result QUERY_STRING    [dict get $uriinfo query]
    dict set result REQUEST_RAW     $http_request
    dict set result SERVER_PORT     [my port_listening]
    dict set result SERVER_NAME     [my clay get server/ name]
    dict set result SERVER_PROTOCOL [my clay get server/ protocol]
    dict set result SERVER_SOFTWARE [my clay get server/ string]
    if {[string match 127.* $ip]} {
      dict set result LOCALHOST [expr {[lindex [split [dict getnull $result HTTP_HOST] :] 0] eq "localhost"}]
    }
    return $result
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 http_request]
      set mimetxt [my HttpHeaders $sock]
      dict set query UUID $uuid
      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]









      dict set query http [my ServerHeaders $ip $http_request $mimetxt]



























      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {
      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]




















      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {
    set reply [my Dispatch_Local $data]
    if {[dict size $reply]} {
      return $reply
    }
    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###

Changes to modules/httpd/httpd.tcl.

333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352














353
354
355
356
















357
358
359
360
361






362
363
364
365
366
367
368
...
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
...
544
545
546
547
548
549
550



551
552
553
554
555
556
557
...
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
...
789
790
791
792
793
794
795


































796
797
798
799
800
801
802
803
804
805
806
807
808
809
810

811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852

853
854
855
856
857
858
859
...
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
...
919
920
921
922
923
924
925




926
927
928
929
930
931
932
....
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
....
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
....
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
....
1745
1746
1747
1748
1749
1750
1751







1752
1753

1754
1755
1756
1757
1758
1759
1760
....
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
....
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939


1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
....
2023
2024
2025
2026
2027
2028
2029

2030
2031
2032

2033

2034
2035
2036
2037
2038
2039

2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081















2082
2083
2084
2085
2086
2087
2088
  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    try {
      my request dispatch $datastate
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line














      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
















      my error 500 $err [dict get $errdat -errorinfo]
    } finally {
      my DoOutput
    }
  }







  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }




  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }
      dispatch {
        set request [my clay get dict/ request]
        foreach datastate $args {
          foreach {f v} $datastate {
            if {[string index $f end] eq "/"} {
              my clay merge $f $v
            } else {
              my clay set $f $v
            }
            if {$f eq "http"} {
              foreach {ff vf} $v {
                dict set request $ff $vf
              }
            }
          }
        }
        my Log_Dispatched
      }
      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}
................................................................................
      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }



































  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 line]
      set mimetxt [my HttpHeaders $sock]

      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]
      dict set query http HTTP_HOST {}
      dict set query http CONTENT_LENGTH 0
      foreach {f v} [my MimeParse $mimetxt] {
        set fld [string toupper [string map {- _} $f]]
        if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
          set qfld $fld
        } else {
          set qfld HTTP_$fld
        }
        dict set query http $qfld $v
      }
      dict set query UUID $uuid
      dict set query http UUID $uuid
      dict set query http REMOTE_ADDR     $ip
      dict set query http REMOTE_HOST     [my HostName $ip]
      dict set query http REQUEST_METHOD  [lindex $line 0]
      set uriinfo [::uri::split [lindex $line 1]]
      dict set query uriinfo $uriinfo
      dict set query http REQUEST_URI     [lindex $line 1]
      dict set query http REQUEST_PATH    [dict get $uriinfo path]
      dict set query http REQUEST_VERSION [lindex [split [lindex $line end] /] end]
      dict set query http DOCUMENT_ROOT   [my clay get server/ doc_root]
      dict set query http QUERY_STRING    [dict get $uriinfo query]
      dict set query http REQUEST_RAW     $line
      dict set query http SERVER_PORT     [my port_listening]
      dict set query http SERVER_NAME     [my clay get server/ name]
      dict set query http SERVER_PROTOCOL [my clay get server/ protocol]
      dict set query http SERVER_SOFTWARE [my clay get server/ string]
      # REMOTE_USER AUTH_TYPE
      # GATEWAY_INTERFACE
      # SERVER_HTTPS_PORT
      #SERVER_NAME
      #SERVER_SOFTWARE

      if {[string match 127.* $ip]} {
        dict set query http LOCALHOST [expr {[lindex [split [dict getnull $query HTTP_HOST] :] 0] eq "localhost"}]
      }
      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {

      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
      return
    }
    if {[dict size $reply]==0} {
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {




    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###
................................................................................
    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method dispatch {newsock datastate} {
    my variable chan
    set chan $newsock
    chan event $chan readable {}
    try {
      my request dispatch $datastate
      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan
................................................................................
        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method dispatch {newsock datastate} {
    my variable reply_body reply_file reply_chan chan
    try {
      my request dispatch $datastate
      set chan $newsock
      chan event $chan readable {}
      chan configure $chan -translation {auto crlf} -buffering line

      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
................................................................................
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method dispatch {newsock datastate} {
    try {
      my request dispatch $datastate
      my variable sock chan
      set chan $newsock
      chan configure $chan -translation {auto crlf} -buffering line
      # Initialize the reply
      my reset
      # Invoke the URL implementation.
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
................................................................................
###
###
# START: scgi.tcl
###
###
# Return data from an SCGI process
###







::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}

::clay::define ::httpd::reply.scgi {
  superclass ::httpd::reply

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}

  clay set reply_class ::httpd::reply.scgi

  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {
      if {[dict exists $reply class]} {
        set class [dict get $reply class]
      } else {
        set class [my clay get reply_class]
      }
      set pageobj [$class create ::httpd::object::$uuid [self]]
      if {[dict exists $reply mixin]} {
        set mixinmap [dict get $reply mixin]
      } else {
        set mixinmap {}
      }
      foreach item [dict keys $reply MIXIN_*] {
        set slot [string range $reply 6 end]
        dict set mixinmap [string tolower $slot] [dict get $reply $item]
      }
      $pageobj clay mixinmap {*}$mixinmap
      if {[dict exists $reply delegate]} {
        $pageobj clay delegate {*}[dict get $reply delegate]
      }


    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}
      catch {chan close $sock}
      return
    }
    try {
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
      return
    }
  }
}

###
................................................................................
    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {

    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]
    foreach {host pattern info} [my uri patterns] {

      if {![string match $host $vhost]} continue

      if {![string match $pattern $uri]} continue
      set buffer $data
      foreach {f v} $info {
        dict set buffer $f $v
      }
      return $buffer

    }
    return {}
  }

  Ensemble uri::patterns {} {
    my variable url_patterns url_stream
    if {![info exists url_stream]} {
      set url_stream {}
      foreach {host hostpat} $url_patterns {
        foreach {pattern info} $hostpat {
          lappend url_stream $host $pattern $info
        }
      }
    }
    return $url_stream
  }

  Ensemble uri::add args {
    my variable url_patterns url_stream
    unset -nocomplain url_stream
    switch [llength $args] {
      2 {
        set vhosts *
        lassign $args patterns info
      }
      3 {
        lassign $args vhosts patterns info
      }
      default {
        error "Usage: add_url ?vhosts? prefix info"
      }
    }
    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }















}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body







|






|

<
<
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

<



>
>
>
>
>
>







 







<







 







>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>













|

>


<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



>







 







<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>







 







|

<
<

<







 







|


<
<
<
<
<







 







|
<
<
|
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>


>







 







<
<
<
<
<
<
<
<










<
<







 







<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>






<
<
<
<
<
<
<
<
<







 







>


<
>

>
|
|
|
|
|
|
>




<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348


349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365



366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382

383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
...
434
435
436
437
438
439
440

441
442
443
444
445
446
447
...
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
...
617
618
619
620
621
622
623


















624
625
626
627
628
629
630
...
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861









862



























863
864
865
866
867
868
869
870
871
872
873
...
874
875
876
877
878
879
880





881




















882
883
884
885
886
887
888
...
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
....
1195
1196
1197
1198
1199
1200
1201
1202
1203


1204

1205
1206
1207
1208
1209
1210
1211
....
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342





1343
1344
1345
1346
1347
1348
1349
....
1543
1544
1545
1546
1547
1548
1549
1550


1551









1552
1553
1554
1555
1556
1557
1558
....
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
....
1819
1820
1821
1822
1823
1824
1825








1826
1827
1828
1829
1830
1831
1832
1833
1834
1835


1836
1837
1838
1839
1840
1841
1842
....
1886
1887
1888
1889
1890
1891
1892





1893













1894
1895
1896
1897
1898
1899
1900
1901









1902
1903
1904
1905
1906
1907
1908
....
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979

1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993













1994
1995













1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
  method Log_Dispatched {} {
    my log Dispatched [dict create \
     REMOTE_ADDR [my request get REMOTE_ADDR] \
     REMOTE_HOST [my request get REMOTE_HOST] \
     COOKIE [my request get HTTP_COOKIE] \
     REFERER [my request get HTTP_REFERER] \
     USER_AGENT [my request get HTTP_USER_AGENT] \
     REQUEST_URI [my request get HTTP_REQUEST_URI] \
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan request
    set chan $newsock


    chan event $chan readable {}
    chan configure $chan -translation {auto crlf} -buffering line

    if {[dict exists $datastate mixin]} {
      set mixinmap [dict get $datastate mixin]
    } else {
      set mixinmap {}
    }
    foreach item [dict keys $datastate MIXIN_*] {
      set slot [string range $item 6 end]
      dict set mixinmap [string tolower $slot] [dict get $datastate $item]
    }
    my clay mixinmap {*}$mixinmap
    if {[dict exists $datastate delegate]} {
      my clay delegate {*}[dict get $datastate delegate]
    }
    my reset



    set request [my clay get dict/ request]
    foreach {f v} $datastate {
      if {[string index $f end] eq "/"} {
        my clay merge $f $v
      } else {
        my clay set $f $v
      }
      if {$f eq "http"} {
        foreach {ff vf} $v {
          dict set request $ff $vf
        }
      }
    }
    my Session_Load
    my Log_Dispatched
    if {[catch {my Dispatch} err errdat]} {
      my error 500 $err [dict get $errdat -errorinfo]

      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.
    my content
    my DoOutput
  }

  method html_css {} {
    set result "<link rel=\"stylesheet\" href=\"/style.css\">"
    append result \n {<style media="screen" type="text/css">
body {
	background:  url(images/etoyoc-circuit-tile.gif) repeat;
	font-family: serif;
................................................................................
    my reset
    set qheaders [my clay dump]
    set HTTP_STATUS "$code [my http_code_string $code]"
    dict with qheaders {}
    my reply replace {}
    my reply set Status $HTTP_STATUS
    my reply set Content-Type {text/html; charset=UTF-8}

    switch $code {
      301 - 302 - 303 - 307 - 308 {
        my reply set Location $msg
        set template [my <server> template redirect]
      }
      404 {
        set template [my <server> template notfound]
................................................................................
      my variable chan
      chan configure $chan -translation binary -blocking 0 -buffering full -buffersize 4096
      set postdata [::coroutine::util::read $chan $length]
    }
    return $postdata
  }

  # Manage session data
  method Session_Load {} {}

  method TransferComplete args {
    my variable chan transfer_complete
    set transfer_complete 1
    my log TransferComplete
    set chan {}
    foreach c $args {
      catch {chan event $c readable {}}
................................................................................

  method request {subcommand args} {
    my variable request
    switch $subcommand {
      dump {
        return $request
      }


















      field {
        tailcall my RequestFind [lindex $args 0]
      }
      get {
        set field [my RequestFind [lindex $args 0]]
        if {![dict exists $request $field]} {
          return {}
................................................................................
      catch {close $sock}
      return
    }
    set uuid [my Uuid_Generate]
    set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
    chan event $sock readable $coro
  }

  method ServerHeaders {ip http_request mimetxt} {
    set result {}
    dict set result HTTP_HOST {}
    dict set result CONTENT_LENGTH 0
    foreach {f v} [my MimeParse $mimetxt] {
      set fld [string toupper [string map {- _} $f]]
      if {$fld in {CONTENT_LENGTH CONTENT_TYPE}} {
        set qfld $fld
      } else {
        set qfld HTTP_$fld
      }
      dict set result $qfld $v
    }
    dict set result REMOTE_ADDR     $ip
    dict set result REMOTE_HOST     [my HostName $ip]
    dict set result REQUEST_METHOD  [lindex $http_request 0]
    set uriinfo [::uri::split [lindex $http_request 1]]
    dict set result uriinfo $uriinfo
    dict set result REQUEST_URI     [lindex $http_request 1]
    dict set result REQUEST_PATH    [dict get $uriinfo path]
    dict set result REQUEST_VERSION [lindex [split [lindex $http_request end] /] end]
    dict set result DOCUMENT_ROOT   [my clay get server/ doc_root]
    dict set result QUERY_STRING    [dict get $uriinfo query]
    dict set result REQUEST_RAW     $http_request
    dict set result SERVER_PORT     [my port_listening]
    dict set result SERVER_NAME     [my clay get server/ name]
    dict set result SERVER_PROTOCOL [my clay get server/ protocol]
    dict set result SERVER_SOFTWARE [my clay get server/ string]
    if {[string match 127.* $ip]} {
      dict set result LOCALHOST [expr {[lindex [split [dict getnull $result HTTP_HOST] :] 0] eq "localhost"}]
    }
    return $result
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}

    chan configure $sock \
      -blocking 0 \
      -translation {auto crlf} \
      -buffering line

    my counter url_hit
    set line {}
    try {
      set readCount [::coroutine::util::gets_safety $sock 4096 http_request]
      set mimetxt [my HttpHeaders $sock]
      dict set query UUID $uuid
      dict set query mimetxt $mimetxt
      dict set query mixin style [my clay get server/ style]









      dict set query http [my ServerHeaders $ip $http_request $mimetxt]



























      my Headers_Process query
      set reply [my dispatch $query]
    } on error {err errdat} {
      puts [dict get $errdat -errorinfo]
      my debug [list uri: [dict getnull $query REQUEST_URI] ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {chan puts $sock "HTTP/1.0 400 Bad Request (The data is invalid)"}
      catch {chan close $sock}
      return
    }
    if {[dict size $reply]==0} {
................................................................................
      my log BadLocation $uuid $query
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]




















      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan close $sock}
    }
................................................................................

  method debug args {}

  ###
  # Route a request to the appropriate handler
  ###
  method dispatch {data} {
    set reply [my Dispatch_Local $data]
    if {[dict size $reply]} {
      return $reply
    }
    return [my Dispatch_Default $data]
  }

  method Dispatch_Default {reply} {
    ###
    # Fallback to docroot handling
    ###
................................................................................
    set HTTP_STATUS [my reply get Status]
    my puts [subst $msg]
  }
}

::clay::define ::httpd::content.cache {

  method Dispatch {} {
    my variable chan


    try {

      my wait writable $chan
      chan configure $chan  -translation {binary binary}
      chan puts -nonewline $chan [my clay get cache/ data]
    } on error {err info} {
      my <server> debug [dict get $info -errorinfo]
    } finally {
      my TransferComplete $chan
................................................................................
        ###
        my reply set Content-Type [::fileutil::magic::filetype $local_file]
        set reply_file $local_file
      }
    }
  }

  method Dispatch {} {
    my variable reply_body reply_file reply_chan chan
    try {





      my reset
      # Invoke the URL implementation.
      my content
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
................................................................................
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chana $chanb
    }
  }

  method Dispatch {} {


    my variable sock chan









    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
      tailcall my DoOutput
    }
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
................................................................................
###
###
# START: scgi.tcl
###
###
# Return data from an SCGI process
###
::clay::define ::httpd::protocol.scgi {

  method EncodeStatus {status} {
    return "Status: $status"
  }
}

::clay::define ::httpd::content.scgi {
  superclass ::httpd::content.proxy


  method scgi_info {} {
    ###
    # This method should check if a process is launched
    # or launch it if needed, and return a list of
    # HOST PORT SCRIPT_NAME
    ###
................................................................................
      chan copy $chana $chanb -size $length -command [namespace code [list my TransferComplete $chana $chanb]]
    } else {
      my TransferComplete $chan $chanb
    }
  }
}









###
# Act as an  SCGI Server
###
::clay::define ::httpd::server.scgi {
  superclass ::httpd::server

  clay set socket/ buffersize   32768
  clay set socket/ blocking     0
  clay set socket/ translation  {binary binary}



  method debug args {
    puts $args
  }

  method Connect {uuid sock ip} {
    yield [info coroutine]
    chan event $sock readable {}
................................................................................
    if {[dict size $reply]==0} {
      my log BadLocation $uuid $query
      dict set query http HTTP_STATUS 404
      dict set query template notfound
      dict set query mixin reply ::httpd::content.template
    }
    try {





      set pageobj [::httpd::reply create ::httpd::object::$uuid [self]]













      dict set reply mixin protocol ::httpd::protocol.scgi
      $pageobj dispatch $sock $reply
    } on error {err errdat} {
      my debug [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      my log BadRequest $uuid [list ip: $ip error: $err errorinfo: [dict get $errdat -errorinfo]]
      catch {$pageobj destroy}
      catch {chan event readable $sock {}}
      catch {chan event writeable $sock {}}









      catch {chan close $sock}
      return
    }
  }
}

###
................................................................................
    set reply [my Dispatch_Dict $data]
    if {[dict size $reply]} {
      return $reply
    }
  }

  method Dispatch_Dict {data} {
    my variable url_patterns
    set vhost [lindex [split [dict get $data http HTTP_HOST] :] 0]
    set uri   [dict get $data http REQUEST_PATH]

    foreach {host hostpat} $url_patterns {
      if {![string match $host $vhost]} continue
      foreach {pattern info} $hostpat {
        if {![string match $pattern $uri]} continue
        set buffer $data
        foreach {f v} $info {
          dict set buffer $f $v
        }
        return $buffer
      }
    }
    return {}
  }














  Ensemble uri::add {vhosts patterns info} {
    my variable url_patterns













    foreach vhost $vhosts {
      foreach pattern $patterns {
        set data $info
        if {![dict exists $data prefix]} {
           dict set data prefix [my PrefixNormalize $pattern]
        }
        dict set url_patterns $vhost [string trimleft $pattern /] $data
      }
    }
  }

  Ensemble uri::direct {vhosts patterns info body} {
    my variable url_patterns url_stream
    set body {}
    if {[dict exists $info superclass]} {
      append body \n "superclass {*}[dict get $info superclass]"
      dict unset info superclass
    }
    append body \n [list method content {} $body]
    set class [namespace current]::${vhosts}/${patterns}
    set class [string map $class {* %} $class]
    ::clay::define $class $body
    dict set info mixin content $class
    my uri add $vhosts $patterns $info
  }
}

::clay::define ::httpd::reply.memchan {
  superclass ::httpd::reply

  method output {} {
    my variable reply_body

Changes to modules/httpd/httpd.test.

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
...
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
...
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
...
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
...
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
  }
}


clay::define ::httpd::server {
  method log args {}


  method TemplateSearch page {
    set doc_root [my clay get server/ doc_root]
    if {$doc_root ne {} && [file exists [file join $doc_root $page.tml]]} {
      return [::fileutil::cat [file join $doc_root $page.tml]]
    }
    if {$doc_root ne {} && [file exists [file join $doc_root $page.html]]} {
      return [::fileutil::cat [file join $doc_root $page.html]]
    }
    switch $page {
      redirect {
        return {404 Not Found}
      }
      internal_error {
        return {500 Server Internal Error}
      }
    }
  }

  ::DEBUG method debug args {
    puts stderr $args
  }
................................................................................
# Build the server
###
set DIR [file dirname [file normalize [info script]]]
set ::DEMOROOT $DIR

::httpd::server create TESTAPP port 10001
TESTAPP plugin dict_dispatch
TESTAPP uri add /     [list mixin {reply ::test::content.echo}]
TESTAPP uri add /echo [list mixin {reply ::test::content.echo}]
TESTAPP uri add /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTAPP uri add /time [list mixin {reply ::test::content.time}]
TESTAPP uri add /error [list mixin {replyy ::test::content.error}]

# Catch all
#TESTAPP uri add * [list mixin {reply httpd::content.echo}]

::DEBUG puts httpd-client-0001
test httpd-client-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
Content-Length: *

THIS IS MY CODE}
} {}


::DEBUG puts httpd-client-0002
test httpd-client-0002 {Do another echo request} {
set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THOUGH THERE ARE MANY LIKE IT}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
................................................................................
  method proxy_channel {} {
    return [::socket localhost [my clay get proxy_port]]
  }
}


::httpd::server create TESTPROXY port 10002
TESTAPP   uri add /proxy*     [list mixin {reply ::test::content.proxy} proxy_port [TESTPROXY port_listening]]
TESTPROXY plugin dict_dispatch
TESTPROXY uri add /     [list mixin {reply ::test::content.echo}]
TESTPROXY uri add /echo [list mixin {reply ::test::content.echo}]
TESTPROXY uri add /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTPROXY uri add /time [list mixin {reply ::test::content.time}]
TESTPROXY uri add /error [list mixin {reply ::test::content.error}]

::DEBUG puts httpd-proxy-0001
test httpd-proxy-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /proxy/echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
................................................................................
::httpd::test::compare $reply $checkreply
} {}

# -------------------------------------------------------------------------
# cgi
TESTAPP plugin local_memchan

TESTAPP uri add /cgi-bin* [list mixin {reply ::test::content.cgi} path $::DEMOROOT]

set fout [open [file join $DIR test.tcl] w]
puts $fout {#!/usr/bin/tclsh

puts stdout "Status: 200 OK"
if {$::env(CONTENT_LENGTH) > 0} {
  puts stdout "Content-Type: $::env(CONTENT_TYPE)"
................................................................................
  variable server_block {SCGI 1.0 SERVER_SOFTWARE {TclScgiServer/0.1}}
}

###
# Build the reply class
###
::clay::define ::scgi::test::reply {
  superclass ::httpd::reply.scgi

  method reset {} {
    my variable reply_body
    my reply replace [my HttpHeaders_Default]
    set reply_body {}
  }
}
................................................................................

  clay set reply_class ::scgi::test::reply
}

puts [list ::test::content.file [info commands ::test::content.file]]
scgi::test::app create TESTSCGI port 10003
TESTSCGI plugin dict_dispatch
TESTSCGI uri add /     [list mixin {reply ::test::content.echo}]
TESTSCGI uri add /echo [list mixin {reply ::test::content.echo}]
TESTSCGI uri add /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTSCGI uri add /time [list mixin {reply ::test::content.time}]
TESTSCGI uri add /error [list mixin {reply ::test::content.error}]

::DEBUG puts scgi-client-0001
test scgi-client-0001 {Do an echo request} {

set reply [::scgi::test::send 10003 {REQUEST_METHOD POST REQUEST_URI /echo} {THIS IS MY CODE}]
set checkreply {Status: 200 OK
Content-Type: text/plain







<













|







 







|
|
|
|
|


|












<







 







|

|
|
|
|
|







 







|







 







|







 







|
|
|
|
|







118
119
120
121
122
123
124

125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246

247
248
249
250
251
252
253
...
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
...
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
...
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
  }
}


clay::define ::httpd::server {
  method log args {}


  method TemplateSearch page {
    set doc_root [my clay get server/ doc_root]
    if {$doc_root ne {} && [file exists [file join $doc_root $page.tml]]} {
      return [::fileutil::cat [file join $doc_root $page.tml]]
    }
    if {$doc_root ne {} && [file exists [file join $doc_root $page.html]]} {
      return [::fileutil::cat [file join $doc_root $page.html]]
    }
    switch $page {
      redirect {
        return {404 Not Found}
      }
      internal_error {
        return {500 Server Internal Error\nTrace:\n$errorInfo}
      }
    }
  }

  ::DEBUG method debug args {
    puts stderr $args
  }
................................................................................
# Build the server
###
set DIR [file dirname [file normalize [info script]]]
set ::DEMOROOT $DIR

::httpd::server create TESTAPP port 10001
TESTAPP plugin dict_dispatch
TESTAPP uri add * /     [list mixin {reply ::test::content.echo}]
TESTAPP uri add * /echo [list mixin {reply ::test::content.echo}]
TESTAPP uri add * /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTAPP uri add * /time [list mixin {reply ::test::content.time}]
TESTAPP uri add * /error [list mixin {replyy ::test::content.error}]

# Catch all
#TESTAPP uri add * * [list mixin {reply httpd::content.echo}]

::DEBUG puts httpd-client-0001
test httpd-client-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
Content-Length: *

THIS IS MY CODE}
} {}


::DEBUG puts httpd-client-0002
test httpd-client-0002 {Do another echo request} {
set reply [::httpd::test::send 10001 {POST /echo HTTP/1.0} {} {THOUGH THERE ARE MANY LIKE IT}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
Connection: close
................................................................................
  method proxy_channel {} {
    return [::socket localhost [my clay get proxy_port]]
  }
}


::httpd::server create TESTPROXY port 10002
TESTAPP   uri add * /proxy*     [list mixin {reply ::test::content.proxy} proxy_port [TESTPROXY port_listening]]
TESTPROXY plugin dict_dispatch
TESTPROXY uri add * /     [list mixin {reply ::test::content.echo}]
TESTPROXY uri add * /echo [list mixin {reply ::test::content.echo}]
TESTPROXY uri add * /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTPROXY uri add * /time [list mixin {reply ::test::content.time}]
TESTPROXY uri add * /error [list mixin {reply ::test::content.error}]

::DEBUG puts httpd-proxy-0001
test httpd-proxy-0001 {Do an echo request} {

set reply [::httpd::test::send 10001 {POST /proxy/echo HTTP/1.0} {} {THIS IS MY CODE}]
::httpd::test::compare $reply {HTTP/1.0 200 OK
Content-Type: text/plain
................................................................................
::httpd::test::compare $reply $checkreply
} {}

# -------------------------------------------------------------------------
# cgi
TESTAPP plugin local_memchan

TESTAPP uri add * /cgi-bin* [list mixin {reply ::test::content.cgi} path $::DEMOROOT]

set fout [open [file join $DIR test.tcl] w]
puts $fout {#!/usr/bin/tclsh

puts stdout "Status: 200 OK"
if {$::env(CONTENT_LENGTH) > 0} {
  puts stdout "Content-Type: $::env(CONTENT_TYPE)"
................................................................................
  variable server_block {SCGI 1.0 SERVER_SOFTWARE {TclScgiServer/0.1}}
}

###
# Build the reply class
###
::clay::define ::scgi::test::reply {
  superclass ::httpd::reply

  method reset {} {
    my variable reply_body
    my reply replace [my HttpHeaders_Default]
    set reply_body {}
  }
}
................................................................................

  clay set reply_class ::scgi::test::reply
}

puts [list ::test::content.file [info commands ::test::content.file]]
scgi::test::app create TESTSCGI port 10003
TESTSCGI plugin dict_dispatch
TESTSCGI uri add * /     [list mixin {reply ::test::content.echo}]
TESTSCGI uri add * /echo [list mixin {reply ::test::content.echo}]
TESTSCGI uri add * /file [list mixin {reply ::test::content.file} doc_root $::DEMOROOT]
TESTSCGI uri add * /time [list mixin {reply ::test::content.time}]
TESTSCGI uri add * /error [list mixin {reply ::test::content.error}]

::DEBUG puts scgi-client-0001
test scgi-client-0001 {Do an echo request} {

set reply [::scgi::test::send 10003 {REQUEST_METHOD POST REQUEST_URI /echo} {THIS IS MY CODE}]
set checkreply {Status: 200 OK
Content-Type: text/plain