punkshell/src/modules/#modpod-zipper-999999.0a1.0/zipper-999999.0a1.0.tm

# ZIP file constructor

package provide zipper 999999.0a1.0

namespace eval zipper {
    namespace export initialize addentry adddir finalize

    namespace eval v {
        variable fd
        variable base
        variable toc
    }
    
    #if we initialize before writing anything to fd - our base is the file base
    # - ie we get an 'internal preamble'
    #if instead, we write data to fd before initialize, our base is the start of the archive-data.
    # - ie we get an 'external preamble'
    #Either way can work - but some zip utilities expect the base to always be the start of the file,
    #others are able to process the external preamble.
    #If the filename has the .zip extension - there should be no external preamble
    #(utils may follow a different codepath for files with different extensions)
    #
    #It seems to be ok either way for reading - but some tools cannot write to file based offset if there is prefix data
    #(e.g file.kit with offset adjusted with something like zip -A which makes the preamble internal to the zip)
    # and some cannot write to archive-based offset if there is prefix data ! 
    #(e.g file.kit with preamble prepended and offsets not adjusted = external preamble)
    #
    #Some tools may auto-adjust to file-based offset when adding entries (e.g pkzip if extension is .zip)

    proc initialize {fd} {
        set v::fd $fd
        set v::base [tell $fd]
        set v::toc {}
        #fconfigure $fd -translation binary -encoding binary
        fconfigure $fd -translation binary -encoding iso8859-1
    }

    proc emit {s} {
        puts -nonewline $v::fd $s
    }

    proc dostime {sec {gmt 0}} {
        set f [clock format $sec -format {%Y %m %d %H %M %S} -gmt $gmt]
        regsub -all { 0(\d)} $f { \1} f
        foreach {Y M D h m s} $f break
        set date [expr {(($Y-1980)<<9) | ($M<<5) | $D}]
        set time [expr {($h<<11) | ($m<<5) | ($s>>1)}]
        return [list $date $time]
    }

    proc addentry {name contents {unixmtime ""} {force 0}} {
        if {$unixmtime == ""} { set unixmtime [clock seconds] }
        #lassign [dostime $date 1] date time ;#UTC would probably be more sensible - but convention seems to be localtime :/
        lassign [dostime $unixmtime 0] date time
        set flag 0
        set type 0 ;# stored
        set fsize [string length $contents]
        set csize $fsize
        set fnlen [string length $name]

        if {$force > 0 && $force != [string length $contents]} {
        set csize $fsize
        set fsize $force
        set type 8 ;# if we're passing in compressed data, it's deflated
        }

        if {[catch { zlib crc32 $contents } crc]} {
        set crc 0
        } elseif {$type == 0} {
        set cdata [zlib deflate $contents]
        if {[string length $cdata] < [string length $contents]} {
            set contents $cdata
            set csize [string length $cdata]
            set type 8 ;# deflate
        }
        }
        #we are at the position to write a *local* file header (record including file data, and often with some duplication of data in corresponding CDR 'file header' - prior to CDR records)
        #use the position to calculate the offset for the corresponding CDR file header
        # -- --- --- --- --- --- ---
        set local_file_relative_offset [expr {[tell $v::fd] -$v::base}]
        #toc / File header within Central directory structure
        #PK\1\2  - 0x02014b50
        #lappend v::toc "[binary format a2c6ssssiiiss4ii PK {1 2 20 0 20 0} \
        #    $flag $type $time $date $crc $csize $fsize $fnlen \
        #    {0 0 0 0} 128 [tell $v::fd]]$name"
        #build the CDR file header - but we don't add it here 
        set do_extended_timestamp 1
        if {!$do_extended_timestamp} {
            lappend v::toc "[binary format a2c6ssssiiiss4ii PK {1 2 20 0 20 0} \
                $flag $type $time $date $crc $csize $fsize $fnlen \
                {0 0 0 0} 128 $local_file_relative_offset]$name"
        } else {
            set extra ""
            # ---
            #                  Value         Size        Description
            #        -----         ----        -----------
            #(time)  0x5455        Short       tag for this extra block type ("UT")
            #        TSize         Short       total data size for this block
            #        Flags         Byte        info bits (refers to local header!)
            #        (ModTime)     Long        time of last modification (UTC/GMT)
            # ---
            # - Tsize = 9 - 4 = 5
            set extended_timestamp [binary format a2sci UT 5 0 $unixmtime] 
            append extra $extended_timestamp
            # ---

            set extralen [string length $extra]
            lappend v::toc "[binary format a2c6ssssiiisss3ii PK {1 2 20 0 20 0} \
                $flag $type $time $date $crc $csize $fsize $fnlen \
                $extralen {0 0 0} 128 $local_file_relative_offset]$name$extra"
        }
        # -- --- --- --- --- --- ---

        #*Local* File Header PK\3\4 = 0x04034b50 (this is outside of and prior to CDR)
        emit [binary format a2c4ssssiiiss PK {3 4 20 0} \
            $flag $type $time $date $crc $csize $fsize $fnlen 0]
        emit $name
        emit $contents
    }

    proc adddir {name {date ""} {force 0}} {
        set name "${name}/"
        if {$date == ""} { set date [clock seconds] }
        lassign [dostime $date 0] date time
        set flag 0
        set type 0 ;# stored
        set fsize 0
        set csize 0
        set fnlen [string length $name]
        
        set crc 0
        
        lappend v::toc "[binary format a2c6ssssiiiss4ii PK {1 2 20 0 20 0} \
        $flag $type $time $date $crc $csize $fsize $fnlen \
        {0 0 0 0} 128 [tell $v::fd]]$name"
        
        emit [binary format a2c4ssssiiiss PK {3 4 20 0} \
        $flag $type $time $date $crc $csize $fsize $fnlen 0]
        emit $name
    }

    proc finalize {} {
        set cd_start_pos [tell $v::fd]

        set ntoc [llength $v::toc]
        foreach x $v::toc { emit $x }
        set v::toc {}

        set cd_end_pos [tell $v::fd]

        set len [expr {$cd_end_pos - $cd_start_pos}]
        #incr pos -$v::base
        set cdr_offset_pos [expr $cd_start_pos -$v::base] ;#review
        #EOCD signature PK\5\6 = 0x06054b50
        emit [binary format a2c2ssssiis PK {5 6} 0 0 $ntoc $ntoc $len $cdr_offset_pos 0]

        return $v::fd
    }
}

if {[info exists pkgtest] && $pkgtest} {
  puts "no test code"
}

# test code below runs when this is launched as the main script
if {[info exists argv0] && [string match zipper-* [file tail $argv0]]} {

    #2024 - zlib should generally be builtin..
    catch { package require zlib }

    zipper::initialize [open try.zip w]

    set dirs [list .]
    while {[llength $dirs] > 0} {
        set d [lindex $dirs 0]
        set dirs [lrange $dirs 1 end]
        foreach f [lsort [glob -nocomplain [file join $d *]]] {
            if {[file isfile $f]} {
                regsub {^\./} $f {} f
                set fd [open $f]
                fconfigure $fd -translation binary -encoding binary
                zipper::addentry $f [read $fd] [file mtime $f]
                close $fd
            } elseif {[file isdir $f]} {
                lappend dirs $f
            }
        }
    }

    close [zipper::finalize]

    puts "size = [file size try.zip]"
    puts [exec unzip -v try.zip]

    file delete try.zip
}