Tcl Library Source Code

Artifact 2423f13bf445738950227db6e7f394ef2a1f84b1:

Attachment "tar.diff" to ticket [2840180fff] added by anonymous 2014-02-12 12:22:35. (unpublished)

---

Index: modules/tar/tar.tcl
==================================================================
--- modules/tar/tar.tcl
+++ modules/tar/tar.tcl
@@ -143,10 +143,11 @@
     set ret {}
     while {![eof $fh]} {
         array set header [readHeader [read $fh 512]]
 	HandleLongLink $fh header
         if {$header(name) == ""} break
+	if {$header(prefix) != ""} {append header(prefix) /}
         lappend ret $header(prefix)$header(name)
         seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current
     }
     if {!$chan} {
 	close $fh
@@ -167,10 +168,11 @@
     while {![eof $fh]} {
         array set header [readHeader [read $fh 512]]
 	HandleLongLink $fh header
         if {$header(name) == ""} break
         seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current
+	if {$header(prefix) != ""} {append header(prefix) /}
         if {$file != "" && "$header(prefix)$header(name)" != $file} {continue}
         set header(type) [string map {0 file 5 directory 3 characterSpecial 4 blockSpecial 6 fifo 2 link} $header(type)]
         set header(mode) [string range $header(mode) 2 end]
         lappend ret $header(prefix)$header(name) [list mode $header(mode) uid $header(uid) gid $header(gid) \
                     size $header(size) mtime $header(mtime) type $header(type) linkname $header(linkname) \
@@ -194,10 +196,11 @@
     while {![eof $fh]} {
 	set data [read $fh 512]
         array set header [readHeader $data]
 	HandleLongLink $fh header
         if {$header(name) == ""} break
+	if {$header(prefix) != ""} {append header(prefix) /}
         set name [string trimleft $header(prefix)$header(name) /]
         if {$name == $file} {
             set file [read $fh $header(size)]
             if {!$chan} {
 		close $fh
@@ -236,10 +239,11 @@
     }
     while {![eof $fh]} {
         array set header [readHeader [read $fh 512]]
 	HandleLongLink $fh header
         if {$header(name) == ""} break
+	if {$header(prefix) != ""} {append header(prefix) /}
         set name [string trimleft $header(prefix)$header(name) /]
         if {![string match $pattern $name] || ($nooverwrite && [file exists $name])} {
             seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current
             continue
         }
@@ -375,12 +379,16 @@
     
     set name [string trimleft $name /]
     if {[string length $name] > 255} {
         return -code error "path name over 255 chars"
     } elseif {[string length $name] > 100} {
-        set prefix [string range $name 0 end-100]
-        set name [string range $name end-99 end]
+	set common [string range $name end-99 154]
+	if {[set splitpoint [string first / $common]] == -1} {
+	    return -code error "path name cannot be split into prefix and name"
+	}
+	set prefix [string range $name 0 end-100][string range $common 0 $splitpoint-1]
+	set name [string range $common $splitpoint+1 end][string range $name 155 end]
     } else {
         set prefix ""
     }
 
     set header [binary format a100A8A8A8A12A12A8a1a100A6a2a32a32a8a8a155a12 \
@@ -487,10 +495,11 @@
         array set header [readHeader [read $fh 512]]
         if {$header(name) == ""} {
             puts -nonewline $tfh [string repeat \x00 1024]
             break
         }
+	if {$header(prefix) != ""} {append header(prefix) /}
         set name $header(prefix)$header(name)
         set len [expr {$header(size) + [pad $header(size)]}]
         if {[lsearch $files $name] > -1} {
             seek $fh $len current
         } else {