* library/starkit.tcl (header): Added helper command

	  'fullnormalize' and use it to resolve symlinks in the path to
	  the file calling starkit::header. This makes it possible to run
	  starkits and starpacks via symlinks.

	* library/zipvfs.tcl: "zip::DosTime" extended to handle bad
	  timestamps without crashing. Force-fixed to nearest legal
	  date/time. "zip::EndOfArchive" extended to find chunk even
	  if a (long) zip archive comment is present.

diff --git a/ChangeLog b/ChangeLog
index 5f4169150535a3f42e347486eee44bf32ad56fc5..985a7a6b581ff42145c7f544f7bc636ee64e5539 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2007-05-28  Andreas Kupries  <andreask@activestate.com>
+
+       * library/starkit.tcl (header): Added helper command
+         'fullnormalize' and use it to resolve symlinks in the path to
+         the file calling starkit::header. This makes it possible to run
+         starkits and starpacks via symlinks.
+
+2007-04-17  Andreas Kupries  <andreask@activestate.com>
+
+       * library/zipvfs.tcl: "zip::DosTime" extended to handle bad
+         timestamps without crashing. Force-fixed to nearest legal
+         date/time. "zip::EndOfArchive" extended to find chunk even
+         if a (long) zip archive comment is present.
+
 2007-04-13  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
        * Makefile.in:     Applied patch #1589278 to include the template

diff --git a/library/starkit.tcl b/library/starkit.tcl
index a5b7b7ba149ac59e9388671ffb6805fa1dd3ca21..6e48f1c046280a94cc445d63e1c6c1242ef8d093 100644 (file)
--- a/library/starkit.tcl
+++ b/library/starkit.tcl
@@ -37,7 +37,7 @@ namespace eval starkit {
     # called from the header of a starkit
     proc header {driver args} {
        if {[catch {
-           set self [info script]
+           set self [fullnormalize [info script]]
 
            package require ${driver}vfs
            eval [list ::vfs::${driver}::Mount $self $self] $args
@@ -48,6 +48,16 @@ namespace eval starkit {
        }
     }
 
+    proc fullnormalize {path} {
+       # SNARFED from tcllib, fileutil.
+       # 8.5
+       # return [file join {expand}[lrange [file split
+       #    [file normalize [file join $path __dummy__]]] 0 end-1]]
+
+       return [eval [list file join] [lrange [file split \
+                  [file normalize [file join $path __dummy__]]] 0 end-1]]
+    }
+
     # called from the startup script of a starkit to init topdir and auto_path
     # 2003/10/21, added in 1.3: remember startup mode in starkit::mode
     proc startup {} {

diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 382090fd64cd10e04333aa010880176dd02ca370..d86d6199552359541924f0033d11b9860f89e035 100644 (file)
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -240,17 +240,37 @@ proc zip::DosTime {date time} {
     set time [u_short $time]
     set date [u_short $date]
 
-    set sec [expr { ($time & 0x1F) * 2 }]
-    set min [expr { ($time >> 5) & 0x3F }]
+    # time = fedcba9876543210
+    #        HHHHHmmmmmmSSSSS (sec/2 actually)
+
+    # data = fedcba9876543210
+    #        yyyyyyyMMMMddddd
+
+    set sec  [expr { ($time & 0x1F) * 2 }]
+    set min  [expr { ($time >> 5) & 0x3F }]
     set hour [expr { ($time >> 11) & 0x1F }]
 
     set mday [expr { $date & 0x1F }]
-    set mon [expr { (($date >> 5) & 0xF) }]
+    set mon  [expr { (($date >> 5) & 0xF) }]
     set year [expr { (($date >> 9) & 0xFF) + 1980 }]
 
-    set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
-       $year $mon $mday $hour $min $sec]
-    return [clock scan $dt -gmt 1]
+    # Fix up bad date/time data, no need to fail
+    while {$sec  > 59} {incr sec  -60}
+    while {$min  > 59} {incr sec  -60}
+    while {$hour > 23} {incr hour -24}
+    if {$mday < 1}  {incr mday}
+    if {$mon  < 1}  {incr mon}
+    while {$mon > 12} {incr hour -12}
+
+    while {[catch {
+       set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
+                   $year $mon $mday $hour $min $sec]
+       set res [clock scan $dt -gmt 1]
+    }]} {
+       # Only mday can be wrong, at end of month
+       incr mday -1
+    }
+    return $res
 }
 
 
@@ -330,15 +350,36 @@ proc zip::EndOfArchive {fd arr} {
 
     # [SF Tclvfs Bug 1003574]. Do not seek over beginning of file.
     seek $fd 0 end
-    set n [tell $fd]
-    if {$n < 512} {set n -$n} else {set n -512}
-    seek $fd $n end
-
-    set hdr [read $fd 512]
-    set pos [string first "PK\05\06" $hdr]
-    if {$pos == -1} {
-       error "no header found"
+
+    # Just looking in the last 512 bytes may be enough to handle zip
+    # archives without comments, however for archives which have
+    # comments the chunk may start at an arbitrary distance from the
+    # end of the file. So if we do not find the header immediately
+    # we have to extend the range of our search, possibly until we
+    # have a large part of the archive in memory. We can fail only
+    # after the whole file has been searched.
+
+    set sz  [tell $fd]
+    set len 512
+    set at  512
+    while {1} {
+       if {$sz < $at} {set n -$sz} else {set n -$at}
+
+       seek $fd $n end
+       set hdr [read $fd $len]
+       set pos [string first "PK\05\06" $hdr]
+       if {$pos == -1} {
+           if {$at >= $sz} {
+               return -code error "no header found"
+           }
+           set len 540 ; # after 1st iteration we force overlap with last buffer
+           incr at 512 ; # to ensure that the pattern we look for is not split at
+           #           ; # a buffer boundary, nor the header itself
+       } else {
+           break
+       }
     }
+
     set hdr [string range $hdr [expr $pos + 4] [expr $pos + 21]]
     set pos [expr [tell $fd] + $pos - 512]