Artifact a38541090a1241ab3e0b73ae9895412f4e9b001f:
0000: 23 21 20 2f 75 73 72 2f 62 69 6e 2f 65 6e 76 20 #! /usr/bin/env
0010: 74 63 6c 73 68 0a 0a 23 20 54 68 69 73 20 66 69 tclsh..# This fi
0020: 6c 65 20 68 61 73 20 6e 6f 20 6c 69 63 65 6e 73 le has no licens
0030: 65 2e 20 20 49 74 20 69 73 20 69 6e 20 74 68 65 e. It is in the
0040: 20 70 75 62 6c 69 63 20 64 6f 6d 61 69 6e 2e 0a public domain..
0050: 23 20 2d 2d 20 52 6f 79 20 4b 65 65 6e 65 20 3c # -- Roy Keene <
0060: 74 63 6c 40 72 6b 65 65 6e 65 2e 6f 72 67 3e 20 tcl@rkeene.org>
0070: 5b 32 30 30 38 31 30 32 35 54 31 34 30 30 51 5d [20081025T1400Q]
0080: 0a 0a 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c ..namespace eval
0090: 20 3a 3a 74 65 61 70 6f 74 63 6c 69 65 6e 74 20 ::teapotclient
00a0: 7b 7d 0a 0a 70 61 63 6b 61 67 65 20 72 65 71 75 {}..package requ
00b0: 69 72 65 20 54 63 6c 0a 70 61 63 6b 61 67 65 20 ire Tcl.package
00c0: 72 65 71 75 69 72 65 20 6d 64 35 0a 70 61 63 6b require md5.pack
00d0: 61 67 65 20 72 65 71 75 69 72 65 20 68 74 74 70 age require http
00e0: 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
00f0: 20 66 69 6c 65 75 74 69 6c 0a 0a 73 65 74 20 3a fileutil..set :
0100: 3a 74 65 61 70 6f 74 63 6c 69 65 6e 74 3a 3a 68 :teapotclient::h
0110: 61 76 65 5f 76 66 73 7a 69 70 20 30 0a 63 61 74 ave_vfszip 0.cat
0120: 63 68 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 ch {..package re
0130: 71 75 69 72 65 20 76 66 73 3a 3a 7a 69 70 0a 09 quire vfs::zip..
0140: 73 65 74 20 3a 3a 74 65 61 70 6f 74 63 6c 69 65 set ::teapotclie
0150: 6e 74 3a 3a 68 61 76 65 5f 76 66 73 7a 69 70 20 nt::have_vfszip
0160: 31 0a 7d 0a 0a 6e 61 6d 65 73 70 61 63 65 20 65 1.}..namespace e
0170: 76 61 6c 20 3a 3a 74 65 61 70 6f 74 63 6c 69 65 val ::teapotclie
0180: 6e 74 20 7b 7d 0a 6e 61 6d 65 73 70 61 63 65 20 nt {}.namespace
0190: 65 76 61 6c 20 3a 3a 74 65 61 70 6f 74 63 6c 69 eval ::teapotcli
01a0: 65 6e 74 20 7b 0a 09 70 72 6f 63 20 5f 5f 67 65 ent {..proc __ge
01b0: 74 5f 74 6d 70 64 69 72 20 7b 7d 20 7b 0a 09 09 t_tmpdir {} {...
01c0: 66 6f 72 65 61 63 68 20 63 68 65 63 6b 65 6e 76 foreach checkenv
01d0: 20 5b 6c 69 73 74 20 54 4d 50 44 49 52 20 54 45 [list TMPDIR TE
01e0: 4d 50 20 54 4d 50 20 54 45 4d 50 44 49 52 5d 20 MP TMP TEMPDIR]
01f0: 7b 0a 09 09 09 69 66 20 7b 5b 69 6e 66 6f 20 65 {....if {[info e
0200: 78 69 73 74 73 20 3a 3a 65 6e 76 28 24 63 68 65 xists ::env($che
0210: 63 6b 65 6e 76 29 5d 7d 20 7b 0a 09 09 09 09 72 ckenv)]} {.....r
0220: 65 74 75 72 6e 20 24 3a 3a 65 6e 76 28 24 63 68 eturn $::env($ch
0230: 65 63 6b 65 6e 76 29 0a 09 09 09 7d 0a 09 09 7d eckenv)....}...}
0240: 0a 0a 09 09 72 65 74 75 72 6e 20 22 2f 74 6d 70 ....return "/tmp
0250: 22 0a 09 7d 0a 0a 09 70 72 6f 63 20 5f 5f 67 65 "..}...proc __ge
0260: 74 5f 68 6f 6d 65 64 69 72 20 7b 7d 20 7b 0a 09 t_homedir {} {..
0270: 09 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 .if {[info exist
0280: 73 20 3a 3a 65 6e 76 28 48 4f 4d 45 29 5d 7d 20 s ::env(HOME)]}
0290: 7b 0a 09 09 09 69 66 20 7b 5b 66 69 6c 65 20 65 {....if {[file e
02a0: 78 69 73 74 73 20 24 3a 3a 65 6e 76 28 48 4f 4d xists $::env(HOM
02b0: 45 29 5d 7d 20 7b 0a 09 09 09 09 72 65 74 75 72 E)]} {.....retur
02c0: 6e 20 24 3a 3a 65 6e 76 28 48 4f 4d 45 29 0a 09 n $::env(HOME)..
02d0: 09 09 7d 0a 09 09 7d 0a 0a 09 09 63 61 74 63 68 ..}...}....catch
02e0: 20 7b 0a 09 09 09 73 65 74 20 3a 3a 65 6e 76 28 {....set ::env(
02f0: 48 4f 4d 45 29 20 5b 66 69 6c 65 20 6e 6f 72 6d HOME) [file norm
0300: 61 6c 69 7a 65 20 7e 5d 0a 09 09 7d 0a 09 09 69 alize ~]...}...i
0310: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0320: 3a 3a 65 6e 76 28 48 4f 4d 45 29 5d 7d 20 7b 0a ::env(HOME)]} {.
0330: 09 09 09 69 66 20 7b 5b 66 69 6c 65 20 65 78 69 ...if {[file exi
0340: 73 74 73 20 24 3a 3a 65 6e 76 28 48 4f 4d 45 29 sts $::env(HOME)
0350: 5d 7d 20 7b 0a 09 09 09 09 72 65 74 75 72 6e 20 ]} {.....return
0360: 24 3a 3a 65 6e 76 28 48 4f 4d 45 29 0a 09 09 09 $::env(HOME)....
0370: 7d 0a 09 09 7d 0a 0a 09 09 73 65 74 20 3a 3a 65 }...}....set ::e
0380: 6e 76 28 48 4f 4d 45 29 20 5b 66 69 6c 65 20 6a nv(HOME) [file j
0390: 6f 69 6e 20 5b 5f 5f 67 65 74 5f 74 6d 70 64 69 oin [__get_tmpdi
03a0: 72 5d 20 46 41 4b 45 48 4f 4d 45 5f 24 74 63 6c r] FAKEHOME_$tcl
03b0: 5f 70 6c 61 74 66 6f 72 6d 28 75 73 65 72 29 5d _platform(user)]
03c0: 0a 09 09 63 61 74 63 68 20 7b 0a 09 09 09 66 69 ...catch {....fi
03d0: 6c 65 20 6d 6b 64 69 72 20 24 3a 3a 65 6e 76 28 le mkdir $::env(
03e0: 48 4f 4d 45 29 0a 09 09 7d 0a 0a 09 09 72 65 74 HOME)...}....ret
03f0: 75 72 6e 20 24 3a 3a 65 6e 76 28 48 4f 4d 45 29 urn $::env(HOME)
0400: 0a 09 7d 0a 0a 09 70 72 6f 63 20 5f 5f 75 6e 7a ..}...proc __unz
0410: 69 70 20 7b 64 69 72 20 66 69 6c 65 7d 20 7b 0a ip {dir file} {.
0420: 09 09 66 69 6c 65 20 6d 6b 64 69 72 20 24 64 69 ..file mkdir $di
0430: 72 0a 09 09 69 66 20 7b 24 3a 3a 74 65 61 70 6f r...if {$::teapo
0440: 74 63 6c 69 65 6e 74 3a 3a 68 61 76 65 5f 76 66 tclient::have_vf
0450: 73 7a 69 70 7d 20 7b 0a 09 09 09 73 65 74 20 6d szip} {....set m
0460: 6e 74 66 64 20 5b 76 66 73 3a 3a 7a 69 70 3a 3a ntfd [vfs::zip::
0470: 4d 6f 75 6e 74 20 24 66 69 6c 65 20 24 66 69 6c Mount $file $fil
0480: 65 5d 0a 0a 09 09 09 66 6f 72 65 61 63 68 20 66 e].....foreach f
0490: 69 6c 65 74 61 69 6c 20 5b 67 6c 6f 62 20 2d 6e iletail [glob -n
04a0: 6f 63 6f 6d 70 6c 61 69 6e 20 2d 74 61 69 6c 73 ocomplain -tails
04b0: 20 2d 64 69 72 65 63 74 6f 72 79 20 24 66 69 6c -directory $fil
04c0: 65 20 2a 5d 20 7b 0a 09 09 09 09 73 65 74 20 73 e *] {.....set s
04d0: 72 63 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 rcfile [file joi
04e0: 6e 20 24 66 69 6c 65 20 24 66 69 6c 65 74 61 69 n $file $filetai
04f0: 6c 5d 0a 09 09 09 09 73 65 74 20 64 65 73 74 64 l].....set destd
0500: 69 72 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 ir [file dirname
0510: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72 [file join $dir
0520: 20 24 66 69 6c 65 74 61 69 6c 5d 5d 0a 09 09 09 $filetail]]....
0530: 09 66 69 6c 65 20 63 6f 70 79 20 2d 66 6f 72 63 .file copy -forc
0540: 65 20 2d 2d 20 24 73 72 63 66 69 6c 65 20 24 64 e -- $srcfile $d
0550: 65 73 74 64 69 72 0a 09 09 09 7d 0a 0a 09 09 09 estdir....}.....
0560: 76 66 73 3a 3a 7a 69 70 3a 3a 55 6e 6d 6f 75 6e vfs::zip::Unmoun
0570: 74 20 24 6d 6e 74 66 64 20 24 66 69 6c 65 0a 09 t $mntfd $file..
0580: 09 7d 20 65 6c 73 65 20 7b 0a 09 09 09 65 78 65 .} else {....exe
0590: 63 20 75 6e 7a 69 70 20 2d 64 20 24 64 69 72 20 c unzip -d $dir
05a0: 2d 6e 20 2d 71 71 20 24 66 69 6c 65 0a 09 09 7d -n -qq $file...}
05b0: 0a 09 7d 0a 0a 09 70 72 6f 63 20 5f 5f 69 73 43 ..}...proc __isC
05c0: 6f 6d 70 61 74 69 62 6c 65 43 50 55 20 7b 74 65 ompatibleCPU {te
05d0: 61 70 6f 74 20 6c 6f 63 61 6c 7d 20 7b 0a 09 7d apot local} {..}
05e0: 0a 0a 09 70 72 6f 63 20 5f 5f 69 73 43 6f 6d 70 ...proc __isComp
05f0: 61 74 69 62 6c 65 4f 53 20 7b 74 65 61 70 6f 74 atibleOS {teapot
0600: 20 6c 6f 63 61 6c 7d 20 7b 0a 09 7d 0a 0a 09 73 local} {..}...s
0610: 65 74 20 70 6b 67 63 61 63 68 65 64 69 72 20 5b et pkgcachedir [
0620: 66 69 6c 65 20 6a 6f 69 6e 20 5b 5f 5f 67 65 74 file join [__get
0630: 5f 68 6f 6d 65 64 69 72 5d 20 22 2e 74 65 61 70 _homedir] ".teap
0640: 6f 74 2d 63 6c 69 65 6e 74 22 20 22 63 61 63 68 ot-client" "cach
0650: 65 64 69 72 22 5d 0a 0a 20 20 20 20 20 20 20 20 edir"]..
0660: 23 20 43 6f 6e 76 65 72 73 69 6f 6e 73 20 66 72 # Conversions fr
0670: 6f 6d 20 54 65 61 70 6f 74 2d 73 74 79 6c 65 20 om Teapot-style
0680: 6e 61 6d 65 73 20 74 6f 20 6c 6f 63 61 6c 20 6f names to local o
0690: 6e 65 73 0a 09 73 65 74 20 6f 73 54 65 61 70 6f nes..set osTeapo
06a0: 74 54 6f 4c 6f 63 61 6c 28 74 63 6c 29 20 5b 6c tToLocal(tcl) [l
06b0: 69 73 74 20 2a 5d 0a 09 73 65 74 20 6f 73 54 65 ist *]..set osTe
06c0: 61 70 6f 74 54 6f 4c 6f 63 61 6c 28 6c 69 6e 75 apotToLocal(linu
06d0: 78 2d 2a 29 20 5b 6c 69 73 74 20 6c 69 6e 75 78 x-*) [list linux
06e0: 5d 0a 09 73 65 74 20 6f 73 54 65 61 70 6f 74 54 ]..set osTeapotT
06f0: 6f 4c 6f 63 61 6c 28 77 69 6e 33 32 29 20 5b 6c oLocal(win32) [l
0700: 69 73 74 20 77 69 6e 64 6f 77 73 5d 0a 09 73 65 ist windows]..se
0710: 74 20 6f 73 54 65 61 70 6f 74 54 6f 4c 6f 63 61 t osTeapotToLoca
0720: 6c 28 73 6f 6c 61 72 69 73 2a 29 20 5b 6c 69 73 l(solaris*) [lis
0730: 74 20 73 6f 6c 61 72 69 73 20 73 75 6e 6f 73 5d t solaris sunos]
0740: 0a 09 73 65 74 20 6f 73 54 65 61 70 6f 74 54 6f ..set osTeapotTo
0750: 4c 6f 63 61 6c 28 66 72 65 65 62 73 64 29 20 5b Local(freebsd) [
0760: 6c 69 73 74 20 66 72 65 65 62 73 64 5f 2a 5d 0a list freebsd_*].
0770: 09 73 65 74 20 6f 73 54 65 61 70 6f 74 54 6f 4c .set osTeapotToL
0780: 6f 63 61 6c 28 69 72 69 78 29 20 5b 6c 69 73 74 ocal(irix) [list
0790: 20 69 72 69 78 5f 2a 5d 0a 0a 09 73 65 74 20 63 irix_*]...set c
07a0: 70 75 54 65 61 70 6f 74 54 6f 4c 6f 63 61 6c 28 puTeapotToLocal(
07b0: 69 78 38 36 29 20 5b 6c 69 73 74 20 78 38 36 20 ix86) [list x86
07c0: 69 6e 74 65 6c 20 69 3f 38 36 20 69 38 36 70 63 intel i?86 i86pc
07d0: 5d 0a 09 73 65 74 20 63 70 75 54 65 61 70 6f 74 ]..set cpuTeapot
07e0: 54 6f 4c 6f 63 61 6c 28 73 70 61 72 63 29 20 5b ToLocal(sparc) [
07f0: 6c 69 73 74 20 73 75 6e 34 2a 5d 0a 09 73 65 74 list sun4*]..set
0800: 20 63 70 75 54 65 61 70 6f 74 54 6f 4c 6f 63 61 cpuTeapotToLoca
0810: 6c 28 73 70 61 72 63 36 34 29 20 5b 6c 69 73 74 l(sparc64) [list
0820: 20 73 75 6e 34 75 20 73 75 6e 34 76 5d 0a 09 73 sun4u sun4v]..s
0830: 65 74 20 63 70 75 54 65 61 70 6f 74 54 6f 4c 6f et cpuTeapotToLo
0840: 63 61 6c 28 75 6e 69 76 65 72 73 61 6c 29 20 5b cal(universal) [
0850: 6c 69 73 74 20 2a 5d 0a 09 73 65 74 20 63 70 75 list *]..set cpu
0860: 54 65 61 70 6f 74 54 6f 4c 6f 63 61 6c 28 70 6f TeapotToLocal(po
0870: 77 65 72 70 63 29 20 5b 6c 69 73 74 20 70 70 63 werpc) [list ppc
0880: 5d 0a 0a 09 70 72 6f 63 20 64 6f 77 6e 6c 6f 61 ]...proc downloa
0890: 64 5f 65 78 74 65 6e 73 69 6f 6e 73 20 7b 72 6f d_extensions {ro
08a0: 6f 74 64 69 72 20 73 65 72 76 65 72 73 20 65 78 otdir servers ex
08b0: 74 65 6e 73 69 6f 6e 73 20 6f 73 20 63 70 75 20 tensions os cpu
08c0: 7b 65 78 69 73 74 69 6e 67 45 78 74 73 20 22 22 {existingExts ""
08d0: 7d 7d 20 7b 0a 09 09 66 6f 72 65 61 63 68 20 63 }} {...foreach c
08e0: 68 6b 64 65 66 65 78 74 20 5b 6c 69 73 74 20 54 hkdefext [list T
08f0: 63 6c 20 54 6b 20 6d 73 67 63 61 74 5d 20 7b 0a cl Tk msgcat] {.
0900: 09 09 09 69 66 20 7b 5b 6c 73 65 61 72 63 68 20 ...if {[lsearch
0910: 2d 65 78 61 63 74 20 24 65 78 69 73 74 69 6e 67 -exact $existing
0920: 45 78 74 73 20 24 63 68 6b 64 65 66 65 78 74 5d Exts $chkdefext]
0930: 20 3d 3d 20 2d 31 7d 20 7b 0a 09 09 09 09 6c 61 == -1} {.....la
0940: 70 70 65 6e 64 20 65 78 69 73 74 69 6e 67 45 78 ppend existingEx
0950: 74 73 20 24 63 68 6b 64 65 66 65 78 74 0a 09 09 ts $chkdefext...
0960: 09 7d 0a 09 09 7d 0a 09 09 66 6f 72 65 61 63 68 .}...}...foreach
0970: 20 73 65 72 76 65 72 20 24 73 65 72 76 65 72 73 server $servers
0980: 20 7b 0a 09 09 09 66 6f 72 65 61 63 68 20 7b 70 {....foreach {p
0990: 6b 67 20 70 6b 67 69 6e 66 6f 7d 20 5b 67 65 74 kg pkginfo} [get
09a0: 5f 65 78 74 65 6e 73 69 6f 6e 73 20 24 73 65 72 _extensions $ser
09b0: 76 65 72 20 24 6f 73 20 24 63 70 75 5d 20 7b 0a ver $os $cpu] {.
09c0: 09 09 09 09 66 6f 72 65 61 63 68 20 70 6b 67 69 ....foreach pkgi
09d0: 6e 73 74 61 6e 63 65 20 24 70 6b 67 69 6e 66 6f nstance $pkginfo
09e0: 20 7b 0a 09 09 09 09 09 6c 61 70 70 65 6e 64 20 {......lappend
09f0: 70 6b 67 69 6e 73 74 61 6e 63 65 20 24 73 65 72 pkginstance $ser
0a00: 76 65 72 0a 09 09 09 09 09 6c 61 70 70 65 6e 64 ver......lappend
0a10: 20 70 6b 67 64 61 74 61 28 24 70 6b 67 29 20 24 pkgdata($pkg) $
0a20: 70 6b 67 69 6e 73 74 61 6e 63 65 0a 09 09 09 09 pkginstance.....
0a30: 7d 0a 09 09 09 7d 0a 09 09 7d 0a 0a 09 09 66 6f }....}...}....fo
0a40: 72 65 61 63 68 20 70 6b 67 20 5b 61 72 72 61 79 reach pkg [array
0a50: 20 6e 61 6d 65 73 20 70 6b 67 64 61 74 61 5d 20 names pkgdata]
0a60: 7b 0a 09 09 09 73 65 74 20 70 6b 67 64 61 74 61 {....set pkgdata
0a70: 28 24 70 6b 67 29 20 5b 6c 73 6f 72 74 20 2d 64 ($pkg) [lsort -d
0a80: 65 63 72 65 61 73 69 6e 67 20 2d 64 69 63 74 69 ecreasing -dicti
0a90: 6f 6e 61 72 79 20 24 70 6b 67 64 61 74 61 28 24 onary $pkgdata($
0aa0: 70 6b 67 29 5d 0a 09 09 7d 0a 0a 09 09 61 72 72 pkg)]...}....arr
0ab0: 61 79 20 73 65 74 20 65 78 74 44 65 70 65 6e 64 ay set extDepend
0ac0: 65 6e 63 69 65 73 20 5b 6c 69 73 74 5d 0a 09 09 encies [list]...
0ad0: 66 6f 72 65 61 63 68 20 65 78 74 65 6e 73 69 6f foreach extensio
0ae0: 6e 20 24 65 78 74 65 6e 73 69 6f 6e 73 20 7b 0a n $extensions {.
0af0: 09 09 09 73 65 74 20 65 78 74 65 6e 73 69 6f 6e ...set extension
0b00: 20 5b 66 69 6c 65 20 74 61 69 6c 20 24 65 78 74 [file tail $ext
0b10: 65 6e 73 69 6f 6e 5d 0a 0a 09 09 09 69 66 20 7b ension].....if {
0b20: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6b ![info exists pk
0b30: 67 64 61 74 61 28 24 65 78 74 65 6e 73 69 6f 6e gdata($extension
0b40: 29 5d 7d 20 7b 0a 09 09 09 09 63 6f 6e 74 69 6e )]} {.....contin
0b50: 75 65 0a 09 09 09 7d 0a 0a 09 09 09 73 65 74 20 ue....}.....set
0b60: 70 6b 67 69 6e 66 6f 20 5b 6c 69 6e 64 65 78 20 pkginfo [lindex
0b70: 24 70 6b 67 64 61 74 61 28 24 65 78 74 65 6e 73 $pkgdata($extens
0b80: 69 6f 6e 29 20 30 5d 0a 0a 09 09 09 73 65 74 20 ion) 0].....set
0b90: 76 65 72 20 5b 6c 69 6e 64 65 78 20 24 70 6b 67 ver [lindex $pkg
0ba0: 69 6e 66 6f 20 30 5d 0a 09 09 09 73 65 74 20 61 info 0]....set a
0bb0: 72 63 68 20 5b 6c 69 6e 64 65 78 20 24 70 6b 67 rch [lindex $pkg
0bc0: 69 6e 66 6f 20 31 5d 0a 09 09 09 73 65 74 20 73 info 1]....set s
0bd0: 65 72 76 65 72 20 5b 6c 69 6e 64 65 78 20 24 70 erver [lindex $p
0be0: 6b 67 69 6e 66 6f 20 32 5d 0a 0a 09 09 09 73 65 kginfo 2].....se
0bf0: 74 20 70 6b 67 64 69 72 20 5b 66 69 6c 65 20 6a t pkgdir [file j
0c00: 6f 69 6e 20 24 72 6f 6f 74 64 69 72 20 24 65 78 oin $rootdir $ex
0c10: 74 65 6e 73 69 6f 6e 24 76 65 72 5d 0a 09 09 09 tension$ver]....
0c20: 66 69 6c 65 20 6d 6b 64 69 72 20 24 70 6b 67 64 file mkdir $pkgd
0c30: 69 72 20 24 3a 3a 74 65 61 70 6f 74 63 6c 69 65 ir $::teapotclie
0c40: 6e 74 3a 3a 70 6b 67 63 61 63 68 65 64 69 72 0a nt::pkgcachedir.
0c50: 0a 09 09 09 73 65 74 20 75 72 6c 20 22 68 74 74 ....set url "htt
0c60: 70 3a 2f 2f 24 73 65 72 76 65 72 2f 70 61 63 6b p://$server/pack
0c70: 61 67 65 2f 6e 61 6d 65 2f 24 65 78 74 65 6e 73 age/name/$extens
0c80: 69 6f 6e 2f 76 65 72 2f 24 76 65 72 2f 61 72 63 ion/ver/$ver/arc
0c90: 68 2f 24 61 72 63 68 2f 66 69 6c 65 22 0a 09 09 h/$arch/file"...
0ca0: 09 73 65 74 20 75 72 6c 63 61 63 68 65 66 69 6c .set urlcachefil
0cb0: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a e [file join $::
0cc0: 74 65 61 70 6f 74 63 6c 69 65 6e 74 3a 3a 70 6b teapotclient::pk
0cd0: 67 63 61 63 68 65 64 69 72 20 5b 3a 3a 6d 64 35 gcachedir [::md5
0ce0: 3a 3a 6d 64 35 20 2d 68 65 78 20 24 75 72 6c 5d ::md5 -hex $url]
0cf0: 5d 0a 0a 09 09 09 69 66 20 7b 21 5b 66 69 6c 65 ].....if {![file
0d00: 20 65 78 69 73 74 73 20 24 75 72 6c 63 61 63 68 exists $urlcach
0d10: 65 66 69 6c 65 5d 7d 20 7b 0a 09 09 09 09 73 65 efile]} {.....se
0d20: 74 20 74 6d 70 66 64 20 5b 6f 70 65 6e 20 24 75 t tmpfd [open $u
0d30: 72 6c 63 61 63 68 65 66 69 6c 65 20 77 5d 0a 09 rlcachefile w]..
0d40: 09 09 09 66 63 6f 6e 66 69 67 75 72 65 20 24 74 ...fconfigure $t
0d50: 6d 70 66 64 20 2d 65 6e 63 6f 64 69 6e 67 20 62 mpfd -encoding b
0d60: 69 6e 61 72 79 20 2d 74 72 61 6e 73 6c 61 74 69 inary -translati
0d70: 6f 6e 20 62 69 6e 61 72 79 20 2d 62 75 66 66 65 on binary -buffe
0d80: 72 69 6e 67 20 6e 6f 6e 65 0a 0a 09 09 09 09 73 ring none......s
0d90: 65 74 20 74 6f 6b 65 6e 20 5b 3a 3a 68 74 74 70 et token [::http
0da0: 3a 3a 67 65 74 75 72 6c 20 24 75 72 6c 20 2d 62 ::geturl $url -b
0db0: 69 6e 61 72 79 20 74 72 75 65 20 2d 63 68 61 6e inary true -chan
0dc0: 6e 65 6c 20 24 74 6d 70 66 64 5d 0a 0a 09 09 09 nel $tmpfd].....
0dd0: 09 3a 3a 68 74 74 70 3a 3a 63 6c 65 61 6e 75 70 .::http::cleanup
0de0: 20 24 74 6f 6b 65 6e 0a 09 09 09 09 63 6c 6f 73 $token.....clos
0df0: 65 20 24 74 6d 70 66 64 0a 09 09 09 7d 0a 0a 09 e $tmpfd....}...
0e00: 09 09 73 65 74 20 72 65 74 61 72 72 28 24 65 78 ..set retarr($ex
0e10: 74 65 6e 73 69 6f 6e 29 20 5b 6c 69 73 74 20 24 tension) [list $
0e20: 76 65 72 20 24 61 72 63 68 20 24 73 65 72 76 65 ver $arch $serve
0e30: 72 5d 0a 09 09 09 73 77 69 74 63 68 20 2d 72 65 r]....switch -re
0e40: 67 65 78 70 20 2d 2d 20 5b 3a 3a 66 69 6c 65 75 gexp -- [::fileu
0e50: 74 69 6c 3a 3a 66 69 6c 65 54 79 70 65 20 24 75 til::fileType $u
0e60: 72 6c 63 61 63 68 65 66 69 6c 65 5d 20 7b 0a 09 rlcachefile] {..
0e70: 09 09 09 22 28 5e 7c 20 29 7a 69 70 28 24 7c 20 ..."(^| )zip($|
0e80: 29 22 20 7b 0a 09 09 09 09 09 63 61 74 63 68 20 )" {......catch
0e90: 7b 0a 09 09 09 09 09 09 5f 5f 75 6e 7a 69 70 20 {.......__unzip
0ea0: 24 70 6b 67 64 69 72 20 24 75 72 6c 63 61 63 68 $pkgdir $urlcach
0eb0: 65 66 69 6c 65 0a 09 09 09 09 09 7d 0a 0a 09 09 efile......}....
0ec0: 09 09 09 23 20 50 72 6f 63 65 73 73 20 24 70 6b ...# Process $pk
0ed0: 67 64 69 72 2f 74 65 61 70 6f 74 2e 74 78 74 0a gdir/teapot.txt.
0ee0: 09 09 09 09 09 73 65 74 20 74 65 61 70 6f 74 20 .....set teapot
0ef0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 70 6b 67 64 [file join $pkgd
0f00: 69 72 20 74 65 61 70 6f 74 2e 74 78 74 5d 0a 09 ir teapot.txt]..
0f10: 09 09 09 09 69 66 20 7b 5b 66 69 6c 65 20 65 78 ....if {[file ex
0f20: 69 73 74 73 20 24 74 65 61 70 6f 74 5d 7d 20 7b ists $teapot]} {
0f30: 0a 09 09 09 09 09 09 73 65 74 20 66 64 20 5b 6f .......set fd [o
0f40: 70 65 6e 20 24 74 65 61 70 6f 74 20 72 5d 0a 09 pen $teapot r]..
0f50: 09 09 09 09 09 66 6f 72 20 7b 67 65 74 73 20 24 .....for {gets $
0f60: 66 64 20 6c 69 6e 65 7d 20 7b 21 5b 65 6f 66 20 fd line} {![eof
0f70: 24 66 64 5d 7d 20 7b 67 65 74 73 20 24 66 64 20 $fd]} {gets $fd
0f80: 6c 69 6e 65 7d 20 7b 0a 09 09 09 09 09 09 09 69 line} {........i
0f90: 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 f {[string match
0fa0: 20 22 4d 65 74 61 20 72 65 71 75 69 72 65 20 2a "Meta require *
0fb0: 22 20 24 6c 69 6e 65 5d 7d 20 7b 0a 09 09 09 09 " $line]} {.....
0fc0: 09 09 09 09 73 65 74 20 64 65 70 69 6e 66 6f 20 ....set depinfo
0fd0: 5b 6c 69 6e 64 65 78 20 24 6c 69 6e 65 20 32 5d [lindex $line 2]
0fe0: 0a 09 09 09 09 09 09 09 09 73 65 74 20 64 65 70 .........set dep
0ff0: 20 5b 6c 69 6e 64 65 78 20 24 64 65 70 69 6e 66 [lindex $depinf
1000: 6f 20 30 5d 0a 09 09 09 09 09 09 09 09 73 65 74 o 0].........set
1010: 20 64 65 70 65 78 74 72 61 20 5b 6c 72 61 6e 67 depextra [lrang
1020: 65 20 24 64 65 70 69 6e 66 6f 20 31 20 65 6e 64 e $depinfo 1 end
1030: 5d 0a 09 09 09 09 09 09 09 09 6c 61 70 70 65 6e ].........lappen
1040: 64 20 65 78 74 44 65 70 65 6e 64 65 6e 63 69 65 d extDependencie
1050: 73 28 24 64 65 70 29 20 24 64 65 70 65 78 74 72 s($dep) $depextr
1060: 61 0a 09 09 09 09 09 09 09 7d 0a 09 09 09 09 09 a........}......
1070: 09 7d 0a 09 09 09 09 09 09 63 6c 6f 73 65 20 24 .}.......close $
1080: 66 64 0a 09 09 09 09 09 7d 0a 09 09 09 09 7d 0a fd......}.....}.
1090: 09 09 09 09 22 28 5e 7c 20 29 74 65 78 74 28 24 ...."(^| )text($
10a0: 7c 20 29 22 20 7b 0a 09 09 09 09 09 75 6e 73 65 | )" {......unse
10b0: 74 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 66 64 t -nocomplain fd
10c0: 0a 0a 09 09 09 09 09 73 65 74 20 65 78 74 66 69 .......set extfi
10d0: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 70 le [file join $p
10e0: 6b 67 64 69 72 20 24 7b 65 78 74 65 6e 73 69 6f kgdir ${extensio
10f0: 6e 7d 2e 74 63 6c 5d 0a 09 09 09 09 09 73 65 74 n}.tcl]......set
1100: 20 69 64 78 66 69 6c 65 20 5b 66 69 6c 65 20 6a idxfile [file j
1110: 6f 69 6e 20 24 70 6b 67 64 69 72 20 70 6b 67 49 oin $pkgdir pkgI
1120: 6e 64 65 78 2e 74 63 6c 5d 0a 0a 09 09 09 09 09 ndex.tcl].......
1130: 63 61 74 63 68 20 7b 0a 09 09 09 09 09 09 66 69 catch {.......fi
1140: 6c 65 20 63 6f 70 79 20 2d 66 6f 72 63 65 20 2d le copy -force -
1150: 2d 20 24 75 72 6c 63 61 63 68 65 66 69 6c 65 20 - $urlcachefile
1160: 24 65 78 74 66 69 6c 65 0a 0a 09 09 09 09 09 09 $extfile........
1170: 73 65 74 20 66 64 20 5b 6f 70 65 6e 20 24 69 64 set fd [open $id
1180: 78 66 69 6c 65 20 77 5d 0a 09 09 09 09 09 09 70 xfile w].......p
1190: 75 74 73 20 24 66 64 20 22 70 61 63 6b 61 67 65 uts $fd "package
11a0: 20 69 66 6e 65 65 64 65 64 20 24 65 78 74 65 6e ifneeded $exten
11b0: 73 69 6f 6e 20 24 76 65 72 20 5c 5b 6c 69 73 74 sion $ver \[list
11c0: 20 73 6f 75 72 63 65 20 5c 5b 66 69 6c 65 20 6a source \[file j
11d0: 6f 69 6e 20 5c 24 64 69 72 20 5b 66 69 6c 65 20 oin \$dir [file
11e0: 74 61 69 6c 20 24 65 78 74 66 69 6c 65 5d 5c 5d tail $extfile]\]
11f0: 5c 5d 22 0a 09 09 09 09 09 7d 0a 0a 09 09 09 09 \]"......}......
1200: 09 63 61 74 63 68 20 7b 0a 09 09 09 09 09 09 63 .catch {.......c
1210: 6c 6f 73 65 20 24 66 64 0a 09 09 09 09 09 7d 0a lose $fd......}.
1220: 0a 09 09 09 09 09 23 20 50 72 6f 63 65 73 73 20 ......# Process
1230: 24 65 78 74 66 69 6c 65 0a 09 09 09 09 09 73 65 $extfile......se
1240: 74 20 66 64 20 5b 6f 70 65 6e 20 24 65 78 74 66 t fd [open $extf
1250: 69 6c 65 20 72 5d 0a 09 09 09 09 09 66 6f 72 20 ile r]......for
1260: 7b 67 65 74 73 20 24 66 64 20 6c 69 6e 65 7d 20 {gets $fd line}
1270: 7b 21 5b 65 6f 66 20 24 66 64 5d 7d 20 7b 67 65 {![eof $fd]} {ge
1280: 74 73 20 24 66 64 20 6c 69 6e 65 7d 20 7b 0a 09 ts $fd line} {..
1290: 09 09 09 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 .....if {[string
12a0: 20 6d 61 74 63 68 20 22 23 20 4d 65 74 61 20 72 match "# Meta r
12b0: 65 71 75 69 72 65 20 2a 22 20 24 6c 69 6e 65 5d equire *" $line]
12c0: 7d 20 7b 0a 09 09 09 09 09 09 09 73 65 74 20 64 } {........set d
12d0: 65 70 69 6e 66 6f 20 5b 6c 69 6e 64 65 78 20 24 epinfo [lindex $
12e0: 6c 69 6e 65 20 33 5d 0a 09 09 09 09 09 09 09 73 line 3]........s
12f0: 65 74 20 64 65 70 20 5b 6c 69 6e 64 65 78 20 24 et dep [lindex $
1300: 64 65 70 69 6e 66 6f 20 30 5d 0a 09 09 09 09 09 depinfo 0]......
1310: 09 09 73 65 74 20 64 65 70 65 78 74 72 61 20 5b ..set depextra [
1320: 6c 72 61 6e 67 65 20 24 64 65 70 69 6e 66 6f 20 lrange $depinfo
1330: 31 20 65 6e 64 5d 0a 09 09 09 09 09 09 09 6c 61 1 end]........la
1340: 70 70 65 6e 64 20 65 78 74 44 65 70 65 6e 64 65 ppend extDepende
1350: 6e 63 69 65 73 28 24 64 65 70 29 20 24 64 65 70 ncies($dep) $dep
1360: 65 78 74 72 61 0a 09 09 09 09 09 09 7d 0a 09 09 extra.......}...
1370: 09 09 09 7d 0a 09 09 09 09 09 63 6c 6f 73 65 20 ...}......close
1380: 24 66 64 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 09 $fd.....}....}..
1390: 09 7d 0a 0a 09 09 66 6f 72 65 61 63 68 20 7b 64 .}....foreach {d
13a0: 65 70 20 64 65 70 69 6e 66 6f 7d 20 5b 61 72 72 ep depinfo} [arr
13b0: 61 79 20 67 65 74 20 65 78 74 44 65 70 65 6e 64 ay get extDepend
13c0: 65 6e 63 69 65 73 5d 20 7b 0a 09 09 09 73 65 74 encies] {....set
13d0: 20 64 65 70 52 65 71 20 2d 31 0a 09 09 09 66 6f depReq -1....fo
13e0: 72 65 61 63 68 20 64 65 70 69 6e 73 74 69 6e 66 reach depinstinf
13f0: 6f 20 24 64 65 70 69 6e 66 6f 20 7b 0a 09 09 09 o $depinfo {....
1400: 09 73 65 74 20 64 65 70 76 65 72 20 5b 6c 69 6e .set depver [lin
1410: 64 65 78 20 24 64 65 70 69 6e 73 74 69 6e 66 6f dex $depinstinfo
1420: 20 30 5d 0a 09 09 09 09 73 65 74 20 64 65 70 69 0].....set depi
1430: 6e 73 74 69 6e 66 6f 20 5b 6c 72 61 6e 67 65 20 nstinfo [lrange
1440: 24 64 65 70 69 6e 73 74 69 6e 66 6f 20 31 20 65 $depinstinfo 1 e
1450: 6e 64 5d 0a 0a 09 09 09 09 66 6f 72 65 61 63 68 nd]......foreach
1460: 20 7b 76 61 72 20 76 61 6c 7d 20 24 64 65 70 69 {var val} $depi
1470: 6e 73 74 69 6e 66 6f 20 7b 0a 09 09 09 09 09 73 nstinfo {......s
1480: 77 69 74 63 68 20 2d 2d 20 24 76 61 72 20 7b 0a witch -- $var {.
1490: 09 09 09 09 09 09 22 2d 70 6c 61 74 66 6f 72 6d ......"-platform
14a0: 22 20 7b 0a 09 09 09 09 09 09 09 69 66 20 7b 24 " {........if {$
14b0: 76 61 6c 20 21 3d 20 24 6f 73 7d 20 7b 0a 09 09 val != $os} {...
14c0: 09 09 09 09 09 09 69 66 20 7b 24 64 65 70 52 65 ......if {$depRe
14d0: 71 20 3d 3d 20 2d 31 7d 20 7b 0a 09 09 09 09 09 q == -1} {......
14e0: 09 09 09 09 73 65 74 20 64 65 70 52 65 71 20 30 ....set depReq 0
14f0: 0a 09 09 09 09 09 09 09 09 7d 0a 09 09 09 09 09 .........}......
1500: 09 09 7d 0a 09 09 09 09 09 09 7d 0a 09 09 09 09 ..}.......}.....
1510: 09 7d 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 0a 09 .}.....}....}...
1520: 09 09 69 66 20 7b 24 64 65 70 52 65 71 20 3d 3d ..if {$depReq ==
1530: 20 30 7d 20 7b 0a 09 09 09 09 63 6f 6e 74 69 6e 0} {.....contin
1540: 75 65 0a 09 09 09 7d 0a 0a 09 09 09 69 66 20 7b ue....}.....if {
1550: 5b 6c 73 65 61 72 63 68 20 24 65 78 69 73 74 69 [lsearch $existi
1560: 6e 67 45 78 74 73 20 24 64 65 70 5d 20 3d 3d 20 ngExts $dep] ==
1570: 2d 31 7d 20 7b 0a 09 09 09 09 6c 61 70 70 65 6e -1} {.....lappen
1580: 64 20 65 78 69 73 74 69 6e 67 45 78 74 73 20 24 d existingExts $
1590: 64 65 70 0a 09 09 09 09 6c 61 70 70 65 6e 64 20 dep.....lappend
15a0: 66 65 74 63 68 44 65 70 73 20 24 64 65 70 0a 09 fetchDeps $dep..
15b0: 09 09 7d 0a 09 09 7d 0a 0a 09 09 69 66 20 7b 5b ..}...}....if {[
15c0: 69 6e 66 6f 20 65 78 69 73 74 73 20 66 65 74 63 info exists fetc
15d0: 68 44 65 70 73 5d 7d 20 7b 0a 09 09 09 73 65 74 hDeps]} {....set
15e0: 20 61 64 64 52 65 74 20 5b 64 6f 77 6e 6c 6f 61 addRet [downloa
15f0: 64 5f 65 78 74 65 6e 73 69 6f 6e 73 20 24 72 6f d_extensions $ro
1600: 6f 74 64 69 72 20 24 73 65 72 76 65 72 73 20 24 otdir $servers $
1610: 66 65 74 63 68 44 65 70 73 20 24 6f 73 20 24 63 fetchDeps $os $c
1620: 70 75 20 24 65 78 69 73 74 69 6e 67 45 78 74 73 pu $existingExts
1630: 5d 0a 09 09 09 61 72 72 61 79 20 73 65 74 20 72 ]....array set r
1640: 65 74 61 72 72 20 24 61 64 64 52 65 74 0a 09 09 etarr $addRet...
1650: 7d 0a 0a 09 09 72 65 74 75 72 6e 20 5b 61 72 72 }....return [arr
1660: 61 79 20 67 65 74 20 72 65 74 61 72 72 5d 0a 09 ay get retarr]..
1670: 7d 0a 0a 09 70 72 6f 63 20 67 65 74 5f 65 78 74 }...proc get_ext
1680: 65 6e 73 69 6f 6e 73 20 7b 73 65 72 76 65 72 20 ensions {server
1690: 7b 6c 69 6d 69 74 6f 73 20 22 2a 22 7d 20 7b 6c {limitos "*"} {l
16a0: 69 6d 69 74 63 70 75 20 22 2a 22 7d 7d 20 7b 0a imitcpu "*"}} {.
16b0: 09 09 75 70 76 61 72 20 3a 3a 74 65 61 70 6f 74 ..upvar ::teapot
16c0: 63 6c 69 65 6e 74 3a 3a 6f 73 54 65 61 70 6f 74 client::osTeapot
16d0: 54 6f 4c 6f 63 61 6c 20 6f 73 54 65 61 70 6f 74 ToLocal osTeapot
16e0: 54 6f 4c 6f 63 61 6c 0a 09 09 75 70 76 61 72 20 ToLocal...upvar
16f0: 3a 3a 74 65 61 70 6f 74 63 6c 69 65 6e 74 3a 3a ::teapotclient::
1700: 63 70 75 54 65 61 70 6f 74 54 6f 4c 6f 63 61 6c cpuTeapotToLocal
1710: 20 63 70 75 54 65 61 70 6f 74 54 6f 4c 6f 63 61 cpuTeapotToLoca
1720: 6c 0a 0a 09 09 66 69 6c 65 20 6d 6b 64 69 72 20 l....file mkdir
1730: 24 3a 3a 74 65 61 70 6f 74 63 6c 69 65 6e 74 3a $::teapotclient:
1740: 3a 70 6b 67 63 61 63 68 65 64 69 72 0a 09 09 73 :pkgcachedir...s
1750: 65 74 20 63 61 63 68 65 66 69 6c 65 20 5b 66 69 et cachefile [fi
1760: 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 65 61 70 6f le join $::teapo
1770: 74 63 6c 69 65 6e 74 3a 3a 70 6b 67 63 61 63 68 tclient::pkgcach
1780: 65 64 69 72 20 54 45 41 50 4f 54 49 4e 46 4f 2d edir TEAPOTINFO-
1790: 5b 3a 3a 6d 64 35 3a 3a 6d 64 35 20 2d 68 65 78 [::md5::md5 -hex
17a0: 20 24 73 65 72 76 65 72 5d 5d 0a 09 09 0a 09 09 $server]]......
17b0: 73 65 74 20 63 75 72 72 74 69 6d 65 20 5b 63 6c set currtime [cl
17c0: 6f 63 6b 20 73 65 63 6f 6e 64 73 5d 0a 0a 09 09 ock seconds]....
17d0: 69 66 20 7b 5b 66 69 6c 65 20 65 78 69 73 74 73 if {[file exists
17e0: 20 24 63 61 63 68 65 66 69 6c 65 5d 7d 20 7b 0a $cachefile]} {.
17f0: 09 09 09 63 61 74 63 68 20 7b 0a 09 09 09 09 73 ...catch {.....s
1800: 65 74 20 66 64 20 5b 6f 70 65 6e 20 24 63 61 63 et fd [open $cac
1810: 68 65 66 69 6c 65 20 72 5d 0a 09 09 09 09 73 65 hefile r].....se
1820: 74 20 64 61 74 61 20 5b 72 65 61 64 20 24 66 64 t data [read $fd
1830: 5d 0a 09 09 09 09 63 6c 6f 73 65 20 24 66 64 0a ].....close $fd.
1840: 0a 09 09 09 09 73 65 74 20 64 61 74 61 74 69 6d .....set datatim
1850: 65 20 5b 6c 69 6e 64 65 78 20 24 64 61 74 61 20 e [lindex $data
1860: 30 5d 0a 09 09 09 09 69 66 20 7b 28 24 63 75 72 0].....if {($cur
1870: 72 74 69 6d 65 20 2d 20 24 64 61 74 61 74 69 6d rtime - $datatim
1880: 65 29 20 3c 20 38 36 34 30 30 7d 20 7b 0a 09 09 e) < 86400} {...
1890: 09 09 09 73 65 74 20 63 68 69 6c 64 72 65 6e 20 ...set children
18a0: 5b 6c 69 6e 64 65 78 20 24 64 61 74 61 20 31 5d [lindex $data 1]
18b0: 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 09 09 7d 0a .....}....}...}.
18c0: 0a 09 09 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 ...if {![info ex
18d0: 69 73 74 73 20 63 68 69 6c 64 72 65 6e 5d 7d 20 ists children]}
18e0: 7b 0a 09 09 09 70 61 63 6b 61 67 65 20 72 65 71 {....package req
18f0: 75 69 72 65 20 68 74 74 70 0a 0a 09 09 09 73 65 uire http.....se
1900: 74 20 75 72 6c 20 22 68 74 74 70 3a 2f 2f 5b 6a t url "http://[j
1910: 6f 69 6e 20 5b 6c 69 73 74 20 24 73 65 72 76 65 oin [list $serve
1920: 72 20 70 61 63 6b 61 67 65 20 6c 69 73 74 5d 20 r package list]
1930: 2f 5d 22 0a 0a 09 09 09 73 65 74 20 74 6f 6b 65 /]".....set toke
1940: 6e 20 5b 3a 3a 68 74 74 70 3a 3a 67 65 74 75 72 n [::http::getur
1950: 6c 20 24 75 72 6c 5d 0a 09 09 09 69 66 20 7b 5b l $url]....if {[
1960: 3a 3a 68 74 74 70 3a 3a 6e 63 6f 64 65 20 24 74 ::http::ncode $t
1970: 6f 6b 65 6e 5d 20 21 3d 20 22 32 30 30 22 7d 20 oken] != "200"}
1980: 7b 0a 09 09 09 09 72 65 74 75 72 6e 20 5b 6c 69 {.....return [li
1990: 73 74 5d 0a 09 09 09 7d 0a 0a 09 09 09 73 65 74 st]....}.....set
19a0: 20 64 61 74 61 20 5b 3a 3a 68 74 74 70 3a 3a 64 data [::http::d
19b0: 61 74 61 20 24 74 6f 6b 65 6e 5d 0a 09 09 09 3a ata $token]....:
19c0: 3a 68 74 74 70 3a 3a 63 6c 65 61 6e 75 70 20 24 :http::cleanup $
19d0: 74 6f 6b 65 6e 0a 0a 09 09 09 73 65 74 20 77 6f token.....set wo
19e0: 72 6b 20 5b 6a 6f 69 6e 20 5b 73 70 6c 69 74 20 rk [join [split
19f0: 24 64 61 74 61 20 5c 6e 5d 20 7b 20 7d 5d 0a 09 $data \n] { }]..
1a00: 09 09 72 65 67 65 78 70 20 7b 5c 5b 5c 5b 54 50 ..regexp {\[\[TP
1a10: 4d 5c 5b 5c 5b 28 2e 2a 29 5c 5d 5c 5d 4d 50 54 M\[\[(.*)\]\]MPT
1a20: 5c 5d 5c 5d 7d 20 24 77 6f 72 6b 20 2d 3e 20 63 \]\]} $work -> c
1a30: 68 69 6c 64 72 65 6e 0a 0a 09 09 09 63 61 74 63 hildren.....catc
1a40: 68 20 7b 0a 09 09 09 09 73 65 74 20 66 64 20 5b h {.....set fd [
1a50: 6f 70 65 6e 20 24 63 61 63 68 65 66 69 6c 65 20 open $cachefile
1a60: 77 5d 0a 09 09 09 09 70 75 74 73 20 24 66 64 20 w].....puts $fd
1a70: 5b 6c 69 73 74 20 24 63 75 72 72 74 69 6d 65 20 [list $currtime
1a80: 24 63 68 69 6c 64 72 65 6e 5d 0a 09 09 09 09 63 $children].....c
1a90: 6c 6f 73 65 20 24 66 64 0a 09 09 09 7d 0a 09 09 lose $fd....}...
1aa0: 7d 0a 0a 09 09 66 6f 72 65 61 63 68 20 63 68 69 }....foreach chi
1ab0: 6c 64 20 24 63 68 69 6c 64 72 65 6e 20 7b 0a 09 ld $children {..
1ac0: 09 09 73 65 74 20 74 79 70 65 20 5b 6c 69 6e 64 ..set type [lind
1ad0: 65 78 20 24 63 68 69 6c 64 20 30 5d 0a 09 09 09 ex $child 0]....
1ae0: 69 66 20 7b 24 74 79 70 65 20 21 3d 20 22 70 61 if {$type != "pa
1af0: 63 6b 61 67 65 22 7d 20 7b 0a 09 09 09 09 63 6f ckage"} {.....co
1b00: 6e 74 69 6e 75 65 0a 09 09 09 7d 0a 0a 09 09 09 ntinue....}.....
1b10: 73 65 74 20 70 6b 67 20 5b 6c 69 6e 64 65 78 20 set pkg [lindex
1b20: 24 63 68 69 6c 64 20 31 5d 0a 09 09 09 73 65 74 $child 1]....set
1b30: 20 76 65 72 20 5b 6c 69 6e 64 65 78 20 24 63 68 ver [lindex $ch
1b40: 69 6c 64 20 32 5d 0a 09 09 09 73 65 74 20 61 72 ild 2]....set ar
1b50: 63 68 20 5b 6c 69 6e 64 65 78 20 24 63 68 69 6c ch [lindex $chil
1b60: 64 20 33 5d 0a 09 09 09 73 65 74 20 61 72 63 68 d 3]....set arch
1b70: 5f 77 6f 72 6b 20 5b 73 70 6c 69 74 20 24 61 72 _work [split $ar
1b80: 63 68 20 2d 5d 0a 09 09 09 73 65 74 20 61 72 63 ch -]....set arc
1b90: 68 5f 6f 73 20 5b 6a 6f 69 6e 20 5b 6c 72 61 6e h_os [join [lran
1ba0: 67 65 20 24 61 72 63 68 5f 77 6f 72 6b 20 30 20 ge $arch_work 0
1bb0: 65 6e 64 2d 31 5d 20 2d 5d 0a 09 09 09 73 65 74 end-1] -]....set
1bc0: 20 61 72 63 68 5f 63 70 75 20 5b 6c 69 6e 64 65 arch_cpu [linde
1bd0: 78 20 24 61 72 63 68 5f 77 6f 72 6b 20 65 6e 64 x $arch_work end
1be0: 5d 0a 0a 09 09 09 69 66 20 7b 24 61 72 63 68 20 ].....if {$arch
1bf0: 3d 3d 20 22 73 6f 75 72 63 65 22 7d 20 7b 0a 09 == "source"} {..
1c00: 09 09 09 63 6f 6e 74 69 6e 75 65 0a 09 09 09 7d ...continue....}
1c10: 0a 0a 09 09 09 73 65 74 20 69 73 43 6f 6d 70 61 .....set isCompa
1c20: 74 4f 53 20 30 0a 09 09 09 69 66 20 7b 24 61 72 tOS 0....if {$ar
1c30: 63 68 20 3d 3d 20 22 74 63 6c 22 7d 20 7b 0a 09 ch == "tcl"} {..
1c40: 09 09 09 73 65 74 20 69 73 43 6f 6d 70 61 74 4f ...set isCompatO
1c50: 53 20 31 0a 09 09 09 7d 20 65 6c 73 65 69 66 20 S 1....} elseif
1c60: 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 {[string match $
1c70: 6c 69 6d 69 74 6f 73 20 24 61 72 63 68 5f 6f 73 limitos $arch_os
1c80: 5d 7d 20 7b 0a 09 09 09 09 73 65 74 20 69 73 43 ]} {.....set isC
1c90: 6f 6d 70 61 74 4f 53 20 31 0a 09 09 09 7d 20 65 ompatOS 1....} e
1ca0: 6c 73 65 20 7b 0a 09 09 09 09 66 6f 72 65 61 63 lse {.....foreac
1cb0: 68 20 7b 74 65 61 70 6f 74 20 6c 6f 63 61 6c 76 h {teapot localv
1cc0: 61 72 69 61 6e 74 73 7d 20 5b 61 72 72 61 79 20 ariants} [array
1cd0: 67 65 74 20 6f 73 54 65 61 70 6f 74 54 6f 4c 6f get osTeapotToLo
1ce0: 63 61 6c 5d 20 7b 0a 09 09 09 09 09 66 6f 72 65 cal] {......fore
1cf0: 61 63 68 20 6c 6f 63 61 6c 20 24 6c 6f 63 61 6c ach local $local
1d00: 76 61 72 69 61 6e 74 73 20 7b 0a 09 09 09 09 09 variants {......
1d10: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 .if {[string mat
1d20: 63 68 20 2d 6e 6f 63 61 73 65 20 24 6c 69 6d 69 ch -nocase $limi
1d30: 74 6f 73 20 24 6c 6f 63 61 6c 5d 20 7c 7c 20 5b tos $local] || [
1d40: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2d 6e 6f string match -no
1d50: 63 61 73 65 20 24 6c 6f 63 61 6c 20 24 6c 69 6d case $local $lim
1d60: 69 74 6f 73 5d 7d 20 7b 0a 09 09 09 09 09 09 09 itos]} {........
1d70: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 if {[string matc
1d80: 68 20 2d 6e 6f 63 61 73 65 20 24 74 65 61 70 6f h -nocase $teapo
1d90: 74 20 24 61 72 63 68 5f 6f 73 5d 20 7c 7c 20 5b t $arch_os] || [
1da0: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2d 6e 6f string match -no
1db0: 63 61 73 65 20 24 61 72 63 68 5f 6f 73 20 24 74 case $arch_os $t
1dc0: 65 61 70 6f 74 5d 7d 20 7b 0a 09 09 09 09 09 09 eapot]} {.......
1dd0: 09 09 73 65 74 20 69 73 43 6f 6d 70 61 74 4f 53 ..set isCompatOS
1de0: 20 31 0a 09 09 09 09 09 09 09 09 62 72 65 61 6b 1.........break
1df0: 0a 09 09 09 09 09 09 09 7d 0a 09 09 09 09 09 09 ........}.......
1e00: 7d 0a 09 09 09 09 09 7d 0a 09 09 09 09 7d 0a 09 }......}.....}..
1e10: 09 09 7d 0a 09 09 09 69 66 20 7b 21 24 69 73 43 ..}....if {!$isC
1e20: 6f 6d 70 61 74 4f 53 7d 20 7b 0a 09 09 09 09 63 ompatOS} {.....c
1e30: 6f 6e 74 69 6e 75 65 0a 09 09 09 7d 0a 0a 09 09 ontinue....}....
1e40: 09 73 65 74 20 69 73 43 6f 6d 70 61 74 43 50 55 .set isCompatCPU
1e50: 20 30 0a 09 09 09 69 66 20 7b 24 61 72 63 68 20 0....if {$arch
1e60: 3d 3d 20 22 74 63 6c 22 7d 20 7b 0a 09 09 09 09 == "tcl"} {.....
1e70: 73 65 74 20 69 73 43 6f 6d 70 61 74 43 50 55 20 set isCompatCPU
1e80: 31 0a 09 09 09 7d 20 65 6c 73 65 69 66 20 7b 5b 1....} elseif {[
1e90: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2d 6e 6f string match -no
1ea0: 63 61 73 65 20 24 6c 69 6d 69 74 63 70 75 20 24 case $limitcpu $
1eb0: 61 72 63 68 5f 63 70 75 5d 7d 20 7b 0a 09 09 09 arch_cpu]} {....
1ec0: 09 73 65 74 20 69 73 43 6f 6d 70 61 74 43 50 55 .set isCompatCPU
1ed0: 20 31 0a 09 09 09 7d 20 65 6c 73 65 20 7b 0a 09 1....} else {..
1ee0: 09 09 09 66 6f 72 65 61 63 68 20 7b 74 65 61 70 ...foreach {teap
1ef0: 6f 74 20 6c 6f 63 61 6c 76 61 72 69 61 6e 74 73 ot localvariants
1f00: 7d 20 5b 61 72 72 61 79 20 67 65 74 20 63 70 75 } [array get cpu
1f10: 54 65 61 70 6f 74 54 6f 4c 6f 63 61 6c 5d 20 7b TeapotToLocal] {
1f20: 0a 09 09 09 09 09 66 6f 72 65 61 63 68 20 6c 6f ......foreach lo
1f30: 63 61 6c 20 24 6c 6f 63 61 6c 76 61 72 69 61 6e cal $localvarian
1f40: 74 73 20 7b 0a 09 09 09 09 09 09 69 66 20 7b 5b ts {.......if {[
1f50: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2d 6e 6f string match -no
1f60: 63 61 73 65 20 24 6c 69 6d 69 74 63 70 75 20 24 case $limitcpu $
1f70: 6c 6f 63 61 6c 5d 20 7c 7c 20 5b 73 74 72 69 6e local] || [strin
1f80: 67 20 6d 61 74 63 68 20 2d 6e 6f 63 61 73 65 20 g match -nocase
1f90: 24 6c 6f 63 61 6c 20 24 6c 69 6d 69 74 63 70 75 $local $limitcpu
1fa0: 5d 7d 20 7b 0a 09 09 09 09 09 09 09 69 66 20 7b ]} {........if {
1fb0: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2d 6e [string match -n
1fc0: 6f 63 61 73 65 20 24 74 65 61 70 6f 74 20 24 61 ocase $teapot $a
1fd0: 72 63 68 5f 63 70 75 5d 20 7c 7c 20 5b 73 74 72 rch_cpu] || [str
1fe0: 69 6e 67 20 6d 61 74 63 68 20 2d 6e 6f 63 61 73 ing match -nocas
1ff0: 65 20 24 61 72 63 68 5f 63 70 75 20 24 74 65 61 e $arch_cpu $tea
2000: 70 6f 74 5d 7d 20 7b 0a 09 09 09 09 09 09 09 09 pot]} {.........
2010: 73 65 74 20 69 73 43 6f 6d 70 61 74 43 50 55 20 set isCompatCPU
2020: 31 0a 09 09 09 09 09 09 09 09 62 72 65 61 6b 0a 1.........break.
2030: 09 09 09 09 09 09 09 7d 0a 09 09 09 09 09 09 7d .......}.......}
2040: 0a 09 09 09 09 09 7d 0a 09 09 09 09 7d 0a 09 09 ......}.....}...
2050: 09 7d 0a 09 09 09 69 66 20 7b 21 24 69 73 43 6f .}....if {!$isCo
2060: 6d 70 61 74 43 50 55 7d 20 7b 0a 09 09 09 09 63 mpatCPU} {.....c
2070: 6f 6e 74 69 6e 75 65 0a 09 09 09 7d 0a 0a 09 09 ontinue....}....
2080: 09 6c 61 70 70 65 6e 64 20 70 6b 67 69 6e 66 6f .lappend pkginfo
2090: 28 24 70 6b 67 29 20 5b 6c 69 73 74 20 24 76 65 ($pkg) [list $ve
20a0: 72 20 24 61 72 63 68 5d 0a 09 09 7d 0a 0a 09 09 r $arch]...}....
20b0: 66 6f 72 65 61 63 68 20 70 6b 67 20 5b 61 72 72 foreach pkg [arr
20c0: 61 79 20 6e 61 6d 65 73 20 70 6b 67 69 6e 66 6f ay names pkginfo
20d0: 5d 20 7b 0a 09 09 09 73 65 74 20 70 6b 67 69 6e ] {....set pkgin
20e0: 66 6f 28 24 70 6b 67 29 20 5b 6c 73 6f 72 74 20 fo($pkg) [lsort
20f0: 2d 64 65 63 72 65 61 73 69 6e 67 20 2d 64 69 63 -decreasing -dic
2100: 74 69 6f 6e 61 72 79 20 24 70 6b 67 69 6e 66 6f tionary $pkginfo
2110: 28 24 70 6b 67 29 5d 0a 09 09 7d 0a 0a 09 09 72 ($pkg)]...}....r
2120: 65 74 75 72 6e 20 5b 61 72 72 61 79 20 67 65 74 eturn [array get
2130: 20 70 6b 67 69 6e 66 6f 5d 0a 09 7d 0a 0a 09 70 pkginfo]..}...p
2140: 72 6f 63 20 73 65 74 63 61 63 68 65 64 69 72 20 roc setcachedir
2150: 7b 64 69 72 7d 20 7b 0a 09 09 73 65 74 20 3a 3a {dir} {...set ::
2160: 74 65 61 70 6f 74 63 6c 69 65 6e 74 3a 3a 70 6b teapotclient::pk
2170: 67 63 61 63 68 65 64 69 72 20 24 64 69 72 0a 09 gcachedir $dir..
2180: 7d 0a 7d 0a 0a 70 61 63 6b 61 67 65 20 70 72 6f }.}..package pro
2190: 76 69 64 65 20 74 65 61 70 6f 74 63 6c 69 65 6e vide teapotclien
21a0: 74 20 30 2e 31 0a t 0.1.