Index: library/lib/nx-zip.tcl =================================================================== diff -u -N -rce99d2e545ab2b5677045db1184e80f6bded0dbe -rc1579421098e1d84f5013cb865cfcdc81159e4b1 --- library/lib/nx-zip.tcl (.../nx-zip.tcl) (revision ce99d2e545ab2b5677045db1184e80f6bded0dbe) +++ library/lib/nx-zip.tcl (.../nx-zip.tcl) (revision c1579421098e1d84f5013cb865cfcdc81159e4b1) @@ -11,9 +11,16 @@ # package require nx -package require Trf -package provide nx::zip 1.1 +# +# In case, we have not Tcl 8.6, fall back to the package Trf. +# +if {[info commands ::zlib] eq ""} { + package require Trf +} + +package provide nx::zip 1.2 + namespace eval ::nx::zip { nx::Class create Archive { @@ -24,9 +31,9 @@ # - addString (add the file-content from a string to the archive) # # - writeToZipFile (produce a Zip file) - # - ns_returnZipFile (return a zip file via AOLserver ns_return) + # - ns_returnZipFile (return a zip file via AOLserver ns_return) # - # - writeToStream (for already opened and configured + # - writeToStream (for already opened and configured # output streams # @@ -37,7 +44,7 @@ # inputFileName - source file to archive # outputFileName - name of the file in the archive if {![file readable $inputFileName] || [file isdirectory $inputFileName]} { - error "filename $inputFileName does not belong to a readable file" + error "filename $inputFileName does not belong to a readable file" } if {![info exists outputFileName]} {set outputFileName $inputFileName} lappend :files file $inputFileName $outputFileName @@ -72,7 +79,7 @@ set channel [ns_conn channel] fconfigure $channel -translation binary :writeToStream $channel - # aolserver/NaviServer closes the channel automatically + # AOLserver/NaviServer closes the channel automatically } # @@ -86,56 +93,56 @@ # set descriptionList [list] foreach {type in fnOut} ${:files} { - lappend descriptionList [:addSingleFile $type $in $fnOut] + lappend descriptionList [:addSingleFile $type $in $fnOut] } # - # we have no + # we have no # - archive description header # - archive extra data record # # Add the central directory # set :cdOffset ${:written} foreach {type in fnOut} ${:files} desc $descriptionList { - array set "" $desc - - # For every file, it contains again part of the information of - # the local file headers, but with some additional information - # such as a the "version made by", comment, ... + array set "" $desc - set comment "" - set platform 0 ;# dos/windows - #if {$::tcl_platform(platform) ne "windows"} { - # set platform 3 ;# unix - #} + # For every file, it contains again part of the information of + # the local file headers, but with some additional information + # such as a the "version made by", comment, ... - # central file header signature - binary scan \x02\x01\x4B\x50 I CFH_SIG - :writeLong $CFH_SIG + set comment "" + set platform 0 ;# dos/windows + #if {$::tcl_platform(platform) ne "windows"} { + # set platform 3 ;# unix + #} - # version made by (os + zip version) - :writeShort [expr { (($platform << 8) | 20) }] - - :writeFileHeaderBlock $desc + # central file header signature + binary scan \x02\x01\x4B\x50 I CFH_SIG + :writeLong $CFH_SIG - # file comment length - :writeShort [string length $comment] - # disk number start - :writeShort 0 - # internal file attributes - :writeShort 0 - # external file attributes - :writeLong 0 - - # relative offset of local header - :writeLong $(offset) - # file name - :writeString $(fileNameInternal) - - :writeExtraFieldUPATH $(fileName) $(fileNameInternal) - - # file comment - :writeString $comment + # version made by (os + zip version) + :writeShort [expr { (($platform << 8) | 20) }] + + :writeFileHeaderBlock $desc + + # file comment length + :writeShort [string length $comment] + # disk number start + :writeShort 0 + # internal file attributes + :writeShort 0 + # external file attributes + :writeLong 0 + + # relative offset of local header + :writeLong $(offset) + # file name + :writeString $(fileNameInternal) + + :writeExtraFieldUPATH $(fileName) $(fileNameInternal) + + # file comment + :writeString $comment } set :cdLength [expr {${:written} - ${:cdOffset}}] @@ -145,20 +152,20 @@ # binary scan \x06\x05\x4B\x50 I EOCD :writeLong $EOCD - + # disk numbers :writeShort 0 :writeShort 0 - + # number of entries set filenum [expr {[llength ${:files}] / 3}] :writeShort $filenum :writeShort $filenum - + # length and location of CD :writeLong ${:cdLength} :writeLong ${:cdOffset} - + # zip file comment set comment "" @@ -177,52 +184,75 @@ set :written 0 } + if {[info commands ::zlib] eq ""} { + # + # Fallback implementation based on Trf + # + :method crc32 {data} { + return [::crc-zlib -- $data] + } + :method compress {data} { + return [string range [::zip -mode compress -- $data] 2 end-4] + } + + } else { + # + # Implementation based on Tcl 8.6 builtin support. + # + :method crc32 {data} { + return [binary format i [::zlib crc32 $data]] + } + :method compress {data} { + return [string range [::zlib compress $data] 2 end-4] + } + } + # # Output content file to the output stream # :method addSingleFile {type in fnOut} { set (offset) ${:written} - + if {$type eq "file"} { - set fdata [open $in r] - fconfigure $fdata -encoding binary -translation binary - set data [read $fdata] - close $fdata - set mtime [file mtime $in] + set fdata [open $in r] + fconfigure $fdata -encoding binary -translation binary + set data [read $fdata] + close $fdata + set mtime [file mtime $in] } else { - set data [encoding convertto utf-8 $in] - set mtime [clock seconds] + set data [encoding convertto utf-8 $in] + set mtime [clock seconds] } - + # # local file header # binary scan \x04\x03\x4B\x50 I LFH_SIG :writeLong $LFH_SIG - set datacompressed [string range [::zip -mode compress -- $data] 2 end-4] + set datacompressed [:compress $data] - set (dosTime) [:toDosTime $mtime] - set (crc) [::crc-zlib -- $data] - set (csize) [string length $datacompressed] - set (size) [string length $data] + set (dosTime) [:toDosTime $mtime] + set (crc) [:crc32 $data] + set (csize) [string length $datacompressed] + set (size) [string length $data] set (fileName) [encoding convertto utf-8 $fnOut] set (fileNameInternal) $(fileName) #set (fileNameInternal) [encoding convertto cp850 $fnOut] set (extraFieldLength) [expr {9+[string length $(fileName)]}] - + :writeFileHeaderBlock [array get ""] # file name :writeString $(fileNameInternal) - + :writeExtraFieldUPATH $(fileName) $(fileNameInternal) # # file data # :writeString $datacompressed - + return [array get ""] } @@ -238,27 +268,27 @@ # compression method :writeShort 8 - + # last modification time and date :writeLong $(dosTime) :writeString $(crc) :writeLong $(csize) :writeLong $(size) - + # file name length :writeShort [string length $(fileNameInternal)] - + # extra field length :writeShort $(extraFieldLength) } - + # # Convert the provided time stamp to DOS time. # :method toDosTime {time} { foreach {year month day hour minute second} \ - [clock format $time -format "%Y %m %e %k %M %S"] {} + [clock format $time -format "%Y %m %e %k %M %S"] {} set RE {^0([0-9]+)$} regexp $RE $year . year @@ -268,9 +298,9 @@ regexp $RE $minute . minute regexp $RE $second . second - set value [expr {(($year - 1980) << 25) | ($month << 21) | - ($day << 16) | ($hour << 11) | ($minute << 5) | - ($second >> 1)}] + set value [expr {(($year - 1980) << 25) | ($month << 21) | + ($day << 16) | ($hour << 11) | ($minute << 5) | + ($second >> 1)}] return $value } @@ -281,12 +311,12 @@ # extra field UPATH binary scan \x70\x75 S EPEF :writeShort $EPEF - :writeShort [expr {5+[string length $fileName]}] + :writeShort [expr {5 + [string length $fileName]}] :writeByte 1 - :writeString [::crc-zlib $fileNameInternal] + :writeString [:crc32 $fileNameInternal] :writeString $fileName } - + # # Write the provided integer in binary form as a long value (32 bit) # @@ -328,13 +358,21 @@ } if {0} { + set z [::nx::zip::Archive new] - $z addFile README.aol + $z addFile README.aol $z addFile COPYRIGHT - $z addFile nsfUtil.o + $z addFile nsfUtil.o $z addFile doc/nx.css $z addString "This is a file\nthat может be from a string\n" README $z addString "-Avec 3,2% des parts de marché, la France est le sixième plus grand pays fournisseur de l’Autriche. " franz.txt $z writeToZipFile /tmp/test.zip $z destroy } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: