Subversion Repositories Koakuma

Rev

Rev 4 | Rev 6 | 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$
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
13 
	foreach {name description version} $components {
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
56 
	dom createNodeCmd -tagName "version" -jsonType NONE elementNode keyVersion
5 nishi 57 
	dom createNodeCmd -tagName "error" -jsonType NONE elementNode keyError
4 nishi 58 
	dom createNodeCmd -jsonType STRING textNode valueString
3 nishi 59 
}] } {
60 
	crash "Failed to load tDOM"
2 nishi 61 
}
3 nishi 62 
 
63 
if { [catch {
64 
	foreach path [glob @@PREFIX@@/lib/koakuma/component/*.tcl] {
65 
		source "$path"
66 
	}
67 
}] } {
68 
	crash "Could not load components"
2 nishi 69 
}
3 nishi 70 
 
5 nishi 71 
set data ""
72 
 
73 
while { [gets stdin line] >= 0 } {
74 
	if { "$data" == "" } {
75 
		set data "$line"
76 
	} else {
77 
		set data "$data\n$line"
78 
	}
79 
}
80 
 
3 nishi 81 
set toc ""
82 
set result ""
83 
set content ""
84 
 
85 
proc rputs {data} {
86 
	global result
87 
	if { "$result" == "" } {
88 
		set result "$data"
89 
	} else {
90 
		set result "$result\n$data"
91 
	}
92 
}
93 
 
94 
proc tputs {data} {
95 
	global content
96 
	if { "$content" == "" } {
97 
		set content "$data"
98 
	} else {
99 
		set content "$content\n$data"
100 
	}
101 
}
102 
 
103 
proc html_escape {data} {
104 
	return "[regsub -all {&} "[regsub -all {>} "[regsub -all {<} "$data" "&lt;"]" "&gt;"]" "&amp;"]"
105 
}
106 
 
107 
proc open_projects {} {
108 
	while 1 {
109 
		if { ![info exists "@@PREFIX@@/lib/koakuma/db/projects.lock"] } {
110 
			break
111 
		}
112 
		set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"]
113 
		if { ![info exists "/proc/[gets $fid line]"] } {
114 
			close $fid
115 
			break
116 
		}
117 
		after 10
118 
		close $fid
119 
	}
120 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"]
121 
	puts $fid "[pid]"
122 
	close $fid
123 
}
124 
 
125 
proc scan_projects {run} {
126 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "r"]
127 
	set content ""
128 
	while { [gets $fid line] >= 0 } {
129 
		if { "$content" == "" } {
130 
			set content "$line"
131 
		} else {
132 
			set content "$content\n$line"
133 
		}
134 
	}
135 
	close $fid
136 
	set dom [dom parse "$content"]
137 
	set doc [$dom documentElement]
138 
	foreach elem [$doc selectNodes "/projects/project"] {
139 
		set name "[$elem selectNodes "string(name)"]"
140 
		set description "[$elem selectNodes "string(description)"]"
141 
		eval $run
142 
	}
143 
}
144 
 
145 
proc project_exists {projname} {
146 
	set desc ""
147 
	scan_projects {
148 
		upvar 1 desc desc
149 
		upvar 1 projname projname
150 
		if { "$name" == "$projname" } {
151 
			set desc "$description"
152 
			break
153 
		}
154 
	}
155 
	return "$desc"
156 
}
157 
 
158 
proc close_projects {} {
159 
	file delete "@@PREFIX@@/lib/koakuma/db/projects.lock"
160 
}
161 
 
162 
proc start_html {title has_toc} {
163 
	global toc
164 
	rputs	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
165 
	rputs	"<html>"
166 
	rputs	"	<head>"
167 
	rputs	"		<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">"
168 
	rputs	"		<title>$title - Koakuma</title>"
169 
	rputs	"		<link rel=\"stylesheet\" href=\"/static/style.css\">"
170 
	rputs	"	</head>"
171 
	rputs	"	<body>"
172 
	rputs	"		<a href=\"/koakuma\" id=\"gomain\">"
173 
	rputs	"			<img src=\"/static/koakuma.png\" alt=\"Koakuma by Kasuya Baian\" height=\"192px\">"
174 
	rputs	"		</a>"
175 
	rputs	"		<div id=\"space\"></div>"
176 
	rputs	"		<div id=\"title\">"
177 
	rputs	"			Koakuma"
178 
	rputs	"		</div>"
179 
	rputs	"		<div id=\"clearfix\"></div>"
180 
	if { "$has_toc" == "1" } {
181 
		rputs	"		<div id=\"toc\">"
182 
		rputs	"			<div id=\"toctitle\">TOC</div>"
183 
		foreach sect $toc {
184 
			if { "[string range "[regsub -all { } "$sect" "-"]" 0 0]" == "-" } {
185 
				rputs "<a class=\"shiftlink\" href=\"#TOC-[regsub {^-} "[regsub -all { } "$sect" "-"]" ""]\">[regsub {^-} "$sect" ""]</a><br>"
186 
			} else {
187 
				rputs "<a href=\"#TOC-[regsub -all { } "$sect" "-"]\">$sect</a><br>"
188 
			}
189 
		}
190 
		rputs	"		</div>"
191 
	}
192 
	if { "$has_toc" == "1" } {
193 
		rputs	"		<div id=\"doc\">"
194 
	} else {
195 
		rputs	"		<div id=\"doc-notoc\">"
196 
	}
197 
	rputs	"			<h1>$title</h1>"
198 
}
199 
proc end_html {has_toc} {
200 
	global KOAKUMA_VERSION
201 
	rputs	"		</div>"
202 
	rputs	"		<hr>"
203 
	rputs	"		<i>Powered by <a href=\"http://nishi.boats/koakuma\">Koakuma</a> $KOAKUMA_VERSION</i>"
204 
	rputs	"	</body>"
205 
	rputs	"</html>"
206 
}
207 
 
208 
proc add_toc {data} {
209 
	global toc
210 
	tputs	"<h2 id=\"TOC-[regsub -all { } "$data" "-"]\"><a href=\"#TOC-[regsub -all { } "$data" "-"]\">#</a> $data</h2>"
211 
	lappend toc "$data"
212 
}
213 
 
214 
proc add_toc2 {data} {
215 
	global toc
216 
	tputs	"<h3 id=\"TOC-[regsub -all { } "$data" "-"]\"><a href=\"#TOC-[regsub -all { } "$data" "-"]\">#</a> $data</h3>"
217 
	lappend toc "-$data"
218 
}
219 
 
220 
if { [catch {
221 
	set path "[regsub -all {/+} "$env(PATH_INFO)" "/"]"
4 nishi 222 
	if { [regexp {^/rpc(/.*)?$} "$path"] } {
223 
		rputs "Content-Type: application/json"
224 
	} else {
225 
		rputs "Content-Type: text/html"
226 
	}
3 nishi 227 
	if { "$path" == "/" } {
228 
		add_toc "Tcl Information"
229 
		tputs	"<table border=\"0\">"
230 
		tputs	"	<tr>"
231 
		tputs	"		<th>"
232 
		tputs	"			Version"
233 
		tputs	"		</th>"
234 
		tputs	"		<td>"
235 
		tputs	"			$tcl_version"
236 
		tputs	"		</td>"
237 
		tputs	"	</tr>"
238 
		tputs	"	<tr>"
239 
		tputs	"		<th>"
240 
		tputs	"			Platform"
241 
		tputs	"		</th>"
242 
		tputs	"		<td>"
243 
		tputs	"			$tcl_platform(os)/$tcl_platform(machine) $tcl_platform(osVersion)"
244 
		tputs	"		</td>"
245 
		tputs	"	</tr>"
246 
		tputs	"</table>"
247 
		add_toc "Components"
248 
		loop_components {
249 
			if { [llength [info procs "${name}_info"]] > 0 } {
250 
				${name}_info
251 
			}
252 
		}
253 
		set has_projects 0
254 
		add_toc "Projects"
255 
		open_projects
256 
		scan_projects {
257 
			upvar 1 has_projects has_projects
258 
			if { "$has_projects" == "0" } {
259 
				set has_projects 1
260 
				tputs	"<table border=\"0\">"
261 
			}
262 
			tputs	"<tr>"
263 
			tputs	"	<th><a href=\"/koakuma/project/$name\">$name</a></th>"
264 
			tputs	"	<td>$description</td>"
265 
			tputs	"</tr>"
266 
		}
267 
		close_projects
268 
		if { "$has_projects" == "1" } {
269 
			tputs	"</table>"
270 
		} else {
271 
			tputs	"No projects have been added, yet."
272 
		}
273 
 
274 
		rputs ""
275 
		start_html "Main" 1
276 
		rputs "$content"
277 
		end_html 1
4 nishi 278 
	} elseif { [regexp {^/rpc(/.*)?$} "$path"] } {
279 
		regexp {^/rpc(/.*)?$} "$path" -> api
280 
		set doc [dom createDocumentNode]
5 nishi 281 
		$doc appendFromScript {
282 
			keyVersion {valueString "$KOAKUMA_VERSION"}
283 
		}
4 nishi 284 
		if { "$api" == "" || "$api" == "/" } {
5 nishi 285 
			rputs ""
286 
			rputs "[$doc asJSON]"
287 
		} elseif { "$api" == "/create-project" } {
288 
			if { [catch {dom parse -json "$data" clidoc}] } {
289 
				rputs "Status: 400 Bad Request"
290 
				$doc appendFromScript {
291 
					keyError {valueString "Bad JSON"}
292 
				}
293 
			} else {
294 
				set projname "[$clidoc selectNodes "string(/name)"]"
295 
				set projdescription "[$clidoc selectNodes "string(/description)"]"
296 
				set vcs "[$clidoc selectNodes "string(/vcs)"]"
297 
				set url "[$clidoc selectNodes "string(/url)"]"
298 
				if { "$projname" == "" || "$projdescription" == "" || "$vcs" == "" || "$url" == "" } {
299 
					rputs "Status: 400 Bad Request"
300 
					$doc appendFromScript {
301 
						keyError {valueString "Required field missing"}
302 
					}
303 
				} else {
304 
					set has_vcs 0
305 
					loop_components {
306 
						upvar 1 has_vcs has_vcs
307 
						upvar 1 vcs vcs
308 
						if { "$name" == "$vcs" } {
309 
							set has_vcs 1
310 
							break
311 
						}
312 
					}
313 
					if { $has_vcs == 0 } {
314 
						rputs "Status: 400 Bad Request"
315 
						$doc appendFromScript {
316 
							keyError {valueString "Not a valid VCS"}
317 
						}
318 
					} else {
319 
						open_projects
320 
						close_projects
321 
					}
322 
				}
323 
			}
324 
			rputs ""
325 
			rputs "[$doc asJSON]"
326 
		} else {
4 nishi 327 
			$root appendFromScript {
5 nishi 328 
				keyError {valueString "No such endpoint"}
4 nishi 329 
			}
5 nishi 330 
			rputs "Status: 404 Not Found"
331 
			rputs ""
4 nishi 332 
			rputs "[$doc asJSON]"
333 
		}
3 nishi 334 
	} elseif { [regexp {^/project/[^/]+.*$} "$path"] } {
335 
		regexp {^/project/([^/]+).*$} "$path" -> projname
336 
		open_projects
337 
		set has_project [project_exists "$projname"]
338 
		close_projects
339 
 
340 
		if { "$has_project" != "" } {
341 
			add_toc "Description"
342 
			tputs "[html_escape "$has_project"]"
343 
 
344 
			rputs ""
345 
			start_html "Project: $projname" 1
346 
			rputs "$content"
347 
			end_html 1
348 
		} else {
349 
			tputs "I could not find the project you were finding."
350 
 
351 
			rputs "Status: 404 Not Found"
352 
			rputs ""
353 
			start_html "Not Found" 0
354 
			rputs "$content"
355 
			end_html 0
356 
		}
357 
	} else {
358 
		tputs "I could not find the content you were finding."
359 
 
360 
		rputs "Status: 404 Not Found"
361 
		rputs ""
362 
		start_html "Not Found" 0
363 
		rputs "$content"
364 
		end_html 0
365 
	}
366 
}] } {
367 
	crash "Could not render the HTML"
368 
} else {
369 
	puts "$result"
370 
}
371 
exiting 0