Tcl Library Source Code

Check-in [bbdea9cd0c]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

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

Overview
Comment:Modifications to httpd: Refactored the ChanCopy method to utilize the yieldto command, per a suggestion from Donal Fellows.
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256:bbdea9cd0c859accc5a190d6a425376210e98abc7613f6db8806697f47627a01
User & Date: hypnotoad 2018-09-12 20:23:06
Context
2018-09-13
15:31
httpd tweak: Proxy replies and file transfers now run in end-of-file mode instead of fixed file size. Keeps from having to read too much into the headers to handle either Content-Size or Chunked encoding replies check-in: 8a1de41126 user: hypnotoad tags: hypnotoad
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

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>"
    }







|
|

|

<
<

|
|

>
>
|
<
<
<
<
<
<
<
<

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




|




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







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
namespace eval ::url {}
namespace eval ::httpd {}
namespace eval ::scgi {}

clay::define ::httpd::mime {

  method ChannelCopy {in out args} {
    set chunk 4096
    set size -1
    foreach {f v} $args {
      set [string trim $f -] $v
    }


    dict set info coroutine [info coroutine]
    if {$size>0 && $chunk>$size} {
        set chunk $size
    }
    set bytes 0
    set sofar 0
    set method [self method]








    while 1 {












      set command {}
      set error {}

      if {$size>=0} {
        incr sofar $bytes
        set remaining [expr {$size-$sofar}]
        if {$remaining <= 0} {
          break
        } elseif {$chunk > $remaining} {
          set chunk $remaining
        }
      }
      lassign [yieldto chan copy $in $out -size $chunk \
        -command [list [info coroutine] $method]] \
        command bytes error
      if {$command ne $method} {
        error "Subroutine $method interrupted"
      }




      if {[string length $error]} {
        error $error
      }

      if {[chan eof $in]} {
        break
      }
    }
  }


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

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

94
95
96
97
98
99
100



101
102
103
104
105
106
107
          }
        }
      }
      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.







>
>
>







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
          }
        }
      }
      my Session_Load
      my Log_Dispatched
      my Dispatch
    } on error {err errdat} {
      puts [list ERROR ***]
      puts [dict get $errdat -errorinfo]
      puts [list ***]
      my error 500 $err [dict get $errdat -errorinfo]
      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.

Changes to modules/httpd/httpd.tcl.

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
...
430
431
432
433
434
435
436



437
438
439
440
441
442
443
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>"
    }
................................................................................
          }
        }
      }
      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.







|
|

|

<
<

|
|

>
>
|
<
<
<
<
<
<
<
<

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




|




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







 







>
>
>







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
...
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
namespace eval ::url {}
namespace eval ::httpd {}
namespace eval ::scgi {}

clay::define ::httpd::mime {

  method ChannelCopy {in out args} {
    set chunk 4096
    set size -1
    foreach {f v} $args {
      set [string trim $f -] $v
    }


    dict set info coroutine [info coroutine]
    if {$size>0 && $chunk>$size} {
        set chunk $size
    }
    set bytes 0
    set sofar 0
    set method [self method]








    while 1 {












      set command {}
      set error {}

      if {$size>=0} {
        incr sofar $bytes
        set remaining [expr {$size-$sofar}]
        if {$remaining <= 0} {
          break
        } elseif {$chunk > $remaining} {
          set chunk $remaining
        }
      }
      lassign [yieldto chan copy $in $out -size $chunk \
        -command [list [info coroutine] $method]] \
        command bytes error
      if {$command ne $method} {
        error "Subroutine $method interrupted"
      }




      if {[string length $error]} {
        error $error
      }

      if {[chan eof $in]} {
        break
      }
    }
  }


  method html_header {{title {}} args} {
    set result {}
    append result "<HTML><HEAD>"
    if {$title ne {}} {
      append result "<TITLE>$title</TITLE>"
    }
................................................................................
          }
        }
      }
      my Session_Load
      my Log_Dispatched
      my Dispatch
    } on error {err errdat} {
      puts [list ERROR ***]
      puts [dict get $errdat -errorinfo]
      puts [list ***]
      my error 500 $err [dict get $errdat -errorinfo]
      my DoOutput
    }
  }

  method Dispatch {} {
    # Invoke the URL implementation.