blob: 3995c801bdbdd2dc09b10a464149a1a3d1b8e998 (
plain)
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
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
# From configuration
# srv Directory which files reside in.
namespace eval http {
# server channel address port
# Server process
#
# content-type filename
# Find the MIME content type of a file
#
# send-file channel filename
# Open and send a file.
#
# respond channel status ?optional
# Makes HTTP response with status on channel. Optional is an optional argument with various meanings.
#
# error-page status
# Returns a small error page.
variable status_codes \
[dict create \
200 {OK} \
301 {Moved Permanently} \
400 {Bad Request} \
404 {Not Found} \
]
variable mime_types \
[dict create \
.txt text/plain \
.html text/html \
.css text/css \
{} text/html \
.png image/png \
.jpg image/jpeg \
.ttf font/ttf \
.pdf application/pdf \
.mp3 audio/mpeg \
]
proc server {channel address port} {
variable hook_namespace;
variable srv;
## (1) Handle first line
puts "(1)"
gets $channel line
set request_target [request_target::get $channel $line]
## (2) Get rest of packet.
set packet {}
while { [gets $channel line] } {
puts $line
## Check if field-line is in correct form.
## ^field-name : OWS field-value OWS $
if [expr ![regexp {^[[:alpha:]-]+(:){1}[[:space:]]?[[:print:]]+[[:space:]]?$} $line]] {
respond $channel 400
}
## Reject duplicates of the host field.
set key [string tolower [string range $line 0 [expr [string first : $line] - 1]]]
if [expr ([string compare $key "host"] == 0) && ([lsearch $packet "host"] != -1)] {
respond $channel 400
}
## Add to packet dictionary
dict append packet \
[string tolower [string range $line 0 [expr [string first : $line] - 1]]] \
[string range $line [expr [string first : $line] + 2] end]
}
## Reject packets that have no host field.
if {[lsearch [dict keys $packet] "host"] == -1} {
respond $channel 400
}
## (3) Find if the file exists, or there is a hooked application.
# If file exists, then 200 OK!
set filename [string cat $srv [request_target::file $request_target]]
if [expr [file exists $filename] && [file isfile $filename]] {
respond $channel 200 $filename
} elseif [expr [file exists [string cat $filename "index.html"]] && [file isfile [string cat $filename "index.html"]]] {
respond $channel 200 [string cat $filename "index.html"]
}
#TODO: Make some filler for this.
# If it's one of the targets of the imported namespace, then 200 OK!
#elseif [namespace eval $hook_namespace [string cat {lsearch $targets } "$filename"]] {
# respond $channel 200 $filename
#}
## Otherwise, 404.
respond $channel 404
}
proc content-type {filename} {
variable mime_types;
return [dict get $mime_types [file extension $filename]]
}
# Sends an opened file or cached file.
proc send-file {channel filename} {
fconfigure $channel -translation binary
if [cache::hit $filename] {
puts $channel [cache::get $filename]
} else {
set file [open $filename]
fconfigure $file -translation binary
fcopy $file $channel
close $file
}
}
## Header
## optional stands for a few different values.
## 200 : Request Target
## 3xx : Location
proc respond {channel status {optional {}}} {
## Import Variables
variable srv;
variable status_codes;
variable hook_namespace;
## New Variables
variable content {};
variable response {};
## If it's not a status code we know, then error, it's your fault!
if [expr [lsearch [dict keys $status_codes] $status] == -1] {
error "Invalid status response"
}
## (1) Give Status Line
append response "HTTP/1.1 $status [dict get $status_codes $status]\n"
append response "Server: unknown\n"
#append response "Last-Modified: Sun, 14 Apr 2024 01:58:24 GMT\n"
append response "Date: [clock format [clock seconds] -format {%a, %d %b %Y %T GMT} -gmt 1]\n"
if { $status == 200 } {
if [file exists $optional] {
append response "Content-Length: [file size $optional]\n"
append response "Content-Type: [content-type $optional]\n"
append response "\n"
puts -nonewline $channel $response
send-file $channel $optional
} else {
#TODO: implement this when have something to implement!
set content "Sup mate!"
append response "Content-Length: [string bytelength $content]\n"
append response "Content-Type: text/html\n"
append response "\n"
puts -nonewline $channel $response
puts -nonewline $channel $content
}
# give a Last-Modified: field
puts -nonewline $channel $response
} else {
## Error Page
set content [error-page $status]
append response "Content-Type: text/html\n"
append response "Content-Length: [string bytelength $content]\n"
if [expr ($status >= 300) && ($status <= 308) && ([string compare $optional {}] != 0)] {
append response "Location: $optional\n"
}
append response "\n"
puts -nonewline $channel $response
puts -nonewline $channel $content
}
close $channel
return -level 2
}
proc error-page {status {location {}}} {
variable status_codes
return "<html><head><title>Status: $status</title></head><body style='font-size:48px;text-align:center'><b style='font-size:72px'>$status</b><br>[dict get $status_codes $status]</body></html>"
}
source http-request_target.tcl
}
|
