#!/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 " " puts " Oops" puts " " puts " " puts "

Oops

" puts "
" puts " Koakuma version $KOAKUMA_VERSION crashed, reason: $reason
" puts " See the server error log for details." puts " " puts "" exiting 1 } if { ![info exists env(PATH_INFO)] } { puts "Status: 301 Moved Permanently" puts "Location: $env(SCRIPT_NAME)/" puts "" exiting 0 } set koakuma_png "/static/koakuma.png" set css "/static/style.css" set running_png "/static/continued.png" set instance_name "Koakuma" set image_alt "Koakuma by Kasuya Baian" if { [file exists "@@PREFIX@@/etc/koakuma/cgi.conf"] } { if { [catch { source "@@PREFIX@@/etc/koakuma/cgi.conf" }] } { crash "Config failure" } } if { [catch { set tdom_version "[package require tdom]" dom createNodeCmd -tagName "rpc" elementNode rootXML dom createNodeCmd -tagName "project" elementNode keyProject dom createNodeCmd -tagName "version" -jsonType NONE elementNode keyVersion dom createNodeCmd -tagName "error" -jsonType NONE elementNode keyError dom createNodeCmd -tagName "name" -jsonType NONE elementNode keyName dom createNodeCmd -tagName "description" -jsonType NONE elementNode keyDescription dom createNodeCmd -tagName "vcs" -jsonType NONE elementNode keyVCS dom createNodeCmd -tagName "url" -jsonType NONE elementNode keyURL dom createNodeCmd -jsonType STRING textNode valueString }] } { crash "Failed to load tDOM" } if { [catch { set tclx_version "[package require Tclx]" }] } { crash "Failed to load TclX" } proc Get_KV {lst key} { foreach {k v} $lst { if { "$k" == "$key" } { return "$v" } } return "" } proc URL_parse {url} { if { [regexp {^([^:]+)://(([^:]+:[^@]+|[^:]+:|[^:]+)@)?([^/]+)(.+)?$} "$url" -> scheme userpass_at userpass host path] } { lappend result "scheme" "$scheme" lappend result "userpass" "$userpass" lappend result "host" "$host" lappend result "path" "$path" return $result } elseif { [regexp {^/.+$} "$url" path] } { lappend result "scheme" "file" lappend result "userpass" "" lappend result "host" "" lappend result "path" "$path" return $result } } if { [catch { foreach path [glob @@PREFIX@@/lib/koakuma/component/*.tcl] { source "$path" } }] } { crash "Could not load components" } set data "" while { [gets stdin line] >= 0 } { if { "$data" == "" } { set data "$line" } else { set data "$data\n$line" } } chan close stdin set toc "" set result "" set content "" proc write_db {data} { set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "w"] puts $fid "$data" close $fid } proc readall_db {} { set data "" set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "r"] while { [gets $fid line] >= 0 } { if { "$data" == "" } { set data "$line" } else { set data "$data\n$line" } } close $fid return "$data" } proc rputs {data} { global result if { "$result" == "" } { set result "$data" } else { set result "$result\n$data" } } proc tputs {data} { global content if { "$content" == "" } { set content "$data" } else { set content "$content\n$data" } } proc html_escape {data} { set tmp "[regsub -all {<} "[regsub -all {>} "[string trim "$data"]" {\>}]" {\<}]" set link "[regsub -all {[^: ]+://[^ \n]+} "$tmp" {\0}]" return "[regsub -all {\n} "$link" {
}]" } proc open_projects {} { while 1 { if { ![info exists "@@PREFIX@@/lib/koakuma/db/projects.lock"] } { break } set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"] if { ![info exists "/proc/[gets $fid line]"] } { close $fid break } after 10 close $fid } set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"] puts $fid "[pid]" close $fid } proc scan_projects {run} { set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "r"] set content "" while { [gets $fid line] >= 0 } { if { "$content" == "" } { set content "$line" } else { set content "$content\n$line" } } close $fid set dom [dom parse "$content"] set doc [$dom documentElement] foreach elem [$doc selectNodes "/projects/project"] { set name "[$elem selectNodes "string(name)"]" set description "[$elem selectNodes "string(description)"]" set vcs "[$elem selectNodes "string(vcs)"]" set vcs_url "[$elem selectNodes "string(url)"]" eval $run } } proc project_exists {projname} { set desc "" scan_projects { upvar 1 desc desc upvar 1 projname projname if { "$name" == "$projname" } { set desc "$description" break } } return "$desc" } proc close_projects {} { file delete "@@PREFIX@@/lib/koakuma/db/projects.lock" } set what "" proc sanitize {data} { set tmp "[regsub -all { } "$data" "-"]" set br "[regsub -all {\(|\)} "$tmp" "_"]" return "$br" } proc start_html {title has_toc} { global toc env koakuma_png css what instance_name image_alt rputs "" rputs "" rputs " " rputs " " rputs " $title - $instance_name" rputs " " set msie " src=\"$koakuma_png\"" if { [info exists "env(HTTP_USER_AGENT)"] } { if { [regexp {MSIE 6} "$env(HTTP_USER_AGENT)"] } { set msie " style=\"filter: progid:DXImageTransform.Microsoft.AlphaImageLoader(src='$koakuma_png', sizingMethod='scale');\" src=\"/static/transparent.gif\"" } } rputs " " rputs " " rputs " " rputs " \"$image_alt\"" rputs " " rputs "
" rputs "
" rputs " $instance_name" rputs "
" rputs " Root" if { "$has_toc" == "1" } { rputs "
" } 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 " " tputs " " tputs "" } close_projects if { "$has_projects" == "1" } { tputs "
$name[html_escape "$description"]
" } else { tputs "No projects have been added, yet." } add_toc "Tcl Information" tputs "" tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs "
" tputs " Version" tputs " " tputs " $tcl_version" tputs "
" tputs " Platform" tputs " " tputs " $tcl_platform(os)/$tcl_platform(machine) $tcl_platform(osVersion)" tputs "
" tputs " tDOM version" tputs " " tputs " $tdom_version" tputs "
" tputs " TclX version" tputs " " tputs " $tclx_version" 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 " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " tputs " " set builds [lsort -ascii [glob -nocomplain "@@PREFIX@@/lib/koakuma/db/data/$projname/build-*"]] if { [llength $builds] > 0 } { tputs " " tputs " " tputs " " tputs " " } tputs "
" tputs " Status" 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 " Last run" 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 " Last successful run" 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 " Successful builds" 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 "
" 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