#!/usr/bin/env tclsh
# $Id$
set KOAKUMA_VERSION "1.00"
set components ""
chan configure stdout -buffering none
proc exiting {code} {
exit $code
}
proc loop_components {run} {
global components
foreach {name description version genre} $components {
eval $run
}
}
proc RunCommand {command} {
puts "* $command"
eval exec $command >@stdout 2>@1
}
proc crash {reason} {
global components KOAKUMA_VERSION
puts stderr "----- Start Koakuma Crash dump log -----"
puts stderr "Included components:"
loop_components {
puts stderr " $name: $description, version $version"
}
puts stderr "Reason: $reason"
puts stderr "Code: $::errorCode"
puts stderr "Info: $::errorInfo"
puts stderr "----- End Koakuma Crash dump log -----"
puts "Content-Type: text/html"
puts "Status: 500 Internal Server Error"
puts ""
puts ""
puts ""
puts "
"
puts " "
} else {
rputs "
"
}
rputs "
"
if { "$has_toc" == "1" } {
rputs "
"
rputs "
"
rputs "
TOC
"
foreach sect $toc {
if { "[string range "[sanitize "$sect"]" 0 0]" == "-" } {
rputs "
[regsub {^-} "$sect" ""]"
} else {
rputs "
$sect"
}
}
rputs "
"
rputs "
"
}
rputs "
"
rputs "
$title
"
rputs " $what"
rputs "
"
}
proc end_html {has_toc} {
global KOAKUMA_VERSION toc
rputs "
"
rputs "
"
rputs "
"
rputs "
"
rputs "
"
rputs "
Powered by Koakuma $KOAKUMA_VERSION"
rputs " "
rputs ""
}
proc add_toc {data} {
global toc
tputs "
# $data
"
lappend toc "$data"
}
proc add_toc2 {data} {
global toc
tputs "
# $data
"
lappend toc "-$data"
}
if { [catch {
set path "[regsub -all {/+} "$env(PATH_INFO)" "/"]"
if { [regexp {^/rpc(/.*)?$} "$path"] } {
rputs "Content-Type: application/json"
} else {
if { ![regexp {/$} "$env(PATH_INFO)"] } {
puts "Status: 301 Moved Permanently"
puts "Location: $env(SCRIPT_NAME)$env(PATH_INFO)/"
puts ""
exiting 0
}
rputs "Content-Type: text/html"
}
if { "$path" == "/" } {
set what "This is the main page."
set has_projects 0
add_toc "Projects"
open_projects
scan_projects {
upvar 1 has_projects has_projects
if { "$has_projects" == "0" } {
set has_projects 1
tputs "
"
}
tputs ""
tputs " $name | "
tputs " [html_escape "$description"] | "
tputs "
"
}
close_projects
if { "$has_projects" == "1" } {
tputs "
"
} else {
tputs "No projects have been added, yet."
}
add_toc "Tcl Information"
tputs "
"
tputs " "
tputs " "
tputs " Version"
tputs " | "
tputs " "
tputs " $tcl_version"
tputs " | "
tputs "
"
tputs " "
tputs " "
tputs " Platform"
tputs " | "
tputs " "
tputs " $tcl_platform(os)/$tcl_platform(machine) $tcl_platform(osVersion)"
tputs " | "
tputs "
"
tputs " "
tputs " "
tputs " tDOM version"
tputs " | "
tputs " "
tputs " $tdom_version"
tputs " | "
tputs "
"
tputs " "
tputs " "
tputs " TclX version"
tputs " | "
tputs " "
tputs " $tclx_version"
tputs " | "
tputs "
"
tputs "
"
add_toc "Components"
loop_components {
add_toc2 "${name} (${genre})"
if { [llength [info procs "${name}_info"]] > 0 } {
${name}_info
}
}
rputs ""
start_html "Main" 1
rputs "$content"
end_html 1
} elseif { [regexp {^/rpc(/.*)?$} "$path"] } {
regexp {^/rpc(/.*)?$} "$path" -> api
set doc [dom createDocumentNode]
$doc appendFromScript {
keyVersion {valueString "$KOAKUMA_VERSION"}
}
if { "$api" == "" || "$api" == "/" } {
rputs ""
rputs "[$doc asJSON]"
} elseif { "$api" == "/launch-job" } {
if { [catch {dom parse -json "$data" clidoc}] } {
rputs "Status: 400 Bad Request"
$doc appendFromScript {
keyError {valueString "Bad JSON"}
}
} else {
set projname "[regsub -all { } "[$clidoc selectNodes "string(/name)"]" "-"]"
set builddesc "[$clidoc selectNodes "string(/description)"]"
if { "$projname" == "" || "$builddesc" == "" } {
rputs "Status: 400 Bad Request"
$doc appendFromScript {
keyError {valueString "Required field missing"}
}
} else {
set has_name 0
set use_vcs ""
set use_vcs_url ""
open_projects
scan_projects {
upvar 1 has_name has_name
upvar 1 projname projname
upvar 1 use_vcs use_vcs
upvar 1 use_vcs_url use_vcs_url
if { "$name" == "$projname" } {
set has_name 1
set use_vcs "$vcs"
set use_vcs_url "$vcs_url"
break
}
}
close_projects
if { $has_name == 0 } {
rputs "Status: 400 Bad Request"
$doc appendFromScript {
keyError {valueString "Project does not exist"}
}
} else {
set cont 1
if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock"] } {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock" "r"]
set readpid "[gets $fid]"
close $fid
if { [file exists "/proc/$readpid"] } {
set cont 0
rputs "Status: 403 Forbidden"
$doc appendFromScript {
keyError {valueString "Other building process has been running"}
}
}
}
if { $cont == 1 } {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/buildcount" "r"]
set count [expr [gets $fid] + 1]
close $fid
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/buildcount" "w"]
puts $fid "$count"
close $fid
set count "[format %08s "$count"]"
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/lastrun" "w"]
puts $fid "[clock seconds]"
close $fid
file mkdir "@@PREFIX@@/lib/koakuma/db/data/$projname/build-$count"
set pid [fork]
if { $pid } {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock" "w"]
puts $fid "$pid"
close $fid
} else {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/build-$count/log" "w"]
set fail 0
fconfigure $fid -encoding binary -translation binary
dup $fid stdout
dup $fid stderr
fconfigure stdout -encoding binary -translation binary
fconfigure stderr -encoding binary -translation binary
puts "Build trigger description: $builddesc"
puts "===== Checkout"
puts "Using VCS: $use_vcs"
if { [llength [info procs "${use_vcs}_repository"]] == 0 } {
puts "Component internal failure"
set fail 1
} else {
cd "@@PREFIX@@/lib/koakuma/db/data/$projname"
if { [${use_vcs}_repository "$use_vcs_url" "workspace"] } {
puts "Checkout failure"
set fail 1
}
}
if { $fail == 0 } {
puts "===== Build"
cd "@@PREFIX@@/lib/koakuma/db/data/$projname/workspace"
if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/workspace/Koakumafile"] } {
if { [catch {
namespace eval koakumafile {
source "@@PREFIX@@/lib/koakuma/db/data/$projname/workspace/Koakumafile"
}
koakumafile::run "$projname"
}] } {
puts "Failed to run Koakumafile"
set fail 1
}
} else {
puts "Nothing to do"
}
}
if { $fail == 0 } {
puts "Build successful"
set fidsuc [open "@@PREFIX@@/lib/koakuma/db/data/$projname/lastsuccessfulrun" "w"]
puts $fidsuc "[clock seconds]"
close $fidsuc
set fidsuc [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "r"]
set sucbul [gets $fidsuc]
close $fidsuc
set fidsuc [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "w"]
puts $fidsuc "[expr $sucbul + 1]"
close $fidsuc
}
close $fid
file delete "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock"
exit 0
}
}
}
}
}
rputs ""
rputs "[$doc asJSON]"
} elseif { "$api" == "/create-project" } {
if { [catch {dom parse -json "$data" clidoc}] } {
rputs "Status: 400 Bad Request"
$doc appendFromScript {
keyError {valueString "Bad JSON"}
}
} else {
set projname "[regsub -all { } "[$clidoc selectNodes "string(/name)"]" "-"]"
set projdescription "[$clidoc selectNodes "string(/description)"]"
set projvcs "[$clidoc selectNodes "string(/vcs)"]"
set url "[$clidoc selectNodes "string(/url)"]"
if { "$projname" == "" || "$projdescription" == "" || "$projvcs" == "" || "$url" == "" } {
rputs "Status: 400 Bad Request"
$doc appendFromScript {
keyError {valueString "Required field missing"}
}
} else {
set has_vcs 0
set has_name 0
loop_components {
upvar 1 has_vcs has_vcs
upvar 1 projvcs projvcs
if { "$name" == "$projvcs" && "$genre" == "VCS" } {
set has_vcs 1
break
}
}
open_projects
scan_projects {
upvar 1 has_name has_name
upvar 1 projname projname
if { "$name" == "$projname" } {
set has_name 1
break
}
}
close_projects
if { $has_vcs == 0 } {
rputs "Status: 400 Bad Request"
$doc appendFromScript {
keyError {valueString "Not a valid VCS"}
}
} elseif { $has_name == 1 } {
rputs "Status: 400 Bad Request"
$doc appendFromScript {
keyError {valueString "Project already exists"}
}
} else {
open_projects
set xml "[readall_db]"
set xmldoc [dom parse "$xml"]
set root [$xmldoc documentElement]
$root appendFromScript {
keyProject {
keyName {valueString "$projname"}
keyDescription {valueString "$projdescription"}
keyVCS {valueString "$projvcs"}
keyURL {valueString "$url"}
}
}
write_db "[$xmldoc asXML]"
file mkdir "@@PREFIX@@/lib/koakuma/db/data/$projname"
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/buildcount" "w"]
puts $fid "0"
close $fid
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "w"]
puts $fid "0"
close $fid
close_projects
}
}
}
rputs ""
rputs "[$doc asJSON]"
} else {
$root appendFromScript {
keyError {valueString "No such endpoint"}
}
rputs "Status: 404 Not Found"
rputs ""
rputs "[$doc asJSON]"
}
} elseif { [regexp {^/project/[^/]+.*$} "$path"] } {
regexp {^/project/([^/]+)(.*)$} "$path" -> projname projpath
open_projects
set has_project [project_exists "$projname"]
close_projects
if { "$has_project" != "" } {
if { "$projpath" == "" || "$projpath" == "/" } {
set what "This is the project page."
add_toc "Description"
tputs "[html_escape "$has_project"]"
add_toc "Details"
tputs "
"
tputs " "
tputs " "
tputs " Status"
tputs " | "
tputs " "
if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock"] } {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/build.lock" "r"]
if { [file exists "/proc/[gets $fid]"] } {
tputs "Running"
} else {
tputs "Idle"
}
close $fid
} else {
tputs "Idle"
}
tputs " "
tputs " | "
tputs "
"
tputs " "
tputs " "
tputs " Last run"
tputs " | "
tputs " "
if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/lastrun"] } {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/lastrun" "r"]
set date "[clock format "[gets $fid]" -format "%a %b %d %H:%M:%S %Z %Y"]"
close $fid
tputs "$date"
} else {
tputs "No builds yet"
}
tputs " "
tputs " | "
tputs "
"
tputs " "
tputs " "
tputs " Last successful run"
tputs " | "
tputs " "
if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/lastsuccessfulrun"] } {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/lastsuccessfulrun" "r"]
set date "[clock format "[gets $fid]" -format "%a %b %d %H:%M:%S %Z %Y"]"
close $fid
tputs "$date"
} else {
tputs "No successful builds yet"
}
tputs " "
tputs " | "
tputs "
"
set builds [lsort -ascii [glob -nocomplain "@@PREFIX@@/lib/koakuma/db/data/$projname/build-*"]]
if { [llength $builds] > 0 } {
tputs " "
tputs " "
tputs " Successful builds"
tputs " | "
tputs " "
if { [file exists "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild"] } {
set fid [open "@@PREFIX@@/lib/koakuma/db/data/$projname/successbuild" "r"]
set sucbui "[gets $fid]"
tputs "[format %.2f [expr ${sucbui}.0 / [llength $builds] * 100]]% ($sucbui/[llength $builds])"
close $fid
}
tputs " "
tputs " | "
tputs "
"
}
tputs "
"
set builds [lsort -ascii [glob -nocomplain "@@PREFIX@@/lib/koakuma/db/data/$projname/build-*"]]
if { [llength $builds] > 0 } {
add_toc "Last build log"
set lastbuild "[lindex $builds [expr [llength $builds] - 1]]"
set fid [open "$lastbuild/log" "r"]
tputs "
"
while { [gets $fid line] >= 0 } {
tputs "[html_escape "$line"]"
}
tputs "
"
close $fid
}
rputs ""
start_html "Project: $projname" 1
rputs "$content"
end_html 1
} else {
tputs "I could not find the endpoint you were finding."
rputs "Status: 404 Not Found"
rputs ""
start_html "Project: $projname" 1
rputs "$content"
end_html 1
}
} else {
tputs "I could not find the project you were finding."
rputs "Status: 404 Not Found"
rputs ""
start_html "Not Found" 0
rputs "$content"
end_html 0
}
} else {
tputs "I could not find the content you were finding."
rputs "Status: 404 Not Found"
rputs ""
start_html "Not Found" 0
rputs "$content"
end_html 0
}
}] } {
crash "Could not render the HTML"
} else {
puts "$result"
}
exiting 0