Hex Artifact Content

Artifact ea792ed6a5125b06a73060c1afc89d5a0e8744af:


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 50 61 72 73 65 20 61  tclsh..# Parse a
0020: 72 67 75 6d 65 6e 74 73 0a 73 65 74 20 6f 70 74  rguments.set opt
0030: 5f 63 6f 6d 70 72 65 73 73 69 6f 6e 20 31 0a 69  _compression 1.i
0040: 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67  f {[llength $arg
0050: 76 5d 20 3c 20 32 7d 20 7b 0a 09 70 75 74 73 20  v] < 2} {..puts 
0060: 73 74 64 65 72 72 20 22 55 73 61 67 65 3a 20 69  stderr "Usage: i
0070: 6e 73 74 61 6c 6c 76 66 73 2e 74 63 6c 20 3c 6b  nstallvfs.tcl <k
0080: 69 74 66 69 6c 65 3e 20 3c 76 66 73 64 69 72 3e  itfile> <vfsdir>
0090: 20 5c 5b 3c 65 6e 61 62 6c 65 5f 63 6f 6d 70 72   \[<enable_compr
00a0: 65 73 73 69 6f 6e 3e 5c 5d 22 0a 0a 09 65 78 69  ession>\]"...exi
00b0: 74 20 31 0a 7d 0a 0a 73 65 74 20 6b 69 74 66 69  t 1.}..set kitfi
00c0: 6c 65 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76  le [lindex $argv
00d0: 20 30 5d 0a 73 65 74 20 76 66 73 64 69 72 20 5b   0].set vfsdir [
00e0: 6c 69 6e 64 65 78 20 24 61 72 67 76 20 31 5d 0a  lindex $argv 1].
00f0: 69 66 20 7b 5b 6c 69 6e 64 65 78 20 24 61 72 67  if {[lindex $arg
0100: 76 20 32 5d 20 21 3d 20 22 22 7d 20 7b 0a 09 73  v 2] != ""} {..s
0110: 65 74 20 6f 70 74 5f 63 6f 6d 70 72 65 73 73 69  et opt_compressi
0120: 6f 6e 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76  on [lindex $argv
0130: 20 32 5d 0a 7d 0a 0a 23 20 4f 6e 20 57 69 6e 64   2].}..# On Wind
0140: 6f 77 73 2c 20 75 73 65 20 74 68 65 20 22 2e 65  ows, use the ".e
0150: 78 65 22 20 66 69 6c 65 20 65 78 74 65 6e 73 69  xe" file extensi
0160: 6f 6e 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74  on.if {$tcl_plat
0170: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65  form(platform) e
0180: 71 20 22 77 69 6e 64 6f 77 73 22 7d 20 7b 0a 20  q "windows"} {. 
0190: 20 73 65 74 20 6b 69 74 66 69 6c 65 20 5b 66 69   set kitfile [fi
01a0: 6c 65 20 72 6f 6f 74 6e 61 6d 65 20 24 6b 69 74  le rootname $kit
01b0: 66 69 6c 65 5d 2e 65 78 65 0a 7d 0a 0a 23 20 44  file].exe.}..# D
01c0: 65 74 65 72 6d 69 6e 65 20 77 68 61 74 20 73 74  etermine what st
01d0: 6f 72 61 67 65 20 6d 65 63 68 61 6e 69 73 6d 20  orage mechanism 
01e0: 69 73 20 62 65 69 6e 67 20 75 73 65 64 0a 73 65  is being used.se
01f0: 74 20 66 64 20 5b 6f 70 65 6e 20 4d 61 6b 65 66  t fd [open Makef
0200: 69 6c 65 2e 63 6f 6d 6d 6f 6e 20 72 5d 0a 73 65  ile.common r].se
0210: 74 20 64 61 74 61 20 5b 72 65 61 64 20 24 66 64  t data [read $fd
0220: 5d 0a 63 6c 6f 73 65 20 24 66 64 0a 0a 69 66 20  ].close $fd..if 
0230: 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 22  {[string match "
0240: 2a 4b 49 54 5f 53 54 4f 52 41 47 45 5f 5a 49 50  *KIT_STORAGE_ZIP
0250: 2a 22 20 24 64 61 74 61 5d 7d 20 7b 0a 09 73 65  *" $data]} {..se
0260: 74 20 74 63 6c 4b 69 74 53 74 6f 72 61 67 65 20  t tclKitStorage 
0270: 7a 69 70 0a 7d 0a 69 66 20 7b 5b 73 74 72 69 6e  zip.}.if {[strin
0280: 67 20 6d 61 74 63 68 20 22 2a 4b 49 54 5f 53 54  g match "*KIT_ST
0290: 4f 52 41 47 45 5f 4d 4b 34 2a 22 20 24 64 61 74  ORAGE_MK4*" $dat
02a0: 61 5d 7d 20 7b 0a 09 73 65 74 20 74 63 6c 4b 69  a]} {..set tclKi
02b0: 74 53 74 6f 72 61 67 65 20 6d 6b 34 0a 7d 0a 69  tStorage mk4.}.i
02c0: 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68  f {[string match
02d0: 20 22 2a 4b 49 54 5f 53 54 4f 52 41 47 45 5f 43   "*KIT_STORAGE_C
02e0: 56 46 53 2a 22 20 24 64 61 74 61 5d 7d 20 7b 0a  VFS*" $data]} {.
02f0: 09 73 65 74 20 74 63 6c 4b 69 74 53 74 6f 72 61  .set tclKitStora
0300: 67 65 20 63 76 66 73 0a 7d 0a 0a 23 20 44 65 66  ge cvfs.}..# Def
0310: 69 6e 65 20 70 72 6f 63 65 64 75 72 65 73 0a 70  ine procedures.p
0320: 72 6f 63 20 63 6f 70 79 5f 66 69 6c 65 20 7b 73  roc copy_file {s
0330: 72 63 66 69 6c 65 20 64 65 73 74 66 69 6c 65 7d  rcfile destfile}
0340: 20 7b 0a 09 73 77 69 74 63 68 20 2d 67 6c 6f 62   {..switch -glob
0350: 20 2d 2d 20 24 73 72 63 66 69 6c 65 20 7b 0a 09   -- $srcfile {..
0360: 09 22 2a 2e 74 63 6c 22 20 2d 20 22 2a 2e 74 78  ."*.tcl" - "*.tx
0370: 74 22 20 7b 0a 09 09 09 73 65 74 20 69 66 64 20  t" {....set ifd 
0380: 5b 6f 70 65 6e 20 24 73 72 63 66 69 6c 65 20 72  [open $srcfile r
0390: 5d 0a 09 09 09 73 65 74 20 6f 66 64 20 5b 6f 70  ]....set ofd [op
03a0: 65 6e 20 24 64 65 73 74 66 69 6c 65 20 77 5d 0a  en $destfile w].
03b0: 0a 09 09 09 73 65 74 20 72 65 74 20 5b 66 63 6f  ....set ret [fco
03c0: 70 79 20 24 69 66 64 20 24 6f 66 64 5d 0a 0a 09  py $ifd $ofd]...
03d0: 09 09 63 6c 6f 73 65 20 24 6f 66 64 0a 09 09 09  ..close $ofd....
03e0: 63 6c 6f 73 65 20 24 69 66 64 0a 09 09 7d 0a 09  close $ifd...}..
03f0: 09 64 65 66 61 75 6c 74 20 7b 0a 09 09 09 66 69  .default {....fi
0400: 6c 65 20 63 6f 70 79 20 2d 2d 20 24 73 72 63 66  le copy -- $srcf
0410: 69 6c 65 20 24 64 65 73 74 66 69 6c 65 0a 09 09  ile $destfile...
0420: 7d 0a 09 7d 0a 7d 0a 0a 70 72 6f 63 20 72 65 63  }..}.}..proc rec
0430: 75 72 73 69 76 65 5f 63 6f 70 79 20 7b 73 72 63  ursive_copy {src
0440: 64 69 72 20 64 65 73 74 64 69 72 7d 20 7b 0a 09  dir destdir} {..
0450: 66 6f 72 65 61 63 68 20 66 69 6c 65 20 5b 67 6c  foreach file [gl
0460: 6f 62 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 2d  ob -nocomplain -
0470: 64 69 72 65 63 74 6f 72 79 20 24 73 72 63 64 69  directory $srcdi
0480: 72 20 2a 5d 20 7b 0a 09 09 73 65 74 20 66 69 6c  r *] {...set fil
0490: 65 74 61 69 6c 20 5b 66 69 6c 65 20 74 61 69 6c  etail [file tail
04a0: 20 24 66 69 6c 65 5d 0a 09 09 73 65 74 20 64 65   $file]...set de
04b0: 73 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69  stfile [file joi
04c0: 6e 20 24 64 65 73 74 64 69 72 20 24 66 69 6c 65  n $destdir $file
04d0: 74 61 69 6c 5d 0a 0a 09 09 69 66 20 7b 5b 66 69  tail]....if {[fi
04e0: 6c 65 20 69 73 64 69 72 65 63 74 6f 72 79 20 24  le isdirectory $
04f0: 66 69 6c 65 5d 7d 20 7b 0a 09 09 09 66 69 6c 65  file]} {....file
0500: 20 6d 6b 64 69 72 20 24 64 65 73 74 66 69 6c 65   mkdir $destfile
0510: 0a 0a 09 09 09 72 65 63 75 72 73 69 76 65 5f 63  .....recursive_c
0520: 6f 70 79 20 24 66 69 6c 65 20 24 64 65 73 74 66  opy $file $destf
0530: 69 6c 65 0a 0a 09 09 09 63 6f 6e 74 69 6e 75 65  ile.....continue
0540: 0a 09 09 7d 0a 0a 09 09 69 66 20 7b 5b 63 61 74  ...}....if {[cat
0550: 63 68 20 7b 0a 09 09 09 63 6f 70 79 5f 66 69 6c  ch {....copy_fil
0560: 65 20 24 66 69 6c 65 20 24 64 65 73 74 66 69 6c  e $file $destfil
0570: 65 0a 09 09 7d 20 65 72 72 5d 7d 20 7b 0a 09 09  e...} err]} {...
0580: 09 70 75 74 73 20 73 74 64 65 72 72 20 22 46 61  .puts stderr "Fa
0590: 69 6c 65 64 20 74 6f 20 63 6f 70 79 3a 20 24 66  iled to copy: $f
05a0: 69 6c 65 3a 20 24 65 72 72 22 0a 09 09 7d 0a 09  ile: $err"...}..
05b0: 7d 0a 7d 0a 0a 23 20 55 70 64 61 74 65 20 74 68  }.}..# Update th
05c0: 65 20 6b 69 74 2c 20 62 61 73 65 64 20 6f 6e 20  e kit, based on 
05d0: 77 68 61 74 20 6b 69 6e 64 20 6f 66 20 6b 69 74  what kind of kit
05e0: 20 74 68 69 73 20 69 73 0a 73 77 69 74 63 68 20   this is.switch 
05f0: 2d 2d 20 24 74 63 6c 4b 69 74 53 74 6f 72 61 67  -- $tclKitStorag
0600: 65 20 7b 0a 09 22 6d 6b 34 22 20 7b 0a 09 09 69  e {.."mk4" {...i
0610: 66 20 7b 5b 63 61 74 63 68 20 7b 0a 09 09 09 23  f {[catch {....#
0620: 20 54 72 79 20 61 73 20 69 66 20 61 20 70 72 65   Try as if a pre
0630: 2d 65 78 69 73 74 69 6e 67 20 54 63 6c 6b 69 74  -existing Tclkit
0640: 2c 20 6f 72 20 61 20 74 63 6c 73 68 0a 09 09 09  , or a tclsh....
0650: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20  package require 
0660: 76 66 73 3a 3a 6d 6b 34 0a 09 09 7d 5d 7d 20 7b  vfs::mk4...}]} {
0670: 0a 09 09 09 23 20 54 72 79 20 61 73 20 69 66 20  ....# Try as if 
0680: 75 6e 69 6e 69 74 69 61 6c 69 7a 65 64 20 54 63  uninitialized Tc
0690: 6c 6b 69 74 0a 09 09 09 63 61 74 63 68 20 7b 0a  lkit....catch {.
06a0: 09 09 09 09 6c 6f 61 64 20 22 22 20 76 66 73 0a  ....load "" vfs.
06b0: 09 09 09 09 6c 6f 61 64 20 22 22 20 4d 6b 34 74  ....load "" Mk4t
06c0: 63 6c 0a 0a 09 09 09 09 73 6f 75 72 63 65 20 5b  cl......source [
06d0: 66 69 6c 65 20 6a 6f 69 6e 20 24 76 66 73 64 69  file join $vfsdi
06e0: 72 20 6c 69 62 2f 76 66 73 2f 76 66 73 55 74 69  r lib/vfs/vfsUti
06f0: 6c 73 2e 74 63 6c 5d 0a 09 09 09 09 73 6f 75 72  ls.tcl].....sour
0700: 63 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 76  ce [file join $v
0710: 66 73 64 69 72 20 6c 69 62 2f 76 66 73 2f 76 66  fsdir lib/vfs/vf
0720: 73 6c 69 62 2e 74 63 6c 5d 0a 09 09 09 09 73 6f  slib.tcl].....so
0730: 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20  urce [file join 
0740: 24 76 66 73 64 69 72 20 6c 69 62 2f 76 66 73 2f  $vfsdir lib/vfs/
0750: 6d 6b 34 76 66 73 2e 74 63 6c 5d 0a 09 09 09 7d  mk4vfs.tcl]....}
0760: 0a 09 09 7d 0a 09 09 73 65 74 20 6d 6b 34 76 66  ...}...set mk4vf
0770: 73 3a 3a 63 6f 6d 70 72 65 73 73 20 24 6f 70 74  s::compress $opt
0780: 5f 63 6f 6d 70 72 65 73 73 69 6f 6e 0a 0a 09 09  _compression....
0790: 73 65 74 20 68 61 6e 64 6c 65 20 5b 76 66 73 3a  set handle [vfs:
07a0: 3a 6d 6b 34 3a 3a 4d 6f 75 6e 74 20 24 6b 69 74  :mk4::Mount $kit
07b0: 66 69 6c 65 20 2f 6b 69 74 20 2d 6e 6f 63 6f 6d  file /kit -nocom
07c0: 6d 69 74 5d 0a 0a 09 09 72 65 63 75 72 73 69 76  mit]....recursiv
07d0: 65 5f 63 6f 70 79 20 24 76 66 73 64 69 72 20 2f  e_copy $vfsdir /
07e0: 6b 69 74 0a 0a 09 09 76 66 73 3a 3a 75 6e 6d 6f  kit....vfs::unmo
07f0: 75 6e 74 20 2f 6b 69 74 0a 09 7d 0a 09 22 7a 69  unt /kit..}.."zi
0800: 70 22 20 7b 0a 09 09 73 65 74 20 6b 69 74 66 64  p" {...set kitfd
0810: 20 5b 6f 70 65 6e 20 24 6b 69 74 66 69 6c 65 20   [open $kitfile 
0820: 61 2b 5d 0a 09 09 66 63 6f 6e 66 69 67 75 72 65  a+]...fconfigure
0830: 20 24 6b 69 74 66 64 20 2d 74 72 61 6e 73 6c 61   $kitfd -transla
0840: 74 69 6f 6e 20 62 69 6e 61 72 79 0a 0a 09 09 63  tion binary....c
0850: 64 20 24 76 66 73 64 69 72 0a 09 09 69 66 20 7b  d $vfsdir...if {
0860: 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c  $tcl_platform(pl
0870: 61 74 66 6f 72 6d 29 20 65 71 20 22 77 69 6e 64  atform) eq "wind
0880: 6f 77 73 22 7d 20 7b 0a 09 09 09 73 65 74 20 6e  ows"} {....set n
0890: 75 6c 6c 20 4e 55 4c 0a 09 09 7d 20 65 6c 73 65  ull NUL...} else
08a0: 20 7b 0a 09 09 09 73 65 74 20 6e 75 6c 6c 20 2f   {....set null /
08b0: 64 65 76 2f 6e 75 6c 6c 0a 09 09 7d 0a 09 09 73  dev/null...}...s
08c0: 65 74 20 7a 69 70 66 64 20 5b 6f 70 65 6e 20 22  et zipfd [open "
08d0: 7c 7a 69 70 20 2d 72 20 2d 20 5b 67 6c 6f 62 20  |zip -r - [glob 
08e0: 2a 5d 20 32 3e 20 24 6e 75 6c 6c 22 5d 0a 09 09  *] 2> $null"]...
08f0: 66 63 6f 6e 66 69 67 75 72 65 20 24 7a 69 70 66  fconfigure $zipf
0900: 64 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 62  d -translation b
0910: 69 6e 61 72 79 0a 0a 09 09 66 63 6f 70 79 20 24  inary....fcopy $
0920: 7a 69 70 66 64 20 24 6b 69 74 66 64 0a 0a 09 09  zipfd $kitfd....
0930: 63 6c 6f 73 65 20 24 6b 69 74 66 64 0a 09 09 69  close $kitfd...i
0940: 66 20 7b 5b 63 61 74 63 68 20 7b 0a 09 09 09 63  f {[catch {....c
0950: 6c 6f 73 65 20 24 7a 69 70 66 64 0a 09 09 7d 20  lose $zipfd...} 
0960: 65 72 72 5d 7d 20 7b 0a 09 09 09 70 75 74 73 20  err]} {....puts 
0970: 73 74 64 65 72 72 20 22 45 72 72 6f 72 20 77 68  stderr "Error wh
0980: 69 6c 65 20 75 70 64 61 74 69 6e 67 20 65 78 65  ile updating exe
0990: 63 75 74 61 62 6c 65 3a 20 24 65 72 72 22 0a 0a  cutable: $err"..
09a0: 09 09 09 65 78 69 74 20 31 0a 09 09 7d 0a 09 7d  ...exit 1...}..}
09b0: 0a 09 22 63 76 66 73 22 20 7b 0a 09 09 23 20 4e  .."cvfs" {...# N
09c0: 6f 2d 6f 70 0a 09 7d 0a 7d 0a                    o-op..}.}.