TclVFS

2010-05-16  Steve Huntley  <[email protected]>

	* library/vfslib.tcl: Changed memchan condition from Tcl version 8.6 or
	greater to presence of chan command (since chan now in later 8.5 builds)

2010-02-01  Steve Huntley  <[email protected]>

2010-12-29  Steve Huntley  <[email protected]>

	* generic/vfs.c: include sys/stat.h so build under MinGW64 will succeed.
	See bug #3107382.
	* library/zipvfs.tcl: Fixed issues with clock handling, dealing with 
	trying to [open] a directory, reading a zip file that has been appended
	to another file.  See bugs 3103687, 3107380

2010-05-16  Steve Huntley  <[email protected]>

	* library/vfslib.tcl: Changed memchan condition from Tcl version 8.6 or
	greater to presence of chan command (since chan now in later 8.5 builds)

2010-02-01  Steve Huntley  <[email protected]>

 * Copyright (c) 2001-2004 Vince Darley.
 * Copyright (c) 2006 ActiveState Software Inc.
 * 
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */




#include <tcl.h>
/* Required to access the 'stat' structure fields, and TclInExit() */
#include "tclInt.h"
#include "tclPort.h"

/*
 * Windows needs to know which symbols to export.  Unix does not.

 * Copyright (c) 2001-2004 Vince Darley.
 * Copyright (c) 2006 ActiveState Software Inc.
 * 
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_SYS_STAT_H
#  include <sys/stat.h>
#endif
#include <tcl.h>
/* Required to access the 'stat' structure fields, and TclInExit() */
#include "tclInt.h"
#include "tclPort.h"

/*
 * Windows needs to know which symbols to export.  Unix does not.

	"" -
	"r" {
	    if {![::zip::exists $zipfd $name]} {
		vfs::filesystem posixerror $::vfs::posix(ENOENT)
	    }
	    
	    ::zip::stat $zipfd $name sb





	    set nfd [vfs::memchan]
	    fconfigure $nfd -translation binary

	    seek $zipfd $sb(ino) start
	    set data [zip::Data $zipfd sb 0]

................................................................................
    set hour [expr { ($time >> 11) & 0x1F }]

    set mday [expr { $date & 0x1F }]
    set mon  [expr { (($date >> 5) & 0xF) }]
    set year [expr { (($date >> 9) & 0xFF) + 1980 }]

    # 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
}


proc zip::Data {fd arr verify} {
    upvar 1 $arr sb

................................................................................
    # 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]
................................................................................
	    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}]





    binary scan $hdr ssssiis \
	cb(ndisk) cb(cdisk) \
	cb(nitems) cb(ntotal) \
	cb(csize) cb(coff) \
	cb(comment)

................................................................................
    set cb(ndisk)	[u_short $cb(ndisk)]
    set cb(nitems)	[u_short $cb(nitems)]
    set cb(ntotal)	[u_short $cb(ntotal)]
    set cb(comment)	[u_short $cb(comment)]

    # Compute base for situations where ZIP file
    # has been appended to another media (e.g. EXE)
    set cb(base)	[expr { $pos - $cb(csize) - $cb(coff) }]




}

proc zip::TOC {fd arr} {

    upvar 1 $arr sb

    set buf [read $fd 46]

    binary scan $buf A4ssssssiiisssssii hdr \
      sb(vem) sb(ver) sb(flags) sb(method) time date \
      sb(crc) sb(csize) sb(size) \
      flen elen clen sb(disk) sb(attr) \
      sb(atx) sb(ino)



    if { ![string equal "PK\01\02" $hdr] } {
	binary scan $hdr H* x
	return -code error "bad central header: $x"
    }

    foreach v {vem ver flags method disk attr} {
................................................................................
	upvar #0 zip::$fd cb
	upvar #0 zip::$fd.toc toc

	fconfigure $fd -translation binary ;#-buffering none
	
	zip::EndOfArchive $fd cb

	seek $fd $cb(coff) start

	set toc(_) 0; unset toc(_); #MakeArray
	
	for {set i 0} {$i < $cb(nitems)} {incr i} {
	    zip::TOC $fd sb
	    
	    set sb(depth) [llength [file split $sb(name)]]

	"" -
	"r" {
	    if {![::zip::exists $zipfd $name]} {
		vfs::filesystem posixerror $::vfs::posix(ENOENT)
	    }
	    
	    ::zip::stat $zipfd $name sb

            if {$sb(ino) == -1} {
                vfs::filesystem posixerror $::vfs::posix(EISDIR)
            }

	    set nfd [vfs::memchan]
	    fconfigure $nfd -translation binary

	    seek $zipfd $sb(ino) start
	    set data [zip::Data $zipfd sb 0]

................................................................................
    set hour [expr { ($time >> 11) & 0x1F }]

    set mday [expr { $date & 0x1F }]
    set mon  [expr { (($date >> 5) & 0xF) }]
    set year [expr { (($date >> 9) & 0xFF) + 1980 }]

    # Fix up bad date/time data, no need to fail
    if {$sec  > 59} {set sec  59}
    if {$min  > 59} {set min  59}
    if {$hour > 23} {set hour 23}
    if {$mday < 1}  {set mday 1}
    if {$mday > 31} {set mday 31}
    if {$mon  < 1}  {set mon  1}
    if {$mon > 12}  {set mon  12}

    set res 0
    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]



    }

    return $res
}


proc zip::Data {fd arr verify} {
    upvar 1 $arr sb

................................................................................
    # 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]
    if {[info exists ::zip::max_header_seek]} {
        if {$::zip::max_header_seek < $sz} {
            set sz $::zip::max_header_seek
        }
    }
    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]
................................................................................
	    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 seekstart [expr {[tell $fd] - 512}]
     if {$seekstart < 0} {
         set seekstart 0
     }
     set pos [expr {$seekstart + $pos}]

    binary scan $hdr ssssiis \
	cb(ndisk) cb(cdisk) \
	cb(nitems) cb(ntotal) \
	cb(csize) cb(coff) \
	cb(comment)

................................................................................
    set cb(ndisk)	[u_short $cb(ndisk)]
    set cb(nitems)	[u_short $cb(nitems)]
    set cb(ntotal)	[u_short $cb(ntotal)]
    set cb(comment)	[u_short $cb(comment)]

    # Compute base for situations where ZIP file
    # has been appended to another media (e.g. EXE)
    set base            [expr { $pos - $cb(csize) - $cb(coff) }]
    if {$base < 0} {
        set base 0
    }
    set cb(base)	$base
}

proc zip::TOC {fd arr} {
    upvar #0 zip::$fd cb
    upvar 1 $arr sb

    set buf [read $fd 46]

    binary scan $buf A4ssssssiiisssssii hdr \
      sb(vem) sb(ver) sb(flags) sb(method) time date \
      sb(crc) sb(csize) sb(size) \
      flen elen clen sb(disk) sb(attr) \
      sb(atx) sb(ino)

    set sb(ino) [expr {$cb(base) + $sb(ino)}]

    if { ![string equal "PK\01\02" $hdr] } {
	binary scan $hdr H* x
	return -code error "bad central header: $x"
    }

    foreach v {vem ver flags method disk attr} {
................................................................................
	upvar #0 zip::$fd cb
	upvar #0 zip::$fd.toc toc

	fconfigure $fd -translation binary ;#-buffering none
	
	zip::EndOfArchive $fd cb

	seek $fd [expr {$cb(base) + $cb(coff)}] start

	set toc(_) 0; unset toc(_); #MakeArray
	
	for {set i 0} {$i < $cb(nitems)} {incr i} {
	    zip::TOC $fd sb
	    
	    set sb(depth) [llength [file split $sb(name)]]