Subversion Repositories Koakuma

Rev

Rev 6 | Rev 12 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 nishi 1 
#!/usr/bin/env tclsh
2 
# $Id: koakuma.cgi.in 11 2024-10-02 00:56:50Z nishi $
3 
 
4 
set KOAKUMA_VERSION "1.00"
5 
set components ""
6 
 
7 
proc exiting {code} {
8 
	exit $code
9 
}
10 
 
3 nishi 11 
proc loop_components {run} {
12 
	global components
6 nishi 13 
	foreach {name description version genre} $components {
3 nishi 14 
		eval $run
15 
	}
16 
}
17 
 
2 nishi 18 
proc crash {reason} {
19 
	global components KOAKUMA_VERSION
20 
	puts stderr "----- Start Koakuma Crash dump log -----"
21 
	puts stderr "Included components:"
3 nishi 22 
	loop_components {
2 nishi 23 
		puts stderr "	$name: $description, version $version"
24 
	}
25 
	puts stderr "Reason: $reason"
26 
	puts stderr "----- End Koakuma Crash dump log -----"
27 
	puts	"Content-Type: text/html"
28 
	puts	"Status: 500 Internal Server Error"
29 
	puts	""
30 
	puts	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">"
31 
	puts	"<html>"
32 
	puts	"	<head>"
33 
	puts	"		<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">"
34 
	puts	"		<title>Oops</title>"
35 
	puts	"	</head>"
36 
	puts	"	<body>"
37 
	puts	"		<h1>Oops</h1>"
38 
	puts	"		<hr>"
39 
	puts	"		Koakuma version $KOAKUMA_VERSION crashed, reason: <code>$reason</code><br>"
40 
	puts	"		See the server error log for details."
41 
	puts	"	</body>"
42 
	puts	"</html>"
43 
	exiting 1
44 
}
45 
 
3 nishi 46 
if { ![info exists env(PATH_INFO)] } {
47 
	puts "Status: 301 Moved Permanently"
48 
	puts "Location: $env(SCRIPT_NAME)/"
49 
	puts ""
50 
	exiting 0
2 nishi 51 
}
52 
 
3 nishi 53 
if { [catch {
54 
	package require tdom
4 nishi 55 
	dom createNodeCmd -tagName "rpc" elementNode rootXML
6 nishi 56 
	dom createNodeCmd -tagName "project" elementNode keyProject
4 nishi 57 
	dom createNodeCmd -tagName "version" -jsonType NONE elementNode keyVersion
5 nishi 58 
	dom createNodeCmd -tagName "error" -jsonType NONE elementNode keyError
6 nishi 59 
	dom createNodeCmd -tagName "name" -jsonType NONE elementNode keyName
60 
	dom createNodeCmd -tagName "description" -jsonType NONE elementNode keyDescription
61 
	dom createNodeCmd -tagName "vcs" -jsonType NONE elementNode keyVCS
62 
	dom createNodeCmd -tagName "url" -jsonType NONE elementNode keyURL
4 nishi 63 
	dom createNodeCmd -jsonType STRING textNode valueString
3 nishi 64 
}] } {
65 
	crash "Failed to load tDOM"
2 nishi 66 
}
3 nishi 67 
 
68 
if { [catch {
69 
	foreach path [glob @@PREFIX@@/lib/koakuma/component/*.tcl] {
70 
		source "$path"
71 
	}
72 
}] } {
73 
	crash "Could not load components"
2 nishi 74 
}
3 nishi 75 
 
5 nishi 76 
set data ""
77 
 
78 
while { [gets stdin line] >= 0 } {
79 
	if { "$data" == "" } {
80 
		set data "$line"
81 
	} else {
82 
		set data "$data\n$line"
83 
	}
84 
}
85 
 
3 nishi 86 
set toc ""
87 
set result ""
88 
set content ""
89 
 
6 nishi 90 
proc write_db {data} {
91 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "w"]
92 
	puts $fid "$data"
93 
	close $fid
94 
}
95 
 
96 
proc readall_db {} {
97 
	set data ""
98 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "r"]
99 
	while { [gets $fid line] >= 0 } {
100 
		if { "$data" == "" } {
101 
			set data "$line"
102 
		} else {
103 
			set data "$data\n$line"
104 
		}
105 
	}
106 
	close $fid
107 
	return "$data"
108 
}
109 
 
3 nishi 110 
proc rputs {data} {
111 
	global result
112 
	if { "$result" == "" } {
113 
		set result "$data"
114 
	} else {
115 
		set result "$result\n$data"
116 
	}
117 
}
118 
 
119 
proc tputs {data} {
120 
	global content
121 
	if { "$content" == "" } {
122 
		set content "$data"
123 
	} else {
124 
		set content "$content\n$data"
125 
	}
126 
}
127 
 
128 
proc html_escape {data} {
129 
	return "[regsub -all {&} "[regsub -all {>} "[regsub -all {<} "$data" "&lt;"]" "&gt;"]" "&amp;"]"
130 
}
131 
 
132 
proc open_projects {} {
133 
	while 1 {
134 
		if { ![info exists "@@PREFIX@@/lib/koakuma/db/projects.lock"] } {
135 
			break
136 
		}
137 
		set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"]
138 
		if { ![info exists "/proc/[gets $fid line]"] } {
139 
			close $fid
140 
			break
141 
		}
142 
		after 10
143 
		close $fid
144 
	}
145 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"]
146 
	puts $fid "[pid]"
147 
	close $fid
148 
}
149 
 
150 
proc scan_projects {run} {
151 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "r"]
152 
	set content ""
153 
	while { [gets $fid line] >= 0 } {
154 
		if { "$content" == "" } {
155 
			set content "$line"
156 
		} else {
157 
			set content "$content\n$line"
158 
		}
159 
	}
160 
	close $fid
161 
	set dom [dom parse "$content"]
162 
	set doc [$dom documentElement]
163 
	foreach elem [$doc selectNodes "/projects/project"] {
164 
		set name "[$elem selectNodes "string(name)"]"
165 
		set description "[$elem selectNodes "string(description)"]"
166 
		eval $run
167 
	}
168 
}
169 
 
170 
proc project_exists {projname} {
171 
	set desc ""
172 
	scan_projects {
173 
		upvar 1 desc desc
174 
		upvar 1 projname projname
175 
		if { "$name" == "$projname" } {
176 
			set desc "$description"
177 
			break
178 
		}
179 
	}
180 
	return "$desc"
181 
}
182 
 
183 
proc close_projects {} {
184 
	file delete "@@PREFIX@@/lib/koakuma/db/projects.lock"
185 
}
186 
 
187 
proc start_html {title has_toc} {
188 
	global toc
189 
	rputs	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
190 
	rputs	"<html>"
191 
	rputs	"	<head>"
192 
	rputs	"		<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">"
193 
	rputs	"		<title>$title - Koakuma</title>"
194 
	rputs	"		<link rel=\"stylesheet\" href=\"/static/style.css\">"
195 
	rputs	"	</head>"
196 
	rputs	"	<body>"
197 
	rputs	"		<a href=\"/koakuma\" id=\"gomain\">"
198 
	rputs	"			<img src=\"/static/koakuma.png\" alt=\"Koakuma by Kasuya Baian\" height=\"192px\">"
199 
	rputs	"		</a>"
200 
	rputs	"		<div id=\"space\"></div>"
201 
	rputs	"		<div id=\"title\">"
202 
	rputs	"			Koakuma"
203 
	rputs	"		</div>"
204 
	rputs	"		<div id=\"clearfix\"></div>"
205 
	if { "$has_toc" == "1" } {
206 
		rputs	"		<div id=\"toc\">"
207 
		rputs	"			<div id=\"toctitle\">TOC</div>"
208 
		foreach sect $toc {
209 
			if { "[string range "[regsub -all { } "$sect" "-"]" 0 0]" == "-" } {
210 
				rputs "<a class=\"shiftlink\" href=\"#TOC-[regsub {^-} "[regsub -all { } "$sect" "-"]" ""]\">[regsub {^-} "$sect" ""]</a><br>"
211 
			} else {
212 
				rputs "<a href=\"#TOC-[regsub -all { } "$sect" "-"]\">$sect</a><br>"
213 
			}
214 
		}
215 
		rputs	"		</div>"
216 
	}
217 
	if { "$has_toc" == "1" } {
218 
		rputs	"		<div id=\"doc\">"
219 
	} else {
220 
		rputs	"		<div id=\"doc-notoc\">"
221 
	}
222 
	rputs	"			<h1>$title</h1>"
223 
}
224 
proc end_html {has_toc} {
225 
	global KOAKUMA_VERSION
226 
	rputs	"		</div>"
227 
	rputs	"		<hr>"
228 
	rputs	"		<i>Powered by <a href=\"http://nishi.boats/koakuma\">Koakuma</a> $KOAKUMA_VERSION</i>"
229 
	rputs	"	</body>"
230 
	rputs	"</html>"
231 
}
232 
 
233 
proc add_toc {data} {
234 
	global toc
235 
	tputs	"<h2 id=\"TOC-[regsub -all { } "$data" "-"]\"><a href=\"#TOC-[regsub -all { } "$data" "-"]\">#</a> $data</h2>"
236 
	lappend toc "$data"
237 
}
238 
 
239 
proc add_toc2 {data} {
240 
	global toc
241 
	tputs	"<h3 id=\"TOC-[regsub -all { } "$data" "-"]\"><a href=\"#TOC-[regsub -all { } "$data" "-"]\">#</a> $data</h3>"
242 
	lappend toc "-$data"
243 
}
244 
 
245 
if { [catch {
246 
	set path "[regsub -all {/+} "$env(PATH_INFO)" "/"]"
4 nishi 247 
	if { [regexp {^/rpc(/.*)?$} "$path"] } {
248 
		rputs "Content-Type: application/json"
249 
	} else {
250 
		rputs "Content-Type: text/html"
251 
	}
3 nishi 252 
	if { "$path" == "/" } {
253 
		add_toc "Tcl Information"
254 
		tputs	"<table border=\"0\">"
255 
		tputs	"	<tr>"
256 
		tputs	"		<th>"
257 
		tputs	"			Version"
258 
		tputs	"		</th>"
259 
		tputs	"		<td>"
260 
		tputs	"			$tcl_version"
261 
		tputs	"		</td>"
262 
		tputs	"	</tr>"
263 
		tputs	"	<tr>"
264 
		tputs	"		<th>"
265 
		tputs	"			Platform"
266 
		tputs	"		</th>"
267 
		tputs	"		<td>"
268 
		tputs	"			$tcl_platform(os)/$tcl_platform(machine) $tcl_platform(osVersion)"
269 
		tputs	"		</td>"
270 
		tputs	"	</tr>"
271 
		tputs	"</table>"
272 
		add_toc "Components"
273 
		loop_components {
274 
			if { [llength [info procs "${name}_info"]] > 0 } {
275 
				${name}_info
276 
			}
277 
		}
278 
		set has_projects 0
279 
		add_toc "Projects"
280 
		open_projects
281 
		scan_projects {
282 
			upvar 1 has_projects has_projects
283 
			if { "$has_projects" == "0" } {
284 
				set has_projects 1
285 
				tputs	"<table border=\"0\">"
286 
			}
287 
			tputs	"<tr>"
288 
			tputs	"	<th><a href=\"/koakuma/project/$name\">$name</a></th>"
289 
			tputs	"	<td>$description</td>"
290 
			tputs	"</tr>"
291 
		}
292 
		close_projects
293 
		if { "$has_projects" == "1" } {
294 
			tputs	"</table>"
295 
		} else {
296 
			tputs	"No projects have been added, yet."
297 
		}
298 
 
299 
		rputs ""
300 
		start_html "Main" 1
301 
		rputs "$content"
302 
		end_html 1
4 nishi 303 
	} elseif { [regexp {^/rpc(/.*)?$} "$path"] } {
304 
		regexp {^/rpc(/.*)?$} "$path" -> api
305 
		set doc [dom createDocumentNode]
5 nishi 306 
		$doc appendFromScript {
307 
			keyVersion {valueString "$KOAKUMA_VERSION"}
308 
		}
4 nishi 309 
		if { "$api" == "" || "$api" == "/" } {
5 nishi 310 
			rputs ""
311 
			rputs "[$doc asJSON]"
312 
		} elseif { "$api" == "/create-project" } {
313 
			if { [catch {dom parse -json "$data" clidoc}] } {
314 
				rputs "Status: 400 Bad Request"
315 
				$doc appendFromScript {
316 
					keyError {valueString "Bad JSON"}
317 
				}
318 
			} else {
319 
				set projname "[$clidoc selectNodes "string(/name)"]"
320 
				set projdescription "[$clidoc selectNodes "string(/description)"]"
6 nishi 321 
				set projvcs "[$clidoc selectNodes "string(/vcs)"]"
5 nishi 322 
				set url "[$clidoc selectNodes "string(/url)"]"
6 nishi 323 
				if { "$projname" == "" || "$projdescription" == "" || "$projvcs" == "" || "$url" == "" } {
5 nishi 324 
					rputs "Status: 400 Bad Request"
325 
					$doc appendFromScript {
326 
						keyError {valueString "Required field missing"}
327 
					}
328 
				} else {
329 
					set has_vcs 0
6 nishi 330 
					set has_name 0
5 nishi 331 
					loop_components {
332 
						upvar 1 has_vcs has_vcs
6 nishi 333 
						upvar 1 projvcs projvcs
334 
						if { "$name" == "$projvcs" && "$genre" == "VCS" } {
5 nishi 335 
							set has_vcs 1
336 
							break
337 
						}
338 
					}
6 nishi 339 
					open_projects
340 
					scan_projects {
341 
						upvar 1 has_name has_name
342 
						upvar 1 projname projname
343 
						if { "$name" == "$projname" } {
344 
							set has_name 1
345 
							break
346 
						}
347 
					}
348 
					close_projects
5 nishi 349 
					if { $has_vcs == 0 } {
350 
						rputs "Status: 400 Bad Request"
351 
						$doc appendFromScript {
352 
							keyError {valueString "Not a valid VCS"}
353 
						}
6 nishi 354 
					} elseif { $has_name == 1 } {
355 
						rputs "Status: 400 Bad Request"
356 
						$doc appendFromScript {
357 
							keyError {valueString "Project already exists"}
358 
						}
5 nishi 359 
					} else {
360 
						open_projects
6 nishi 361 
						set xml "[readall_db]"
362 
						set xmldoc [dom parse "$xml"]
363 
						set root [$xmldoc documentElement]
364 
						$root appendFromScript {
365 
							keyProject {
366 
								keyName {valueString "$projname"}
367 
								keyDescription {valueString "$projdescription"}
368 
								keyVCS {valueString "$projvcs"}
369 
								keyURL {valueString "$url"}
370 
							}
371 
						}
372 
						write_db "[$xmldoc asXML]"
11 nishi 373 
						file mkdir "@@PREFIX@@/lib/koakuma/db/data/$projname"
5 nishi 374 
						close_projects
375 
					}
376 
				}
377 
			}
378 
			rputs ""
379 
			rputs "[$doc asJSON]"
380 
		} else {
4 nishi 381 
			$root appendFromScript {
5 nishi 382 
				keyError {valueString "No such endpoint"}
4 nishi 383 
			}
5 nishi 384 
			rputs "Status: 404 Not Found"
385 
			rputs ""
4 nishi 386 
			rputs "[$doc asJSON]"
387 
		}
3 nishi 388 
	} elseif { [regexp {^/project/[^/]+.*$} "$path"] } {
389 
		regexp {^/project/([^/]+).*$} "$path" -> projname
390 
		open_projects
391 
		set has_project [project_exists "$projname"]
392 
		close_projects
393 
 
394 
		if { "$has_project" != "" } {
395 
			add_toc "Description"
396 
			tputs "[html_escape "$has_project"]"
11 nishi 397 
			add_toc "Details"
398 
			tputs	"<table border=\"0\">"
399 
			tputs	"	<tr>"
400 
			tputs	"		<th>"
401 
			tputs	"			Last run"
402 
			tputs	"		</th>"
403 
			tputs	"		<td>"
404 
			if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/lastrun"] } {
405 
			} else {
406 
				tputs "Was never ran"
407 
			}
408 
			tputs	"			"
409 
			tputs	"		</td>"
410 
			tputs	"	</tr>"
411 
			tputs	"</table>"
3 nishi 412 
 
413 
			rputs ""
414 
			start_html "Project: $projname" 1
415 
			rputs "$content"
416 
			end_html 1
417 
		} else {
418 
			tputs "I could not find the project you were finding."
419 
 
420 
			rputs "Status: 404 Not Found"
421 
			rputs ""
422 
			start_html "Not Found" 0
423 
			rputs "$content"
424 
			end_html 0
425 
		}
426 
	} else {
427 
		tputs "I could not find the content you were finding."
428 
 
429 
		rputs "Status: 404 Not Found"
430 
		rputs ""
431 
		start_html "Not Found" 0
432 
		rputs "$content"
433 
		end_html 0
434 
	}
435 
}] } {
436 
	crash "Could not render the HTML"
437 
} else {
438 
	puts "$result"
439 
}
440 
exiting 0