Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch httpd-ssl
Excluding Merge-Ins
This is equivalent to a diff from
89719d76cf
to 00b11abd2e
2019-04-09
| | |
14:55 |
|
Closed-Leaf
check-in: 00b11abd2e user: hypnotoad tags: httpd-ssl
|
2018-10-18
| | |
19:20 |
|
check-in: 68e4ebd04b user: hypnotoad tags: hypnotoad
|
00:14 |
|
check-in: c57cecd147 user: hypnotoad tags: httpd-ssl
|
2018-10-16
| | |
15:27 |
|
check-in: 89719d76cf user: hypnotoad tags: hypnotoad
|
2018-10-11
| | |
17:40 |
|
check-in: b075fb9a6b user: hypnotoad tags: hypnotoad
|
| | |
Changes to examples/httpd/httpd.tcl.
︙ | | |
188
189
190
191
192
193
194
195
196
|
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
my puts "<tr><th>$f</th><td>$v</td></tr>"
}
my puts "<tr><th>File Size</th><td>[my request get CONTENT_LENGTH]</td></tr>"
my puts </TABLE>
my puts </BODY></HTML>
}
set portlist {}
set info {}
if {[dict exists $serveropts myaddr]} {
dict set info SERVER_IP [dict get $serveropts myaddr]
}
if {[dict exists $serveropts port]} {
dict set info SERVER_PORT [dict get $serveropts port]
lappend portlist $info
} else {
dict set info SERVER_PORT auto
lappend portlist $info
}
if {[dict exists $serveropts cafile] && ![catch {package require tls}]} {
dict set info SERVER_SSL 1
dict set info CA_FILE [dict get $serveropts cafile]
if {[dict exists $serveropts port_ssl]} {
dict set info SERVER_PORT [dict get $serveropts port_ssl]
lappend portlist $info
} else {
dict set info SERVER_PORT auto
lappend portlist $info
}
}
puts $portlist
appmain start $portlist
puts [list LISTENING on [appmain port_listening]]
cron::main
|
Changes to modules/httpd/build/scgi.tcl.
︙ | | |
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
-
+
+
+
+
|
clay set socket/ blocking 0
clay set socket/ translation {binary binary}
method debug args {
puts $args
}
method Connect {uuid sock ip} {
method Connect {uuid sock ip {info {}}} {
yield [info coroutine]
chan event $sock readable {}
chan configure $sock \
-blocking 1 \
-translation {binary binary} \
-buffersize 4096 \
-buffering none
my counter url_hit
try {
# Read the SCGI request on byte at a time until we reach a ":"
dict set query http HTTP_HOST {}
dict set query http CONTENT_LENGTH 0
dict set query http REQUEST_URI /
dict set query http REMOTE_ADDR $ip
foreach {f v} $info {
dict set query http $f $v
}
set size {}
while 1 {
set char [::coroutine::util::read $sock 1]
if {[chan eof $sock]} {
catch {close $sock}
return
}
|
︙ | | |
Changes to modules/httpd/build/server.tcl.
︙ | | |
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
|
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
|
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
set arglist [lindex $args 0]
} else {
set arglist $args
}
foreach {var val} $arglist {
my clay set server/ $var $val
}
my start
}
destructor {
my stop
}
###
# Reply to an open socket. This method builds a coroutine to manage the remainder
# of the connection. The coroutine's operations are driven by the [cmd Connect] method.
###
method connect {sock ip port} {
method connect args {
switch [llength $args] {
3 {
set info {}
lassign $args sock ip port
}
4 {
lassign $args info sock ip port
}
default {
error "Usage: [self method] ?info? sock ip port"
}
}
###
# If an IP address is blocked drop the
# connection
###
if {[my Validate_Connection $sock $ip]} {
catch {close $sock}
return
}
set uuid [my Uuid_Generate]
set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip $info]]]
chan event $sock readable $coro
}
method ServerHeaders {ip http_request mimetxt} {
set result {}
dict set result HTTP_HOST {}
dict set result CONTENT_LENGTH 0
|
︙ | | |
109
110
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
|
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
|
-
+
+
+
+
|
# determine if the request is valid, and/or what kind of reply to generate. Under
# normal cases, an object of class [cmd ::http::reply] is created, and that class's
# [cmd dispatch] method.
# This action passes control of the socket to
# the reply object. The reply object manages the rest of the transaction, including
# closing the socket.
###
method Connect {uuid sock ip} {
method Connect {uuid sock ip {info {}}} {
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]
foreach {f v} $info {
dict set query http $f $v
}
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}
|
︙ | | |
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
|
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
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
|
-
+
-
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
}
method source {filename} {
source $filename
}
# Open the socket listener.
method start {} {
method start {{portlist {}}} {
# Build a namespace to contain replies
namespace eval [namespace current]::reply {}
my variable socklist port_listening
if {[my clay get server/ configuration_file] ne {}} {
source [my clay get server/ configuration_file]
}
if {[llength $portlist]==0} {
set port [my clay get server/ port]
if { $port in {auto {}} } {
set port [my clay get server/ port]
if {$port in {{} auto}} {
package require nettool
set port [::nettool::allocate_port 8015]
}
set port_listening $port
set myaddr [my clay get server/ myaddr]
my debug [list [self] listening on $port $myaddr]
if {$myaddr ni {all any * {}}} {
foreach ip $myaddr {
lappend socklist [socket -server [namespace code [list my connect]] -myaddr $ip $port]
}
} else {
lappend socklist [socket -server [namespace code [list my connect]] $port]
}
set port [::nettool::allocate_port 8015]
}
set info {}
dict set info SERVER_PORT $port
set myaddr [my clay get server/ myaddr]
if {$myaddr ni {all any * {}}} {
dict set info SERVER_IP $myaddr
}
lappend portlist $info
}
foreach info $portlist {
if {[dict exists $info SERVER_SSL] && [dict get $info SERVER_SSL]} {
package require tls
set cmd ::tls::socket
set opts {-tls1 1 -ssl2 0 -ssl3 0}
if {[dict exist $info CA_FILE]} {
lappend opts -cafile [dict get $info CA_FILE]
}
} else {
set cmd ::socket
set opts {}
}
if {![dict exists $info SERVER_PORT] || [dict get $info SERVER_PORT] in {{} auto}} {
package require nettool
dict set info SERVER_PORT [::nettool::allocate_port 8015]
}
if {[dict exists $info SERVER_IP] && [llength [dict get $info SERVER_IP]]} {
foreach ip [dict get $info SERVER_IP] {
puts [list $cmd -server [namespace code [list my connect $info]] {*}$opts -myaddr $ip [dict get $info SERVER_PORT]]
lappend socklist [$cmd -server [namespace code [list my connect $info]] {*}$opts -myaddr $ip [dict get $info SERVER_PORT]]
lappend port_listening $info
}
} else {
puts [list $cmd -server [namespace code [list my connect $info]] {*}$opts [dict get $info SERVER_PORT]]
lappend socklist [$cmd -server [namespace code [list my connect $info]] {*}$opts [dict get $info SERVER_PORT]]
lappend port_listening $info
}
}
my debug [list [self] listening on $port_listening]
::cron::every [self] 120 [namespace code {my CheckTimeout}]
my Thread_start
}
# Shut off the socket listener, and destroy any pending replies.
method stop {} {
my variable socklist
|
︙ | | |
Changes to modules/httpd/httpd.man.
︙ | | |
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
|
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
|
-
+
-
+
|
[list_begin definitions]
[call method [cmd "constructor"] [arg args] [opt "[arg port] [const "auto"]"] [opt "[arg myaddr] [const "127.0.0.1"]"] [opt "[arg string] [const "auto"]"] [opt "[arg name] [const "auto"]"] [opt "[arg doc_root] [const ""]"] [opt "[arg reverse_dns] [const "0"]"] [opt "[arg configuration_file] [const ""]"] [opt "[arg protocol] [const "HTTP/1.1"]"]]
[call method [cmd "destructor"] [opt "[arg dictargs]"]]
[call method [cmd "connect"] [arg sock] [arg ip] [arg port]]
[call method [cmd "connect"] [opt "[arg args]"]]
Reply to an open socket. This method builds a coroutine to manage the remainder
of the connection. The coroutine's operations are driven by the [cmd Connect] method.
[call method [cmd "ServerHeaders"] [arg ip] [arg http_request] [arg mimetxt]]
[call method [cmd "Connect"] [arg uuid] [arg sock] [arg ip]]
[call method [cmd "Connect"] [arg uuid] [arg sock] [arg ip] [opt "[arg info] [const ""]"]]
This method reads HTTP headers, and then consults the [cmd dispatch] method to
determine if the request is valid, and/or what kind of reply to generate. Under
normal cases, an object of class [cmd ::http::reply] is created, and that class's
[cmd dispatch] method.
This action passes control of the socket to
the reply object. The reply object manages the rest of the transaction, including
|
︙ | | |
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
-
+
|
needed for the application.
[call method [cmd "source"] [arg filename]]
[call method [cmd "start"]]
[call method [cmd "start"] [opt "[arg portlist] [const ""]"]]
Open the socket listener.
[call method [cmd "stop"]]
Shut off the socket listener, and destroy any pending replies.
|
︙ | | |
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
|
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
|
-
+
|
[para]
[class {Methods}]
[list_begin definitions]
[call method [cmd "debug"] [opt "[arg args]"]]
[call method [cmd "Connect"] [arg uuid] [arg sock] [arg ip]]
[call method [cmd "Connect"] [arg uuid] [arg sock] [arg ip] [opt "[arg info] [const ""]"]]
[list_end]
[para]
[subsection {Class httpd::content.websocket}]
|
︙ | | |
Changes to modules/httpd/httpd.tcl.
︙ | | |
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
|
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
|
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
set arglist [lindex $args 0]
} else {
set arglist $args
}
foreach {var val} $arglist {
my clay set server/ $var $val
}
my start
}
destructor {
my stop
}
method connect {sock ip port} {
method connect args {
switch [llength $args] {
3 {
set info {}
lassign $args sock ip port
}
4 {
lassign $args info sock ip port
}
default {
error "Usage: [self method] ?info? sock ip port"
}
}
###
# If an IP address is blocked drop the
# connection
###
if {[my Validate_Connection $sock $ip]} {
catch {close $sock}
return
}
set uuid [my Uuid_Generate]
set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip]]]
set coro [coroutine ::httpd::coro::$uuid {*}[namespace code [list my Connect $uuid $sock $ip $info]]]
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] {
|
︙ | | |
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
|
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
|
-
+
+
+
+
|
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} {
method Connect {uuid sock ip {info {}}} {
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]
foreach {f v} $info {
dict set query http $f $v
}
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}
|
︙ | | |
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
|
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
|
-
+
-
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
set prefix [string trimright $prefix *]
set prefix [string trimright $prefix /]
return $prefix
}
method source {filename} {
source $filename
}
method start {} {
method start {{portlist {}}} {
# Build a namespace to contain replies
namespace eval [namespace current]::reply {}
my variable socklist port_listening
if {[my clay get server/ configuration_file] ne {}} {
source [my clay get server/ configuration_file]
}
if {[llength $portlist]==0} {
set port [my clay get server/ port]
if { $port in {auto {}} } {
set port [my clay get server/ port]
if {$port in {{} auto}} {
package require nettool
set port [::nettool::allocate_port 8015]
}
set port_listening $port
set myaddr [my clay get server/ myaddr]
my debug [list [self] listening on $port $myaddr]
if {$myaddr ni {all any * {}}} {
foreach ip $myaddr {
lappend socklist [socket -server [namespace code [list my connect]] -myaddr $ip $port]
}
} else {
lappend socklist [socket -server [namespace code [list my connect]] $port]
}
set port [::nettool::allocate_port 8015]
}
set info {}
dict set info SERVER_PORT $port
set myaddr [my clay get server/ myaddr]
if {$myaddr ni {all any * {}}} {
dict set info SERVER_IP $myaddr
}
lappend portlist $info
}
foreach info $portlist {
if {[dict exists $info SERVER_SSL] && [dict get $info SERVER_SSL]} {
package require tls
set cmd ::tls::socket
set opts {-tls1 1 -ssl2 0 -ssl3 0}
if {[dict exist $info CA_FILE]} {
lappend opts -cafile [dict get $info CA_FILE]
}
} else {
set cmd ::socket
set opts {}
}
if {![dict exists $info SERVER_PORT] || [dict get $info SERVER_PORT] in {{} auto}} {
package require nettool
dict set info SERVER_PORT [::nettool::allocate_port 8015]
}
if {[dict exists $info SERVER_IP] && [llength [dict get $info SERVER_IP]]} {
foreach ip [dict get $info SERVER_IP] {
puts [list $cmd -server [namespace code [list my connect $info]] {*}$opts -myaddr $ip [dict get $info SERVER_PORT]]
lappend socklist [$cmd -server [namespace code [list my connect $info]] {*}$opts -myaddr $ip [dict get $info SERVER_PORT]]
lappend port_listening $info
}
} else {
puts [list $cmd -server [namespace code [list my connect $info]] {*}$opts [dict get $info SERVER_PORT]]
lappend socklist [$cmd -server [namespace code [list my connect $info]] {*}$opts [dict get $info SERVER_PORT]]
lappend port_listening $info
}
}
my debug [list [self] listening on $port_listening]
::cron::every [self] 120 [namespace code {my CheckTimeout}]
my Thread_start
}
method stop {} {
my variable socklist
if {[info exists socklist]} {
foreach sock $socklist {
|
︙ | | |
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
|
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
|
-
+
+
+
+
|
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} {
method Connect {uuid sock ip {info {}}} {
yield [info coroutine]
chan event $sock readable {}
chan configure $sock \
-blocking 1 \
-translation {binary binary} \
-buffersize 4096 \
-buffering none
my counter url_hit
try {
# Read the SCGI request on byte at a time until we reach a ":"
dict set query http HTTP_HOST {}
dict set query http CONTENT_LENGTH 0
dict set query http REQUEST_URI /
dict set query http REMOTE_ADDR $ip
foreach {f v} $info {
dict set query http $f $v
}
set size {}
while 1 {
set char [::coroutine::util::read $sock 1]
if {[chan eof $sock]} {
catch {close $sock}
return
}
|
︙ | | |
Changes to modules/httpd/httpd.test.
︙ | | |
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
+
|
###
# Build the server
###
set DIR [file dirname [file normalize [info script]]]
set ::DEMOROOT $DIR
::httpd::server create TESTAPP port 10001
TESTAPP start
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}]
|
︙ | | |
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
|
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
|
-
+
-
+
|
superclass ::httpd::content.proxy
method proxy_channel {} {
return [::socket localhost [my clay get proxy_port]]
}
}
::httpd::server create TESTPROXY port 10002
TESTPROXY start
TESTAPP uri add * /proxy* [list mixin {reply ::test::content.proxy} proxy_port [TESTPROXY port_listening]]
TESTAPP uri add * /proxy* [list mixin {reply ::test::content.proxy} proxy_port 10002]
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}]
|
︙ | | |
576
577
578
579
580
581
582
583
584
585
586
587
588
589
|
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
|
+
|
superclass ::httpd::server.scgi
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 start
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}]
|
︙ | | |