Overview
| Comment: | Added "sun4v" and "sun4u" to list of sparc64 types Copied web CustomKit interface into teaparty |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: | 09fa0e9b42245b0fd8f712ee868ead05c1e01de6 |
| User & Date: | rkeene on 2011-11-23 13:06:21 |
| Other Links: | manifest | tags |
Context
|
2011-12-04
| ||
| 02:17 | Updated to deal with more platforms check-in: 21cf4390c8 user: rkeene tags: trunk | |
|
2011-11-23
| ||
| 13:06 | Added "sun4v" and "sun4u" to list of sparc64 types Copied web CustomKit interface into teaparty check-in: 09fa0e9b42 user: rkeene tags: trunk | |
|
2011-09-11
| ||
| 23:59 | Updated to CTk 8.0.2801 to fix issues with Tcl 8.6 check-in: c80dceaca0 user: rkeene tags: trunk | |
Changes
Modified client/lib/teapotclient0.1/teapotclient.tcl from [7c9f4e855b] to [a38541090a].
64 64 } 65 65 66 66 vfs::zip::Unmount $mntfd $file 67 67 } else { 68 68 exec unzip -d $dir -n -qq $file 69 69 } 70 70 } 71 + 72 + proc __isCompatibleCPU {teapot local} { 73 + } 74 + 75 + proc __isCompatibleOS {teapot local} { 76 + } 71 77 72 78 set pkgcachedir [file join [__get_homedir] ".teapot-client" "cachedir"] 73 79 74 80 # Conversions from Teapot-style names to local ones 75 81 set osTeapotToLocal(tcl) [list *] 76 82 set osTeapotToLocal(linux-*) [list linux] 77 83 set osTeapotToLocal(win32) [list windows] 78 84 set osTeapotToLocal(solaris*) [list solaris sunos] 79 85 set osTeapotToLocal(freebsd) [list freebsd_*] 80 86 set osTeapotToLocal(irix) [list irix_*] 81 87 82 88 set cpuTeapotToLocal(ix86) [list x86 intel i?86 i86pc] 83 89 set cpuTeapotToLocal(sparc) [list sun4*] 90 + set cpuTeapotToLocal(sparc64) [list sun4u sun4v] 84 91 set cpuTeapotToLocal(universal) [list *] 85 92 set cpuTeapotToLocal(powerpc) [list ppc] 86 93 87 94 proc download_extensions {rootdir servers extensions os cpu {existingExts ""}} { 88 95 foreach chkdefext [list Tcl Tk msgcat] { 89 96 if {[lsearch -exact $existingExts $chkdefext] == -1} { 90 97 lappend existingExts $chkdefext
Added client/web/common.tcl version [09d7dce52a].
1 +#! /usr/bin/env tclsh 2 + 3 +# This file has no license. It is in the public domain. 4 +# -- Roy Keene <tcl@rkeene.org> [20081025T1400Q] 5 + 6 +package require md5 7 +package require Tclx 8 + 9 +namespace eval ::customkit {} 10 +namespace eval ::customkit { 11 + set starkitdir "/home/rkeene/devel/starkit2exe" 12 + set tclkitsdir "$starkitdir/tclkits" 13 + set findkit "$starkitdir/support/find-tclkit" 14 + set sdx "$starkitdir/support/sdx-1nrl.kit" 15 + set pkgcachedir "/tmp/DELETEME_customkit_[string tolower [md5::md5 -hex [list [info script] [id user]]]].cache" 16 + 17 + # Generate a mapping of Tclkits to user viewable and referencable keys 18 + array set Mapping [list] 19 + catch { 20 + foreach file [glob -nocomplain -directory $tclkitsdir *] { 21 + set work [split [file tail $file] -] 22 + set file_tclver [lindex $work 1] 23 + set file_os [lindex $work 2] 24 + set file_cpu [lindex $work 3] 25 + 26 + set file_exts [list Itcl Mk4tcl] 27 + 28 + if {[lindex $work 0] != "tclkitnotk"} { 29 + lappend file_exts "Tk" 30 + } 31 + 32 + unset -nocomplain file_info 33 + array set file_info {} 34 + catch { 35 + file stat $file file_info 36 + unset file_info(atime) 37 + } 38 + 39 + set key [string tolower [md5::md5 -hex [list $file [array get file_info] [expr [clock seconds] / 86400]]]] 40 + 41 + set Mapping($key) [list $file $file_tclver $file_os $file_cpu $file_exts] 42 + } 43 + } 44 + 45 + # Descriptive mappings 46 + set OSDesc(macosx) "Mac OS X" 47 + set OSDesc(macos) "Mac OS Classic" 48 + set OSDesc(freebsd) "FreeBSD" 49 + set OSDesc(openbsd) "OpenBSD" 50 + set OSDesc(netbsd) "NetBSD" 51 + set OSDesc(hpux) "HP/UX" 52 + set OSDesc(irix) "IRIX" 53 + set OSDesc(aix) "AIX" 54 + 55 + set CPUDesc(ppc) "PowerPC" 56 + set CPUDesc(m68k) "Motorola 68K" 57 + set CPUDesc(x86_64) "AMD64" 58 + set CPUDesc(parisc) "PA-RISC" 59 + set CPUDesc(sun4m) "SPARC" 60 + set CPUDesc(sun4u) "UltraSPARC" 61 + set CPUDesc(armv9) "ARM v9" 62 + 63 + # Conversions from Teapot-style names to local ones 64 + set osTeapotToLocal(tcl) * 65 + set osTeapotToLocal(linux-*) linux 66 + set osTeapotToLocal(win32) windows 67 + set osTeapotToLocal(solaris*) solaris 68 + set osTeapotToLocal(freebsd) freebsd_* 69 + set osTeapotToLocal(irix) irix_* 70 + 71 + set cpuTeapotToLocal(ix86) x86 72 + set cpuTeapotToLocal(sparc) sun4* 73 + set cpuTeapotToLocal(universal) * 74 + set cpuTeapotToLocal(powerpc) ppc 75 + 76 + 77 +proc get_descs_from_mapping {} { 78 + upvar ::customkit::Mapping Mapping 79 + 80 + set descs [list] 81 + foreach key [array names Mapping] { 82 + set tclver [lindex $Mapping($key) 1] 83 + set os [lindex $Mapping($key) 2] 84 + set cpu [lindex $Mapping($key) 3] 85 + set exts [lindex $Mapping($key) 4] 86 + 87 + set os [descOSLocalToEnglish $os] 88 + set cpu [descCPULocalToEnglish $cpu] 89 + 90 + set desc "Tcl v$tclver for $os on the $cpu architecture" 91 + 92 + if {[lsearch -exact $exts "Tk"] == -1} { 93 + append desc " (no Tk)" 94 + } 95 + 96 + lappend descs [list $desc $key] 97 + } 98 + 99 + return $descs 100 +} 101 + 102 +proc descOSLocalToEnglish {os} { 103 + upvar ::customkit::OSDesc OSDesc 104 + 105 + set work [split $os _] 106 + set os_extra [join [lrange $work 1 end]] 107 + set os [lindex $work 0] 108 + if {[info exists OSDesc($os)]} { 109 + set os "$OSDesc($os) $os_extra" 110 + } else { 111 + set os "[string totitle $os] $os_extra" 112 + } 113 + set os [string trim $os] 114 + 115 + return $os 116 +} 117 + 118 +proc descCPULocalToEnglish {cpu} { 119 + upvar ::customkit::CPUDesc CPUDesc 120 + 121 + set new_cpu [list] 122 + foreach cpu [split $cpu +] { 123 + if {[info exists CPUDesc($cpu)]} { 124 + set cpu $CPUDesc($cpu) 125 + } 126 + lappend new_cpu $cpu 127 + } 128 + set cpu [join $new_cpu {, }] 129 +} 130 + 131 +proc download_extensions_teapot {rootdir servers extensions os cpu {existingExts "Tcl Tk"}} { 132 + package require http 133 + package require fileutil 134 + 135 + foreach server $servers { 136 + foreach {pkg pkginfo} [get_extensions_teapot $server $os $cpu] { 137 + foreach pkginstance $pkginfo { 138 + lappend pkginstance $server 139 + lappend pkgdata($pkg) $pkginstance 140 + } 141 + } 142 + } 143 + 144 + foreach pkg [array names pkgdata] { 145 + set pkgdata($pkg) [lsort -decreasing -dictionary $pkgdata($pkg)] 146 + } 147 + 148 + array set extDependencies [list] 149 + foreach extension $extensions { 150 + set extension [file tail $extension] 151 + 152 + if {![info exists pkgdata($extension)]} { 153 + continue 154 + } 155 + 156 + set pkginfo [lindex $pkgdata($extension) 0] 157 + 158 + set ver [lindex $pkginfo 0] 159 + set arch [lindex $pkginfo 1] 160 + set server [lindex $pkginfo 2] 161 + 162 + set pkgdir [file join $rootdir lib $extension$ver] 163 + file mkdir $pkgdir $::customkit::pkgcachedir 164 + 165 + set url "http://$server/package/name/$extension/ver/$ver/arch/$arch/file" 166 + set urlcachefile [file join $::customkit::pkgcachedir [::md5::md5 -hex $url]] 167 + 168 + if {![file exists $urlcachefile]} { 169 + set tmpfd [open $urlcachefile w] 170 + set token [::http::geturl $url -channel $tmpfd] 171 + 172 + ::http::cleanup $token 173 + close $tmpfd 174 + } 175 + 176 + set retarr($extension) [list $ver $arch $server] 177 + switch -regexp -- [::fileutil::fileType $urlcachefile] { 178 + "(^| )zip($| )" { 179 + catch { 180 + exec unzip -d $pkgdir -n -qq $urlcachefile 181 + } 182 + 183 + # Process $pkgdir/teapot.txt 184 + set teapot [file join $pkgdir teapot.txt] 185 + if {[file exists $teapot]} { 186 + set fd [open $teapot r] 187 + for {gets $fd line} {![eof $fd]} {gets $fd line} { 188 + if {[string match "Meta require *" $line]} { 189 + set depinfo [lindex $line 2] 190 + set dep [lindex $depinfo 0] 191 + set depextra [lrange $depinfo 1 end] 192 + lappend extDependencies($dep) $depextra 193 + } 194 + } 195 + close $fd 196 + } 197 + } 198 + "(^| )text($| )" { 199 + unset -nocomplain fd 200 + 201 + set extfile [file join $pkgdir ${extension}.tcl] 202 + set idxfile [file join $pkgdir pkgIndex.tcl] 203 + 204 + catch { 205 + file copy -force -- $urlcachefile $extfile 206 + 207 + set fd [open $idxfile w] 208 + puts $fd "package ifneeded $extension $ver \[list source \[file join \$dir [file tail $extfile]\]\]" 209 + } 210 + 211 + catch { 212 + close $fd 213 + } 214 + 215 + # Process $extfile 216 + set fd [open $extfile r] 217 + for {gets $fd line} {![eof $fd]} {gets $fd line} { 218 + if {[string match "# Meta require *" $line]} { 219 + set depinfo [lindex $line 3] 220 + set dep [lindex $depinfo 0] 221 + set depextra [lrange $depinfo 1 end] 222 + lappend extDependencies($dep) $depextra 223 + } 224 + } 225 + close $fd 226 + } 227 + } 228 + } 229 + 230 + foreach {dep depinfo} [array get extDependencies] { 231 + set depReq -1 232 + foreach depinstinfo $depinfo { 233 + set depver [lindex $depinstinfo 0] 234 + set depinstinfo [lrange $depinstinfo 1 end] 235 + 236 + foreach {var val} $depinstinfo { 237 + switch -- $var { 238 + "-platform" { 239 + if {$val != $os} { 240 + if {$depReq == -1} { 241 + set depReq 0 242 + } 243 + } 244 + } 245 + } 246 + } 247 + } 248 + 249 + if {$depReq == 0} { 250 + continue 251 + } 252 + 253 + if {[lsearch $existingExts $dep] == -1} { 254 + lappend existingExts $dep 255 + lappend fetchDeps $dep 256 + } 257 + } 258 + 259 + if {[info exists fetchDeps]} { 260 + set addRet [download_extensions_teapot $rootdir $servers $fetchDeps $os $cpu $existingExts] 261 + array set retarr $addRet 262 + } 263 + 264 + return [array get retarr] 265 +} 266 + 267 +proc get_extensions_teapot {server {limitos "*"} {limitcpu "*"}} { 268 + upvar ::customkit::osTeapotToLocal osTeapotToLocal 269 + upvar ::customkit::cpuTeapotToLocal cpuTeapotToLocal 270 + 271 + set cachefile "/tmp/DELETEME_teapot_cache_[string tolower [md5::md5 -hex [list [info script] $server [id user]]]].tmp" 272 + set currtime [clock seconds] 273 + 274 + if {[file exists $cachefile]} { 275 + catch { 276 + set fd [open $cachefile r] 277 + set data [read $fd] 278 + close $fd 279 + 280 + set datatime [lindex $data 0] 281 + if {($currtime - $datatime) < 86400} { 282 + set children [lindex $data 1] 283 + } 284 + } 285 + } 286 + 287 + if {![info exists children]} { 288 + package require http 289 + 290 + set url "http://[join [list $server package list] /]" 291 + 292 + set token [::http::geturl $url] 293 + if {[::http::ncode $token] != "200"} { 294 + return [list] 295 + } 296 + 297 + set data [::http::data $token] 298 + ::http::cleanup $token 299 + 300 + set work [join [split $data \n] { }] 301 + regexp {\[\[TPM\[\[(.*)\]\]MPT\]\]} $work -> children 302 + 303 + catch { 304 + set fd [open $cachefile w] 305 + puts $fd [list $currtime $children] 306 + close $fd 307 + } 308 + } 309 + 310 + foreach child $children { 311 + set type [lindex $child 0] 312 + if {$type != "package"} { 313 + continue 314 + } 315 + 316 + set pkg [lindex $child 1] 317 + set ver [lindex $child 2] 318 + set arch [lindex $child 3] 319 + set arch_work [split $arch -] 320 + set arch_os [join [lrange $arch_work 0 end-1] -] 321 + set arch_cpu [lindex $arch_work end] 322 + 323 + if {$arch == "source"} { 324 + continue 325 + } 326 + 327 + set isCompatOS 0 328 + if {$arch == "tcl"} { 329 + set isCompatOS 1 330 + } elseif {[string match $limitos $arch_os]} { 331 + set isCompatOS 1 332 + } else { 333 + foreach {teapot local} [array get osTeapotToLocal] { 334 + if {[string match $limitos $local] || [string match $local $limitos]} { 335 + if {[string match $teapot $arch_os] || [string match $arch_os $teapot]} { 336 + set isCompatOS 1 337 + break 338 + } 339 + } 340 + } 341 + } 342 + if {!$isCompatOS} { 343 + continue 344 + } 345 + 346 + set isCompatCPU 0 347 + if {$arch == "tcl"} { 348 + set isCompatCPU 1 349 + } elseif {[string match $limitcpu $arch_cpu]} { 350 + set isCompatCPU 1 351 + } else { 352 + foreach {teapot local} [array get cpuTeapotToLocal] { 353 + if {[string match $limitcpu $local] || [string match $local $limitcpu]} { 354 + if {[string match $teapot $arch_cpu] || [string match $arch_cpu $teapot]} { 355 + set isCompatCPU 1 356 + break 357 + } 358 + } 359 + } 360 + } 361 + if {!$isCompatCPU} { 362 + continue 363 + } 364 + 365 + lappend pkginfo($pkg) [list $ver $arch] 366 + } 367 + 368 + foreach pkg [array names pkginfo] { 369 + set pkginfo($pkg) [lsort -decreasing -dictionary $pkginfo($pkg)] 370 + } 371 + 372 + return [array get pkginfo] 373 +} 374 + 375 +}
Added client/web/customkit.rvt version [9192efd9c0].
1 +<? 2 + 3 +# This file has no license. It is in the public domain. 4 +# -- Roy Keene <tcl@rkeene.org> [20081025T1400Q] 5 + 6 +if {[var exists source]} { 7 + headers type "text/plain; charset=us-ascii" 8 + rivet_flush 9 + 10 + set fd [open $::env(PATH_TRANSLATED) r] 11 + fcopy $fd stdout 12 + close $fd 13 + 14 + abort_page 15 + exit 0 16 +} 17 + 18 +source [file join [file dirname [info script]] common.tcl] 19 + 20 +if {[var exists starpack_platform] && [var exists extensions]} { 21 + 22 + set ourkit [exec $::customkit::findkit] 23 + 24 + set starpack_platform [var get starpack_platform] 25 + set extensions [var get extensions] 26 + 27 + set platforminfo $::customkit::Mapping($starpack_platform) 28 + set platforminfo_kit [lindex $platforminfo 0] 29 + set platforminfo_tclver [lindex $platforminfo 1] 30 + set platforminfo_os [lindex $platforminfo 2] 31 + set platforminfo_cpu [lindex $platforminfo 3] 32 + 33 + set workdir [file join "/tmp" DELETEME_[::md5::md5 -hex [clock seconds][clock clicks][pid][array get ::env]]] 34 + set extpath [file join $workdir exts] 35 + set kitpath [file join $workdir kit] 36 + file mkdir $workdir 37 + 38 + array set incextensions [::customkit::download_extensions_teapot $extpath [list teapot.rkeene.org] $extensions $platforminfo_os $platforminfo_cpu] 39 + 40 + set webkit [file join kits customkit-v$platforminfo_tclver-$platforminfo_os-$platforminfo_cpu-[string tolower [::md5::md5 -hex [list $platforminfo [array get incextensions]]]].bin] 41 + 42 + if {![file exists $webkit]} { 43 + file copy -force -- $platforminfo_kit $kitpath 44 + 45 + catch { 46 + exec $ourkit $::customkit::sdx sync -auto 1 -forcedest 1 $extpath $kitpath 47 + } 48 + 49 + file mkdir [file dirname $webkit] 50 + file copy -force -- $kitpath $webkit 51 + } 52 + 53 + file delete -force -- $workdir 54 +} 55 + 56 +# Set content-type 57 +headers type "text/html; charset=us-ascii" 58 + 59 +rivet_flush 60 + 61 +?><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd"> 62 +<html> 63 + <head> 64 + <title>CustomKit Builder</title> 65 + </head> 66 + <body> 67 + <h1>CustomKit</h1> 68 +<? 69 +if {[info exists webkit]} { 70 +?> <h2>Complete</h2> 71 + <div> 72 + The following CustomKit has been created: <a href="<? puts -nonewline $webkit ?>"><? puts -nonewline [file tail $webkit] ?></a>. It was created with the following parameters: 73 + <table border="1"> 74 + <tr> 75 + <td>Tcl Version:</td> 76 + <td><? puts -nonewline $platforminfo_tclver ?></td> 77 + </tr> 78 + <tr> 79 + <td>OS:</td> 80 + <td><? puts -nonewline [::customkit::descOSLocalToEnglish $platforminfo_os] ?></td> 81 + </tr> 82 + <tr> 83 + <td>CPU:</td> 84 + <td><? puts -nonewline [::customkit::descCPULocalToEnglish $platforminfo_cpu] ?></td> 85 + </tr> 86 + <tr> 87 + <td>Included Extensions:</td> 88 + <td> 89 +<? 90 + foreach {ext extinfo} [array get incextensions] { 91 + set extinfo_ver [lindex $extinfo 0] 92 + if {[lsearch $extensions $ext] == -1} { 93 + puts " <i>$ext v$extinfo_ver</i><br>" 94 + } else { 95 + puts " $ext v$extinfo_ver<br>" 96 + } 97 + } 98 +?> </td> 99 + </tr> 100 + <tr> 101 + <td>Excluded Extensions:</td> 102 + <td> 103 +<? 104 + foreach ext $extensions { 105 + if {![info exists incextensions($ext)]} { 106 + puts " <b>$ext</b><br>" 107 + } 108 + } 109 +?> </td> 110 + </tr> 111 + </table> 112 + </div> 113 + <div> 114 + <a href="?start_over=1">Start Over</a> 115 + </div> 116 +<? 117 +} else { 118 +?> <h2>Select Parameters</h2> 119 + <form method="post" action="<? puts -nonewline $::env(REQUEST_URI) ?>"> 120 + <table> 121 + <tr> 122 + <td>Target Platform:</td> 123 + <td> 124 + <select name="starpack_platform"> 125 +<? 126 + set descs [::customkit::get_descs_from_mapping] 127 + 128 + foreach desckey [lsort -dictionary $descs] { 129 + set desc [lindex $desckey 0] 130 + set key [lindex $desckey 1] 131 + puts " <option value=\"$key\">$desc</option>" 132 + } 133 +?> </select> 134 + </td> 135 + </tr> 136 + <tr> 137 + <td>Extensions:</td> 138 + <td> 139 + <select name="extensions" size="20" multiple> 140 +<? 141 + set extensionsinfo [::customkit::get_extensions_teapot teapot.rkeene.org] 142 + 143 + set extensions [list] 144 + foreach {extension extdata} $extensionsinfo { 145 + if {[lsearch -exact $extensions $extension] != -1} { 146 + continue 147 + } 148 + 149 + lappend extensions $extension 150 + } 151 + 152 + foreach extension [lsort -dictionary $extensions] { 153 + puts " <option value=\"$extension\">$extension</option>" 154 + } 155 +?> </select> 156 + </td> 157 + </tr> 158 + <tr> 159 + <td colspan="2"> 160 + <input type="submit" name="submit_upload" value="Create"> 161 + </td> 162 + </tr> 163 + </table> 164 + </form> 165 +<? 166 +} 167 +?> <div> 168 + <a href="?source=1">Source</a> 169 + </div> 170 + </body> 171 +</html>
Added client/web/tcl-to-exe.rvt version [aecea58e24].
1 +<? 2 + 3 +# This file has no license. It is in the public domain. 4 +# -- Roy Keene <tcl@rkeene.org> [20081025T1400Q] 5 + 6 +if {[var exists source]} { 7 + headers type "text/plain; charset=us-ascii" 8 + rivet_flush 9 + 10 + set fd [open $::env(PATH_TRANSLATED) r] 11 + fcopy $fd stdout 12 + close $fd 13 + 14 + abort_page 15 + exit 0 16 +} 17 + 18 +source [file join [file dirname [info script]] common.tcl] 19 + 20 +if {[var exists starkit] && [var exists starpack_platform]} { 21 + headers type "text/plain" 22 + 23 + puts "[var get starkit]" 24 + puts "--" 25 + puts "[var get starpack_platform]" 26 + puts "--" 27 + puts "OK" 28 +} else { 29 + # Set content-type 30 + headers type "text/html; charset=us-ascii" 31 + 32 +?><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd"> 33 +<html> 34 + <head> 35 + <title>Starpacker <? puts -nonewline "[var exists starkit][var get starpack_platform {-}]" ?></title> 36 + </head> 37 + <body> 38 +<? 39 + if {$::env(REQUEST_METHOD) == "POST"} { 40 + foreach {var val} [array get ::env] { 41 + puts "$var = \"$val\"<br>" 42 + } 43 + } 44 +?> 45 + <form action="<? puts -nonewline $::env(REQUEST_URI) ?>" method="post" enctype="multipart/form-data"> 46 + <table> 47 + <tr> 48 + <td>Upload file:</td> 49 + <td><input type="file" name="starkit"> (ZIP file, Tarball, Starkit, or Single Tcl File)</td> 50 + </tr> 51 + <tr> 52 + <td>Target Platform:</td> 53 + <td> 54 + <select name="starpack_platform"> 55 +<? 56 + set descs [::customkit::get_descs_from_mapping] 57 + 58 + foreach desckey [lsort -dictionary $descs] { 59 + set desc [lindex $desckey 0] 60 + set key [lindex $desckey 1] 61 + puts " <option value=\"$key\">$desc</option>" 62 + } 63 +?> </select> 64 + </td> 65 + </tr> 66 + <tr> 67 + <td colspan="2"> 68 + <input type="submit" name="submit_upload" value="Create"> 69 + </td> 70 + </tr> 71 + <tr> 72 + <td colspan="2"> 73 +<? 74 + puts "$::env(REQUEST_METHOD)" 75 +?> 76 + </td> 77 + </tr> 78 + </table> 79 + </form> 80 + <div> 81 + <a href="?source=1">Source</a> 82 + </div> 83 + </body> 84 +</html><? 85 +} 86 +?>