Index: client/lib/teapotclient0.1/teapotclient.tcl ================================================================== --- client/lib/teapotclient0.1/teapotclient.tcl +++ client/lib/teapotclient0.1/teapotclient.tcl @@ -66,10 +66,16 @@ vfs::zip::Unmount $mntfd $file } else { exec unzip -d $dir -n -qq $file } } + + proc __isCompatibleCPU {teapot local} { + } + + proc __isCompatibleOS {teapot local} { + } set pkgcachedir [file join [__get_homedir] ".teapot-client" "cachedir"] # Conversions from Teapot-style names to local ones set osTeapotToLocal(tcl) [list *] @@ -79,10 +85,11 @@ set osTeapotToLocal(freebsd) [list freebsd_*] set osTeapotToLocal(irix) [list irix_*] set cpuTeapotToLocal(ix86) [list x86 intel i?86 i86pc] set cpuTeapotToLocal(sparc) [list sun4*] + set cpuTeapotToLocal(sparc64) [list sun4u sun4v] set cpuTeapotToLocal(universal) [list *] set cpuTeapotToLocal(powerpc) [list ppc] proc download_extensions {rootdir servers extensions os cpu {existingExts ""}} { foreach chkdefext [list Tcl Tk msgcat] { ADDED client/web/common.tcl Index: client/web/common.tcl ================================================================== --- client/web/common.tcl +++ client/web/common.tcl @@ -0,0 +1,375 @@ +#! /usr/bin/env tclsh + +# This file has no license. It is in the public domain. +# -- Roy Keene [20081025T1400Q] + +package require md5 +package require Tclx + +namespace eval ::customkit {} +namespace eval ::customkit { + set starkitdir "/home/rkeene/devel/starkit2exe" + set tclkitsdir "$starkitdir/tclkits" + set findkit "$starkitdir/support/find-tclkit" + set sdx "$starkitdir/support/sdx-1nrl.kit" + set pkgcachedir "/tmp/DELETEME_customkit_[string tolower [md5::md5 -hex [list [info script] [id user]]]].cache" + + # Generate a mapping of Tclkits to user viewable and referencable keys + array set Mapping [list] + catch { + foreach file [glob -nocomplain -directory $tclkitsdir *] { + set work [split [file tail $file] -] + set file_tclver [lindex $work 1] + set file_os [lindex $work 2] + set file_cpu [lindex $work 3] + + set file_exts [list Itcl Mk4tcl] + + if {[lindex $work 0] != "tclkitnotk"} { + lappend file_exts "Tk" + } + + unset -nocomplain file_info + array set file_info {} + catch { + file stat $file file_info + unset file_info(atime) + } + + set key [string tolower [md5::md5 -hex [list $file [array get file_info] [expr [clock seconds] / 86400]]]] + + set Mapping($key) [list $file $file_tclver $file_os $file_cpu $file_exts] + } + } + + # Descriptive mappings + set OSDesc(macosx) "Mac OS X" + set OSDesc(macos) "Mac OS Classic" + set OSDesc(freebsd) "FreeBSD" + set OSDesc(openbsd) "OpenBSD" + set OSDesc(netbsd) "NetBSD" + set OSDesc(hpux) "HP/UX" + set OSDesc(irix) "IRIX" + set OSDesc(aix) "AIX" + + set CPUDesc(ppc) "PowerPC" + set CPUDesc(m68k) "Motorola 68K" + set CPUDesc(x86_64) "AMD64" + set CPUDesc(parisc) "PA-RISC" + set CPUDesc(sun4m) "SPARC" + set CPUDesc(sun4u) "UltraSPARC" + set CPUDesc(armv9) "ARM v9" + + # Conversions from Teapot-style names to local ones + set osTeapotToLocal(tcl) * + set osTeapotToLocal(linux-*) linux + set osTeapotToLocal(win32) windows + set osTeapotToLocal(solaris*) solaris + set osTeapotToLocal(freebsd) freebsd_* + set osTeapotToLocal(irix) irix_* + + set cpuTeapotToLocal(ix86) x86 + set cpuTeapotToLocal(sparc) sun4* + set cpuTeapotToLocal(universal) * + set cpuTeapotToLocal(powerpc) ppc + + +proc get_descs_from_mapping {} { + upvar ::customkit::Mapping Mapping + + set descs [list] + foreach key [array names Mapping] { + set tclver [lindex $Mapping($key) 1] + set os [lindex $Mapping($key) 2] + set cpu [lindex $Mapping($key) 3] + set exts [lindex $Mapping($key) 4] + + set os [descOSLocalToEnglish $os] + set cpu [descCPULocalToEnglish $cpu] + + set desc "Tcl v$tclver for $os on the $cpu architecture" + + if {[lsearch -exact $exts "Tk"] == -1} { + append desc " (no Tk)" + } + + lappend descs [list $desc $key] + } + + return $descs +} + +proc descOSLocalToEnglish {os} { + upvar ::customkit::OSDesc OSDesc + + set work [split $os _] + set os_extra [join [lrange $work 1 end]] + set os [lindex $work 0] + if {[info exists OSDesc($os)]} { + set os "$OSDesc($os) $os_extra" + } else { + set os "[string totitle $os] $os_extra" + } + set os [string trim $os] + + return $os +} + +proc descCPULocalToEnglish {cpu} { + upvar ::customkit::CPUDesc CPUDesc + + set new_cpu [list] + foreach cpu [split $cpu +] { + if {[info exists CPUDesc($cpu)]} { + set cpu $CPUDesc($cpu) + } + lappend new_cpu $cpu + } + set cpu [join $new_cpu {, }] +} + +proc download_extensions_teapot {rootdir servers extensions os cpu {existingExts "Tcl Tk"}} { + package require http + package require fileutil + + foreach server $servers { + foreach {pkg pkginfo} [get_extensions_teapot $server $os $cpu] { + foreach pkginstance $pkginfo { + lappend pkginstance $server + lappend pkgdata($pkg) $pkginstance + } + } + } + + foreach pkg [array names pkgdata] { + set pkgdata($pkg) [lsort -decreasing -dictionary $pkgdata($pkg)] + } + + array set extDependencies [list] + foreach extension $extensions { + set extension [file tail $extension] + + if {![info exists pkgdata($extension)]} { + continue + } + + set pkginfo [lindex $pkgdata($extension) 0] + + set ver [lindex $pkginfo 0] + set arch [lindex $pkginfo 1] + set server [lindex $pkginfo 2] + + set pkgdir [file join $rootdir lib $extension$ver] + file mkdir $pkgdir $::customkit::pkgcachedir + + set url "http://$server/package/name/$extension/ver/$ver/arch/$arch/file" + set urlcachefile [file join $::customkit::pkgcachedir [::md5::md5 -hex $url]] + + if {![file exists $urlcachefile]} { + set tmpfd [open $urlcachefile w] + set token [::http::geturl $url -channel $tmpfd] + + ::http::cleanup $token + close $tmpfd + } + + set retarr($extension) [list $ver $arch $server] + switch -regexp -- [::fileutil::fileType $urlcachefile] { + "(^| )zip($| )" { + catch { + exec unzip -d $pkgdir -n -qq $urlcachefile + } + + # Process $pkgdir/teapot.txt + set teapot [file join $pkgdir teapot.txt] + if {[file exists $teapot]} { + set fd [open $teapot r] + for {gets $fd line} {![eof $fd]} {gets $fd line} { + if {[string match "Meta require *" $line]} { + set depinfo [lindex $line 2] + set dep [lindex $depinfo 0] + set depextra [lrange $depinfo 1 end] + lappend extDependencies($dep) $depextra + } + } + close $fd + } + } + "(^| )text($| )" { + unset -nocomplain fd + + set extfile [file join $pkgdir ${extension}.tcl] + set idxfile [file join $pkgdir pkgIndex.tcl] + + catch { + file copy -force -- $urlcachefile $extfile + + set fd [open $idxfile w] + puts $fd "package ifneeded $extension $ver \[list source \[file join \$dir [file tail $extfile]\]\]" + } + + catch { + close $fd + } + + # Process $extfile + set fd [open $extfile r] + for {gets $fd line} {![eof $fd]} {gets $fd line} { + if {[string match "# Meta require *" $line]} { + set depinfo [lindex $line 3] + set dep [lindex $depinfo 0] + set depextra [lrange $depinfo 1 end] + lappend extDependencies($dep) $depextra + } + } + close $fd + } + } + } + + foreach {dep depinfo} [array get extDependencies] { + set depReq -1 + foreach depinstinfo $depinfo { + set depver [lindex $depinstinfo 0] + set depinstinfo [lrange $depinstinfo 1 end] + + foreach {var val} $depinstinfo { + switch -- $var { + "-platform" { + if {$val != $os} { + if {$depReq == -1} { + set depReq 0 + } + } + } + } + } + } + + if {$depReq == 0} { + continue + } + + if {[lsearch $existingExts $dep] == -1} { + lappend existingExts $dep + lappend fetchDeps $dep + } + } + + if {[info exists fetchDeps]} { + set addRet [download_extensions_teapot $rootdir $servers $fetchDeps $os $cpu $existingExts] + array set retarr $addRet + } + + return [array get retarr] +} + +proc get_extensions_teapot {server {limitos "*"} {limitcpu "*"}} { + upvar ::customkit::osTeapotToLocal osTeapotToLocal + upvar ::customkit::cpuTeapotToLocal cpuTeapotToLocal + + set cachefile "/tmp/DELETEME_teapot_cache_[string tolower [md5::md5 -hex [list [info script] $server [id user]]]].tmp" + set currtime [clock seconds] + + if {[file exists $cachefile]} { + catch { + set fd [open $cachefile r] + set data [read $fd] + close $fd + + set datatime [lindex $data 0] + if {($currtime - $datatime) < 86400} { + set children [lindex $data 1] + } + } + } + + if {![info exists children]} { + package require http + + set url "http://[join [list $server package list] /]" + + set token [::http::geturl $url] + if {[::http::ncode $token] != "200"} { + return [list] + } + + set data [::http::data $token] + ::http::cleanup $token + + set work [join [split $data \n] { }] + regexp {\[\[TPM\[\[(.*)\]\]MPT\]\]} $work -> children + + catch { + set fd [open $cachefile w] + puts $fd [list $currtime $children] + close $fd + } + } + + foreach child $children { + set type [lindex $child 0] + if {$type != "package"} { + continue + } + + set pkg [lindex $child 1] + set ver [lindex $child 2] + set arch [lindex $child 3] + set arch_work [split $arch -] + set arch_os [join [lrange $arch_work 0 end-1] -] + set arch_cpu [lindex $arch_work end] + + if {$arch == "source"} { + continue + } + + set isCompatOS 0 + if {$arch == "tcl"} { + set isCompatOS 1 + } elseif {[string match $limitos $arch_os]} { + set isCompatOS 1 + } else { + foreach {teapot local} [array get osTeapotToLocal] { + if {[string match $limitos $local] || [string match $local $limitos]} { + if {[string match $teapot $arch_os] || [string match $arch_os $teapot]} { + set isCompatOS 1 + break + } + } + } + } + if {!$isCompatOS} { + continue + } + + set isCompatCPU 0 + if {$arch == "tcl"} { + set isCompatCPU 1 + } elseif {[string match $limitcpu $arch_cpu]} { + set isCompatCPU 1 + } else { + foreach {teapot local} [array get cpuTeapotToLocal] { + if {[string match $limitcpu $local] || [string match $local $limitcpu]} { + if {[string match $teapot $arch_cpu] || [string match $arch_cpu $teapot]} { + set isCompatCPU 1 + break + } + } + } + } + if {!$isCompatCPU} { + continue + } + + lappend pkginfo($pkg) [list $ver $arch] + } + + foreach pkg [array names pkginfo] { + set pkginfo($pkg) [lsort -decreasing -dictionary $pkginfo($pkg)] + } + + return [array get pkginfo] +} + +} ADDED client/web/customkit.rvt Index: client/web/customkit.rvt ================================================================== --- client/web/customkit.rvt +++ client/web/customkit.rvt @@ -0,0 +1,171 @@ + [20081025T1400Q] + +if {[var exists source]} { + headers type "text/plain; charset=us-ascii" + rivet_flush + + set fd [open $::env(PATH_TRANSLATED) r] + fcopy $fd stdout + close $fd + + abort_page + exit 0 +} + +source [file join [file dirname [info script]] common.tcl] + +if {[var exists starpack_platform] && [var exists extensions]} { + + set ourkit [exec $::customkit::findkit] + + set starpack_platform [var get starpack_platform] + set extensions [var get extensions] + + set platforminfo $::customkit::Mapping($starpack_platform) + set platforminfo_kit [lindex $platforminfo 0] + set platforminfo_tclver [lindex $platforminfo 1] + set platforminfo_os [lindex $platforminfo 2] + set platforminfo_cpu [lindex $platforminfo 3] + + set workdir [file join "/tmp" DELETEME_[::md5::md5 -hex [clock seconds][clock clicks][pid][array get ::env]]] + set extpath [file join $workdir exts] + set kitpath [file join $workdir kit] + file mkdir $workdir + + array set incextensions [::customkit::download_extensions_teapot $extpath [list teapot.rkeene.org] $extensions $platforminfo_os $platforminfo_cpu] + + set webkit [file join kits customkit-v$platforminfo_tclver-$platforminfo_os-$platforminfo_cpu-[string tolower [::md5::md5 -hex [list $platforminfo [array get incextensions]]]].bin] + + if {![file exists $webkit]} { + file copy -force -- $platforminfo_kit $kitpath + + catch { + exec $ourkit $::customkit::sdx sync -auto 1 -forcedest 1 $extpath $kitpath + } + + file mkdir [file dirname $webkit] + file copy -force -- $kitpath $webkit + } + + file delete -force -- $workdir +} + +# Set content-type +headers type "text/html; charset=us-ascii" + +rivet_flush + +?> + + + CustomKit Builder + + +

CustomKit

+

Complete

+
+ The following CustomKit has been created: . It was created with the following parameters: + + + + + + + + + + + + + + + + + + + + + +
Tcl Version:
OS:
CPU:
Included Extensions: +$ext v$extinfo_ver
" + } else { + puts " $ext v$extinfo_ver
" + } + } +?>
Excluded Extensions: +$ext
" + } + } +?>
+
+
+ Start Over +
+

Select Parameters

+
+ + + + + + + + + + + + +
Target Platform: + +
Extensions: + +
+ +
+
+
+ Source +
+ + ADDED client/web/tcl-to-exe.rvt Index: client/web/tcl-to-exe.rvt ================================================================== --- client/web/tcl-to-exe.rvt +++ client/web/tcl-to-exe.rvt @@ -0,0 +1,86 @@ + [20081025T1400Q] + +if {[var exists source]} { + headers type "text/plain; charset=us-ascii" + rivet_flush + + set fd [open $::env(PATH_TRANSLATED) r] + fcopy $fd stdout + close $fd + + abort_page + exit 0 +} + +source [file join [file dirname [info script]] common.tcl] + +if {[var exists starkit] && [var exists starpack_platform]} { + headers type "text/plain" + + puts "[var get starkit]" + puts "--" + puts "[var get starpack_platform]" + puts "--" + puts "OK" +} else { + # Set content-type + headers type "text/html; charset=us-ascii" + +?> + + + Starpacker <? puts -nonewline "[var exists starkit][var get starpack_platform {-}]" ?> + + +" + } + } +?> +
+ + + + + + + + + + + + + + + +
Upload file: (ZIP file, Tarball, Starkit, or Single Tcl File)
Target Platform: + +
+ +
+ +
+
+
+ Source +
+ +