ADDED client/lib/teapotclient0.1/pkgIndex.tcl Index: client/lib/teapotclient0.1/pkgIndex.tcl ================================================================== --- client/lib/teapotclient0.1/pkgIndex.tcl +++ client/lib/teapotclient0.1/pkgIndex.tcl @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded teapotclient 0.1 [list source [file join $dir teapotclient.tcl]] ADDED client/lib/teapotclient0.1/teapotclient.tcl Index: client/lib/teapotclient0.1/teapotclient.tcl ================================================================== --- client/lib/teapotclient0.1/teapotclient.tcl +++ client/lib/teapotclient0.1/teapotclient.tcl @@ -0,0 +1,272 @@ +#! /usr/bin/env tclsh + +# This file has no license. It is in the public domain. +# -- Roy Keene [20081025T1400Q] + +package require md5 +package require http +package require fileutil + +namespace eval ::teapotclient {} +namespace eval ::teapotclient { + set pkgcachedir "/tmp/DELETEME_teapotclient_[string tolower [md5::md5 -hex [list [info script] $::tcl_platform(user)]]].cache" + + # 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 download_extensions {rootdir servers extensions os cpu {existingExts "Tcl Tk"}} { + foreach server $servers { + foreach {pkg pkginfo} [get_extensions $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 $::teapotclient::pkgcachedir + + set url "http://$server/package/name/$extension/ver/$ver/arch/$arch/file" + set urlcachefile [file join $::teapotclient::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 {server {limitos "*"} {limitcpu "*"}} { + upvar ::teapotclient::osTeapotToLocal osTeapotToLocal + upvar ::teapotclient::cpuTeapotToLocal cpuTeapotToLocal + + file mkdir $::teapotclient::pkgcachedir + set cachefile [file join $::teapotclient::pkgcachedir TEAPOTINFO] + + 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] + } + +} + +package provide teapotclient 0.1 ADDED client/teapot.tcl Index: client/teapot.tcl ================================================================== --- client/teapot.tcl +++ client/teapot.tcl @@ -0,0 +1,80 @@ +#! /usr/bin/env tclsh + +set teapotservers [list teapot.activestate.com] + +lappend auto_path [file join [file dirname [info script]] lib] + +package require teapotclient + +proc print_help {} { + puts stderr "Usage: teapot.tcl get " + puts stderr "Usage: teapot.tcl list ? ???" +} + +set cmd [lindex $argv 0] +set argv [lrange $argv 1 end] + +switch -- $cmd { + "get" { + if {[llength $argv] < 4} { + print_help + exit 1 + } + + set dir [lindex $argv 0] + set os [lindex $argv 1] + set cpu [lindex $argv 2] + set packages [lrange $argv 3 end] + set extsinfo [::teapotclient::download_extensions $dir $teapotservers $packages $os $cpu] + set exts [list] + puts "Fetched Extensions:" + foreach {ext extinfo} $extsinfo { + lappend exts $ext + puts " $ext v[lindex $extinfo 0]" + } + + set failedexts [list] + foreach pkg $packages { + if {[lsearch -exact $exts $pkg] == -1} { + lappend failedexts $pkg + } + } + if {[llength $failedexts] != 0} { + puts "Failed to fetch:" + foreach ext $failedexts { + puts " $ext" + } + exit 1 + } + } + "list" { + set os "*" + set cpu "*" + if {[llength $argv] > 0} { + set os [lindex $argv 0] + } + if {[llength $argv] > 1} { + set cpu [lindex $argv 1] + } + + puts "Extensions available for OS=$os, CPU=$cpu:" + + set extsinfo [::teapotclient::get_extensions $teapotservers $os $cpu] + foreach {ext extinfo} $extsinfo { + set extvers [list] + foreach extinfoitem $extinfo { + set extinfoitemvers [lindex $extinfoitem 0] + if {[lsearch -exact $extvers $extinfoitemvers] == -1} { + lappend extvers $extinfoitemvers + } + } + set extvers [lsort -decreasing -dictionary $extvers] + + puts " $ext [lindex $extvers 0]" + } + } + default { + print_help + exit 1 + } +}