Hex Artifact Content

Artifact 734aa55ae1434ee18ef260707cbd3f8ff20b50e8:


0000: 23 20 52 65 6d 6f 76 65 64 20 70 72 6f 76 69 73  # Removed provis
0010: 69 6f 6e 20 6f 66 20 74 68 65 20 62 61 63 6b 77  ion of the backw
0020: 61 72 64 20 63 6f 6d 70 61 74 69 62 6c 65 20 6e  ard compatible n
0030: 61 6d 65 2e 20 4d 6f 76 65 64 20 74 6f 20 73 65  ame. Moved to se
0040: 70 61 72 61 74 65 0a 23 20 66 69 6c 65 2f 70 61  parate.# file/pa
0050: 63 6b 61 67 65 2e 0a 0a 70 61 63 6b 61 67 65 20  ckage...package 
0060: 72 65 71 75 69 72 65 20 76 66 73 0a 0a 23 20 55  require vfs..# U
0070: 73 69 6e 67 20 74 68 65 20 76 66 73 2c 20 6d 65  sing the vfs, me
0080: 6d 63 68 61 6e 20 61 6e 64 20 54 72 66 20 65 78  mchan and Trf ex
0090: 74 65 6e 73 69 6f 6e 73 2c 20 77 65 20 6f 75 67  tensions, we oug
00a0: 68 74 20 74 6f 20 62 65 20 61 62 6c 65 0a 23 20  ht to be able.# 
00b0: 74 6f 20 77 72 69 74 65 20 61 20 54 63 6c 2d 6f  to write a Tcl-o
00c0: 6e 6c 79 20 7a 69 70 20 76 69 72 74 75 61 6c 20  nly zip virtual 
00d0: 66 69 6c 65 73 79 73 74 65 6d 2e 20 20 57 68 61  filesystem.  Wha
00e0: 74 20 77 65 20 68 61 76 65 20 62 65 6c 6f 77 0a  t we have below.
00f0: 23 20 69 73 20 62 61 73 69 63 61 6c 6c 79 20 74  # is basically t
0100: 68 61 74 2e 0a 0a 6e 61 6d 65 73 70 61 63 65 20  hat...namespace 
0110: 65 76 61 6c 20 76 66 73 3a 3a 7a 69 70 20 7b 7d  eval vfs::zip {}
0120: 0a 0a 23 20 55 73 65 64 20 74 6f 20 65 78 65 63  ..# Used to exec
0130: 75 74 65 20 61 20 7a 69 70 20 61 72 63 68 69 76  ute a zip archiv
0140: 65 2e 20 20 54 68 69 73 20 69 73 20 72 61 74 68  e.  This is rath
0150: 65 72 20 6c 69 6b 65 20 61 20 6a 61 72 20 66 69  er like a jar fi
0160: 6c 65 0a 23 20 62 75 74 20 73 69 6d 70 6c 65 72  le.# but simpler
0170: 2e 20 20 57 65 20 73 69 6d 70 6c 79 20 6d 6f 75  .  We simply mou
0180: 6e 74 20 69 74 20 61 6e 64 20 74 68 65 6e 20 73  nt it and then s
0190: 6f 75 72 63 65 20 61 20 74 6f 70 6c 65 76 65 6c  ource a toplevel
01a0: 0a 23 20 66 69 6c 65 20 63 61 6c 6c 65 64 20 27  .# file called '
01b0: 6d 61 69 6e 2e 74 63 6c 27 2e 0a 70 72 6f 63 20  main.tcl'..proc 
01c0: 76 66 73 3a 3a 7a 69 70 3a 3a 45 78 65 63 75 74  vfs::zip::Execut
01d0: 65 20 7b 7a 69 70 66 69 6c 65 7d 20 7b 0a 20 20  e {zipfile} {.  
01e0: 20 20 4d 6f 75 6e 74 20 24 7a 69 70 66 69 6c 65    Mount $zipfile
01f0: 20 24 7a 69 70 66 69 6c 65 0a 20 20 20 20 73 6f   $zipfile.    so
0200: 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20  urce [file join 
0210: 24 7a 69 70 66 69 6c 65 20 6d 61 69 6e 2e 74 63  $zipfile main.tc
0220: 6c 5d 0a 7d 0a 0a 70 72 6f 63 20 76 66 73 3a 3a  l].}..proc vfs::
0230: 7a 69 70 3a 3a 4d 6f 75 6e 74 20 7b 7a 69 70 66  zip::Mount {zipf
0240: 69 6c 65 20 6c 6f 63 61 6c 7d 20 7b 0a 20 20 20  ile local} {.   
0250: 20 73 65 74 20 66 64 20 5b 3a 3a 7a 69 70 3a 3a   set fd [::zip::
0260: 6f 70 65 6e 20 5b 3a 3a 66 69 6c 65 20 6e 6f 72  open [::file nor
0270: 6d 61 6c 69 7a 65 20 24 7a 69 70 66 69 6c 65 5d  malize $zipfile]
0280: 5d 0a 20 20 20 20 76 66 73 3a 3a 66 69 6c 65 73  ].    vfs::files
0290: 79 73 74 65 6d 20 6d 6f 75 6e 74 20 24 6c 6f 63  ystem mount $loc
02a0: 61 6c 20 5b 6c 69 73 74 20 3a 3a 76 66 73 3a 3a  al [list ::vfs::
02b0: 7a 69 70 3a 3a 68 61 6e 64 6c 65 72 20 24 66 64  zip::handler $fd
02c0: 5d 0a 20 20 20 20 23 20 52 65 67 69 73 74 65 72  ].    # Register
02d0: 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 75 6e 6d 6f   command to unmo
02e0: 75 6e 74 0a 20 20 20 20 76 66 73 3a 3a 52 65 67  unt.    vfs::Reg
02f0: 69 73 74 65 72 4d 6f 75 6e 74 20 24 6c 6f 63 61  isterMount $loca
0300: 6c 20 5b 6c 69 73 74 20 3a 3a 76 66 73 3a 3a 7a  l [list ::vfs::z
0310: 69 70 3a 3a 55 6e 6d 6f 75 6e 74 20 24 66 64 5d  ip::Unmount $fd]
0320: 0a 20 20 20 20 72 65 74 75 72 6e 20 24 66 64 0a  .    return $fd.
0330: 7d 0a 0a 70 72 6f 63 20 76 66 73 3a 3a 7a 69 70  }..proc vfs::zip
0340: 3a 3a 55 6e 6d 6f 75 6e 74 20 7b 66 64 20 6c 6f  ::Unmount {fd lo
0350: 63 61 6c 7d 20 7b 0a 20 20 20 20 76 66 73 3a 3a  cal} {.    vfs::
0360: 66 69 6c 65 73 79 73 74 65 6d 20 75 6e 6d 6f 75  filesystem unmou
0370: 6e 74 20 24 6c 6f 63 61 6c 0a 20 20 20 20 3a 3a  nt $local.    ::
0380: 7a 69 70 3a 3a 5f 63 6c 6f 73 65 20 24 66 64 0a  zip::_close $fd.
0390: 7d 0a 0a 70 72 6f 63 20 76 66 73 3a 3a 7a 69 70  }..proc vfs::zip
03a0: 3a 3a 68 61 6e 64 6c 65 72 20 7b 7a 69 70 66 64  ::handler {zipfd
03b0: 20 63 6d 64 20 72 6f 6f 74 20 72 65 6c 61 74 69   cmd root relati
03c0: 76 65 20 61 63 74 75 61 6c 70 61 74 68 20 61 72  ve actualpath ar
03d0: 67 73 7d 20 7b 0a 20 20 20 20 23 3a 3a 76 66 73  gs} {.    #::vfs
03e0: 3a 3a 6c 6f 67 20 5b 6c 69 73 74 20 24 7a 69 70  ::log [list $zip
03f0: 66 64 20 24 63 6d 64 20 24 72 6f 6f 74 20 24 72  fd $cmd $root $r
0400: 65 6c 61 74 69 76 65 20 24 61 63 74 75 61 6c 70  elative $actualp
0410: 61 74 68 20 24 61 72 67 73 5d 0a 20 20 20 20 69  ath $args].    i
0420: 66 20 7b 24 63 6d 64 20 3d 3d 20 22 6d 61 74 63  f {$cmd == "matc
0430: 68 69 6e 64 69 72 65 63 74 6f 72 79 22 7d 20 7b  hindirectory"} {
0440: 0a 09 65 76 61 6c 20 5b 6c 69 73 74 20 24 63 6d  ..eval [list $cm
0450: 64 20 24 7a 69 70 66 64 20 24 72 65 6c 61 74 69  d $zipfd $relati
0460: 76 65 20 24 61 63 74 75 61 6c 70 61 74 68 5d 20  ve $actualpath] 
0470: 24 61 72 67 73 0a 20 20 20 20 7d 20 65 6c 73 65  $args.    } else
0480: 20 7b 0a 09 65 76 61 6c 20 5b 6c 69 73 74 20 24   {..eval [list $
0490: 63 6d 64 20 24 7a 69 70 66 64 20 24 72 65 6c 61  cmd $zipfd $rela
04a0: 74 69 76 65 5d 20 24 61 72 67 73 0a 20 20 20 20  tive] $args.    
04b0: 7d 0a 7d 0a 0a 70 72 6f 63 20 76 66 73 3a 3a 7a  }.}..proc vfs::z
04c0: 69 70 3a 3a 61 74 74 72 69 62 75 74 65 73 20 7b  ip::attributes {
04d0: 7a 69 70 66 64 7d 20 7b 20 72 65 74 75 72 6e 20  zipfd} { return 
04e0: 5b 6c 69 73 74 20 22 73 74 61 74 65 22 5d 20 7d  [list "state"] }
04f0: 0a 70 72 6f 63 20 76 66 73 3a 3a 7a 69 70 3a 3a  .proc vfs::zip::
0500: 73 74 61 74 65 20 7b 7a 69 70 66 64 20 61 72 67  state {zipfd arg
0510: 73 7d 20 7b 0a 20 20 20 20 76 66 73 3a 3a 61 74  s} {.    vfs::at
0520: 74 72 69 62 75 74 65 43 61 6e 74 43 6f 6e 66 69  tributeCantConfi
0530: 67 75 72 65 20 22 73 74 61 74 65 22 20 22 72 65  gure "state" "re
0540: 61 64 6f 6e 6c 79 22 20 24 61 72 67 73 0a 7d 0a  adonly" $args.}.
0550: 0a 23 20 49 66 20 77 65 20 69 6d 70 6c 65 6d 65  .# If we impleme
0560: 6e 74 20 74 68 65 20 63 6f 6d 6d 61 6e 64 73 20  nt the commands 
0570: 62 65 6c 6f 77 2c 20 77 65 20 77 69 6c 6c 20 68  below, we will h
0580: 61 76 65 20 61 20 70 65 72 66 65 63 74 0a 23 20  ave a perfect.# 
0590: 76 69 72 74 75 61 6c 20 66 69 6c 65 20 73 79 73  virtual file sys
05a0: 74 65 6d 20 66 6f 72 20 7a 69 70 20 66 69 6c 65  tem for zip file
05b0: 73 2e 0a 0a 70 72 6f 63 20 76 66 73 3a 3a 7a 69  s...proc vfs::zi
05c0: 70 3a 3a 6d 61 74 63 68 69 6e 64 69 72 65 63 74  p::matchindirect
05d0: 6f 72 79 20 7b 7a 69 70 66 64 20 70 61 74 68 20  ory {zipfd path 
05e0: 61 63 74 75 61 6c 70 61 74 68 20 70 61 74 74 65  actualpath patte
05f0: 72 6e 20 74 79 70 65 7d 20 7b 0a 20 20 20 20 23  rn type} {.    #
0600: 3a 3a 76 66 73 3a 3a 6c 6f 67 20 5b 6c 69 73 74  ::vfs::log [list
0610: 20 6d 61 74 63 68 69 6e 64 69 72 65 63 74 6f 72   matchindirector
0620: 79 20 24 70 61 74 68 20 24 61 63 74 75 61 6c 70  y $path $actualp
0630: 61 74 68 20 24 70 61 74 74 65 72 6e 20 24 74 79  ath $pattern $ty
0640: 70 65 5d 0a 0a 20 20 20 20 23 20 54 68 69 73 20  pe]..    # This 
0650: 63 61 6c 6c 20 74 6f 20 7a 69 70 3a 3a 67 65 74  call to zip::get
0660: 64 69 72 20 68 61 6e 64 6c 65 73 20 65 6d 70 74  dir handles empt
0670: 79 20 70 61 74 74 65 72 6e 73 20 70 72 6f 70 65  y patterns prope
0680: 72 6c 79 20 61 73 20 61 73 6b 69 6e 67 0a 20 20  rly as asking.  
0690: 20 20 23 20 66 6f 72 20 74 68 65 20 65 78 69 73    # for the exis
06a0: 74 65 6e 63 65 20 6f 66 20 61 20 73 69 6e 67 6c  tence of a singl
06b0: 65 20 66 69 6c 65 20 24 70 61 74 68 20 6f 6e 6c  e file $path onl
06c0: 79 0a 20 20 20 20 73 65 74 20 72 65 73 20 5b 3a  y.    set res [:
06d0: 3a 7a 69 70 3a 3a 67 65 74 64 69 72 20 24 7a 69  :zip::getdir $zi
06e0: 70 66 64 20 24 70 61 74 68 20 24 70 61 74 74 65  pfd $path $patte
06f0: 72 6e 5d 0a 20 20 20 20 23 3a 3a 76 66 73 3a 3a  rn].    #::vfs::
0700: 6c 6f 67 20 22 67 6f 74 20 24 72 65 73 22 0a 20  log "got $res". 
0710: 20 20 20 69 66 20 7b 21 5b 73 74 72 69 6e 67 20     if {![string 
0720: 6c 65 6e 67 74 68 20 24 70 61 74 74 65 72 6e 5d  length $pattern]
0730: 7d 20 7b 0a 09 69 66 20 7b 21 5b 3a 3a 7a 69 70  } {..if {![::zip
0740: 3a 3a 65 78 69 73 74 73 20 24 7a 69 70 66 64 20  ::exists $zipfd 
0750: 24 70 61 74 68 5d 7d 20 7b 20 72 65 74 75 72 6e  $path]} { return
0760: 20 7b 7d 20 7d 0a 09 73 65 74 20 72 65 73 20 5b   {} }..set res [
0770: 6c 69 73 74 20 24 61 63 74 75 61 6c 70 61 74 68  list $actualpath
0780: 5d 0a 09 73 65 74 20 61 63 74 75 61 6c 70 61 74  ]..set actualpat
0790: 68 20 22 22 0a 20 20 20 20 7d 0a 0a 20 20 20 20  h "".    }..    
07a0: 73 65 74 20 6e 65 77 72 65 73 20 5b 6c 69 73 74  set newres [list
07b0: 5d 0a 20 20 20 20 66 6f 72 65 61 63 68 20 70 20  ].    foreach p 
07c0: 5b 3a 3a 76 66 73 3a 3a 6d 61 74 63 68 43 6f 72  [::vfs::matchCor
07d0: 72 65 63 74 54 79 70 65 73 20 24 74 79 70 65 20  rectTypes $type 
07e0: 24 72 65 73 20 24 61 63 74 75 61 6c 70 61 74 68  $res $actualpath
07f0: 5d 20 7b 0a 09 6c 61 70 70 65 6e 64 20 6e 65 77  ] {..lappend new
0800: 72 65 73 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24  res [file join $
0810: 61 63 74 75 61 6c 70 61 74 68 20 24 70 5d 0a 20  actualpath $p]. 
0820: 20 20 20 7d 0a 20 20 20 20 23 3a 3a 76 66 73 3a     }.    #::vfs:
0830: 3a 6c 6f 67 20 22 67 6f 74 20 24 6e 65 77 72 65  :log "got $newre
0840: 73 22 0a 20 20 20 20 72 65 74 75 72 6e 20 24 6e  s".    return $n
0850: 65 77 72 65 73 0a 7d 0a 0a 70 72 6f 63 20 76 66  ewres.}..proc vf
0860: 73 3a 3a 7a 69 70 3a 3a 73 74 61 74 20 7b 7a 69  s::zip::stat {zi
0870: 70 66 64 20 6e 61 6d 65 7d 20 7b 0a 20 20 20 20  pfd name} {.    
0880: 23 3a 3a 76 66 73 3a 3a 6c 6f 67 20 22 73 74 61  #::vfs::log "sta
0890: 74 20 24 6e 61 6d 65 22 0a 20 20 20 20 3a 3a 7a  t $name".    ::z
08a0: 69 70 3a 3a 73 74 61 74 20 24 7a 69 70 66 64 20  ip::stat $zipfd 
08b0: 24 6e 61 6d 65 20 73 62 0a 20 20 20 20 23 3a 3a  $name sb.    #::
08c0: 76 66 73 3a 3a 6c 6f 67 20 5b 61 72 72 61 79 20  vfs::log [array 
08d0: 67 65 74 20 73 62 5d 0a 20 20 20 20 61 72 72 61  get sb].    arra
08e0: 79 20 67 65 74 20 73 62 0a 7d 0a 0a 70 72 6f 63  y get sb.}..proc
08f0: 20 76 66 73 3a 3a 7a 69 70 3a 3a 61 63 63 65 73   vfs::zip::acces
0900: 73 20 7b 7a 69 70 66 64 20 6e 61 6d 65 20 6d 6f  s {zipfd name mo
0910: 64 65 7d 20 7b 0a 20 20 20 20 23 3a 3a 76 66 73  de} {.    #::vfs
0920: 3a 3a 6c 6f 67 20 22 7a 69 70 2d 61 63 63 65 73  ::log "zip-acces
0930: 73 20 24 6e 61 6d 65 20 24 6d 6f 64 65 22 0a 20  s $name $mode". 
0940: 20 20 20 69 66 20 7b 24 6d 6f 64 65 20 26 20 32     if {$mode & 2
0950: 7d 20 7b 0a 09 76 66 73 3a 3a 66 69 6c 65 73 79  } {..vfs::filesy
0960: 73 74 65 6d 20 70 6f 73 69 78 65 72 72 6f 72 20  stem posixerror 
0970: 24 3a 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45 52  $::vfs::posix(ER
0980: 4f 46 53 29 0a 20 20 20 20 7d 0a 20 20 20 20 23  OFS).    }.    #
0990: 20 52 65 61 64 61 62 6c 65 2c 20 45 78 69 73 74   Readable, Exist
09a0: 73 20 61 6e 64 20 45 78 65 63 75 74 61 62 6c 65  s and Executable
09b0: 20 61 72 65 20 74 72 65 61 74 65 64 20 61 73 20   are treated as 
09c0: 27 65 78 69 73 74 73 27 0a 20 20 20 20 23 20 43  'exists'.    # C
09d0: 6f 75 6c 64 20 77 65 20 67 65 74 20 6d 6f 72 65  ould we get more
09e0: 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 66 72 6f   information fro
09f0: 6d 20 74 68 65 20 61 72 63 68 69 76 65 3f 0a 20  m the archive?. 
0a00: 20 20 20 69 66 20 7b 5b 3a 3a 7a 69 70 3a 3a 65     if {[::zip::e
0a10: 78 69 73 74 73 20 24 7a 69 70 66 64 20 24 6e 61  xists $zipfd $na
0a20: 6d 65 5d 7d 20 7b 0a 09 72 65 74 75 72 6e 20 31  me]} {..return 1
0a30: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 65  .    } else {..e
0a40: 72 72 6f 72 20 22 4e 6f 20 73 75 63 68 20 66 69  rror "No such fi
0a50: 6c 65 22 0a 20 20 20 20 7d 0a 20 20 20 20 0a 7d  le".    }.    .}
0a60: 0a 0a 70 72 6f 63 20 76 66 73 3a 3a 7a 69 70 3a  ..proc vfs::zip:
0a70: 3a 6f 70 65 6e 20 7b 7a 69 70 66 64 20 6e 61 6d  :open {zipfd nam
0a80: 65 20 6d 6f 64 65 20 70 65 72 6d 69 73 73 69 6f  e mode permissio
0a90: 6e 73 7d 20 7b 0a 20 20 20 20 23 3a 3a 76 66 73  ns} {.    #::vfs
0aa0: 3a 3a 6c 6f 67 20 22 6f 70 65 6e 20 24 6e 61 6d  ::log "open $nam
0ab0: 65 20 24 6d 6f 64 65 20 24 70 65 72 6d 69 73 73  e $mode $permiss
0ac0: 69 6f 6e 73 22 0a 20 20 20 20 23 20 72 65 74 75  ions".    # retu
0ad0: 72 6e 20 61 20 6c 69 73 74 20 6f 66 20 74 77 6f  rn a list of two
0ae0: 20 65 6c 65 6d 65 6e 74 73 3a 0a 20 20 20 20 23   elements:.    #
0af0: 20 31 2e 20 66 69 72 73 74 20 65 6c 65 6d 65 6e   1. first elemen
0b00: 74 20 69 73 20 74 68 65 20 54 63 6c 20 63 68 61  t is the Tcl cha
0b10: 6e 6e 65 6c 20 6e 61 6d 65 20 77 68 69 63 68 20  nnel name which 
0b20: 68 61 73 20 62 65 65 6e 20 6f 70 65 6e 65 64 0a  has been opened.
0b30: 20 20 20 20 23 20 32 2e 20 73 65 63 6f 6e 64 20      # 2. second 
0b40: 65 6c 65 6d 65 6e 74 20 28 6f 70 74 69 6f 6e 61  element (optiona
0b50: 6c 29 20 69 73 20 61 20 63 6f 6d 6d 61 6e 64 20  l) is a command 
0b60: 74 6f 20 65 76 61 6c 75 61 74 65 20 77 68 65 6e  to evaluate when
0b70: 0a 20 20 20 20 23 20 20 20 20 74 68 65 20 63 68  .    #    the ch
0b80: 61 6e 6e 65 6c 20 69 73 20 63 6c 6f 73 65 64 2e  annel is closed.
0b90: 0a 0a 20 20 20 20 73 77 69 74 63 68 20 2d 2d 20  ..    switch -- 
0ba0: 24 6d 6f 64 65 20 7b 0a 09 22 22 20 2d 0a 09 22  $mode {.."" -.."
0bb0: 72 22 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b  r" {..    if {![
0bc0: 3a 3a 7a 69 70 3a 3a 65 78 69 73 74 73 20 24 7a  ::zip::exists $z
0bd0: 69 70 66 64 20 24 6e 61 6d 65 5d 7d 20 7b 0a 09  ipfd $name]} {..
0be0: 09 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d  .vfs::filesystem
0bf0: 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a 76   posixerror $::v
0c00: 66 73 3a 3a 70 6f 73 69 78 28 45 4e 4f 45 4e 54  fs::posix(ENOENT
0c10: 29 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 0a 09  )..    }..    ..
0c20: 20 20 20 20 3a 3a 7a 69 70 3a 3a 73 74 61 74 20      ::zip::stat 
0c30: 24 7a 69 70 66 64 20 24 6e 61 6d 65 20 73 62 0a  $zipfd $name sb.
0c40: 0a 09 20 20 20 20 73 65 74 20 6e 66 64 20 5b 76  ..    set nfd [v
0c50: 66 73 3a 3a 6d 65 6d 63 68 61 6e 5d 0a 09 20 20  fs::memchan]..  
0c60: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 6e 66    fconfigure $nf
0c70: 64 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 62  d -translation b
0c80: 69 6e 61 72 79 0a 0a 09 20 20 20 20 73 65 65 6b  inary...    seek
0c90: 20 24 7a 69 70 66 64 20 24 73 62 28 69 6e 6f 29   $zipfd $sb(ino)
0ca0: 20 73 74 61 72 74 0a 09 20 20 20 20 7a 69 70 3a   start..    zip:
0cb0: 3a 44 61 74 61 20 24 7a 69 70 66 64 20 73 62 20  :Data $zipfd sb 
0cc0: 64 61 74 61 0a 0a 09 20 20 20 20 70 75 74 73 20  data...    puts 
0cd0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 6e 66 64 20  -nonewline $nfd 
0ce0: 24 64 61 74 61 0a 0a 09 20 20 20 20 66 63 6f 6e  $data...    fcon
0cf0: 66 69 67 75 72 65 20 24 6e 66 64 20 2d 74 72 61  figure $nfd -tra
0d00: 6e 73 6c 61 74 69 6f 6e 20 61 75 74 6f 0a 09 20  nslation auto.. 
0d10: 20 20 20 73 65 65 6b 20 24 6e 66 64 20 30 0a 09     seek $nfd 0..
0d20: 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 73 74      return [list
0d30: 20 24 6e 66 64 5d 0a 09 7d 0a 09 64 65 66 61 75   $nfd]..}..defau
0d40: 6c 74 20 7b 0a 09 20 20 20 20 76 66 73 3a 3a 66  lt {..    vfs::f
0d50: 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65  ilesystem posixe
0d60: 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73  rror $::vfs::pos
0d70: 69 78 28 45 52 4f 46 53 29 0a 09 7d 0a 20 20 20  ix(EROFS)..}.   
0d80: 20 7d 0a 7d 0a 0a 70 72 6f 63 20 76 66 73 3a 3a   }.}..proc vfs::
0d90: 7a 69 70 3a 3a 63 72 65 61 74 65 64 69 72 65 63  zip::createdirec
0da0: 74 6f 72 79 20 7b 7a 69 70 66 64 20 6e 61 6d 65  tory {zipfd name
0db0: 7d 20 7b 0a 20 20 20 20 23 3a 3a 76 66 73 3a 3a  } {.    #::vfs::
0dc0: 6c 6f 67 20 22 63 72 65 61 74 65 64 69 72 65 63  log "createdirec
0dd0: 74 6f 72 79 20 24 6e 61 6d 65 22 0a 20 20 20 20  tory $name".    
0de0: 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20  vfs::filesystem 
0df0: 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a 76 66  posixerror $::vf
0e00: 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 29 0a  s::posix(EROFS).
0e10: 7d 0a 0a 70 72 6f 63 20 76 66 73 3a 3a 7a 69 70  }..proc vfs::zip
0e20: 3a 3a 72 65 6d 6f 76 65 64 69 72 65 63 74 6f 72  ::removedirector
0e30: 79 20 7b 7a 69 70 66 64 20 6e 61 6d 65 20 72 65  y {zipfd name re
0e40: 63 75 72 73 69 76 65 7d 20 7b 0a 20 20 20 20 23  cursive} {.    #
0e50: 3a 3a 76 66 73 3a 3a 6c 6f 67 20 22 72 65 6d 6f  ::vfs::log "remo
0e60: 76 65 64 69 72 65 63 74 6f 72 79 20 24 6e 61 6d  vedirectory $nam
0e70: 65 22 0a 20 20 20 20 76 66 73 3a 3a 66 69 6c 65  e".    vfs::file
0e80: 73 79 73 74 65 6d 20 70 6f 73 69 78 65 72 72 6f  system posixerro
0e90: 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 69 78 28  r $::vfs::posix(
0ea0: 45 52 4f 46 53 29 0a 7d 0a 0a 70 72 6f 63 20 76  EROFS).}..proc v
0eb0: 66 73 3a 3a 7a 69 70 3a 3a 64 65 6c 65 74 65 66  fs::zip::deletef
0ec0: 69 6c 65 20 7b 7a 69 70 66 64 20 6e 61 6d 65 7d  ile {zipfd name}
0ed0: 20 7b 0a 20 20 20 20 23 3a 3a 76 66 73 3a 3a 6c   {.    #::vfs::l
0ee0: 6f 67 20 22 64 65 6c 65 74 65 66 69 6c 65 20 24  og "deletefile $
0ef0: 6e 61 6d 65 22 0a 20 20 20 20 76 66 73 3a 3a 66  name".    vfs::f
0f00: 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65  ilesystem posixe
0f10: 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73  rror $::vfs::pos
0f20: 69 78 28 45 52 4f 46 53 29 0a 7d 0a 0a 70 72 6f  ix(EROFS).}..pro
0f30: 63 20 76 66 73 3a 3a 7a 69 70 3a 3a 66 69 6c 65  c vfs::zip::file
0f40: 61 74 74 72 69 62 75 74 65 73 20 7b 7a 69 70 66  attributes {zipf
0f50: 64 20 6e 61 6d 65 20 61 72 67 73 7d 20 7b 0a 20  d name args} {. 
0f60: 20 20 20 23 3a 3a 76 66 73 3a 3a 6c 6f 67 20 22     #::vfs::log "
0f70: 66 69 6c 65 61 74 74 72 69 62 75 74 65 73 20 24  fileattributes $
0f80: 61 72 67 73 22 0a 20 20 20 20 73 77 69 74 63 68  args".    switch
0f90: 20 2d 2d 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72   -- [llength $ar
0fa0: 67 73 5d 20 7b 0a 09 30 20 7b 0a 09 20 20 20 20  gs] {..0 {..    
0fb0: 23 20 6c 69 73 74 20 73 74 72 69 6e 67 73 0a 09  # list strings..
0fc0: 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 73 74      return [list
0fd0: 5d 0a 09 7d 0a 09 31 20 7b 0a 09 20 20 20 20 23  ]..}..1 {..    #
0fe0: 20 67 65 74 20 76 61 6c 75 65 0a 09 20 20 20 20   get value..    
0ff0: 73 65 74 20 69 6e 64 65 78 20 5b 6c 69 6e 64 65  set index [linde
1000: 78 20 24 61 72 67 73 20 30 5d 0a 09 20 20 20 20  x $args 0]..    
1010: 72 65 74 75 72 6e 20 22 22 0a 09 7d 0a 09 32 20  return ""..}..2 
1020: 7b 0a 09 20 20 20 20 23 20 73 65 74 20 76 61 6c  {..    # set val
1030: 75 65 0a 09 20 20 20 20 73 65 74 20 69 6e 64 65  ue..    set inde
1040: 78 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20  x [lindex $args 
1050: 30 5d 0a 09 20 20 20 20 73 65 74 20 76 61 6c 20  0]..    set val 
1060: 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 31 5d  [lindex $args 1]
1070: 0a 09 20 20 20 20 76 66 73 3a 3a 66 69 6c 65 73  ..    vfs::files
1080: 79 73 74 65 6d 20 70 6f 73 69 78 65 72 72 6f 72  ystem posixerror
1090: 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45   $::vfs::posix(E
10a0: 52 4f 46 53 29 0a 09 7d 0a 20 20 20 20 7d 0a 7d  ROFS)..}.    }.}
10b0: 0a 0a 70 72 6f 63 20 76 66 73 3a 3a 7a 69 70 3a  ..proc vfs::zip:
10c0: 3a 75 74 69 6d 65 20 7b 66 64 20 70 61 74 68 20  :utime {fd path 
10d0: 61 63 74 69 6d 65 20 6d 74 69 6d 65 7d 20 7b 0a  actime mtime} {.
10e0: 20 20 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73      vfs::filesys
10f0: 74 65 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24  tem posixerror $
1100: 3a 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f  ::vfs::posix(ERO
1110: 46 53 29 0a 7d 0a 0a 23 20 42 65 6c 6f 77 20 63  FS).}..# Below c
1120: 6f 70 69 65 64 20 66 72 6f 6d 20 54 63 6c 4b 69  opied from TclKi
1130: 74 20 64 69 73 74 72 69 62 75 74 69 6f 6e 0a 0a  t distribution..
1140: 23 0a 23 20 5a 49 50 20 64 65 63 6f 64 65 72 3a  #.# ZIP decoder:
1150: 0a 23 0a 23 20 46 6f 72 6d 61 74 20 6f 66 20 7a  .#.# Format of z
1160: 69 70 20 66 69 6c 65 3a 0a 23 20 5b 20 44 61 74  ip file:.# [ Dat
1170: 61 20 5d 2a 20 5b 20 54 4f 43 20 5d 2a 20 45 6e  a ]* [ TOC ]* En
1180: 64 4f 66 41 72 63 68 69 76 65 0a 23 0a 23 20 4e  dOfArchive.#.# N
1190: 6f 74 65 3a 20 54 4f 43 20 69 73 20 72 65 66 65  ote: TOC is refe
11a0: 72 65 64 20 74 6f 20 69 6e 20 5a 49 50 20 64 6f  red to in ZIP do
11b0: 63 20 61 73 20 22 43 65 6e 74 72 61 6c 20 41 72  c as "Central Ar
11c0: 63 68 69 76 65 22 0a 23 0a 23 20 54 68 69 73 20  chive".#.# This 
11d0: 6d 65 61 6e 73 20 74 68 65 72 65 20 61 72 65 20  means there are 
11e0: 74 77 6f 20 77 61 79 73 20 6f 66 20 61 63 63 65  two ways of acce
11f0: 73 73 69 6e 67 3a 0a 23 0a 23 20 31 29 20 66 72  ssing:.#.# 1) fr
1200: 6f 6d 20 74 68 65 20 62 65 67 69 6e 69 6e 67 20  om the begining 
1210: 61 73 20 61 20 73 74 72 65 61 6d 20 2d 20 75 6e  as a stream - un
1220: 74 69 6c 20 74 68 65 20 68 65 61 64 65 72 0a 23  til the header.#
1230: 09 69 73 20 6e 6f 74 20 22 50 4b 5c 30 33 5c 30  .is not "PK\03\0
1240: 34 22 20 2d 20 69 64 65 61 6c 20 66 6f 72 20 75  4" - ideal for u
1250: 6e 7a 69 70 70 69 6e 67 2e 0a 23 0a 23 20 32 29  nzipping..#.# 2)
1260: 20 66 6f 72 20 74 61 62 6c 65 20 6f 66 20 63 6f   for table of co
1270: 6e 74 65 6e 74 73 20 77 69 74 68 6f 75 74 20 72  ntents without r
1280: 65 61 64 69 6e 67 20 65 6e 74 69 72 65 0a 23 09  eading entire.#.
1290: 61 72 63 68 69 76 65 20 62 79 20 66 69 72 73 74  archive by first
12a0: 20 66 65 74 63 68 69 6e 67 20 45 6e 64 4f 66 41   fetching EndOfA
12b0: 72 63 68 69 76 65 2c 20 74 68 65 6e 0a 23 09 6a  rchive, then.#.j
12c0: 75 73 74 20 6c 6f 61 64 69 6e 67 20 74 68 65 20  ust loading the 
12d0: 54 4f 43 0a 23 0a 0a 6e 61 6d 65 73 70 61 63 65  TOC.#..namespace
12e0: 20 65 76 61 6c 20 7a 69 70 20 7b 0a 20 20 20 20   eval zip {.    
12f0: 61 72 72 61 79 20 73 65 74 20 6d 65 74 68 6f 64  array set method
1300: 73 20 7b 0a 09 30 09 7b 73 74 6f 72 65 64 20 2d  s {..0.{stored -
1310: 20 54 68 65 20 66 69 6c 65 20 69 73 20 73 74 6f   The file is sto
1320: 72 65 64 20 28 6e 6f 20 63 6f 6d 70 72 65 73 73  red (no compress
1330: 69 6f 6e 29 7d 0a 09 31 09 7b 73 68 72 75 6e 6b  ion)}..1.{shrunk
1340: 20 2d 20 54 68 65 20 66 69 6c 65 20 69 73 20 53   - The file is S
1350: 68 72 75 6e 6b 7d 0a 09 32 09 7b 72 65 64 75 63  hrunk}..2.{reduc
1360: 65 31 20 2d 20 54 68 65 20 66 69 6c 65 20 69 73  e1 - The file is
1370: 20 52 65 64 75 63 65 64 20 77 69 74 68 20 63 6f   Reduced with co
1380: 6d 70 72 65 73 73 69 6f 6e 20 66 61 63 74 6f 72  mpression factor
1390: 20 31 7d 0a 09 33 09 7b 72 65 64 75 63 65 32 20   1}..3.{reduce2 
13a0: 2d 20 54 68 65 20 66 69 6c 65 20 69 73 20 52 65  - The file is Re
13b0: 64 75 63 65 64 20 77 69 74 68 20 63 6f 6d 70 72  duced with compr
13c0: 65 73 73 69 6f 6e 20 66 61 63 74 6f 72 20 32 7d  ession factor 2}
13d0: 0a 09 34 09 7b 72 65 64 75 63 65 33 20 2d 20 54  ..4.{reduce3 - T
13e0: 68 65 20 66 69 6c 65 20 69 73 20 52 65 64 75 63  he file is Reduc
13f0: 65 64 20 77 69 74 68 20 63 6f 6d 70 72 65 73 73  ed with compress
1400: 69 6f 6e 20 66 61 63 74 6f 72 20 33 7d 0a 09 35  ion factor 3}..5
1410: 09 7b 72 65 64 75 63 65 34 20 2d 20 54 68 65 20  .{reduce4 - The 
1420: 66 69 6c 65 20 69 73 20 52 65 64 75 63 65 64 20  file is Reduced 
1430: 77 69 74 68 20 63 6f 6d 70 72 65 73 73 69 6f 6e  with compression
1440: 20 66 61 63 74 6f 72 20 34 7d 0a 09 36 09 7b 69   factor 4}..6.{i
1450: 6d 70 6c 6f 64 65 20 2d 20 54 68 65 20 66 69 6c  mplode - The fil
1460: 65 20 69 73 20 49 6d 70 6c 6f 64 65 64 7d 0a 09  e is Imploded}..
1470: 37 09 7b 72 65 73 65 72 76 65 64 20 2d 20 52 65  7.{reserved - Re
1480: 73 65 72 76 65 64 20 66 6f 72 20 54 6f 6b 65 6e  served for Token
1490: 69 7a 69 6e 67 20 63 6f 6d 70 72 65 73 73 69 6f  izing compressio
14a0: 6e 20 61 6c 67 6f 72 69 74 68 6d 7d 0a 09 38 09  n algorithm}..8.
14b0: 7b 64 65 66 6c 61 74 65 20 2d 20 54 68 65 20 66  {deflate - The f
14c0: 69 6c 65 20 69 73 20 44 65 66 6c 61 74 65 64 7d  ile is Deflated}
14d0: 0a 09 39 09 7b 72 65 73 65 72 76 65 64 20 2d 20  ..9.{reserved - 
14e0: 52 65 73 65 72 76 65 64 20 66 6f 72 20 65 6e 68  Reserved for enh
14f0: 61 6e 63 65 64 20 44 65 66 6c 61 74 69 6e 67 7d  anced Deflating}
1500: 0a 09 31 30 09 7b 70 6b 69 6d 70 6c 6f 64 65 20  ..10.{pkimplode 
1510: 2d 20 50 4b 57 41 52 45 20 44 61 74 65 20 43 6f  - PKWARE Date Co
1520: 6d 70 72 65 73 73 69 6f 6e 20 4c 69 62 72 61 72  mpression Librar
1530: 79 20 49 6d 70 6c 6f 64 69 6e 67 7d 0a 20 20 20  y Imploding}.   
1540: 20 7d 0a 20 20 20 20 23 20 56 65 72 73 69 6f 6e   }.    # Version
1550: 20 74 79 70 65 73 20 28 68 69 67 68 2d 6f 72 64   types (high-ord
1560: 65 72 20 62 79 74 65 29 0a 20 20 20 20 61 72 72  er byte).    arr
1570: 61 79 20 73 65 74 20 73 79 73 74 65 6d 73 20 7b  ay set systems {
1580: 0a 09 30 09 7b 64 6f 73 7d 0a 09 31 09 7b 61 6d  ..0.{dos}..1.{am
1590: 69 67 61 7d 0a 09 32 09 7b 76 6d 73 7d 0a 09 33  iga}..2.{vms}..3
15a0: 09 7b 75 6e 69 78 7d 0a 09 34 09 7b 76 6d 20 63  .{unix}..4.{vm c
15b0: 6d 73 7d 0a 09 35 09 7b 61 74 61 72 69 7d 0a 09  ms}..5.{atari}..
15c0: 36 09 7b 6f 73 2f 32 7d 0a 09 37 09 7b 6d 61 63  6.{os/2}..7.{mac
15d0: 6f 73 7d 0a 09 38 09 7b 7a 20 73 79 73 74 65 6d  os}..8.{z system
15e0: 20 38 7d 0a 09 39 09 7b 63 70 2f 6d 7d 0a 09 31   8}..9.{cp/m}..1
15f0: 30 09 7b 74 6f 70 73 32 30 7d 0a 09 31 31 09 7b  0.{tops20}..11.{
1600: 77 69 6e 64 6f 77 73 7d 0a 09 31 32 09 7b 71 64  windows}..12.{qd
1610: 6f 73 7d 0a 09 31 33 09 7b 72 69 73 63 6f 73 7d  os}..13.{riscos}
1620: 0a 09 31 34 09 7b 76 66 61 74 7d 0a 09 31 35 09  ..14.{vfat}..15.
1630: 7b 6d 76 73 7d 0a 09 31 36 09 7b 62 65 6f 73 7d  {mvs}..16.{beos}
1640: 0a 09 31 37 09 7b 74 61 6e 64 65 6d 7d 0a 09 31  ..17.{tandem}..1
1650: 38 09 7b 74 68 65 6f 73 7d 0a 20 20 20 20 7d 0a  8.{theos}.    }.
1660: 20 20 20 20 23 20 44 4f 53 20 46 69 6c 65 20 41      # DOS File A
1670: 74 74 72 73 0a 20 20 20 20 61 72 72 61 79 20 73  ttrs.    array s
1680: 65 74 20 64 6f 73 61 74 74 72 73 20 7b 0a 09 31  et dosattrs {..1
1690: 09 7b 72 65 61 64 6f 6e 6c 79 7d 0a 09 32 09 7b  .{readonly}..2.{
16a0: 68 69 64 64 65 6e 7d 0a 09 34 09 7b 73 79 73 74  hidden}..4.{syst
16b0: 65 6d 7d 0a 09 38 09 7b 75 6e 6b 6e 6f 77 6e 38  em}..8.{unknown8
16c0: 7d 0a 09 31 36 09 7b 64 69 72 65 63 74 6f 72 79  }..16.{directory
16d0: 7d 0a 09 33 32 09 7b 61 72 63 68 69 76 65 7d 0a  }..32.{archive}.
16e0: 09 36 34 09 7b 75 6e 6b 6e 6f 77 6e 36 34 7d 0a  .64.{unknown64}.
16f0: 09 31 32 38 09 7b 6e 6f 72 6d 61 6c 7d 0a 20 20  .128.{normal}.  
1700: 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 75 5f    }..    proc u_
1710: 73 68 6f 72 74 20 7b 6e 7d 20 20 7b 20 72 65 74  short {n}  { ret
1720: 75 72 6e 20 5b 65 78 70 72 20 7b 20 28 24 6e 2b  urn [expr { ($n+
1730: 30 78 31 30 30 30 30 29 25 30 78 31 30 30 30 30  0x10000)%0x10000
1740: 20 7d 5d 20 7d 0a 7d 0a 0a 70 72 6f 63 20 7a 69   }] }.}..proc zi
1750: 70 3a 3a 44 6f 73 54 69 6d 65 20 7b 64 61 74 65  p::DosTime {date
1760: 20 74 69 6d 65 7d 20 7b 0a 20 20 20 20 23 20 54   time} {.    # T
1770: 68 65 20 70 72 65 2d 56 46 53 20 65 6e 76 69 72  he pre-VFS envir
1780: 6f 6e 6d 65 6e 74 20 77 69 6c 6c 20 6e 6f 74 20  onment will not 
1790: 68 61 76 65 20 61 63 63 65 73 73 20 74 6f 20 22  have access to "
17a0: 63 6c 6f 63 6b 22 2c 20 73 6f 20 64 6f 6e 27 74  clock", so don't
17b0: 20 65 76 65 6e 0a 20 20 20 20 23 20 62 6f 74 68   even.    # both
17c0: 65 72 0a 20 20 20 20 72 65 74 75 72 6e 20 30 0a  er.    return 0.
17d0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 20 5b 75  .    set time [u
17e0: 5f 73 68 6f 72 74 20 24 74 69 6d 65 5d 0a 20 20  _short $time].  
17f0: 20 20 73 65 74 20 64 61 74 65 20 5b 75 5f 73 68    set date [u_sh
1800: 6f 72 74 20 24 64 61 74 65 5d 0a 0a 20 20 20 20  ort $date]..    
1810: 23 20 74 69 6d 65 20 3d 20 66 65 64 63 62 61 39  # time = fedcba9
1820: 38 37 36 35 34 33 32 31 30 0a 20 20 20 20 23 20  876543210.    # 
1830: 20 20 20 20 20 20 20 48 48 48 48 48 6d 6d 6d 6d         HHHHHmmmm
1840: 6d 6d 53 53 53 53 53 20 28 73 65 63 2f 32 20 61  mmSSSSS (sec/2 a
1850: 63 74 75 61 6c 6c 79 29 0a 0a 20 20 20 20 23 20  ctually)..    # 
1860: 64 61 74 61 20 3d 20 66 65 64 63 62 61 39 38 37  data = fedcba987
1870: 36 35 34 33 32 31 30 0a 20 20 20 20 23 20 20 20  6543210.    #   
1880: 20 20 20 20 20 79 79 79 79 79 79 79 4d 4d 4d 4d       yyyyyyyMMMM
1890: 64 64 64 64 64 0a 0a 20 20 20 20 73 65 74 20 73  ddddd..    set s
18a0: 65 63 20 20 5b 65 78 70 72 20 7b 20 28 24 74 69  ec  [expr { ($ti
18b0: 6d 65 20 26 20 30 78 31 46 29 20 2a 20 32 20 7d  me & 0x1F) * 2 }
18c0: 5d 0a 20 20 20 20 73 65 74 20 6d 69 6e 20 20 5b  ].    set min  [
18d0: 65 78 70 72 20 7b 20 28 24 74 69 6d 65 20 3e 3e  expr { ($time >>
18e0: 20 35 29 20 26 20 30 78 33 46 20 7d 5d 0a 20 20   5) & 0x3F }].  
18f0: 20 20 73 65 74 20 68 6f 75 72 20 5b 65 78 70 72    set hour [expr
1900: 20 7b 20 28 24 74 69 6d 65 20 3e 3e 20 31 31 29   { ($time >> 11)
1910: 20 26 20 30 78 31 46 20 7d 5d 0a 0a 20 20 20 20   & 0x1F }]..    
1920: 73 65 74 20 6d 64 61 79 20 5b 65 78 70 72 20 7b  set mday [expr {
1930: 20 24 64 61 74 65 20 26 20 30 78 31 46 20 7d 5d   $date & 0x1F }]
1940: 0a 20 20 20 20 73 65 74 20 6d 6f 6e 20 20 5b 65  .    set mon  [e
1950: 78 70 72 20 7b 20 28 28 24 64 61 74 65 20 3e 3e  xpr { (($date >>
1960: 20 35 29 20 26 20 30 78 46 29 20 7d 5d 0a 20 20   5) & 0xF) }].  
1970: 20 20 73 65 74 20 79 65 61 72 20 5b 65 78 70 72    set year [expr
1980: 20 7b 20 28 28 24 64 61 74 65 20 3e 3e 20 39 29   { (($date >> 9)
1990: 20 26 20 30 78 46 46 29 20 2b 20 31 39 38 30 20   & 0xFF) + 1980 
19a0: 7d 5d 0a 0a 20 20 20 20 23 20 46 69 78 20 75 70  }]..    # Fix up
19b0: 20 62 61 64 20 64 61 74 65 2f 74 69 6d 65 20 64   bad date/time d
19c0: 61 74 61 2c 20 6e 6f 20 6e 65 65 64 20 74 6f 20  ata, no need to 
19d0: 66 61 69 6c 0a 20 20 20 20 69 66 20 7b 24 73 65  fail.    if {$se
19e0: 63 20 20 3e 20 35 39 7d 20 7b 73 65 74 20 73 65  c  > 59} {set se
19f0: 63 20 20 35 39 7d 0a 20 20 20 20 69 66 20 7b 24  c  59}.    if {$
1a00: 6d 69 6e 20 20 3e 20 35 39 7d 20 7b 73 65 74 20  min  > 59} {set 
1a10: 73 65 63 20 20 35 39 7d 0a 20 20 20 20 69 66 20  sec  59}.    if 
1a20: 7b 24 68 6f 75 72 20 3e 20 32 33 7d 20 7b 73 65  {$hour > 23} {se
1a30: 74 20 68 6f 75 72 20 32 33 7d 0a 20 20 20 20 69  t hour 23}.    i
1a40: 66 20 7b 24 6d 64 61 79 20 3c 20 31 7d 20 20 7b  f {$mday < 1}  {
1a50: 73 65 74 20 6d 64 61 79 20 31 7d 0a 20 20 20 20  set mday 1}.    
1a60: 69 66 20 7b 24 6d 64 61 79 20 3e 20 33 35 7d 20  if {$mday > 35} 
1a70: 7b 73 65 74 20 6d 64 61 79 20 33 35 7d 0a 20 20  {set mday 35}.  
1a80: 20 20 69 66 20 7b 24 6d 6f 6e 20 20 3c 20 31 7d    if {$mon  < 1}
1a90: 20 20 7b 73 65 74 20 6d 6f 6e 20 20 31 7d 0a 20    {set mon  1}. 
1aa0: 20 20 20 69 66 20 7b 24 6d 6f 6e 20 3e 20 31 32     if {$mon > 12
1ab0: 7d 20 20 7b 73 65 74 20 6d 6f 6e 20 20 31 32 7d  }  {set mon  12}
1ac0: 0a 0a 20 20 20 20 73 65 74 20 72 65 73 20 30 0a  ..    set res 0.
1ad0: 20 20 20 20 77 68 69 6c 65 20 7b 24 6d 64 61 79      while {$mday
1ae0: 20 3e 20 31 20 26 26 20 5b 63 61 74 63 68 20 7b   > 1 && [catch {
1af0: 0a 09 73 65 74 20 64 74 20 5b 66 6f 72 6d 61 74  ..set dt [format
1b00: 20 7b 25 34 2e 34 64 2d 25 32 2e 32 64 2d 25 32   {%4.4d-%2.2d-%2
1b10: 2e 32 64 20 25 32 2e 32 64 3a 25 32 2e 32 64 3a  .2d %2.2d:%2.2d:
1b20: 25 32 2e 32 64 7d 20 5c 0a 09 09 20 20 20 20 24  %2.2d} \...    $
1b30: 79 65 61 72 20 24 6d 6f 6e 20 24 6d 64 61 79 20  year $mon $mday 
1b40: 24 68 6f 75 72 20 24 6d 69 6e 20 24 73 65 63 5d  $hour $min $sec]
1b50: 0a 09 73 65 74 20 72 65 73 20 5b 63 6c 6f 63 6b  ..set res [clock
1b60: 20 73 63 61 6e 20 24 64 74 20 2d 67 6d 74 20 31   scan $dt -gmt 1
1b70: 5d 0a 20 20 20 20 7d 5d 7d 20 7b 0a 09 23 20 4f  ].    }]} {..# O
1b80: 6e 6c 79 20 6d 64 61 79 20 63 61 6e 20 62 65 20  nly mday can be 
1b90: 77 72 6f 6e 67 2c 20 61 74 20 65 6e 64 20 6f 66  wrong, at end of
1ba0: 20 6d 6f 6e 74 68 0a 09 69 6e 63 72 20 6d 64 61   month..incr mda
1bb0: 79 20 2d 31 0a 20 20 20 20 7d 0a 0a 20 20 20 20  y -1.    }..    
1bc0: 72 65 74 75 72 6e 20 24 72 65 73 0a 7d 0a 0a 0a  return $res.}...
1bd0: 70 72 6f 63 20 7a 69 70 3a 3a 44 61 74 61 20 7b  proc zip::Data {
1be0: 66 64 20 61 72 72 20 7b 76 61 72 50 74 72 20 22  fd arr {varPtr "
1bf0: 22 7d 20 7b 76 65 72 69 66 79 20 30 7d 7d 20 7b  "} {verify 0}} {
1c00: 0a 20 20 20 20 75 70 76 61 72 20 31 20 24 61 72  .    upvar 1 $ar
1c10: 72 20 73 62 0a 0a 20 20 20 20 69 66 20 7b 20 24  r sb..    if { $
1c20: 76 61 72 50 74 72 20 21 3d 20 22 22 20 7d 20 7b  varPtr != "" } {
1c30: 0a 09 75 70 76 61 72 20 31 20 24 76 61 72 50 74  ..upvar 1 $varPt
1c40: 72 20 64 61 74 61 0a 20 20 20 20 7d 0a 0a 20 20  r data.    }..  
1c50: 20 20 73 65 74 20 62 75 66 20 5b 72 65 61 64 20    set buf [read 
1c60: 24 66 64 20 33 30 5d 0a 20 20 20 20 73 65 74 20  $fd 30].    set 
1c70: 6e 20 5b 62 69 6e 61 72 79 20 73 63 61 6e 20 24  n [binary scan $
1c80: 62 75 66 20 41 34 73 73 73 73 73 69 69 69 73 73  buf A4sssssiiiss
1c90: 20 5c 0a 09 09 68 64 72 20 73 62 28 76 65 72 29   \...hdr sb(ver)
1ca0: 20 73 62 28 66 6c 61 67 73 29 20 73 62 28 6d 65   sb(flags) sb(me
1cb0: 74 68 6f 64 29 20 5c 0a 09 09 74 69 6d 65 20 64  thod) \...time d
1cc0: 61 74 65 20 5c 0a 09 09 73 62 28 63 72 63 29 20  ate \...sb(crc) 
1cd0: 73 62 28 63 73 69 7a 65 29 20 73 62 28 73 69 7a  sb(csize) sb(siz
1ce0: 65 29 20 66 6c 65 6e 20 65 6c 65 6e 5d 0a 0a 20  e) flen elen].. 
1cf0: 20 20 20 69 66 20 7b 20 21 5b 73 74 72 69 6e 67     if { ![string
1d00: 20 65 71 75 61 6c 20 22 50 4b 5c 30 33 5c 30 34   equal "PK\03\04
1d10: 22 20 24 68 64 72 5d 20 7d 20 7b 0a 09 62 69 6e  " $hdr] } {..bin
1d20: 61 72 79 20 73 63 61 6e 20 24 68 64 72 20 48 2a  ary scan $hdr H*
1d30: 20 78 0a 09 65 72 72 6f 72 20 22 62 61 64 20 68   x..error "bad h
1d40: 65 61 64 65 72 3a 20 24 78 22 0a 20 20 20 20 7d  eader: $x".    }
1d50: 0a 20 20 20 20 73 65 74 20 73 62 28 76 65 72 29  .    set sb(ver)
1d60: 09 09 5b 75 5f 73 68 6f 72 74 20 24 73 62 28 76  ..[u_short $sb(v
1d70: 65 72 29 5d 0a 20 20 20 20 73 65 74 20 73 62 28  er)].    set sb(
1d80: 66 6c 61 67 73 29 09 5b 75 5f 73 68 6f 72 74 20  flags).[u_short 
1d90: 24 73 62 28 66 6c 61 67 73 29 5d 0a 20 20 20 20  $sb(flags)].    
1da0: 73 65 74 20 73 62 28 6d 65 74 68 6f 64 29 09 5b  set sb(method).[
1db0: 75 5f 73 68 6f 72 74 20 24 73 62 28 6d 65 74 68  u_short $sb(meth
1dc0: 6f 64 29 5d 0a 20 20 20 20 73 65 74 20 73 62 28  od)].    set sb(
1dd0: 6d 74 69 6d 65 29 09 5b 44 6f 73 54 69 6d 65 20  mtime).[DosTime 
1de0: 24 64 61 74 65 20 24 74 69 6d 65 5d 0a 0a 20 20  $date $time]..  
1df0: 20 20 73 65 74 20 73 62 28 6e 61 6d 65 29 20 5b    set sb(name) [
1e00: 72 65 61 64 20 24 66 64 20 5b 75 5f 73 68 6f 72  read $fd [u_shor
1e10: 74 20 24 66 6c 65 6e 5d 5d 0a 20 20 20 20 73 65  t $flen]].    se
1e20: 74 20 73 62 28 65 78 74 72 61 29 20 5b 72 65 61  t sb(extra) [rea
1e30: 64 20 24 66 64 20 5b 75 5f 73 68 6f 72 74 20 24  d $fd [u_short $
1e40: 65 6c 65 6e 5d 5d 0a 0a 20 20 20 20 69 66 20 7b  elen]]..    if {
1e50: 20 24 76 61 72 50 74 72 20 3d 3d 20 22 22 20 7d   $varPtr == "" }
1e60: 20 7b 0a 09 73 65 65 6b 20 24 66 64 20 24 73 62   {..seek $fd $sb
1e70: 28 63 73 69 7a 65 29 20 63 75 72 72 65 6e 74 0a  (csize) current.
1e80: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 23 20      } else {..# 
1e90: 41 64 64 65 64 20 62 79 20 43 68 75 63 6b 20 46  Added by Chuck F
1ea0: 65 72 72 69 6c 20 31 30 2d 32 36 2d 30 33 20 74  erril 10-26-03 t
1eb0: 6f 20 66 69 78 20 72 65 61 64 69 6e 67 20 6f 66  o fix reading of
1ec0: 20 4f 70 65 6e 4f 66 66 69 63 65 0a 09 23 20 20   OpenOffice..#  
1ed0: 2e 73 78 77 20 66 69 6c 65 73 2e 20 41 6e 79 20  .sxw files. Any 
1ee0: 66 69 6c 65 73 20 69 6e 20 74 68 65 20 7a 69 70  files in the zip
1ef0: 20 74 68 61 74 20 68 61 64 20 61 20 6d 65 74 68   that had a meth
1f00: 6f 64 20 6f 66 20 38 0a 09 23 20 20 28 64 65 66  od of 8..#  (def
1f10: 6c 61 74 65 29 20 66 61 69 6c 65 64 20 68 65 72  late) failed her
1f20: 65 20 62 65 63 61 75 73 65 20 73 69 7a 65 20 61  e because size a
1f30: 6e 64 20 63 73 69 7a 65 20 77 65 72 65 20 7a 65  nd csize were ze
1f40: 72 6f 2e 0a 09 23 20 20 49 27 6d 20 6e 6f 74 20  ro...#  I'm not 
1f50: 73 75 72 65 20 77 68 79 20 74 68 65 20 61 62 6f  sure why the abo
1f60: 76 65 20 63 6f 6d 70 75 74 65 73 20 74 68 65 20  ve computes the 
1f70: 73 69 7a 65 20 61 6e 64 20 63 73 69 7a 65 0a 09  size and csize..
1f80: 23 20 20 77 72 6f 6e 67 2c 20 62 75 74 20 73 74  #  wrong, but st
1f90: 61 74 20 61 70 70 65 61 72 73 20 77 6f 72 6b 73  at appears works
1fa0: 20 70 72 6f 70 65 72 6c 79 2e 20 49 20 6f 72 69   properly. I ori
1fb0: 67 69 6e 61 6c 6c 79 0a 09 23 20 20 63 68 65 63  ginally..#  chec
1fc0: 6b 65 64 20 66 6f 72 20 63 73 69 7a 65 20 6f 66  ked for csize of
1fd0: 20 7a 65 72 6f 2c 20 62 75 74 20 61 64 64 69 6e   zero, but addin
1fe0: 67 20 74 68 69 73 20 63 68 61 6e 67 65 20 64 69  g this change di
1ff0: 64 6e 27 74 0a 09 23 20 20 61 70 70 65 61 72 20  dn't..#  appear 
2000: 74 6f 20 62 72 65 61 6b 20 74 68 65 20 6e 6f 6e  to break the non
2010: 65 20 64 65 66 6c 61 74 65 64 20 66 69 6c 65 20  e deflated file 
2020: 61 63 63 65 73 73 20 61 6e 64 20 73 65 65 6d 65  access and seeme
2030: 64 0a 09 23 20 20 6d 6f 72 65 20 6e 61 74 75 72  d..#  more natur
2040: 61 6c 2e 0a 20 09 7a 69 70 3a 3a 73 74 61 74 20  al.. .zip::stat 
2050: 24 66 64 20 24 73 62 28 6e 61 6d 65 29 20 73 62  $fd $sb(name) sb
2060: 0a 0a 09 73 65 74 20 64 61 74 61 20 5b 72 65 61  ...set data [rea
2070: 64 20 24 66 64 20 24 73 62 28 63 73 69 7a 65 29  d $fd $sb(csize)
2080: 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 66 20  ].    }..    if 
2090: 7b 20 24 73 62 28 66 6c 61 67 73 29 20 26 20 30  { $sb(flags) & 0
20a0: 78 34 20 7d 20 7b 0a 09 23 20 44 61 74 61 20 44  x4 } {..# Data D
20b0: 65 73 63 72 69 70 74 6f 72 20 75 73 65 64 0a 09  escriptor used..
20c0: 73 65 74 20 62 75 66 20 5b 72 65 61 64 20 24 66  set buf [read $f
20d0: 64 20 31 32 5d 0a 09 62 69 6e 61 72 79 20 73 63  d 12]..binary sc
20e0: 61 6e 20 24 62 75 66 20 69 69 69 20 73 62 28 63  an $buf iii sb(c
20f0: 72 63 29 20 73 62 28 63 73 69 7a 65 29 20 73 62  rc) sb(csize) sb
2100: 28 73 69 7a 65 29 0a 20 20 20 20 7d 0a 0a 0a 20  (size).    }... 
2110: 20 20 20 69 66 20 7b 20 24 76 61 72 50 74 72 20     if { $varPtr 
2120: 3d 3d 20 22 22 20 7d 20 7b 0a 09 72 65 74 75 72  == "" } {..retur
2130: 6e 20 22 22 0a 20 20 20 20 7d 0a 0a 20 20 20 20  n "".    }..    
2140: 69 66 20 7b 20 24 73 62 28 6d 65 74 68 6f 64 29  if { $sb(method)
2150: 20 21 3d 20 30 20 7d 20 7b 0a 09 69 66 20 7b 20   != 0 } {..if { 
2160: 5b 63 61 74 63 68 20 7b 0a 09 20 20 20 20 73 65  [catch {..    se
2170: 74 20 64 61 74 61 20 5b 76 66 73 3a 3a 7a 69 70  t data [vfs::zip
2180: 20 2d 6d 6f 64 65 20 64 65 63 6f 6d 70 72 65 73   -mode decompres
2190: 73 20 2d 6e 6f 77 72 61 70 20 31 20 24 64 61 74  s -nowrap 1 $dat
21a0: 61 5d 0a 09 7d 20 65 72 72 5d 20 7d 20 7b 0a 09  a]..} err] } {..
21b0: 20 20 20 20 3a 3a 76 66 73 3a 3a 6c 6f 67 20 22      ::vfs::log "
21c0: 24 73 62 28 6e 61 6d 65 29 3a 20 69 6e 66 6c 61  $sb(name): infla
21d0: 74 65 20 65 72 72 6f 72 3a 20 24 65 72 72 22 0a  te error: $err".
21e0: 09 20 20 20 20 62 69 6e 61 72 79 20 73 63 61 6e  .    binary scan
21f0: 20 24 64 61 74 61 20 48 2a 20 78 0a 09 20 20 20   $data H* x..   
2200: 20 3a 3a 76 66 73 3a 3a 6c 6f 67 20 24 78 0a 09   ::vfs::log $x..
2210: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75  }.    }.    retu
2220: 72 6e 0a 20 20 20 20 69 66 20 7b 20 24 76 65 72  rn.    if { $ver
2230: 69 66 79 20 7d 20 7b 0a 09 73 65 74 20 6e 63 72  ify } {..set ncr
2240: 63 20 5b 76 66 73 3a 3a 63 72 63 20 24 64 61 74  c [vfs::crc $dat
2250: 61 5d 0a 09 69 66 20 7b 20 24 6e 63 72 63 20 21  a]..if { $ncrc !
2260: 3d 20 24 73 62 28 63 72 63 29 20 7d 20 7b 0a 09  = $sb(crc) } {..
2270: 20 20 20 20 74 63 6c 4c 6f 67 20 5b 66 6f 72 6d      tclLog [form
2280: 61 74 20 7b 25 73 3a 20 63 72 63 20 6d 69 73 6d  at {%s: crc mism
2290: 61 74 63 68 3a 20 65 78 70 65 63 74 65 64 20 30  atch: expected 0
22a0: 78 25 78 2c 20 67 6f 74 20 30 78 25 78 7d 20 5c  x%x, got 0x%x} \
22b0: 0a 09 09 20 20 20 20 24 73 62 28 6e 61 6d 65 29  ...    $sb(name)
22c0: 20 24 73 62 28 63 72 63 29 20 24 6e 63 72 63 5d   $sb(crc) $ncrc]
22d0: 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f  ..}.    }.}..pro
22e0: 63 20 7a 69 70 3a 3a 45 6e 64 4f 66 41 72 63 68  c zip::EndOfArch
22f0: 69 76 65 20 7b 66 64 20 61 72 72 7d 20 7b 0a 20  ive {fd arr} {. 
2300: 20 20 20 75 70 76 61 72 20 31 20 24 61 72 72 20     upvar 1 $arr 
2310: 63 62 0a 0a 20 20 20 20 23 20 5b 53 46 20 54 63  cb..    # [SF Tc
2320: 6c 76 66 73 20 42 75 67 20 31 30 30 33 35 37 34  lvfs Bug 1003574
2330: 5d 2e 20 44 6f 20 6e 6f 74 20 73 65 65 6b 20 6f  ]. Do not seek o
2340: 76 65 72 20 62 65 67 69 6e 6e 69 6e 67 20 6f 66  ver beginning of
2350: 20 66 69 6c 65 2e 0a 20 20 20 20 73 65 65 6b 20   file..    seek 
2360: 24 66 64 20 30 20 65 6e 64 0a 0a 20 20 20 20 23  $fd 0 end..    #
2370: 20 4a 75 73 74 20 6c 6f 6f 6b 69 6e 67 20 69 6e   Just looking in
2380: 20 74 68 65 20 6c 61 73 74 20 35 31 32 20 62 79   the last 512 by
2390: 74 65 73 20 6d 61 79 20 62 65 20 65 6e 6f 75 67  tes may be enoug
23a0: 68 20 74 6f 20 68 61 6e 64 6c 65 20 7a 69 70 0a  h to handle zip.
23b0: 20 20 20 20 23 20 61 72 63 68 69 76 65 73 20 77      # archives w
23c0: 69 74 68 6f 75 74 20 63 6f 6d 6d 65 6e 74 73 2c  ithout comments,
23d0: 20 68 6f 77 65 76 65 72 20 66 6f 72 20 61 72 63   however for arc
23e0: 68 69 76 65 73 20 77 68 69 63 68 20 68 61 76 65  hives which have
23f0: 0a 20 20 20 20 23 20 63 6f 6d 6d 65 6e 74 73 20  .    # comments 
2400: 74 68 65 20 63 68 75 6e 6b 20 6d 61 79 20 73 74  the chunk may st
2410: 61 72 74 20 61 74 20 61 6e 20 61 72 62 69 74 72  art at an arbitr
2420: 61 72 79 20 64 69 73 74 61 6e 63 65 20 66 72 6f  ary distance fro
2430: 6d 20 74 68 65 0a 20 20 20 20 23 20 65 6e 64 20  m the.    # end 
2440: 6f 66 20 74 68 65 20 66 69 6c 65 2e 20 53 6f 20  of the file. So 
2450: 69 66 20 77 65 20 64 6f 20 6e 6f 74 20 66 69 6e  if we do not fin
2460: 64 20 74 68 65 20 68 65 61 64 65 72 20 69 6d 6d  d the header imm
2470: 65 64 69 61 74 65 6c 79 0a 20 20 20 20 23 20 77  ediately.    # w
2480: 65 20 68 61 76 65 20 74 6f 20 65 78 74 65 6e 64  e have to extend
2490: 20 74 68 65 20 72 61 6e 67 65 20 6f 66 20 6f 75   the range of ou
24a0: 72 20 73 65 61 72 63 68 2c 20 70 6f 73 73 69 62  r search, possib
24b0: 6c 79 20 75 6e 74 69 6c 20 77 65 0a 20 20 20 20  ly until we.    
24c0: 23 20 68 61 76 65 20 61 20 6c 61 72 67 65 20 70  # have a large p
24d0: 61 72 74 20 6f 66 20 74 68 65 20 61 72 63 68 69  art of the archi
24e0: 76 65 20 69 6e 20 6d 65 6d 6f 72 79 2e 20 57 65  ve in memory. We
24f0: 20 63 61 6e 20 66 61 69 6c 20 6f 6e 6c 79 0a 20   can fail only. 
2500: 20 20 20 23 20 61 66 74 65 72 20 74 68 65 20 77     # after the w
2510: 68 6f 6c 65 20 66 69 6c 65 20 68 61 73 20 62 65  hole file has be
2520: 65 6e 20 73 65 61 72 63 68 65 64 2e 0a 0a 20 20  en searched...  
2530: 20 20 73 65 74 20 73 7a 20 20 5b 74 65 6c 6c 20    set sz  [tell 
2540: 24 66 64 5d 0a 20 20 20 20 73 65 74 20 6c 65 6e  $fd].    set len
2550: 20 35 31 32 0a 20 20 20 20 73 65 74 20 61 74 20   512.    set at 
2560: 20 35 31 32 0a 20 20 20 20 77 68 69 6c 65 20 7b   512.    while {
2570: 31 7d 20 7b 0a 09 69 66 20 7b 24 73 7a 20 3c 20  1} {..if {$sz < 
2580: 24 61 74 7d 20 7b 73 65 74 20 6e 20 2d 24 73 7a  $at} {set n -$sz
2590: 7d 20 65 6c 73 65 20 7b 73 65 74 20 6e 20 2d 24  } else {set n -$
25a0: 61 74 7d 0a 0a 09 73 65 65 6b 20 24 66 64 20 24  at}...seek $fd $
25b0: 6e 20 65 6e 64 0a 09 73 65 74 20 68 64 72 20 5b  n end..set hdr [
25c0: 72 65 61 64 20 24 66 64 20 24 6c 65 6e 5d 0a 09  read $fd $len]..
25d0: 73 65 74 20 70 6f 73 20 5b 73 74 72 69 6e 67 20  set pos [string 
25e0: 66 69 72 73 74 20 22 50 4b 5c 30 35 5c 30 36 22  first "PK\05\06"
25f0: 20 24 68 64 72 5d 0a 09 69 66 20 7b 24 70 6f 73   $hdr]..if {$pos
2600: 20 3d 3d 20 2d 31 7d 20 7b 0a 09 20 20 20 20 69   == -1} {..    i
2610: 66 20 7b 24 61 74 20 3e 3d 20 24 73 7a 7d 20 7b  f {$at >= $sz} {
2620: 0a 09 09 72 65 74 75 72 6e 20 2d 63 6f 64 65 20  ...return -code 
2630: 65 72 72 6f 72 20 22 6e 6f 20 68 65 61 64 65 72  error "no header
2640: 20 66 6f 75 6e 64 22 0a 09 20 20 20 20 7d 0a 09   found"..    }..
2650: 20 20 20 20 73 65 74 20 6c 65 6e 20 35 34 30 20      set len 540 
2660: 3b 20 23 20 61 66 74 65 72 20 31 73 74 20 69 74  ; # after 1st it
2670: 65 72 61 74 69 6f 6e 20 77 65 20 66 6f 72 63 65  eration we force
2680: 20 6f 76 65 72 6c 61 70 20 77 69 74 68 20 6c 61   overlap with la
2690: 73 74 20 62 75 66 66 65 72 0a 09 20 20 20 20 69  st buffer..    i
26a0: 6e 63 72 20 61 74 20 35 31 32 20 3b 20 23 20 74  ncr at 512 ; # t
26b0: 6f 20 65 6e 73 75 72 65 20 74 68 61 74 20 74 68  o ensure that th
26c0: 65 20 70 61 74 74 65 72 6e 20 77 65 20 6c 6f 6f  e pattern we loo
26d0: 6b 20 66 6f 72 20 69 73 20 6e 6f 74 20 73 70 6c  k for is not spl
26e0: 69 74 20 61 74 0a 09 20 20 20 20 23 20 20 20 20  it at..    #    
26f0: 20 20 20 20 20 20 20 3b 20 23 20 61 20 62 75 66         ; # a buf
2700: 66 65 72 20 62 6f 75 6e 64 61 72 79 2c 20 6e 6f  fer boundary, no
2710: 72 20 74 68 65 20 68 65 61 64 65 72 20 69 74 73  r the header its
2720: 65 6c 66 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20  elf..} else {.. 
2730: 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20     break..}.    
2740: 7d 0a 0a 20 20 20 20 73 65 74 20 68 64 72 20 5b  }..    set hdr [
2750: 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 68 64  string range $hd
2760: 72 20 5b 65 78 70 72 20 24 70 6f 73 20 2b 20 34  r [expr $pos + 4
2770: 5d 20 5b 65 78 70 72 20 24 70 6f 73 20 2b 20 32  ] [expr $pos + 2
2780: 31 5d 5d 0a 20 20 20 20 73 65 74 20 70 6f 73 20  1]].    set pos 
2790: 5b 65 78 70 72 20 5b 74 65 6c 6c 20 24 66 64 5d  [expr [tell $fd]
27a0: 20 2b 20 24 70 6f 73 20 2d 20 35 31 32 5d 0a 0a   + $pos - 512]..
27b0: 20 20 20 20 62 69 6e 61 72 79 20 73 63 61 6e 20      binary scan 
27c0: 24 68 64 72 20 73 73 73 73 69 69 73 20 5c 0a 09  $hdr ssssiis \..
27d0: 63 62 28 6e 64 69 73 6b 29 20 63 62 28 63 64 69  cb(ndisk) cb(cdi
27e0: 73 6b 29 20 5c 0a 09 63 62 28 6e 69 74 65 6d 73  sk) \..cb(nitems
27f0: 29 20 63 62 28 6e 74 6f 74 61 6c 29 20 5c 0a 09  ) cb(ntotal) \..
2800: 63 62 28 63 73 69 7a 65 29 20 63 62 28 63 6f 66  cb(csize) cb(cof
2810: 66 29 20 5c 0a 09 63 62 28 63 6f 6d 6d 65 6e 74  f) \..cb(comment
2820: 29 0a 0a 20 20 20 20 73 65 74 20 63 62 28 6e 64  )..    set cb(nd
2830: 69 73 6b 29 09 5b 75 5f 73 68 6f 72 74 20 24 63  isk).[u_short $c
2840: 62 28 6e 64 69 73 6b 29 5d 0a 20 20 20 20 73 65  b(ndisk)].    se
2850: 74 20 63 62 28 6e 69 74 65 6d 73 29 09 5b 75 5f  t cb(nitems).[u_
2860: 73 68 6f 72 74 20 24 63 62 28 6e 69 74 65 6d 73  short $cb(nitems
2870: 29 5d 0a 20 20 20 20 73 65 74 20 63 62 28 6e 74  )].    set cb(nt
2880: 6f 74 61 6c 29 09 5b 75 5f 73 68 6f 72 74 20 24  otal).[u_short $
2890: 63 62 28 6e 74 6f 74 61 6c 29 5d 0a 20 20 20 20  cb(ntotal)].    
28a0: 73 65 74 20 63 62 28 63 6f 6d 6d 65 6e 74 29 09  set cb(comment).
28b0: 5b 75 5f 73 68 6f 72 74 20 24 63 62 28 63 6f 6d  [u_short $cb(com
28c0: 6d 65 6e 74 29 5d 0a 0a 20 20 20 20 23 20 43 6f  ment)]..    # Co
28d0: 6d 70 75 74 65 20 62 61 73 65 20 66 6f 72 20 73  mpute base for s
28e0: 69 74 75 61 74 69 6f 6e 73 20 77 68 65 72 65 20  ituations where 
28f0: 5a 49 50 20 66 69 6c 65 0a 20 20 20 20 23 20 68  ZIP file.    # h
2900: 61 73 20 62 65 65 6e 20 61 70 70 65 6e 64 65 64  as been appended
2910: 20 74 6f 20 61 6e 6f 74 68 65 72 20 6d 65 64 69   to another medi
2920: 61 20 28 65 2e 67 2e 20 45 58 45 29 0a 20 20 20  a (e.g. EXE).   
2930: 20 73 65 74 20 63 62 28 62 61 73 65 29 09 5b 65   set cb(base).[e
2940: 78 70 72 20 7b 20 24 70 6f 73 20 2d 20 24 63 62  xpr { $pos - $cb
2950: 28 63 73 69 7a 65 29 20 2d 20 24 63 62 28 63 6f  (csize) - $cb(co
2960: 66 66 29 20 7d 5d 0a 7d 0a 0a 70 72 6f 63 20 7a  ff) }].}..proc z
2970: 69 70 3a 3a 54 4f 43 20 7b 66 64 20 61 72 72 7d  ip::TOC {fd arr}
2980: 20 7b 0a 20 20 20 20 75 70 76 61 72 20 23 30 20   {.    upvar #0 
2990: 7a 69 70 3a 3a 24 66 64 20 63 62 0a 20 20 20 20  zip::$fd cb.    
29a0: 75 70 76 61 72 20 31 20 24 61 72 72 20 73 62 0a  upvar 1 $arr sb.
29b0: 0a 20 20 20 20 73 65 74 20 62 75 66 20 5b 72 65  .    set buf [re
29c0: 61 64 20 24 66 64 20 34 36 5d 0a 0a 20 20 20 20  ad $fd 46]..    
29d0: 62 69 6e 61 72 79 20 73 63 61 6e 20 24 62 75 66  binary scan $buf
29e0: 20 41 34 73 73 73 73 73 73 69 69 69 73 73 73 73   A4ssssssiiissss
29f0: 73 69 69 20 68 64 72 20 5c 0a 20 20 20 20 20 20  sii hdr \.      
2a00: 73 62 28 76 65 6d 29 20 73 62 28 76 65 72 29 20  sb(vem) sb(ver) 
2a10: 73 62 28 66 6c 61 67 73 29 20 73 62 28 6d 65 74  sb(flags) sb(met
2a20: 68 6f 64 29 20 74 69 6d 65 20 64 61 74 65 20 5c  hod) time date \
2a30: 0a 20 20 20 20 20 20 73 62 28 63 72 63 29 20 73  .      sb(crc) s
2a40: 62 28 63 73 69 7a 65 29 20 73 62 28 73 69 7a 65  b(csize) sb(size
2a50: 29 20 5c 0a 20 20 20 20 20 20 66 6c 65 6e 20 65  ) \.      flen e
2a60: 6c 65 6e 20 63 6c 65 6e 20 73 62 28 64 69 73 6b  len clen sb(disk
2a70: 29 20 73 62 28 61 74 74 72 29 20 5c 0a 20 20 20  ) sb(attr) \.   
2a80: 20 20 20 73 62 28 61 74 78 29 20 73 62 28 69 6e     sb(atx) sb(in
2a90: 6f 29 0a 0a 20 20 20 20 73 65 74 20 73 62 28 69  o)..    set sb(i
2aa0: 6e 6f 29 20 5b 65 78 70 72 20 7b 24 63 62 28 62  no) [expr {$cb(b
2ab0: 61 73 65 29 20 2b 20 24 73 62 28 69 6e 6f 29 7d  ase) + $sb(ino)}
2ac0: 5d 0a 0a 20 20 20 20 69 66 20 7b 20 21 5b 73 74  ]..    if { ![st
2ad0: 72 69 6e 67 20 65 71 75 61 6c 20 22 50 4b 5c 30  ring equal "PK\0
2ae0: 31 5c 30 32 22 20 24 68 64 72 5d 20 7d 20 7b 0a  1\02" $hdr] } {.
2af0: 09 62 69 6e 61 72 79 20 73 63 61 6e 20 24 68 64  .binary scan $hd
2b00: 72 20 48 2a 20 78 0a 09 65 72 72 6f 72 20 22 62  r H* x..error "b
2b10: 61 64 20 63 65 6e 74 72 61 6c 20 68 65 61 64 65  ad central heade
2b20: 72 3a 20 24 78 22 0a 20 20 20 20 7d 0a 0a 20 20  r: $x".    }..  
2b30: 20 20 66 6f 72 65 61 63 68 20 76 20 7b 76 65 6d    foreach v {vem
2b40: 20 76 65 72 20 66 6c 61 67 73 20 6d 65 74 68 6f   ver flags metho
2b50: 64 20 64 69 73 6b 20 61 74 74 72 7d 20 7b 0a 09  d disk attr} {..
2b60: 73 65 74 20 63 62 28 24 76 29 20 5b 75 5f 73 68  set cb($v) [u_sh
2b70: 6f 72 74 20 5b 73 65 74 20 73 62 28 24 76 29 5d  ort [set sb($v)]
2b80: 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74  ].    }..    set
2b90: 20 73 62 28 6d 74 69 6d 65 29 20 5b 44 6f 73 54   sb(mtime) [DosT
2ba0: 69 6d 65 20 24 64 61 74 65 20 24 74 69 6d 65 5d  ime $date $time]
2bb0: 0a 20 20 20 20 73 65 74 20 73 62 28 6d 6f 64 65  .    set sb(mode
2bc0: 29 20 5b 65 78 70 72 20 7b 20 28 24 73 62 28 61  ) [expr { ($sb(a
2bd0: 74 78 29 20 3e 3e 20 31 36 29 20 26 20 30 78 66  tx) >> 16) & 0xf
2be0: 66 66 66 20 7d 5d 0a 20 20 20 20 69 66 20 7b 20  fff }].    if { 
2bf0: 28 20 24 73 62 28 61 74 78 29 20 26 20 30 78 66  ( $sb(atx) & 0xf
2c00: 66 20 29 20 26 20 31 36 20 7d 20 7b 0a 09 73 65  f ) & 16 } {..se
2c10: 74 20 73 62 28 74 79 70 65 29 20 64 69 72 65 63  t sb(type) direc
2c20: 74 6f 72 79 0a 20 20 20 20 7d 20 65 6c 73 65 20  tory.    } else 
2c30: 7b 0a 09 73 65 74 20 73 62 28 74 79 70 65 29 20  {..set sb(type) 
2c40: 66 69 6c 65 0a 20 20 20 20 7d 0a 20 20 20 20 73  file.    }.    s
2c50: 65 74 20 73 62 28 6e 61 6d 65 29 20 5b 72 65 61  et sb(name) [rea
2c60: 64 20 24 66 64 20 5b 75 5f 73 68 6f 72 74 20 24  d $fd [u_short $
2c70: 66 6c 65 6e 5d 5d 0a 20 20 20 20 73 65 74 20 73  flen]].    set s
2c80: 62 28 65 78 74 72 61 29 20 5b 72 65 61 64 20 24  b(extra) [read $
2c90: 66 64 20 5b 75 5f 73 68 6f 72 74 20 24 65 6c 65  fd [u_short $ele
2ca0: 6e 5d 5d 0a 20 20 20 20 73 65 74 20 73 62 28 63  n]].    set sb(c
2cb0: 6f 6d 6d 65 6e 74 29 20 5b 72 65 61 64 20 24 66  omment) [read $f
2cc0: 64 20 5b 75 5f 73 68 6f 72 74 20 24 63 6c 65 6e  d [u_short $clen
2cd0: 5d 5d 0a 7d 0a 0a 70 72 6f 63 20 7a 69 70 3a 3a  ]].}..proc zip::
2ce0: 6f 70 65 6e 20 7b 70 61 74 68 7d 20 7b 0a 20 20  open {path} {.  
2cf0: 20 20 73 65 74 20 66 64 20 5b 3a 3a 6f 70 65 6e    set fd [::open
2d00: 20 24 70 61 74 68 5d 0a 20 20 20 20 0a 20 20 20   $path].    .   
2d10: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 0a 09 75   if {[catch {..u
2d20: 70 76 61 72 20 23 30 20 7a 69 70 3a 3a 24 66 64  pvar #0 zip::$fd
2d30: 20 63 62 0a 09 75 70 76 61 72 20 23 30 20 7a 69   cb..upvar #0 zi
2d40: 70 3a 3a 24 66 64 2e 74 6f 63 20 74 6f 63 0a 0a  p::$fd.toc toc..
2d50: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 20  .fconfigure $fd 
2d60: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 62 69 6e  -translation bin
2d70: 61 72 79 20 3b 23 2d 62 75 66 66 65 72 69 6e 67  ary ;#-buffering
2d80: 20 6e 6f 6e 65 0a 09 0a 09 7a 69 70 3a 3a 45 6e   none....zip::En
2d90: 64 4f 66 41 72 63 68 69 76 65 20 24 66 64 20 63  dOfArchive $fd c
2da0: 62 0a 0a 09 73 65 65 6b 20 24 66 64 20 5b 65 78  b...seek $fd [ex
2db0: 70 72 20 7b 24 63 62 28 62 61 73 65 29 20 2b 20  pr {$cb(base) + 
2dc0: 24 63 62 28 63 6f 66 66 29 7d 5d 20 73 74 61 72  $cb(coff)}] star
2dd0: 74 0a 0a 09 73 65 74 20 74 6f 63 28 5f 29 20 30  t...set toc(_) 0
2de0: 3b 20 75 6e 73 65 74 20 74 6f 63 28 5f 29 3b 20  ; unset toc(_); 
2df0: 23 4d 61 6b 65 41 72 72 61 79 0a 09 0a 09 66 6f  #MakeArray....fo
2e00: 72 20 7b 20 73 65 74 20 69 20 30 20 7d 20 7b 20  r { set i 0 } { 
2e10: 24 69 20 3c 20 24 63 62 28 6e 69 74 65 6d 73 29  $i < $cb(nitems)
2e20: 20 7d 20 7b 20 69 6e 63 72 20 69 20 7d 20 7b 0a   } { incr i } {.
2e30: 09 20 20 20 20 7a 69 70 3a 3a 54 4f 43 20 24 66  .    zip::TOC $f
2e40: 64 20 73 62 0a 09 20 20 20 20 0a 09 20 20 20 20  d sb..    ..    
2e50: 73 65 74 20 73 62 28 64 65 70 74 68 29 20 5b 6c  set sb(depth) [l
2e60: 6c 65 6e 67 74 68 20 5b 66 69 6c 65 20 73 70 6c  length [file spl
2e70: 69 74 20 24 73 62 28 6e 61 6d 65 29 5d 5d 0a 09  it $sb(name)]]..
2e80: 20 20 20 20 0a 09 20 20 20 20 73 65 74 20 6e 61      ..    set na
2e90: 6d 65 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77  me [string tolow
2ea0: 65 72 20 24 73 62 28 6e 61 6d 65 29 5d 0a 09 20  er $sb(name)].. 
2eb0: 20 20 20 73 65 74 20 74 6f 63 28 24 6e 61 6d 65     set toc($name
2ec0: 29 20 5b 61 72 72 61 79 20 67 65 74 20 73 62 5d  ) [array get sb]
2ed0: 0a 09 20 20 20 20 46 41 4b 45 44 49 52 20 74 6f  ..    FAKEDIR to
2ee0: 63 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20  c [file dirname 
2ef0: 24 6e 61 6d 65 5d 0a 09 7d 0a 20 20 20 20 7d 20  $name]..}.    } 
2f00: 65 72 72 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24  err]} {..close $
2f10: 66 64 0a 09 72 65 74 75 72 6e 20 2d 63 6f 64 65  fd..return -code
2f20: 20 65 72 72 6f 72 20 24 65 72 72 0a 20 20 20 20   error $err.    
2f30: 7d 0a 0a 20 20 20 20 72 65 74 75 72 6e 20 24 66  }..    return $f
2f40: 64 0a 7d 0a 0a 70 72 6f 63 20 7a 69 70 3a 3a 46  d.}..proc zip::F
2f50: 41 4b 45 44 49 52 20 7b 61 72 72 20 70 61 74 68  AKEDIR {arr path
2f60: 7d 20 7b 0a 20 20 20 20 75 70 76 61 72 20 31 20  } {.    upvar 1 
2f70: 24 61 72 72 20 74 6f 63 0a 0a 20 20 20 20 69 66  $arr toc..    if
2f80: 20 7b 20 24 70 61 74 68 20 3d 3d 20 22 2e 22 7d   { $path == "."}
2f90: 20 7b 20 72 65 74 75 72 6e 20 7d 0a 0a 0a 20 20   { return }...  
2fa0: 20 20 69 66 20 7b 20 21 5b 69 6e 66 6f 20 65 78    if { ![info ex
2fb0: 69 73 74 73 20 74 6f 63 28 24 70 61 74 68 29 5d  ists toc($path)]
2fc0: 20 7d 20 7b 0a 09 23 20 49 6d 70 6c 69 63 69 74   } {..# Implicit
2fd0: 20 64 69 72 65 63 74 6f 72 79 0a 09 6c 61 70 70   directory..lapp
2fe0: 65 6e 64 20 74 6f 63 28 24 70 61 74 68 29 20 5c  end toc($path) \
2ff0: 0a 09 09 6e 61 6d 65 20 24 70 61 74 68 20 5c 0a  ...name $path \.
3000: 09 09 74 79 70 65 20 64 69 72 65 63 74 6f 72 79  ..type directory
3010: 20 6d 74 69 6d 65 20 30 20 73 69 7a 65 20 30 20   mtime 0 size 0 
3020: 6d 6f 64 65 20 30 37 37 37 20 5c 0a 09 09 69 6e  mode 0777 \...in
3030: 6f 20 2d 31 20 64 65 70 74 68 20 5b 6c 6c 65 6e  o -1 depth [llen
3040: 67 74 68 20 5b 66 69 6c 65 20 73 70 6c 69 74 20  gth [file split 
3050: 24 70 61 74 68 5d 5d 0a 20 20 20 20 7d 0a 20 20  $path]].    }.  
3060: 20 20 46 41 4b 45 44 49 52 20 74 6f 63 20 5b 66    FAKEDIR toc [f
3070: 69 6c 65 20 64 69 72 6e 61 6d 65 20 24 70 61 74  ile dirname $pat
3080: 68 5d 0a 7d 0a 0a 70 72 6f 63 20 7a 69 70 3a 3a  h].}..proc zip::
3090: 65 78 69 73 74 73 20 7b 66 64 20 70 61 74 68 7d  exists {fd path}
30a0: 20 7b 0a 20 20 20 20 23 3a 3a 76 66 73 3a 3a 6c   {.    #::vfs::l
30b0: 6f 67 20 22 24 66 64 20 24 70 61 74 68 22 0a 20  og "$fd $path". 
30c0: 20 20 20 69 66 20 7b 24 70 61 74 68 20 3d 3d 20     if {$path == 
30d0: 22 22 7d 20 7b 0a 09 72 65 74 75 72 6e 20 31 0a  ""} {..return 1.
30e0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 75 70      } else {..up
30f0: 76 61 72 20 23 30 20 7a 69 70 3a 3a 24 66 64 2e  var #0 zip::$fd.
3100: 74 6f 63 20 74 6f 63 0a 09 69 6e 66 6f 20 65 78  toc toc..info ex
3110: 69 73 74 73 20 74 6f 63 28 5b 73 74 72 69 6e 67  ists toc([string
3120: 20 74 6f 6c 6f 77 65 72 20 24 70 61 74 68 5d 29   tolower $path])
3130: 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 7a  .    }.}..proc z
3140: 69 70 3a 3a 73 74 61 74 20 7b 66 64 20 70 61 74  ip::stat {fd pat
3150: 68 20 61 72 72 7d 20 7b 0a 20 20 20 20 75 70 76  h arr} {.    upv
3160: 61 72 20 23 30 20 7a 69 70 3a 3a 24 66 64 2e 74  ar #0 zip::$fd.t
3170: 6f 63 20 74 6f 63 0a 20 20 20 20 75 70 76 61 72  oc toc.    upvar
3180: 20 31 20 24 61 72 72 20 73 62 0a 0a 20 20 20 20   1 $arr sb..    
3190: 73 65 74 20 6e 61 6d 65 20 5b 73 74 72 69 6e 67  set name [string
31a0: 20 74 6f 6c 6f 77 65 72 20 24 70 61 74 68 5d 0a   tolower $path].
31b0: 20 20 20 20 69 66 20 7b 20 24 6e 61 6d 65 20 3d      if { $name =
31c0: 3d 20 22 22 20 7c 7c 20 24 6e 61 6d 65 20 3d 3d  = "" || $name ==
31d0: 20 22 2e 22 20 7d 20 7b 0a 09 61 72 72 61 79 20   "." } {..array 
31e0: 73 65 74 20 73 62 20 7b 0a 09 20 20 20 20 74 79  set sb {..    ty
31f0: 70 65 20 64 69 72 65 63 74 6f 72 79 20 6d 74 69  pe directory mti
3200: 6d 65 20 30 20 73 69 7a 65 20 30 20 6d 6f 64 65  me 0 size 0 mode
3210: 20 30 37 37 37 20 0a 09 20 20 20 20 69 6e 6f 20   0777 ..    ino 
3220: 2d 31 20 64 65 70 74 68 20 30 20 6e 61 6d 65 20  -1 depth 0 name 
3230: 22 22 0a 09 7d 0a 20 20 20 20 7d 20 65 6c 73 65  ""..}.    } else
3240: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74  if {![info exist
3250: 73 20 74 6f 63 28 24 6e 61 6d 65 29 5d 20 7d 20  s toc($name)] } 
3260: 7b 0a 09 72 65 74 75 72 6e 20 2d 63 6f 64 65 20  {..return -code 
3270: 65 72 72 6f 72 20 22 63 6f 75 6c 64 20 6e 6f 74  error "could not
3280: 20 72 65 61 64 20 5c 22 24 70 61 74 68 5c 22 3a   read \"$path\":
3290: 20 6e 6f 20 73 75 63 68 20 66 69 6c 65 20 6f 72   no such file or
32a0: 20 64 69 72 65 63 74 6f 72 79 22 0a 20 20 20 20   directory".    
32b0: 7d 20 65 6c 73 65 20 7b 0a 09 61 72 72 61 79 20  } else {..array 
32c0: 73 65 74 20 73 62 20 24 74 6f 63 28 24 6e 61 6d  set sb $toc($nam
32d0: 65 29 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74  e).    }.    set
32e0: 20 73 62 28 64 65 76 29 20 2d 31 0a 20 20 20 20   sb(dev) -1.    
32f0: 73 65 74 20 73 62 28 75 69 64 29 09 2d 31 0a 20  set sb(uid).-1. 
3300: 20 20 20 73 65 74 20 73 62 28 67 69 64 29 09 2d     set sb(gid).-
3310: 31 0a 20 20 20 20 73 65 74 20 73 62 28 6e 6c 69  1.    set sb(nli
3320: 6e 6b 29 20 31 0a 20 20 20 20 73 65 74 20 73 62  nk) 1.    set sb
3330: 28 61 74 69 6d 65 29 20 24 73 62 28 6d 74 69 6d  (atime) $sb(mtim
3340: 65 29 0a 20 20 20 20 73 65 74 20 73 62 28 63 74  e).    set sb(ct
3350: 69 6d 65 29 20 24 73 62 28 6d 74 69 6d 65 29 0a  ime) $sb(mtime).
3360: 20 20 20 20 72 65 74 75 72 6e 20 22 22 0a 7d 0a      return "".}.
3370: 0a 23 20 54 72 65 61 74 73 20 65 6d 70 74 79 20  .# Treats empty 
3380: 70 61 74 74 65 72 6e 20 61 73 20 61 73 6b 69 6e  pattern as askin
3390: 67 20 66 6f 72 20 61 20 70 61 72 74 69 63 75 6c  g for a particul
33a0: 61 72 20 66 69 6c 65 20 6f 6e 6c 79 0a 70 72 6f  ar file only.pro
33b0: 63 20 7a 69 70 3a 3a 67 65 74 64 69 72 20 7b 66  c zip::getdir {f
33c0: 64 20 70 61 74 68 20 7b 70 61 74 20 2a 7d 7d 20  d path {pat *}} 
33d0: 7b 0a 20 20 20 20 23 3a 3a 76 66 73 3a 3a 6c 6f  {.    #::vfs::lo
33e0: 67 20 5b 6c 69 73 74 20 67 65 74 64 69 72 20 24  g [list getdir $
33f0: 66 64 20 24 70 61 74 68 20 24 70 61 74 5d 0a 20  fd $path $pat]. 
3400: 20 20 20 75 70 76 61 72 20 23 30 20 7a 69 70 3a     upvar #0 zip:
3410: 3a 24 66 64 2e 74 6f 63 20 74 6f 63 0a 0a 20 20  :$fd.toc toc..  
3420: 20 20 69 66 20 7b 20 24 70 61 74 68 20 3d 3d 20    if { $path == 
3430: 22 2e 22 20 7c 7c 20 24 70 61 74 68 20 3d 3d 20  "." || $path == 
3440: 22 22 20 7d 20 7b 0a 09 73 65 74 20 70 61 74 68  "" } {..set path
3450: 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72   [string tolower
3460: 20 24 70 61 74 5d 0a 20 20 20 20 7d 20 65 6c 73   $pat].    } els
3470: 65 20 7b 0a 09 73 65 74 20 70 61 74 68 20 5b 73  e {..set path [s
3480: 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 24 70  tring tolower $p
3490: 61 74 68 5d 0a 09 69 66 20 7b 24 70 61 74 20 21  ath]..if {$pat !
34a0: 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 61 70 70  = ""} {..    app
34b0: 65 6e 64 20 70 61 74 68 20 2f 5b 73 74 72 69 6e  end path /[strin
34c0: 67 20 74 6f 6c 6f 77 65 72 20 24 70 61 74 5d 0a  g tolower $pat].
34d0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74  .}.    }.    set
34e0: 20 64 65 70 74 68 20 5b 6c 6c 65 6e 67 74 68 20   depth [llength 
34f0: 5b 66 69 6c 65 20 73 70 6c 69 74 20 24 70 61 74  [file split $pat
3500: 68 5d 5d 0a 0a 20 20 20 20 23 70 75 74 73 20 73  h]]..    #puts s
3510: 74 64 65 72 72 20 22 67 65 74 64 69 72 20 24 66  tderr "getdir $f
3520: 64 20 24 70 61 74 68 20 24 64 65 70 74 68 20 24  d $path $depth $
3530: 70 61 74 20 5b 61 72 72 61 79 20 6e 61 6d 65 73  pat [array names
3540: 20 74 6f 63 20 24 70 61 74 68 5d 22 0a 20 20 20   toc $path]".   
3550: 20 69 66 20 7b 24 64 65 70 74 68 7d 20 7b 0a 09   if {$depth} {..
3560: 73 65 74 20 72 65 74 20 7b 7d 0a 09 66 6f 72 65  set ret {}..fore
3570: 61 63 68 20 6b 65 79 20 5b 61 72 72 61 79 20 6e  ach key [array n
3580: 61 6d 65 73 20 74 6f 63 20 24 70 61 74 68 5d 20  ames toc $path] 
3590: 7b 0a 09 20 20 20 20 69 66 20 7b 5b 73 74 72 69  {..    if {[stri
35a0: 6e 67 20 69 6e 64 65 78 20 24 6b 65 79 20 65 6e  ng index $key en
35b0: 64 5d 20 3d 3d 20 22 2f 22 7d 20 7b 0a 09 09 23  d] == "/"} {...#
35c0: 20 44 69 72 65 63 74 6f 72 69 65 73 20 61 72 65   Directories are
35d0: 20 6c 69 73 74 65 64 20 74 77 69 63 65 3a 20 62   listed twice: b
35e0: 6f 74 68 20 77 69 74 68 20 61 6e 64 20 77 69 74  oth with and wit
35f0: 68 6f 75 74 0a 09 09 23 20 74 68 65 20 74 72 61  hout...# the tra
3600: 69 6c 69 6e 67 20 27 2f 27 2c 20 73 6f 20 77 65  iling '/', so we
3610: 20 69 67 6e 6f 72 65 20 74 68 65 20 6f 6e 65 20   ignore the one 
3620: 77 69 74 68 0a 09 09 63 6f 6e 74 69 6e 75 65 0a  with...continue.
3630: 09 20 20 20 20 7d 0a 09 20 20 20 20 61 72 72 61  .    }..    arra
3640: 79 20 73 65 74 20 73 62 20 24 74 6f 63 28 24 6b  y set sb $toc($k
3650: 65 79 29 0a 0a 09 20 20 20 20 69 66 20 7b 20 24  ey)...    if { $
3660: 73 62 28 64 65 70 74 68 29 20 3d 3d 20 24 64 65  sb(depth) == $de
3670: 70 74 68 20 7d 20 7b 0a 09 09 69 66 20 7b 5b 69  pth } {...if {[i
3680: 6e 66 6f 20 65 78 69 73 74 73 20 74 6f 63 28 24  nfo exists toc($
3690: 7b 6b 65 79 7d 2f 29 5d 7d 20 7b 0a 09 09 20 20  {key}/)]} {...  
36a0: 20 20 61 72 72 61 79 20 73 65 74 20 73 62 20 24    array set sb $
36b0: 74 6f 63 28 24 7b 6b 65 79 7d 2f 29 0a 09 09 7d  toc(${key}/)...}
36c0: 0a 09 09 6c 61 70 70 65 6e 64 20 72 65 74 20 5b  ...lappend ret [
36d0: 66 69 6c 65 20 74 61 69 6c 20 24 73 62 28 6e 61  file tail $sb(na
36e0: 6d 65 29 5d 0a 09 20 20 20 20 7d 20 65 6c 73 65  me)]..    } else
36f0: 20 7b 0a 09 09 23 3a 3a 76 66 73 3a 3a 6c 6f 67   {...#::vfs::log
3700: 20 22 24 73 62 28 64 65 70 74 68 29 20 76 73 20   "$sb(depth) vs 
3710: 24 64 65 70 74 68 20 66 6f 72 20 24 73 62 28 6e  $depth for $sb(n
3720: 61 6d 65 29 22 0a 09 20 20 20 20 7d 0a 09 20 20  ame)"..    }..  
3730: 20 20 75 6e 73 65 74 20 73 62 0a 09 7d 0a 09 72    unset sb..}..r
3740: 65 74 75 72 6e 20 24 72 65 74 0a 20 20 20 20 7d  eturn $ret.    }
3750: 20 65 6c 73 65 20 7b 0a 09 23 20 6a 75 73 74 20   else {..# just 
3760: 74 68 65 20 27 72 6f 6f 74 27 20 6f 66 20 74 68  the 'root' of th
3770: 65 20 7a 69 70 20 61 72 63 68 69 76 65 2e 20 20  e zip archive.  
3780: 54 68 69 73 20 6f 62 76 69 6f 75 73 6c 79 20 65  This obviously e
3790: 78 69 73 74 73 20 61 6e 64 0a 09 23 20 69 73 20  xists and..# is 
37a0: 61 20 64 69 72 65 63 74 6f 72 79 2e 0a 09 72 65  a directory...re
37b0: 74 75 72 6e 20 5b 6c 69 73 74 20 7b 7d 5d 0a 20  turn [list {}]. 
37c0: 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 7a 69 70     }.}..proc zip
37d0: 3a 3a 5f 63 6c 6f 73 65 20 7b 66 64 7d 20 7b 0a  ::_close {fd} {.
37e0: 20 20 20 20 76 61 72 69 61 62 6c 65 20 24 66 64      variable $fd
37f0: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 24 66  .    variable $f
3800: 64 2e 74 6f 63 0a 20 20 20 20 75 6e 73 65 74 20  d.toc.    unset 
3810: 24 66 64 0a 20 20 20 20 75 6e 73 65 74 20 24 66  $fd.    unset $f
3820: 64 2e 74 6f 63 0a 20 20 20 20 3a 3a 63 6c 6f 73  d.toc.    ::clos
3830: 65 20 24 66 64 0a 7d 0a 0a 23 20 75 73 65 20 7a  e $fd.}..# use z
3840: 6c 69 62 20 74 6f 20 64 65 66 69 6e 65 20 7a 69  lib to define zi
3850: 70 20 61 6e 64 20 63 72 63 20 69 66 20 61 76 61  p and crc if ava
3860: 69 6c 61 62 6c 65 0a 69 66 20 7b 5b 6c 6c 65 6e  ilable.if {[llen
3870: 67 74 68 20 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e  gth [info comman
3880: 64 20 76 66 73 3a 3a 7a 69 70 5d 5d 20 3d 3d 20  d vfs::zip]] == 
3890: 30 20 26 26 20 5b 6c 6c 65 6e 67 74 68 20 5b 69  0 && [llength [i
38a0: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 20 7a 6c 69 62  nfo command zlib
38b0: 5d 5d 20 7c 7c 20 21 5b 63 61 74 63 68 20 7b 6c  ]] || ![catch {l
38c0: 6f 61 64 20 22 22 20 7a 6c 69 62 7d 5d 7d 20 7b  oad "" zlib}]} {
38d0: 0a 09 70 72 6f 63 20 76 66 73 3a 3a 7a 69 70 20  ..proc vfs::zip 
38e0: 7b 66 6c 61 67 20 76 61 6c 75 65 20 61 72 67 73  {flag value args
38f0: 7d 20 7b 0a 09 09 73 77 69 74 63 68 20 2d 67 6c  } {...switch -gl
3900: 6f 62 20 2d 2d 20 22 24 66 6c 61 67 20 24 76 61  ob -- "$flag $va
3910: 6c 75 65 22 20 7b 0a 09 09 09 7b 2d 6d 6f 64 65  lue" {....{-mode
3920: 20 64 2a 7d 20 7b 20 73 65 74 20 6d 6f 64 65 20   d*} { set mode 
3930: 64 65 63 6f 6d 70 72 65 73 73 20 7d 0a 09 09 09  decompress }....
3940: 7b 2d 6d 6f 64 65 20 63 2a 7d 20 7b 20 73 65 74  {-mode c*} { set
3950: 20 6d 6f 64 65 20 63 6f 6d 70 72 65 73 73 20 7d   mode compress }
3960: 0a 09 09 09 64 65 66 61 75 6c 74 20 7b 20 65 72  ....default { er
3970: 72 6f 72 20 22 75 73 61 67 65 3a 20 7a 69 70 20  ror "usage: zip 
3980: 2d 6d 6f 64 65 20 7b 63 6f 6d 70 72 65 73 73 7c  -mode {compress|
3990: 64 65 63 6f 6d 70 72 65 73 73 7d 20 64 61 74 61  decompress} data
39a0: 22 20 7d 0a 09 09 7d 0a 0a 09 09 23 20 6b 6c 75  " }...}....# klu
39b0: 64 67 65 20 74 6f 20 61 6c 6c 6f 77 20 22 2d 6e  dge to allow "-n
39c0: 6f 77 72 61 70 20 31 22 20 61 73 20 73 65 63 6f  owrap 1" as seco
39d0: 6e 64 20 6f 70 74 69 6f 6e 2c 20 35 2d 39 2d 32  nd option, 5-9-2
39e0: 30 30 32 0a 09 09 69 66 20 7b 5b 6c 6c 65 6e 67  002...if {[lleng
39f0: 74 68 20 24 61 72 67 73 5d 20 3e 20 32 20 26 26  th $args] > 2 &&
3a00: 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 73 20 30   [lrange $args 0
3a10: 20 31 5d 20 65 71 20 22 2d 6e 6f 77 72 61 70 20   1] eq "-nowrap 
3a20: 31 22 7d 20 7b 0a 09 09 09 69 66 20 7b 24 6d 6f  1"} {....if {$mo
3a30: 64 65 20 65 71 20 22 63 6f 6d 70 72 65 73 73 22  de eq "compress"
3a40: 7d 20 7b 0a 09 09 09 09 73 65 74 20 6d 6f 64 65  } {.....set mode
3a50: 20 64 65 66 6c 61 74 65 0a 09 09 09 7d 20 65 6c   deflate....} el
3a60: 73 65 20 7b 0a 09 09 09 09 73 65 74 20 6d 6f 64  se {.....set mod
3a70: 65 20 69 6e 66 6c 61 74 65 0a 09 09 09 7d 0a 09  e inflate....}..
3a80: 09 7d 0a 0a 09 09 72 65 74 75 72 6e 20 5b 7a 6c  .}....return [zl
3a90: 69 62 20 24 6d 6f 64 65 20 5b 6c 69 6e 64 65 78  ib $mode [lindex
3aa0: 20 24 61 72 67 73 20 65 6e 64 5d 5d 0a 09 7d 0a   $args end]]..}.
3ab0: 7d 0a                                            }.