Tcl Library Source Code

Check-in [bb27bb43b4]
Login

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

Overview
Comment:httpd module: Replaced naked calls to [chan copy] with a new co-subroutine ChanCopy which is part of the metaclass for the httpd module. Using ChanCopy means the coroutine can remain in control for the entire process of processing an http request. For large file transfers we were killing the coroutine and waking the object back up with a fileevent. Added a test for 404 Not Found errors
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256:bb27bb43b438da1648e6ac72b87c93774781af22d29b4e71e652355257cda3ea
User & Date: hypnotoad 2018-09-12 19:31:55
Context
2018-09-12
20:23
Modifications to httpd: Refactored the ChanCopy method to utilize the yieldto command, per a suggestion from Donal Fellows. check-in: bbdea9cd0c user: hypnotoad tags: hypnotoad
19:31
httpd module: Replaced naked calls to [chan copy] with a new co-subroutine ChanCopy which is part of the metaclass for the httpd module. Using ChanCopy means the coroutine can remain in control for the entire process of processing an http request. For large file transfers we were killing the coroutine and waking the object back up with a fileevent. Added a test for 404 Not Found errors check-in: bb27bb43b4 user: hypnotoad tags: hypnotoad
2018-09-11
18:49
Httpd Module: Servers now pass control off to reply objects via a tailcall. Removed a puts statement in the example httpd app that was logging to stdout check-in: 4b3bc8df0b user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

86
87
88
89
90
91
92
93
94
95
96
97

98
99
100
101
102
103
104
105
106
...
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb
      chan event $chanb readable [info coroutine]
    }

    yield

  }


  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
................................................................................
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      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
    }
  }

  ###
  # For most CGI applications a directory list is vorboten
  ###
  method DirectoryListing {local_file} {
    my error 403 {Not Allowed}
    tailcall my DoOutput
  }
}







|


<

>

<







 







|
<
<











86
87
88
89
90
91
92
93
94
95

96
97
98

99
100
101
102
103
104
105
...
121
122
123
124
125
126
127
128


129
130
131
132
133
134
135
136
137
138
139
    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      my ChannelCopy $chana $chanb -size $length
    } else {
      chan flush $chanb

    }
    chan event $chanb readable [info coroutine]
    yield

  }


  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
................................................................................
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      my ChannelCopy $chana $chanb -size $length


    }
  }

  ###
  # For most CGI applications a directory list is vorboten
  ###
  method DirectoryListing {local_file} {
    my error 403 {Not Allowed}
    tailcall my DoOutput
  }
}

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

26
27
28
29
30
31
32






















































33
34
35
36
37
38
39

namespace eval ::url {}
namespace eval ::httpd {}
namespace eval ::scgi {}

clay::define ::httpd::mime {
























































  method html_header {{title {}} args} {
    set result {}
    append result "<HTML><HEAD>"
    if {$title ne {}} {
      append result "<TITLE>$title</TITLE>"
    }







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







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

namespace eval ::url {}
namespace eval ::httpd {}
namespace eval ::scgi {}

clay::define ::httpd::mime {

  method ChannelCopy {in out args} {
    dict set info chunk     4096
    dict set info size      -1
    foreach {f v} $args {
      dict set info [string trim $f -] $v
    }
    set total     [dict get $info size]
    set chunksize [dict get $info chunk]
    dict set info coroutine [info coroutine]
    if {$total>0 && $chunksize>$total} {
        set chunksize $total
    }
    dict set info process   [self method]
    dict set info chunk     $chunksize
    dict set info in        $in
    dict set info out       $out
    dict set info sofar     0
    dict set info complete  0
    chan copy $in $out \
        -size $chunksize \
        -command [namespace code [list my ChannelCopyEvent $info]]
    while 1 {
      set code [yield]
      if {![dict exists $code process]} break
      if {[dict get $code process] ne [self method]} {
        error "Subroutine [self method] interrupted"
      }
      if {![dict exists $code complete]} break
      if {[dict get $code complete]==1} break
    }
  }
  method ChannelCopyEvent {info {bytes 0} {error {}}} {
    dict with info {
      if {[string length $error] || [chan eof $in]} {
        set compete 1
        dict set info error $error
      }
      if {$size>=0} {
        incr sofar $bytes
        set remaining [expr {$size-$sofar}]
        if {$remaining <= 0} {
          set complete 1
        } elseif {$chunk > $remaining} {
          set chunk $remaining
        }
      }
    }
    if {[dict get $info complete]==0} {
      chan copy $in $out \
        -size $chunk \
        -command [namespace code [list my [self method] $info]]
    }
    tailcall $coroutine $info
  }

  method html_header {{title {}} args} {
    set result {}
    append result "<HTML><HEAD>"
    if {$title ne {}} {
      append result "<TITLE>$title</TITLE>"
    }

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

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
      ###
      set size [file size $reply_file]
      my reply set Content-Length $size
      append result [my reply output] \n
      chan puts -nonewline $chan $result
      set reply_chan [open $reply_file r]
      my log SendReply [list length $size]
      chan configure $reply_chan  -translation {binary binary}
      ###

      # Send any POST/PUT/etc content
      # Note, we are terminating the coroutine at this point
      # and using the file event to wake the object back up
      #
      # We *could*:
      # chan copy $sock $chan -command [info coroutine]
      # yield
      #
      # But in the field this pegs the CPU for long transfers and locks
      # up the process
      ###
      chan copy $reply_chan $chan -command [namespace code [list my TransferComplete $reply_chan $chan]]
    } on error {err errdat} {
      my TransferComplete $reply_chan $chan
    }
  }
}







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




129
130
131
132
133
134
135
136

137
138












139
140
141
142
      ###
      set size [file size $reply_file]
      my reply set Content-Length $size
      append result [my reply output] \n
      chan puts -nonewline $chan $result
      set reply_chan [open $reply_file r]
      my log SendReply [list length $size]
      chan configure $reply_chan -translation {binary binary}

      my ChannelCopy $reply_chan $chan -size $size
    } finally {












      my TransferComplete $reply_chan $chan
    }
  }
}

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

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
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
161
...
164
165
166
167
168
169
170

171
172


173
174

    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb
      chan event $chanb readable [info coroutine]
    }

    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set readCount [::coroutine::util::gets_safety $chana 4096 reply_status]
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]
    if {![dict exists $replydat Content-Length]} {
      set length 0
    } else {
      set length [dict get $replydat Content-Length]
    }
    ###
    # Read the first incoming line as the HTTP reply status
    # Return the rest of the headers verbatim
    ###
    set replybuffer "$reply_status\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      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]
................................................................................
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
    }
    my log HttpAccess {}
    chan event $sock writable [info coroutine]
    yield

    my ProxyRequest $chan $sock
    my ProxyReply   $sock $chan


  }
}








|


<

>









<
<
<
<
|








|
|





|
<
<







 







>
|
|
>
>
|
|
>
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
136
137
138
139
140
141
142
143
144
145
146
147
148


149
150
151
152
153
154
155
...
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      my ChannelCopy $chana $chanb -size $length
    } else {
      chan flush $chanb

    }
    chan event $chanb readable [info coroutine]
    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set readCount [::coroutine::util::gets_safety $chana 4096 reply_status]
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]





    ###
    # Read the first incoming line as the HTTP reply status
    # Return the rest of the headers verbatim
    ###
    set replybuffer "$reply_status\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    if {[dict exists $replydat Content-Length]} {
      set length [dict get $replydat Content-Length]
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      my ChannelCopy $chana $chanb -size $length


    }
  }

  method Dispatch {} {
    my variable sock chan
    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
................................................................................
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
    }
    my log HttpAccess {}
    chan event $sock writable [info coroutine]
    yield
    try {
      my ProxyRequest $chan $sock
      my ProxyReply   $sock $chan
    } finally {
      my TransferComplete $chan $sock
    }
  }
}

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

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
     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.







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







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
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan request
    try {
      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
      my Dispatch
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.

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

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
    #set cmd [list coroutine [my CoroName] {*}[namespace code [list my ProxyReply $chanb $chana]]]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###

      chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb
      chan event $chanb readable [info coroutine]
    }

    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]
    if {![dict exists $replydat Content-Length]} {
      set length 0
    } else {
      set length [dict get $replydat Content-Length]
    }
    ###
    # Convert the Status: header from the CGI process to
    # a standard service reply line from a web server, but
    # otherwise spit out the rest of the headers verbatim
    ###
    set replybuffer "HTTP/1.0 [dict get $replydat Status]\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      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 $chan $chanb
    }
  }
}

###
# Act as an  SCGI Server
###







>
|


<

>








<
<
<
<
<









|
|





|
<
<







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
    #set cmd [list coroutine [my CoroName] {*}[namespace code [list my ProxyReply $chanb $chana]]]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      my ChannelCopy $chana $chanb -size $length
      #chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb

    }
    chan event $chanb readable [info coroutine]
    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]





    ###
    # Convert the Status: header from the CGI process to
    # a standard service reply line from a web server, but
    # otherwise spit out the rest of the headers verbatim
    ###
    set replybuffer "HTTP/1.0 [dict get $replydat Status]\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    if {[dict exists $replydat Content-Length]} {
      set length [dict get $replydat Content-Length]
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      my ChannelCopy $chana $chanb -size $length


    }
  }
}

###
# Act as an  SCGI Server
###

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

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
...
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    }
    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 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]]
      tailcall $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 counter which {
    my variable counters
    incr counters($which)
  }








<




<

<







 







|

|
|
|

<
|
|
<
<
<
<
<
<







88
89
90
91
92
93
94

95
96
97
98

99

100
101
102
103
104
105
106
...
110
111
112
113
114
115
116
117
118
119
120
121
122

123
124






125
126
127
128
129
130
131
    }
    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

    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 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} {
      set reply $query
      my log BadLocation $uuid $query
      dict set reply http HTTP_STATUS {404 Not Found}
      dict set reply template notfound
      dict set reply mixin reply ::httpd::content.template
    }

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






  }

  method counter which {
    my variable counters
    incr counters($which)
  }

Changes to modules/httpd/httpd.tcl.

39
40
41
42
43
44
45






















































46
47
48
49
50
51
52
...
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
...
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
...
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
....
1359
1360
1361
1362
1363
1364
1365
1366
1367

1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
....
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513

1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
....
1555
1556
1557
1558
1559
1560
1561

1562
1563



1564
1565
1566
1567
1568
1569
1570
....
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669

1670
1671
1672
1673
1674
1675
1676
1677
1678
....
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
....
1777
1778
1779
1780
1781
1782
1783

1784
1785
1786
1787
1788

1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827

namespace eval ::url {}
namespace eval ::httpd {}
namespace eval ::scgi {}

clay::define ::httpd::mime {
























































  method html_header {{title {}} args} {
    set result {}
    append result "<HTML><HEAD>"
    if {$title ne {}} {
      append result "<TITLE>$title</TITLE>"
    }
................................................................................
     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.
................................................................................
    }
    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 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]]
      tailcall $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 counter which {
    my variable counters
    incr counters($which)
  }

................................................................................
      ###
      set size [file size $reply_file]
      my reply set Content-Length $size
      append result [my reply output] \n
      chan puts -nonewline $chan $result
      set reply_chan [open $reply_file r]
      my log SendReply [list length $size]
      chan configure $reply_chan  -translation {binary binary}
      ###

      # Send any POST/PUT/etc content
      # Note, we are terminating the coroutine at this point
      # and using the file event to wake the object back up
      #
      # We *could*:
      # chan copy $sock $chan -command [info coroutine]
      # yield
      #
      # But in the field this pegs the CPU for long transfers and locks
      # up the process
      ###
      chan copy $reply_chan $chan -command [namespace code [list my TransferComplete $reply_chan $chan]]
    } on error {err errdat} {
      my TransferComplete $reply_chan $chan
    }
  }
}

###
# END: file.tcl
................................................................................
    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb
      chan event $chanb readable [info coroutine]
    }

    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set readCount [::coroutine::util::gets_safety $chana 4096 reply_status]
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]
    if {![dict exists $replydat Content-Length]} {
      set length 0
    } else {
      set length [dict get $replydat Content-Length]
    }
    ###
    # Read the first incoming line as the HTTP reply status
    # Return the rest of the headers verbatim
    ###
    set replybuffer "$reply_status\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      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]
................................................................................
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
    }
    my log HttpAccess {}
    chan event $sock writable [info coroutine]
    yield

    my ProxyRequest $chan $sock
    my ProxyReply   $sock $chan



  }
}

###
# END: proxy.tcl
###
###
................................................................................
    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb
      chan event $chanb readable [info coroutine]
    }

    yield

  }


  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
................................................................................
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      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
    }
  }

  ###
  # For most CGI applications a directory list is vorboten
  ###
  method DirectoryListing {local_file} {
................................................................................
    #set cmd [list coroutine [my CoroName] {*}[namespace code [list my ProxyReply $chanb $chana]]]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###

      chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb
      chan event $chanb readable [info coroutine]
    }

    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]
    if {![dict exists $replydat Content-Length]} {
      set length 0
    } else {
      set length [dict get $replydat Content-Length]
    }
    ###
    # Convert the Status: header from the CGI process to
    # a standard service reply line from a web server, but
    # otherwise spit out the rest of the headers verbatim
    ###
    set replybuffer "HTTP/1.0 [dict get $replydat Status]\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      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 $chan $chanb
    }
  }
}

###
# Act as an  SCGI Server
###







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







 







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







 







<




<

<







 







|

|
|
|

<
|
|
<
<
<
<
<
<







 







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







 







|


<

>









<
<
<
<
|








|
|





|
<
<







 







>
|
|
>
>
>







 







|


<

>

<







 







|
<
<







 







>
|


<

>








<
<
<
<
<









|
|





|
<
<







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
...
395
396
397
398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
...
896
897
898
899
900
901
902

903
904
905
906

907

908
909
910
911
912
913
914
...
918
919
920
921
922
923
924
925
926
927
928
929
930

931
932






933
934
935
936
937
938
939
....
1404
1405
1406
1407
1408
1409
1410
1411

1412
1413












1414
1415
1416
1417
1418
1419
1420
....
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544

1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555




1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572


1573
1574
1575
1576
1577
1578
1579
....
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
....
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698

1699
1700
1701

1702
1703
1704
1705
1706
1707
1708
....
1724
1725
1726
1727
1728
1729
1730
1731


1732
1733
1734
1735
1736
1737
1738
....
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815

1816
1817
1818
1819
1820
1821
1822
1823
1824
1825





1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842


1843
1844
1845
1846
1847
1848
1849

namespace eval ::url {}
namespace eval ::httpd {}
namespace eval ::scgi {}

clay::define ::httpd::mime {

  method ChannelCopy {in out args} {
    dict set info chunk     4096
    dict set info size      -1
    foreach {f v} $args {
      dict set info [string trim $f -] $v
    }
    set total     [dict get $info size]
    set chunksize [dict get $info chunk]
    dict set info coroutine [info coroutine]
    if {$total>0 && $chunksize>$total} {
        set chunksize $total
    }
    dict set info process   [self method]
    dict set info chunk     $chunksize
    dict set info in        $in
    dict set info out       $out
    dict set info sofar     0
    dict set info complete  0
    chan copy $in $out \
        -size $chunksize \
        -command [namespace code [list my ChannelCopyEvent $info]]
    while 1 {
      set code [yield]
      if {![dict exists $code process]} break
      if {[dict get $code process] ne [self method]} {
        error "Subroutine [self method] interrupted"
      }
      if {![dict exists $code complete]} break
      if {[dict get $code complete]==1} break
    }
  }
  method ChannelCopyEvent {info {bytes 0} {error {}}} {
    dict with info {
      if {[string length $error] || [chan eof $in]} {
        set compete 1
        dict set info error $error
      }
      if {$size>=0} {
        incr sofar $bytes
        set remaining [expr {$size-$sofar}]
        if {$remaining <= 0} {
          set complete 1
        } elseif {$chunk > $remaining} {
          set chunk $remaining
        }
      }
    }
    if {[dict get $info complete]==0} {
      chan copy $in $out \
        -size $chunk \
        -command [namespace code [list my [self method] $info]]
    }
    tailcall $coroutine $info
  }

  method html_header {{title {}} args} {
    set result {}
    append result "<HTML><HEAD>"
    if {$title ne {}} {
      append result "<TITLE>$title</TITLE>"
    }
................................................................................
     HTTP_HOST [my request get HTTP_HOST] \
     SESSION [my request get SESSION] \
    ]
  }

  method dispatch {newsock datastate} {
    my variable chan request
    try {
      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
      my Dispatch
    } on error {err errdat} {
      my error 500 $err [dict get $errdat -errorinfo]
      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.
................................................................................
    }
    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

    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 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} {
      set reply $query
      my log BadLocation $uuid $query
      dict set reply http HTTP_STATUS {404 Not Found}
      dict set reply template notfound
      dict set reply mixin reply ::httpd::content.template
    }

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






  }

  method counter which {
    my variable counters
    incr counters($which)
  }

................................................................................
      ###
      set size [file size $reply_file]
      my reply set Content-Length $size
      append result [my reply output] \n
      chan puts -nonewline $chan $result
      set reply_chan [open $reply_file r]
      my log SendReply [list length $size]
      chan configure $reply_chan -translation {binary binary}

      my ChannelCopy $reply_chan $chan -size $size
    } finally {












      my TransferComplete $reply_chan $chan
    }
  }
}

###
# END: file.tcl
................................................................................
    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      my ChannelCopy $chana $chanb -size $length
    } else {
      chan flush $chanb

    }
    chan event $chanb readable [info coroutine]
    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set readCount [::coroutine::util::gets_safety $chana 4096 reply_status]
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]





    ###
    # Read the first incoming line as the HTTP reply status
    # Return the rest of the headers verbatim
    ###
    set replybuffer "$reply_status\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    if {[dict exists $replydat Content-Length]} {
      set length [dict get $replydat Content-Length]
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      my ChannelCopy $chana $chanb -size $length


    }
  }

  method Dispatch {} {
    my variable sock chan
    if {[catch {my proxy_channel} sock errdat]} {
      my error 504 {Service Temporarily Unavailable} [dict get $errdat -errorinfo]
................................................................................
    if {$sock eq {}} {
      my error 404 {Not Found}
      tailcall my DoOutput
    }
    my log HttpAccess {}
    chan event $sock writable [info coroutine]
    yield
    try {
      my ProxyRequest $chan $sock
      my ProxyReply   $sock $chan
    } finally {
      my TransferComplete $chan $sock
    }
  }
}

###
# END: proxy.tcl
###
###
................................................................................
    set length [my request get CONTENT_LENGTH]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      my ChannelCopy $chana $chanb -size $length
    } else {
      chan flush $chanb

    }
    chan event $chanb readable [info coroutine]
    yield

  }


  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
................................................................................
    my log SendReply [list length $length]
    if {$length} {
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      my ChannelCopy $chana $chanb -size $length


    }
  }

  ###
  # For most CGI applications a directory list is vorboten
  ###
  method DirectoryListing {local_file} {
................................................................................
    #set cmd [list coroutine [my CoroName] {*}[namespace code [list my ProxyReply $chanb $chana]]]
    if {$length} {
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      ###
      # Send any POST/PUT/etc content
      ###
      my ChannelCopy $chana $chanb -size $length
      #chan copy $chana $chanb -size $length -command [info coroutine]
    } else {
      chan flush $chanb

    }
    chan event $chanb readable [info coroutine]
    yield
  }

  method ProxyReply {chana chanb args} {
    my log ProxyReply [list args $args]
    chan event $chana readable {}
    set replyhead [my HttpHeaders $chana]
    set replydat  [my MimeParse $replyhead]





    ###
    # Convert the Status: header from the CGI process to
    # a standard service reply line from a web server, but
    # otherwise spit out the rest of the headers verbatim
    ###
    set replybuffer "HTTP/1.0 [dict get $replydat Status]\n"
    append replybuffer $replyhead
    chan configure $chanb -translation {auto crlf} -blocking 0 -buffering full -buffersize 4096
    chan puts $chanb $replybuffer
    if {[dict exists $replydat Content-Length]} {
      set length [dict get $replydat Content-Length]
      ###
      # Output the body
      ###
      chan configure $chana -translation binary -blocking 0 -buffering full -buffersize 4096
      chan configure $chanb -translation binary -blocking 0 -buffering full -buffersize 4096
      my ChannelCopy $chana $chanb -size $length


    }
  }
}

###
# Act as an  SCGI Server
###

Changes to modules/httpd/httpd.test.

128
129
130
131
132
133
134



135
136
137
138
139
140
141

142
143
144
145
146
147
148
...
304
305
306
307
308
309
310













311
312
313
314
315
316
317
      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
  }

  ::DEBUG method log args {
    puts stdout $args
................................................................................
$replyfile"

::DEBUG puts httpd-client-0006
test httpd-client-0006 {Return a file} {
set reply [::httpd::test::send 10001 {GET /file HTTP/1.0} {} {}]
::httpd::test::compare $reply $checkreply
} {}














# -------------------------------------------------------------------------
# Test proxies

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








>
>
>



|



>







 







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







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
...
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
      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 {300 Redirect}
      }
      notfound {
        return {404 Not Found}
      }
      internal_error {
        return {500 Server Internal Error}
      }
    }
  }


  ::DEBUG method debug args {
    puts stderr $args
  }

  ::DEBUG method log args {
    puts stdout $args
................................................................................
$replyfile"

::DEBUG puts httpd-client-0006
test httpd-client-0006 {Return a file} {
set reply [::httpd::test::send 10001 {GET /file HTTP/1.0} {} {}]
::httpd::test::compare $reply $checkreply
} {}

::DEBUG puts httpd-client-0007
test httpd-client-0007 {URL Generates Not Found} {

set reply [::httpd::test::send 10001 {POST /doesnotexist HTTP/1.0} {} {THIS ONE ALONE IS MINE}]

::httpd::test::compare $reply {HTTP/1.0 404 Not Found
Content-Type: text/plain
Connection: close
Content-Length: *

404 Not Found}
} {}

# -------------------------------------------------------------------------
# Test proxies

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