Check-in [1bf8a9efe1]
Overview
Comment:Added teapot project (client-only so far), derivative of starkit2exe
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1bf8a9efe1e0ab00f2f346daadd85001b66ce1d5
User & Date: rkeene on 2009-04-18 02:43:20
Other Links: manifest | tags
Context
2009-04-18
02:48
Renamed teapot.tcl to teapot-client.tcl check-in: d64ee24bd0 user: rkeene tags: trunk
02:43
Added teapot project (client-only so far), derivative of starkit2exe check-in: 1bf8a9efe1 user: rkeene tags: trunk
02:43
initial empty check-in check-in: 23dfc15ca5 user: rkeene tags: trunk
Changes

Added client/lib/teapotclient0.1/pkgIndex.tcl version [f041fc3a79].























>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
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 version [b940fef8b1].

































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
#! /usr/bin/env tclsh

# This file has no license.  It is in the public domain.
# -- Roy Keene <tcl@rkeene.org> [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 version [384fceb21a].

































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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 <dir> <os> <cpu> <packages...>"
	puts stderr "Usage: teapot.tcl list ?<os> ?<cpu>??"
}

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
	}
}