Subversion Repositories Koakuma

Rev

Rev 12 | Rev 14 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 12 Rev 13
Line 1... Line 1...
1 
#!/usr/bin/env tclsh
 1 
#!/usr/bin/env tclsh
2 
# $Id: koakuma.cgi.in 12 2024-10-02 03:25:33Z nishi $
 2 
# $Id: koakuma.cgi.in 13 2024-10-02 06:39:33Z nishi $
3 
 
 3 
 
4 
set KOAKUMA_VERSION "1.00"
 4 
set KOAKUMA_VERSION "1.00"
5 
set components ""
 5 
set components ""
6 
 
 6 
 
- 
 
 7 
chan configure stdout -buffering none
- 
 
 8 
 
7 
proc exiting {code} {
 9 
proc exiting {code} {
8 
	exit $code
 10 
	exit $code
9 
}
 11 
}
10 
 
 12 
 
11 
proc loop_components {run} {
 13 
proc loop_components {run} {
Line 21... Line 23...
21 
	puts stderr "Included components:"
 23 
	puts stderr "Included components:"
22 
	loop_components {
 24 
	loop_components {
23 
		puts stderr "	$name: $description, version $version"
 25 
		puts stderr "	$name: $description, version $version"
24 
	}
 26 
	}
25 
	puts stderr "Reason: $reason"
 27 
	puts stderr "Reason: $reason"
- 
 
 28 
	puts stderr "Code: $::errorCode"
- 
 
 29 
	puts stderr "Info: $::errorInfo"
26 
	puts stderr "----- End Koakuma Crash dump log -----"
 30 
	puts stderr "----- End Koakuma Crash dump log -----"
27 
	puts	"Content-Type: text/html"
 31 
	puts	"Content-Type: text/html"
28 
	puts	"Status: 500 Internal Server Error"
 32 
	puts	"Status: 500 Internal Server Error"
29 
	puts	""
 33 
	puts	""
30 
	puts	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">"
 34 
	puts	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">"
Line 48... Line 52...
48 
	puts "Location: $env(SCRIPT_NAME)/"
 52 
	puts "Location: $env(SCRIPT_NAME)/"
49 
	puts ""
 53 
	puts ""
50 
	exiting 0
 54 
	exiting 0
51 
}
 55 
}
52 
 
 56 
 
- 
 
 57 
if { [file exists "@@PREFIX@@/etc/koakuma/cgi.conf"] } {
- 
 
 58 
	if { [catch {
- 
 
 59 
		source "@@PREFIX@@/etc/koakuma/cgi.conf"
- 
 
 60 
	}] } {
- 
 
 61 
		crash "Config failure"
- 
 
 62 
	}
- 
 
 63 
}
- 
 
 64 
 
53 
if { [catch {
 65 
if { [catch {
54 
	package require tdom
 66 
	set tdom_version "[package require tdom]"
55 
	dom createNodeCmd -tagName "rpc" elementNode rootXML
 67 
	dom createNodeCmd -tagName "rpc" elementNode rootXML
56 
	dom createNodeCmd -tagName "project" elementNode keyProject
 68 
	dom createNodeCmd -tagName "project" elementNode keyProject
57 
	dom createNodeCmd -tagName "version" -jsonType NONE elementNode keyVersion
 69 
	dom createNodeCmd -tagName "version" -jsonType NONE elementNode keyVersion
58 
	dom createNodeCmd -tagName "error" -jsonType NONE elementNode keyError
 70 
	dom createNodeCmd -tagName "error" -jsonType NONE elementNode keyError
59 
	dom createNodeCmd -tagName "name" -jsonType NONE elementNode keyName
 71 
	dom createNodeCmd -tagName "name" -jsonType NONE elementNode keyName
Line 64... Line 76...
64 
}] } {
 76 
}] } {
65 
	crash "Failed to load tDOM"
 77 
	crash "Failed to load tDOM"
66 
}
 78 
}
67 
 
 79 
 
68 
if { [catch {
 80 
if { [catch {
- 
 
 81 
	set tclx_version "[package require Tclx]"
- 
 
 82 
}] } {
- 
 
 83 
	crash "Failed to load TclX"
- 
 
 84 
}
- 
 
 85 
 
- 
 
 86 
proc Get_KV {lst key} {
- 
 
 87 
	foreach {k v} $lst {
- 
 
 88 
		if { "$k" == "$key" } {
- 
 
 89 
			return "$v"
- 
 
 90 
		}
- 
 
 91 
	}
- 
 
 92 
	return ""
- 
 
 93 
}
- 
 
 94 
 
- 
 
 95 
proc URL_parse {url} {
- 
 
 96 
	if { [regexp {^([^:]+)://(([^:]+:[^@]+|[^:]+:|[^:]+)@)?([^/]+)(.+)?$} "$url" -> scheme userpass_at userpass host path] } {
- 
 
 97 
		lappend result "scheme" "$scheme"
- 
 
 98 
		lappend result "userpass" "$userpass"
- 
 
 99 
		lappend result "host" "$host"
- 
 
 100 
		lappend result "path" "$path"
- 
 
 101 
		return $result
- 
 
 102 
	} elseif { [regexp {^/.+$} "$url" path] } {
- 
 
 103 
		lappend result "scheme" "file"
- 
 
 104 
		lappend result "userpass" ""
- 
 
 105 
		lappend result "host" ""
- 
 
 106 
		lappend result "path" "$path"
- 
 
 107 
		return $result
- 
 
 108 
	}
- 
 
 109 
}
- 
 
 110 
 
- 
 
 111 
if { [catch {
69 
	foreach path [glob @@PREFIX@@/lib/koakuma/component/*.tcl] {
 112 
	foreach path [glob @@PREFIX@@/lib/koakuma/component/*.tcl] {
70 
		source "$path"
 113 
		source "$path"
71 
	}
 114 
	}
72 
}] } {
 115 
}] } {
73 
	crash "Could not load components"
 116 
	crash "Could not load components"
Line 80... Line 123...
80 
		set data "$line"
 123 
		set data "$line"
81 
	} else {
 124 
	} else {
82 
		set data "$data\n$line"
 125 
		set data "$data\n$line"
83 
	}
 126 
	}
84 
}
 127 
}
- 
 
 128 
chan close stdin
85 
 
 129 
 
86 
set toc ""
 130 
set toc ""
87 
set result ""
 131 
set result ""
88 
set content ""
 132 
set content ""
89 
 
 133 
 
Line 124... Line 168...
124 
		set content "$content\n$data"
 168 
		set content "$content\n$data"
125 
	}
 169 
	}
126 
}
 170 
}
127 
 
 171 
 
128 
proc html_escape {data} {
 172 
proc html_escape {data} {
129 
	return "[regsub -all {&} "[regsub -all {>} "[regsub -all {<} "$data" "&lt;"]" "&gt;"]" "&amp;"]"
 173 
	set tmp "[regsub -all {<} "[regsub -all {>} "$data" {\&gt;}]" {\&lt;}]"
- 
 
 174 
	return "[regsub -all {[^:]+://[^ ]+} "$tmp" {<a href="\0">\0</a>}]"
130 
}
 175 
}
131 
 
 176 
 
132 
proc open_projects {} {
 177 
proc open_projects {} {
133 
	while 1 {
 178 
	while 1 {
134 
		if { ![info exists "@@PREFIX@@/lib/koakuma/db/projects.lock"] } {
 179 
		if { ![info exists "@@PREFIX@@/lib/koakuma/db/projects.lock"] } {
Line 161... Line 206...
161 
	set dom [dom parse "$content"]
 206 
	set dom [dom parse "$content"]
162 
	set doc [$dom documentElement]
 207 
	set doc [$dom documentElement]
163 
	foreach elem [$doc selectNodes "/projects/project"] {
 208 
	foreach elem [$doc selectNodes "/projects/project"] {
164 
		set name "[$elem selectNodes "string(name)"]"
 209 
		set name "[$elem selectNodes "string(name)"]"
165 
		set description "[$elem selectNodes "string(description)"]"
 210 
		set description "[$elem selectNodes "string(description)"]"
- 
 
 211 
		set vcs "[$elem selectNodes "string(vcs)"]"
- 
 
 212 
		set vcs_url "[$elem selectNodes "string(url)"]"
166 
		eval $run
 213 
		eval $run
167 
	}
 214 
	}
168 
}
 215 
}
169 
 
 216 
 
170 
proc project_exists {projname} {
 217 
proc project_exists {projname} {
Line 183... Line 230...
183 
proc close_projects {} {
 230 
proc close_projects {} {
184 
	file delete "@@PREFIX@@/lib/koakuma/db/projects.lock"
 231 
	file delete "@@PREFIX@@/lib/koakuma/db/projects.lock"
185 
}
 232 
}
186 
 
 233 
 
187 
proc start_html {title has_toc} {
 234 
proc start_html {title has_toc} {
188 
	global toc env
 235 
	global toc env koakuma_png css
189 
	rputs	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
 236 
	rputs	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
190 
	rputs	"<html>"
 237 
	rputs	"<html>"
191 
	rputs	"	<head>"
 238 
	rputs	"	<head>"
192 
	rputs	"		<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">"
 239 
	rputs	"		<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">"
193 
	rputs	"		<title>$title - Koakuma</title>"
 240 
	rputs	"		<title>$title - Koakuma</title>"
194 
	rputs	"		<link rel=\"stylesheet\" href=\"/static/style.css\">"
 241 
	rputs	"		<link rel=\"stylesheet\" href=\"$css\">"
195 
	rputs	"	</head>"
 242 
	rputs	"	</head>"
196 
	rputs	"	<body>"
 243 
	rputs	"	<body>"
197 
	rputs	"		<a href=\"/koakuma\" id=\"gomain\">"
 244 
	rputs	"		<a href=\"/koakuma\" id=\"gomain\">"
198 
	rputs	"			<img src=\"/static/koakuma.png\" alt=\"Koakuma by Kasuya Baian\" height=\"192px\">"
 245 
	rputs	"			<img src=\"$koakuma_png\" alt=\"Koakuma by Kasuya Baian\" height=\"192px\">"
199 
	rputs	"		</a>"
 246 
	rputs	"		</a>"
200 
	rputs	"		<div id=\"space\"></div>"
 247 
	rputs	"		<div id=\"space\"></div>"
201 
	rputs	"		<div id=\"title\">"
 248 
	rputs	"		<div id=\"title\">"
202 
	rputs	"			Koakuma"
 249 
	rputs	"			Koakuma"
203 
	rputs	"		</div>"
 250 
	rputs	"		</div>"
Line 273... Line 320...
273 
		tputs	"		</th>"
 320 
		tputs	"		</th>"
274 
		tputs	"		<td>"
 321 
		tputs	"		<td>"
275 
		tputs	"			$tcl_platform(os)/$tcl_platform(machine) $tcl_platform(osVersion)"
 322 
		tputs	"			$tcl_platform(os)/$tcl_platform(machine) $tcl_platform(osVersion)"
276 
		tputs	"		</td>"
 323 
		tputs	"		</td>"
277 
		tputs	"	</tr>"
 324 
		tputs	"	</tr>"
- 
 
 325 
		tputs	"	<tr>"
- 
 
 326 
		tputs	"		<th>"
- 
 
 327 
		tputs	"			tDOM version"
- 
 
 328 
		tputs	"		</th>"
- 
 
 329 
		tputs	"		<td>"
- 
 
 330 
		tputs	"			$tdom_version"
- 
 
 331 
		tputs	"		</td>"
- 
 
 332 
		tputs	"	</tr>"
- 
 
 333 
		tputs	"	<tr>"
- 
 
 334 
		tputs	"		<th>"
- 
 
 335 
		tputs	"			TclX version"
- 
 
 336 
		tputs	"		</th>"
- 
 
 337 
		tputs	"		<td>"
- 
 
 338 
		tputs	"			$tclx_version"
- 
 
 339 
		tputs	"		</td>"
- 
 
 340 
		tputs	"	</tr>"
278 
		tputs	"</table>"
 341 
		tputs	"</table>"
279 
		add_toc "Components"
 342 
		add_toc "Components"
280 
		loop_components {
 343 
		loop_components {
281 
			if { [llength [info procs "${name}_info"]] > 0 } {
 344 
			if { [llength [info procs "${name}_info"]] > 0 } {
282 
				${name}_info
 345 
				${name}_info
Line 291... Line 354...
291 
				set has_projects 1
 354 
				set has_projects 1
292 
				tputs	"<table border=\"0\">"
 355 
				tputs	"<table border=\"0\">"
293 
			}
 356 
			}
294 
			tputs	"<tr>"
 357 
			tputs	"<tr>"
295 
			tputs	"	<th><a href=\"/koakuma/project/$name\">$name</a></th>"
 358 
			tputs	"	<th><a href=\"/koakuma/project/$name\">$name</a></th>"
296 
			tputs	"	<td>$description</td>"
 359 
			tputs	"	<td>[html_escape "$description"]</td>"
297 
			tputs	"</tr>"
 360 
			tputs	"</tr>"
298 
		}
 361 
		}
299 
		close_projects
 362 
		close_projects
300 
		if { "$has_projects" == "1" } {
 363 
		if { "$has_projects" == "1" } {
301 
			tputs	"</table>"
 364 
			tputs	"</table>"
Line 330... Line 393...
330 
					$doc appendFromScript {
 393 
					$doc appendFromScript {
331 
						keyError {valueString "Required field missing"}
 394 
						keyError {valueString "Required field missing"}
332 
					}
 395 
					}
333 
				} else {
 396 
				} else {
334 
					set has_name 0
 397 
					set has_name 0
- 
 
 398 
					set use_vcs ""
- 
 
 399 
					set use_vcs_url ""
335 
					open_projects
 400 
					open_projects
336 
					scan_projects {
 401 
					scan_projects {
337 
						upvar 1 has_name has_name
 402 
						upvar 1 has_name has_name
338 
						upvar 1 projname projname
 403 
						upvar 1 projname projname
- 
 
 404 
						upvar 1 use_vcs use_vcs
- 
 
 405 
						upvar 1 use_vcs_url use_vcs_url
339 
						if { "$name" == "$projname" } {
 406 
						if { "$name" == "$projname" } {
340 
							set has_name 1
 407 
							set has_name 1
- 
 
 408 
							set use_vcs "$vcs"
- 
 
 409 
							set use_vcs_url "$vcs_url"
341 
							break
 410 
							break
342 
						}
 411 
						}
343 
					}
 412 
					}
344 
					close_projects
 413 
					close_projects
345 
					if { $has_name == 0 } {
 414 
					if { $has_name == 0 } {
346 
						rputs "Status: 400 Bad Request"
 415 
						rputs "Status: 400 Bad Request"
347 
						$doc appendFromScript {
 416 
						$doc appendFromScript {
348 
							keyError {valueString "Project does not exist"}
 417 
							keyError {valueString "Project does not exist"}
349 
						}
 418 
						}
350 
					} else {
 419 
					} else {
- 
 
 420 
						set cont 1
- 
 
 421 
						if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock"] } {
- 
 
 422 
							set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock" "r"]
- 
 
 423 
							set readpid "[gets $fid]"
- 
 
 424 
							close $fid
- 
 
 425 
							if { [file exists "/proc/$readpid"] } {
- 
 
 426 
								set cont 0
- 
 
 427 
								rputs "Status: 403 Forbidden"
- 
 
 428 
								$doc appendFromScript {
- 
 
 429 
									keyError {valueString "Other building process has been running"}
- 
 
 430 
								}
- 
 
 431 
							}
- 
 
 432 
						}
- 
 
 433 
						if { $cont == 1 } {
- 
 
 434 
							set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/buildcount" "r"]
- 
 
 435 
							set count [expr [gets $fid] + 1]
- 
 
 436 
							close $fid
- 
 
 437 
 
- 
 
 438 
							set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/buildcount" "w"]
- 
 
 439 
							puts $fid "$count"
- 
 
 440 
							close $fid
- 
 
 441 
 
- 
 
 442 
							set count "[format %08s "$count"]"
- 
 
 443 
 
- 
 
 444 
							set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/lastrun" "w"]
- 
 
 445 
							puts $fid "[clock seconds]"
- 
 
 446 
							close $fid
- 
 
 447 
 
- 
 
 448 
							file mkdir "@@PREFIX@@/lib/koakuma/db/data/$projname/build-$count"
- 
 
 449 
 
- 
 
 450 
							set pid [fork]
- 
 
 451 
							if { $pid } {
- 
 
 452 
								set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock" "w"]
- 
 
 453 
								puts $fid "$pid"
- 
 
 454 
								close $fid
- 
 
 455 
							} else {
- 
 
 456 
								set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/build-$count/log" "w"]
- 
 
 457 
								set fail 0
- 
 
 458 
 
- 
 
 459 
								dup $fid stdout
- 
 
 460 
								dup $fid stderr
- 
 
 461
- 
 
 462 
								puts "===== Checkout"
- 
 
 463 
								puts "Using VCS: $use_vcs"
- 
 
 464 
								if { [llength [info procs "${use_vcs}_repository"]] == 0 } {
- 
 
 465 
									puts "Component internal failure"
- 
 
 466 
									set fail 1
- 
 
 467 
								} else {
- 
 
 468 
									cd "@@PREFIX@@/lib/koakuma/db/data/$projname"
- 
 
 469 
									if { [${use_vcs}_repository "$use_vcs_url" "workspace"] } {
- 
 
 470 
										puts "Checkout failure"
- 
 
 471 
										set fail 1
- 
 
 472 
									}
- 
 
 473 
								}
- 
 
 474 
								if { $fail == 0 } {
- 
 
 475 
									puts "===== Build"
- 
 
 476 
									cd "@@PREFIX@@/lib/koakuma/db/data/$projname/workspace"
- 
 
 477 
									if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/workspace/Koakumafile"] } {
- 
 
 478 
										if { [catch {
- 
 
 479 
											namespace eval koakumafile {
- 
 
 480 
												source "@@PREFIX@@/lib/koakuma/db/data/$projname/workspace/Koakumafile"
- 
 
 481 
											}
- 
 
 482 
											koakumafile::run "$projname"
- 
 
 483 
										}] } {
- 
 
 484 
											puts "Failed to run Koakumafile"
- 
 
 485 
											set fail 1
- 
 
 486 
										}
- 
 
 487 
									} else {
- 
 
 488 
										puts "Nothing to do"
- 
 
 489 
									}
- 
 
 490 
								}
- 
 
 491 
								if { $fail == 0 } {
- 
 
 492 
									puts "Build successful"
- 
 
 493 
									set fidsuc [open "@@PREFIX@@/lib/koakuma/db/data/$projname/lastsuccessfulrun" "w"]
- 
 
 494 
									puts $fidsuc "[clock seconds]"
- 
 
 495 
									close $fidsuc
- 
 
 496
- 
 
 497 
									set fidsuc [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "r"]
- 
 
 498 
									set sucbul [gets $fidsuc]
- 
 
 499 
									close $fidsuc
- 
 
 500
- 
 
 501 
									set fidsuc [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "w"]
- 
 
 502 
									puts $fidsuc "[expr $sucbul + 1]"
- 
 
 503 
									close $fidsuc
- 
 
 504 
								}
- 
 
 505 
 
- 
 
 506 
								close $fid
- 
 
 507 
 
- 
 
 508 
								file delete "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock"
- 
 
 509 
								exit 0
- 
 
 510 
							}
- 
 
 511 
						}
351 
					}
 512 
					}
352 
				}
 513 
				}
353 
			}
 514 
			}
354 
			rputs ""
 515 
			rputs ""
355 
			rputs "[$doc asJSON]"
 516 
			rputs "[$doc asJSON]"
Line 413... Line 574...
413 
								keyURL {valueString "$url"}
 574 
								keyURL {valueString "$url"}
414 
							}
 575 
							}
415 
						}
 576 
						}
416 
						write_db "[$xmldoc asXML]"
 577 
						write_db "[$xmldoc asXML]"
417 
						file mkdir "@@PREFIX@@/lib/koakuma/db/data/$projname"
 578 
						file mkdir "@@PREFIX@@/lib/koakuma/db/data/$projname"
- 
 
 579 
						set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/buildcount" "w"]
- 
 
 580 
						puts $fid "0"
- 
 
 581 
						close $fid
- 
 
 582 
						set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "w"]
- 
 
 583 
						puts $fid "0"
- 
 
 584 
						close $fid
418 
						close_projects
 585 
						close_projects
419 
					}
 586 
					}
420 
				}
 587 
				}
421 
			}
 588 
			}
422 
			rputs ""
 589 
			rputs ""
Line 471... Line 638...
471 
					tputs "No successful builds yet"
 638 
					tputs "No successful builds yet"
472 
				}
 639 
				}
473 
				tputs	"			"
 640 
				tputs	"			"
474 
				tputs	"		</td>"
 641 
				tputs	"		</td>"
475 
				tputs	"	</tr>"
 642 
				tputs	"	</tr>"
- 
 
 643 
				set builds [lsort -ascii [glob -nocomplain "@@PREFIX@@/lib/koakuma/db/data/$projname/build-*"]]
- 
 
 644 
				if { [llength $builds] > 0 } {
- 
 
 645 
					tputs	"	<tr>"
- 
 
 646 
					tputs	"		<th>"
- 
 
 647 
					tputs	"			Successful builds"
- 
 
 648 
					tputs	"		</th>"
- 
 
 649 
					tputs	"		<td>"
- 
 
 650 
					if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild"] } {
- 
 
 651 
						set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "r"]
- 
 
 652 
						tputs "[format %.2f [expr [gets $fid] / [llength $builds] * 100]]%"
- 
 
 653 
						close $fid
- 
 
 654 
					}
- 
 
 655 
					tputs	"			"
- 
 
 656 
					tputs	"		</td>"
- 
 
 657 
					tputs	"	</tr>"
- 
 
 658 
				}
476 
				tputs	"</table>"
 659 
				tputs	"</table>"
- 
 
 660 
 
- 
 
 661 
				set builds [lsort -ascii [glob -nocomplain "@@PREFIX@@/lib/koakuma/db/data/$projname/build-*"]]
- 
 
 662 
				if { [llength $builds] > 0 } {
477 
				add_toc "Build details"
 663 
					add_toc "Last build log"
- 
 
 664 
					set lastbuild "[lindex $builds [expr [llength $builds] - 1]]"
- 
 
 665 
					set fid [open "$lastbuild/log" "r"]
- 
 
 666 
					tputs "<pre>"
- 
 
 667 
					while { [gets $fid line] >= 0 } {
- 
 
 668 
						tputs "[html_escape "$line"]"
- 
 
 669 
					}
- 
 
 670 
					tputs "</pre>"
- 
 
 671 
					close $fid
- 
 
 672 
				}
478
673
479 
				rputs ""
 674 
				rputs ""
480 
				start_html "Project: $projname" 1
 675 
				start_html "Project: $projname" 1
481 
				rputs "$content"
 676 
				rputs "$content"
482 
				end_html 1
 677 
				end_html 1