Subversion Repositories Koakuma

Rev

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