Tcl Library Source Code

Check-in [deba870ed0]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

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

Overview
Comment:Pulling changes from trunk
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256: deba870ed01b7ad0e9083befb31248588153bfbc0cdd754e03cd36f7ed18d478
User & Date: hypnotoad 2017-11-02 19:44:14
Context
2017-11-03
19:19
Modifications to fix file path handing for MSYS Kit building check-in: e8ee0468c2 user: tne tags: hypnotoad
2017-11-02
19:44
Pulling changes from trunk check-in: deba870ed0 user: hypnotoad tags: hypnotoad
18:52
Fix to the scgi.test in the httpd module check-in: 6e5dd75c1f user: hypnotoad tags: trunk
18:21
Pulling changes from trunk check-in: 9bbf4e73bb user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/httpd/scgi-app.tcl. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

###
# Author: Sean Woods, [email protected]
###
# This file provides the "application" side of the SCGI protocol
###

package require html
package require TclOO
package require httpd 4.0

namespace eval ::scgi {}

tool::class create ::scgi::reply {  
  superclass ::httpd::reply
  
  ###
  # A modified dispatch method from a standard HTTP reply
  # Unlike in HTTP, our headers were spoon fed to use from
  # the server
  ###
  method dispatch {newsock datastate} {
    my query_headers replace $datastate













|

|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

###
# Author: Sean Woods, [email protected]
###
# This file provides the "application" side of the SCGI protocol
###

package require html
package require TclOO
package require httpd 4.0

namespace eval ::scgi {}

tool::class create ::scgi::reply {
  superclass ::httpd::reply

  ###
  # A modified dispatch method from a standard HTTP reply
  # Unlike in HTTP, our headers were spoon fed to use from
  # the server
  ###
  method dispatch {newsock datastate} {
    my query_headers replace $datastate
︙︙
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

    } on error {err info} {
      puts stderr $::errorInfo
      my error 500 $err
    } finally {
      my output
    }
  }
  
  method EncodeStatus {status} {
    return "Status: $status"
  }
}

tool::class create scgi::app {
  superclass ::httpd::server

  property socket buffersize   32768
  property socket blocking     0
  property socket translation  {binary binary}
  
  property reply_class ::scgi::reply
  
  method connect {sock ip port} {
    ###
    # If an IP address is blocked
    # send a "go to hell" message
    ###
    if {[my validation Blocked_IP $sock $ip]} {
      catch {close $sock}
      return
    }
    set query {
      REQUEST_URI {NOT_POPULATED}
    }
    try {
      chan configure $sock \
        -blocking 1 \
        -translation {binary binary} \
        -buffersize 4096 \
        -buffering none
    
      # Read the SCGI request on byte at a time until we reach a ":"
      set size {}
      while 1 {
        set char [read $sock 1]
        if {[chan eof $sock]} {
          catch {close $sock}
          return
        }
        if {$char eq ":"} break
        append size $char
      }
      # With length in hand, read the netstring encoded headers
      set inbuffer [read $sock [expr $size+1]]
      chan configure $sock -blocking 0 -buffersize 4096 -buffering full
      set query [lrange [split [string range $inbuffer 0 end-1] \0] 0 end-1]
      set reply [my dispatch $query]
      dict with query {}
      if {[llength $reply]} {
        if {[dict exists $reply class]} {
          set class [dict get $reply class]          
        } else {
          set class [my cget reply_class]
        }  
        set pageobj [$class create [namespace current]::reply::[::tool::uuid_short] [self]]
        if {[dict exists $reply mixin]} {
          oo::objdefine $pageobj mixin [dict get $reply mixin]
        }
        $pageobj dispatch $sock $reply
        my log HttpAccess $REQUEST_URI
      } else {








|











|

|





|












|



















|


|








31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

    } on error {err info} {
      puts stderr $::errorInfo
      my error 500 $err
    } finally {
      my output
    }
  }

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

tool::class create scgi::app {
  superclass ::httpd::server

  property socket buffersize   32768
  property socket blocking     0
  property socket translation  {binary binary}

  property reply_class ::scgi::reply

  method connect {sock ip port} {
    ###
    # If an IP address is blocked
    # send a "go to hell" message
    ###
    if {[my Validate_Connection $sock $ip]} {
      catch {close $sock}
      return
    }
    set query {
      REQUEST_URI {NOT_POPULATED}
    }
    try {
      chan configure $sock \
        -blocking 1 \
        -translation {binary binary} \
        -buffersize 4096 \
        -buffering none

      # Read the SCGI request on byte at a time until we reach a ":"
      set size {}
      while 1 {
        set char [read $sock 1]
        if {[chan eof $sock]} {
          catch {close $sock}
          return
        }
        if {$char eq ":"} break
        append size $char
      }
      # With length in hand, read the netstring encoded headers
      set inbuffer [read $sock [expr $size+1]]
      chan configure $sock -blocking 0 -buffersize 4096 -buffering full
      set query [lrange [split [string range $inbuffer 0 end-1] \0] 0 end-1]
      set reply [my dispatch $query]
      dict with query {}
      if {[llength $reply]} {
        if {[dict exists $reply class]} {
          set class [dict get $reply class]
        } else {
          set class [my cget reply_class]
        }
        set pageobj [$class create [namespace current]::reply::[::tool::uuid_short] [self]]
        if {[dict exists $reply mixin]} {
          oo::objdefine $pageobj mixin [dict get $reply mixin]
        }
        $pageobj dispatch $sock $reply
        my log HttpAccess $REQUEST_URI
      } else {
︙︙

This page was generated in about 0.009s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19