Hex Artifact Content

Artifact bc242be260dbb0ac008d02e0572eca6fc13abb0e:


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 73 65 74 20 74 65 61 70 6f  tclsh..set teapo
0020: 74 73 65 72 76 65 72 73 20 5b 6c 69 73 74 20 74  tservers [list t
0030: 65 61 70 6f 74 2e 61 63 74 69 76 65 73 74 61 74  eapot.activestat
0040: 65 2e 63 6f 6d 20 74 65 61 70 6f 74 2e 72 6b 65  e.com teapot.rke
0050: 65 6e 65 2e 6f 72 67 5d 0a 0a 6c 61 70 70 65 6e  ene.org]..lappen
0060: 64 20 61 75 74 6f 5f 70 61 74 68 20 5b 66 69 6c  d auto_path [fil
0070: 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72  e join [file dir
0080: 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70  name [info scrip
0090: 74 5d 5d 20 6c 69 62 5d 0a 0a 70 61 63 6b 61 67  t]] lib]..packag
00a0: 65 20 72 65 71 75 69 72 65 20 74 65 61 70 6f 74  e require teapot
00b0: 63 6c 69 65 6e 74 0a 0a 70 72 6f 63 20 70 72 69  client..proc pri
00c0: 6e 74 5f 68 65 6c 70 20 7b 7d 20 7b 0a 09 70 75  nt_help {} {..pu
00d0: 74 73 20 73 74 64 65 72 72 20 22 55 73 61 67 65  ts stderr "Usage
00e0: 3a 20 74 65 61 70 6f 74 2d 63 6c 69 65 6e 74 20  : teapot-client 
00f0: 67 65 74 20 3c 64 69 72 3e 20 3c 6f 73 3e 20 3c  get <dir> <os> <
0100: 63 70 75 3e 20 3c 70 61 63 6b 61 67 65 73 2e 2e  cpu> <packages..
0110: 2e 3e 22 0a 09 70 75 74 73 20 73 74 64 65 72 72  .>"..puts stderr
0120: 20 22 55 73 61 67 65 3a 20 74 65 61 70 6f 74 2d   "Usage: teapot-
0130: 63 6c 69 65 6e 74 20 6c 69 73 74 20 3f 3c 6f 73  client list ?<os
0140: 3e 20 3f 3c 63 70 75 3e 3f 3f 22 0a 7d 0a 0a 73  > ?<cpu>??".}..s
0150: 65 74 20 63 6d 64 20 5b 6c 69 6e 64 65 78 20 24  et cmd [lindex $
0160: 61 72 67 76 20 30 5d 0a 73 65 74 20 61 72 67 76  argv 0].set argv
0170: 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 76 20 31   [lrange $argv 1
0180: 20 65 6e 64 5d 0a 0a 73 77 69 74 63 68 20 2d 2d   end]..switch --
0190: 20 24 63 6d 64 20 7b 0a 09 22 67 65 74 22 20 7b   $cmd {.."get" {
01a0: 0a 09 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20  ...if {[llength 
01b0: 24 61 72 67 76 5d 20 3c 20 34 7d 20 7b 0a 09 09  $argv] < 4} {...
01c0: 09 70 72 69 6e 74 5f 68 65 6c 70 0a 09 09 09 65  .print_help....e
01d0: 78 69 74 20 31 0a 09 09 7d 0a 0a 09 09 73 65 74  xit 1...}....set
01e0: 20 65 78 69 73 74 69 6e 67 65 78 74 73 20 5b 6c   existingexts [l
01f0: 69 73 74 5d 0a 0a 09 09 73 65 74 20 64 69 72 20  ist]....set dir 
0200: 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 30 5d  [lindex $argv 0]
0210: 0a 09 09 73 65 74 20 6f 73 20 5b 6c 69 6e 64 65  ...set os [linde
0220: 78 20 24 61 72 67 76 20 31 5d 0a 09 09 73 65 74  x $argv 1]...set
0230: 20 63 70 75 20 5b 6c 69 6e 64 65 78 20 24 61 72   cpu [lindex $ar
0240: 67 76 20 32 5d 0a 09 09 73 65 74 20 70 61 63 6b  gv 2]...set pack
0250: 61 67 65 73 20 5b 6c 72 61 6e 67 65 20 24 61 72  ages [lrange $ar
0260: 67 76 20 33 20 65 6e 64 5d 0a 0a 09 09 73 65 74  gv 3 end]....set
0270: 20 6e 65 77 70 61 63 6b 61 67 65 73 20 5b 6c 69   newpackages [li
0280: 73 74 5d 0a 09 09 66 6f 72 65 61 63 68 20 70 61  st]...foreach pa
0290: 63 6b 61 67 65 20 24 70 61 63 6b 61 67 65 73 20  ckage $packages 
02a0: 7b 0a 09 09 09 69 66 20 7b 5b 73 74 72 69 6e 67  {....if {[string
02b0: 20 69 6e 64 65 78 20 24 70 61 63 6b 61 67 65 20   index $package 
02c0: 30 5d 20 3d 3d 20 22 21 22 7d 20 7b 0a 09 09 09  0] == "!"} {....
02d0: 09 6c 61 70 70 65 6e 64 20 65 78 69 73 74 69 6e  .lappend existin
02e0: 67 65 78 74 73 20 5b 73 74 72 69 6e 67 20 72 61  gexts [string ra
02f0: 6e 67 65 20 24 70 61 63 6b 61 67 65 20 31 20 65  nge $package 1 e
0300: 6e 64 5d 0a 09 09 09 7d 20 65 6c 73 65 20 7b 0a  nd]....} else {.
0310: 09 09 09 09 6c 61 70 70 65 6e 64 20 6e 65 77 70  ....lappend newp
0320: 61 63 6b 61 67 65 73 20 24 70 61 63 6b 61 67 65  ackages $package
0330: 0a 09 09 09 7d 0a 09 09 7d 0a 09 09 73 65 74 20  ....}...}...set 
0340: 70 61 63 6b 61 67 65 73 20 24 6e 65 77 70 61 63  packages $newpac
0350: 6b 61 67 65 73 0a 0a 09 09 73 65 74 20 65 78 74  kages....set ext
0360: 73 69 6e 66 6f 20 5b 3a 3a 74 65 61 70 6f 74 63  sinfo [::teapotc
0370: 6c 69 65 6e 74 3a 3a 64 6f 77 6e 6c 6f 61 64 5f  lient::download_
0380: 65 78 74 65 6e 73 69 6f 6e 73 20 5b 66 69 6c 65  extensions [file
0390: 20 6a 6f 69 6e 20 24 64 69 72 20 6c 69 62 5d 20   join $dir lib] 
03a0: 24 74 65 61 70 6f 74 73 65 72 76 65 72 73 20 24  $teapotservers $
03b0: 70 61 63 6b 61 67 65 73 20 24 6f 73 20 24 63 70  packages $os $cp
03c0: 75 20 24 65 78 69 73 74 69 6e 67 65 78 74 73 5d  u $existingexts]
03d0: 0a 09 09 73 65 74 20 65 78 74 73 20 5b 6c 69 73  ...set exts [lis
03e0: 74 5d 0a 09 09 70 75 74 73 20 22 46 65 74 63 68  t]...puts "Fetch
03f0: 65 64 20 45 78 74 65 6e 73 69 6f 6e 73 3a 22 0a  ed Extensions:".
0400: 09 09 66 6f 72 65 61 63 68 20 7b 65 78 74 20 65  ..foreach {ext e
0410: 78 74 69 6e 66 6f 7d 20 24 65 78 74 73 69 6e 66  xtinfo} $extsinf
0420: 6f 20 7b 0a 09 09 09 6c 61 70 70 65 6e 64 20 65  o {....lappend e
0430: 78 74 73 20 24 65 78 74 0a 09 09 09 70 75 74 73  xts $ext....puts
0440: 20 22 20 20 24 65 78 74 20 76 5b 6c 69 6e 64 65   "  $ext v[linde
0450: 78 20 24 65 78 74 69 6e 66 6f 20 30 5d 22 0a 09  x $extinfo 0]"..
0460: 09 7d 0a 0a 09 09 73 65 74 20 66 61 69 6c 65 64  .}....set failed
0470: 65 78 74 73 20 5b 6c 69 73 74 5d 0a 09 09 66 6f  exts [list]...fo
0480: 72 65 61 63 68 20 70 6b 67 20 24 70 61 63 6b 61  reach pkg $packa
0490: 67 65 73 20 7b 0a 09 09 09 69 66 20 7b 5b 6c 73  ges {....if {[ls
04a0: 65 61 72 63 68 20 2d 65 78 61 63 74 20 24 65 78  earch -exact $ex
04b0: 74 73 20 24 70 6b 67 5d 20 3d 3d 20 2d 31 7d 20  ts $pkg] == -1} 
04c0: 7b 0a 09 09 09 09 6c 61 70 70 65 6e 64 20 66 61  {.....lappend fa
04d0: 69 6c 65 64 65 78 74 73 20 24 70 6b 67 0a 09 09  iledexts $pkg...
04e0: 09 7d 0a 09 09 7d 0a 09 09 69 66 20 7b 5b 6c 6c  .}...}...if {[ll
04f0: 65 6e 67 74 68 20 24 66 61 69 6c 65 64 65 78 74  ength $failedext
0500: 73 5d 20 21 3d 20 30 7d 20 7b 0a 09 09 09 70 75  s] != 0} {....pu
0510: 74 73 20 22 46 61 69 6c 65 64 20 74 6f 20 66 65  ts "Failed to fe
0520: 74 63 68 3a 22 0a 09 09 09 66 6f 72 65 61 63 68  tch:"....foreach
0530: 20 65 78 74 20 24 66 61 69 6c 65 64 65 78 74 73   ext $failedexts
0540: 20 7b 0a 09 09 09 09 70 75 74 73 20 22 20 20 24   {.....puts "  $
0550: 65 78 74 22 0a 09 09 09 7d 0a 09 09 09 65 78 69  ext"....}....exi
0560: 74 20 31 0a 09 09 7d 0a 09 7d 0a 09 22 6c 69 73  t 1...}..}.."lis
0570: 74 22 20 7b 0a 09 09 69 66 20 7b 24 74 63 6c 5f  t" {...if {$tcl_
0580: 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72  platform(platfor
0590: 6d 29 20 3d 3d 20 22 75 6e 69 78 22 7d 20 7b 0a  m) == "unix"} {.
05a0: 09 09 09 73 65 74 20 6f 73 20 5b 73 74 72 69 6e  ...set os [strin
05b0: 67 20 74 6f 6c 6f 77 65 72 20 24 74 63 6c 5f 70  g tolower $tcl_p
05c0: 6c 61 74 66 6f 72 6d 28 6f 73 29 5d 0a 09 09 7d  latform(os)]...}
05d0: 20 65 6c 73 65 20 7b 0a 09 09 09 73 65 74 20 6f   else {....set o
05e0: 73 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65  s [string tolowe
05f0: 72 20 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28  r $tcl_platform(
0600: 70 6c 61 74 66 6f 72 6d 29 5d 0a 09 09 7d 0a 09  platform)]...}..
0610: 09 73 65 74 20 63 70 75 20 5b 73 74 72 69 6e 67  .set cpu [string
0620: 20 74 6f 6c 6f 77 65 72 20 24 74 63 6c 5f 70 6c   tolower $tcl_pl
0630: 61 74 66 6f 72 6d 28 6d 61 63 68 69 6e 65 29 5d  atform(machine)]
0640: 0a 09 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20  ...if {[llength 
0650: 24 61 72 67 76 5d 20 3e 20 30 7d 20 7b 0a 09 09  $argv] > 0} {...
0660: 09 73 65 74 20 6f 73 20 5b 6c 69 6e 64 65 78 20  .set os [lindex 
0670: 24 61 72 67 76 20 30 5d 0a 09 09 7d 0a 09 09 69  $argv 0]...}...i
0680: 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67  f {[llength $arg
0690: 76 5d 20 3e 20 31 7d 20 7b 0a 09 09 09 73 65 74  v] > 1} {....set
06a0: 20 63 70 75 20 5b 6c 69 6e 64 65 78 20 24 61 72   cpu [lindex $ar
06b0: 67 76 20 31 5d 0a 09 09 7d 0a 0a 09 09 70 75 74  gv 1]...}....put
06c0: 73 20 22 45 78 74 65 6e 73 69 6f 6e 73 20 61 76  s "Extensions av
06d0: 61 69 6c 61 62 6c 65 20 66 6f 72 20 4f 53 3d 24  ailable for OS=$
06e0: 6f 73 2c 20 43 50 55 3d 24 63 70 75 3a 22 0a 0a  os, CPU=$cpu:"..
06f0: 09 09 66 6f 72 65 61 63 68 20 74 65 61 70 6f 74  ..foreach teapot
0700: 73 65 72 76 65 72 20 24 74 65 61 70 6f 74 73 65  server $teapotse
0710: 72 76 65 72 73 20 7b 0a 09 09 09 61 72 72 61 79  rvers {....array
0720: 20 73 65 74 20 65 78 74 73 20 5b 3a 3a 74 65 61   set exts [::tea
0730: 70 6f 74 63 6c 69 65 6e 74 3a 3a 67 65 74 5f 65  potclient::get_e
0740: 78 74 65 6e 73 69 6f 6e 73 20 24 74 65 61 70 6f  xtensions $teapo
0750: 74 73 65 72 76 65 72 20 24 6f 73 20 24 63 70 75  tserver $os $cpu
0760: 5d 0a 09 09 7d 0a 0a 09 09 66 6f 72 65 61 63 68  ]...}....foreach
0770: 20 65 78 74 20 5b 6c 73 6f 72 74 20 2d 64 69 63   ext [lsort -dic
0780: 74 69 6f 6e 61 72 79 20 5b 61 72 72 61 79 20 6e  tionary [array n
0790: 61 6d 65 73 20 65 78 74 73 5d 5d 20 7b 0a 09 09  ames exts]] {...
07a0: 09 73 65 74 20 65 78 74 69 6e 66 6f 20 24 65 78  .set extinfo $ex
07b0: 74 73 28 24 65 78 74 29 0a 0a 09 09 09 73 65 74  ts($ext).....set
07c0: 20 65 78 74 76 65 72 73 20 5b 6c 69 73 74 5d 0a   extvers [list].
07d0: 09 09 09 66 6f 72 65 61 63 68 20 65 78 74 69 6e  ...foreach extin
07e0: 66 6f 69 74 65 6d 20 24 65 78 74 69 6e 66 6f 20  foitem $extinfo 
07f0: 7b 0a 09 09 09 09 73 65 74 20 65 78 74 69 6e 66  {.....set extinf
0800: 6f 69 74 65 6d 76 65 72 73 20 5b 6c 69 6e 64 65  oitemvers [linde
0810: 78 20 24 65 78 74 69 6e 66 6f 69 74 65 6d 20 30  x $extinfoitem 0
0820: 5d 0a 09 09 09 09 69 66 20 7b 5b 6c 73 65 61 72  ].....if {[lsear
0830: 63 68 20 2d 65 78 61 63 74 20 24 65 78 74 76 65  ch -exact $extve
0840: 72 73 20 24 65 78 74 69 6e 66 6f 69 74 65 6d 76  rs $extinfoitemv
0850: 65 72 73 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 09 09  ers] == -1} {...
0860: 09 09 09 6c 61 70 70 65 6e 64 20 65 78 74 76 65  ...lappend extve
0870: 72 73 20 24 65 78 74 69 6e 66 6f 69 74 65 6d 76  rs $extinfoitemv
0880: 65 72 73 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 09  ers.....}....}..
0890: 09 09 73 65 74 20 65 78 74 76 65 72 73 20 5b 6c  ..set extvers [l
08a0: 73 6f 72 74 20 2d 64 65 63 72 65 61 73 69 6e 67  sort -decreasing
08b0: 20 2d 64 69 63 74 69 6f 6e 61 72 79 20 24 65 78   -dictionary $ex
08c0: 74 76 65 72 73 5d 0a 0a 09 09 09 70 75 74 73 20  tvers].....puts 
08d0: 22 20 20 24 65 78 74 20 5b 6c 69 6e 64 65 78 20  "  $ext [lindex 
08e0: 24 65 78 74 76 65 72 73 20 30 5d 22 0a 09 09 7d  $extvers 0]"...}
08f0: 0a 09 7d 0a 09 64 65 66 61 75 6c 74 20 7b 0a 09  ..}..default {..
0900: 09 70 72 69 6e 74 5f 68 65 6c 70 0a 09 09 65 78  .print_help...ex
0910: 69 74 20 31 0a 09 7d 0a 7d 0a                    it 1..}.}.