blob: e0578442cdbfce705cf79a4712b4f195f39a5ccc (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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
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
|
#!/usr/bin/tclsh
namespace eval www {
package require TclOO
oo::class create server {
constructor {{ports 0} {acts {}}} {
my variable sock actions
set actions $acts
foreach port $ports {
my bind $port
}
}
# actions of existing clients (where request is ongoing) aren't modified, only actions for new clients
method action {uri handler} {
my variable actions
dict set actions $uri $handler
}
method bind {{port 0}} {
socket -server "[self namespace] accept" $port
}
method accept {chan addr port} {
my variable actions
if [dict exists $actions accept] {
[{*}[dict get $actions accept] $chan $addr $port]
}
client new $chan $actions
}
}
oo::class create client {
constructor {sock {actions {}}} {
my variable sock stage actions
set stage headers
set chan $sock
chan event $chan readable {[self namespace] readable}
chan configure $chan -blocking 0
}
destructor {} {
my variable sock
close sock
}
method readable {
my variable to_parse chan stage headers arguments uri
switch $stage {
headers {
if {[catch {append to_parse {gets $chan}}] != 0} {
my destroy
}
if {[string first "\n\n" $to_parse] != -1} {
set list [split $to_parse ":\n"]
set uri [lindex [split [lindex $list 0] " "] 1]
set headers [lreplace $list 0 0]
set i 0
dict map {key value} $headers {
if {expr {[incr i] % 2}} {
set key [string tolower $key]
}
}
set variables [split [lindex [split $uri "?"] 1] "&=;"]
set body {}
if [dict exists content-length] {
set stage body
set to_parse {}
chan configure $chan -translation {binary auto} -encoding binary -eofchar {{} {}}
} else {
my request_complete
}
}
}
body {
if {[catch {append to_parse {gets $chan}}] != 0} {
my destroy
}
if {[string length to_parse] == [dict get $headers content-length]} {
my request_complete
}
}
}
}
method request_complete {
my variable actions headers arguments uri body
dict for {key value} $actions {
if [string match -nocase $key $uri] {
return [{*}$value $arguments $headers $body]
}
}
return [my send {content-type text/plain} {404 not found-ni najdeno} {404 not found-ni najdeno}]
}
# uri is "string match". handler gets parsed array of request variables, request headers and request body
method send {headers body code} {
my variable to_write chan data
# cr is auto translated to crlf for network sockets in tcl
set to_write "HTTP/1.0 $code
Connection: close
"
dict for {key value} $headers {
append to_write "$key: $value
"
}
set data $body
chan event $chan writable {[self namespace] writable}
}
method writable {} {
my variable chan to_write
if {[catch {[puts -nonewline $chan $to_write}] != 0} {
my destroy
}
chan configure $chan -translation {binary binary} -encoding binary
if {[catch {puts -nonewline $chan $data}] != 0} {
}
my destroy
}
}
if {$argv0 == www.tcl} {
}
}
|
