install: sherpa
	$(SHELL) scripts/make_skel.sh
	$(SHELL) scripts/make_tcl.sh
	ODIE_BUILD_TCLSH=`autosetup/find-tclsh`
	$(ODIE_BUILD_TCLSH) scripts/make_sherpa.tcl
	$(SHERPA) upgrade sqlite odielib tcllib
	${ODIE_BUILD_TCLSH} src/toadkit/build.tcl toadkit

packages: sherpa
	$(SHERPA) install sqlite odielib tcllib

upgrade:
	$(FOSSIL) update
	${ODIE_BUILD_TCLSH} scripts/upgrade.tcl
	$(ODIE_BUILD_TCLSH) scripts/make_sherpa.tcl
	$(SHERPA) upgrade sqlite odielib tcllib
	${ODIE_BUILD_TCLSH} src/toadkit/build.tcl toadkit

upgrade-tcl:
	$(FOSSIL) update
	$(SHELL) scripts/make_tcl.sh
	ODIE_BUILD_TCLSH=`autosetup/find-tclsh`
	${ODIE_BUILD_TCLSH} scripts/upgrade.tcl
	$(ODIE_BUILD_TCLSH) scripts/make_sherpa.tcl
	$(SHERPA) upgrade sqlite odielib tcllib
	${ODIE_BUILD_TCLSH} src/toadkit/build.tcl toadkit

tcl:
	$(SHELL) scripts/make_tcl.sh

rebuild:
	$(SHELL) scripts/make_distclean.sh
	$(FOSSIL) update
	$(SHELL) scripts/make_tcl.sh
	$(ODIE_BUILD_TCLSH) scripts/make_sherpa.tcl
	$(SHERPA) upgrade sqlite odielib tcllib
	${ODIE_BUILD_TCLSH} src/toadkit/build.tcl toadkit

distclean:
	$(SHELL) scripts/make_distclean.sh

basekit:
	${ODIE_BUILD_TCLSH} src/toadkit/build.tcl toadkit

sherpa: $ODIE_DOWNLOAD/sherpa/sherpa.tcl

$ODIE_DOWNLOAD/sherpa/sherpa.tcl:
	$(ODIE_BUILD_TCLSH) scripts/make_sherpa.tcl

$(ODIE_MKHDR):

  while {[gets $fin line]>=0} {
    if {[regexp TCL_MODULE $line] || [regexp DLLEXPORT $line]} {
      foreach regexp {
           {(.*) ([a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)}
           {(.*) (\x2a[a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)}
      } {
        if {[regexp $regexp $line all keywords funcname arglist]} {
          if {[lindex [split $funcname _] end] eq "Init"} {
            lappend ::project(modules) $funcname        
            break
          }
        }
      }
    }
  }
}

proc cthulhu_find_mkhdr {} {

<?xml version="1.0" encoding="UTF-8"?>
<!-- Komodo Project File - DO NOT EDIT -->
<project id="6beb12f5-4b92-1c42-8a7b-0fff2e8fc0a7" kpf_version="5" name="odie.komodoproject">
<preference-set idref="6beb12f5-4b92-1c42-8a7b-0fff2e8fc0a7" id="project" preftype="project">
  <string relative="path" id="import_dirname"></string>
  <string id="import_exclude_matches">*.*~;*.bak;*.tmp;CVS;.#*;*.pyo;*.pyc;.svn;*%25*;tmp*.html;.DS_Store;.fslckout;cthulhu.rc;*.vfs;embedded</string>
  <string id="import_include_matches">auto.def;autosetup;*.c;Makefile*;*.tcl;*.h;cthulhu*;*.in;*.3;*.n;*.html;*.man;*.sh;*.m4;*.sql</string>
  <long id="prefs_version">1</long>
</preference-set>
</project>

#! /bin/bash

source odieConfig.sh

TCL_SRCPATH=${SANDBOX}/tcl8.6.5/${ODIE_TCL_PLATFORM_DIR}
TK_SRCPATH=${SANDBOX}/tk8.6.5/${ODIE_TCL_PLATFORM_DIR}
ODIE_SRCPATH=${SANDBOX}/odie

#echo DOWNLOAD $DOWNLOAD
#echo "Cloning Tcl/Tk Sources"
#if [ ! -f "${DOWNLOAD}/tcl.fos" ]; then
#  ${FOSSIL} clone ${ODIEMIRRORURL}/tcl ${DOWNLOAD}/tcl.fos
#fi
#if [ ! -f "${SANDBOX}/tcl/${FOSSIL_CHECKOUT}" ]; then
#  mkdir -p ${SANDBOX}/tcl
#  cd ${SANDBOX}/tcl
#  ${FOSSIL} open ${DOWNLOAD}/tcl.fos
#fi
#if [ "${TK_FOSSIL_BRANCH}" != "none" ] ; then
#  TK_SRCPATH=${SANDBOX}/tk/${ODIE_TCL_PLATFORM_DIR}
#  if [ ! -f "${DOWNLOAD}/tk.fos" ] ; then
#    ${FOSSIL} clone ${ODIEMIRRORURL}/tk ${DOWNLOAD}/tk.fos
#  fi
#  if [ ! -f "${SANDBOX}/tk/${FOSSIL_CHECKOUT}" ] ; then
#    mkdir -p ${SANDBOX}/tk
#    cd ${SANDBOX}/tk
#    ${FOSSIL} open ${DOWNLOAD}/tk.fos ${TK_FOSSIL_BRANCH}
#  fi
#fi

echo "Building Local Tcl"

echo $ODIE_HOST
echo $ODIE_TARGET

#cd ${SANDBOX}/tcl
#${FOSSIL} update ${TCL_FOSSIL_BRANCH}
cd ${TCL_SRCPATH}
# Build Tcl twice. Once statically, once dynamically
echo Build Static Tcl
if [ "${ODIE_HOST}" != "${ODIE_TARGET}" ] ; then
    sh ./configure --enable-shared=no --with-tzdata --host=${ODIE_TARGET} ${TCL_CONFIG_FLAGS}
else
    sh ./configure --enable-shared=no --with-tzdata ${TCL_CONFIG_FLAGS}

fi
make clean
make binaries
make install

if [ "${TK_FOSSIL_BRANCH}" != "none" ] ; then
  echo "Building Local Tk"
  #cd ${SANDBOX}/tk
  #${FOSSIL} update ${TK_FOSSIL_BRANCH}
  cd ${TK_SRCPATH}
  echo Build Dynamic Tk
  if [ "${ODIE_OS}" == "macosx" ] ; then
     if [ "${ODIE_CONFIG_WINDOWSYSTEM}" == "x11" ] ; then
	  export CPPFLAGS=-I/opt/X11/include
     fi
  fi

###
# script to build a tclkit
###
set HERE [file dirname [file normalize [info script]]]
set PWD [pwd]

if {[lindex $argv 0] eq "clean"} {
  file delete -force build
  file delete -force tcl
  file delete -force tk
  foreach file [glob -nocomplain *.a] {
    file delete $file
  }
  exit
}

package require fileutil

proc ::cat fname {
    set fname [open $fname r]
    set data [read $fname]
    close $fname
    return $data
}

###
# topic: 15c41a8a701fb2afdfbd8d479d464bda
###
proc ::pkgIndexDir {root fout d1} {
  puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} [file tail $d1]]
  set idx [string length $root]
  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      pkgIndexDir $root $fout $f
    } elseif {[file tail $f] eq "pkgIndex.tcl"} {
      puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]"
      puts $fout [cat $f]
    }
  }
}

proc read_Config.sh {filename} {
  set fin [open $filename r]
  set result {}
  while {[gets $fin line] >= 0} {
    set line [string trim $line]
    if {[string index $line 0] eq "#"} continue
    if {$line eq {}} continue
    catch {
      set eq [string first "=" $line]
      if {$eq > 0} {
        set field [string range $line 0 [expr {$eq - 1}]]
        set value [string trim [string range $line [expr {$eq+1}] end] ']
        #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local]
        dict set result $field $value
      }
    } err opts
    if {[dict get $opts -code] != 0} {
      #puts $opts
      puts "Error reading line:\n$line\nerr: $err\n***"
      return $err {*}$opts
    }
  }
  return $result
}

proc ::doexec args {
  puts [list {*}$args]
  exec {*}$args >&@ stdout
}

proc ::domake {args} {
  puts [list make {*}$args]
  exec make {*}$args >&@ stdout
}

proc ::COMPILE {which cfile {extras {}}} {
  set objfile [file normalize build/[file tail [file dirname $cfile]]_[file rootname [file tail $cfile]].o]
  lappend ::KIT(${which}_OBJS) $objfile
  if {[file exists $objfile] && [file mtime $objfile] > [file mtime $cfile]} return
  lappend cmd  $::KIT(cc) {*}$::KIT(cflags_optimize) {*}$::KIT(shlib_cflags) {*}$::KIT(cflags_warning) {*}$::KIT(extra_cflags) {*}$::KIT(defs) {*}$extras
  foreach path $::KIT(INCLUDES) {
    lappend cmd -I./[fileutil::relative $::PWD $path]
  }
  lappend cmd {*}$::KIT(EXTRA_CFLAGS)
  lappend cmd -c [fileutil::relative $::PWD $cfile] -o $objfile
  puts [list [file tail $cfile] -> [file tail $objfile]]
  puts $cmd
  exec {*}$cmd >&@ stdout
}

proc ::copyDir {d1 d2} {
  file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      copyDir $f [file join $d2 $ftail]
    } elseif {[file isfile $f]} {
      file copy -force $f [file join $d2 $ftail]
    }
  }
}

set path [file normalize [file join $HERE .. ..]]
puts [list loading ODIECONFIG [file join $path odieConfig.tcl]]
source [file join $path odieConfig.tcl]
if { $::odie(platform) eq "windows" } {
  set ::KIT(EXEEXT) .exe
} else {
  set ::KIT(EXEEXT) {}
}

set fout [open [file join $PWD wrap.tcl] w]
puts $::fout [list set ::KIT(EXEEXT) $::KIT(EXEEXT)]
puts $::fout "if {!\[file exists tclkit_bare\$::KIT(EXEEXT)\]} \{[list exec \[info nameofexecutable\] [info script] >&@ stdout]}"
puts $fout {
proc ::copyDir {d1 d2} {
  file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      copyDir $f [file join $d2 $ftail]
    } elseif {[file isfile $f]} {
      file copy -force $f [file join $d2 $ftail]
    }
  }
}
    
set name [lindex $argv 0]
set path [lindex $argv 1]
file copy -force tclkit_bare$::KIT(EXEEXT) toadkit$::KIT(EXEEXT) 
package ifneeded zipfile::mkzip 1.2 [list source [file join $HERE mkzip.tcl]]
package require zipfile::mkzip
copyDir tclkit.vfs/boot $path/boot
copyDir tclkit.vfs/lib $path/lib

::zipfile::mkzip::mkzip ${name}$::KIT(EXEEXT) -runtime tclkit_bare$::KIT(EXEEXT) -directory $path
}
close $fout


puts "BUILDING ZipVFS KITS"
if {![file exists tclkit_bare$::KIT(EXEEXT)]} {
  file mkdir build
  file mkdir tclkit.vfs/boot
  if {![file exists [file join $PWD tcl]]} {
    copyDir $::odie_tcl(src_dir) [file join $PWD tcl]
    cd [file join $PWD tcl $::odie(tcl_src_dir)]
    catch {domake distclean}
  }
  set tclConfig.sh [file join $PWD tcl $::odie(tcl_src_dir) tclConfig.sh]
  if {![file exists ${tclConfig.sh}]} {
    cd [file join $PWD tcl $::odie(tcl_src_dir)]
    set opts {}
    if {$::odie(host) != $::odie(target)} {
      lappend opts --host=$::odie(target)
    }
    lappend opts {*}$::odie(tcl_config_flags) --with-tzdata --enable-shared=no
    doexec sh configure {*}$opts
    domake binaries
    domake packages
    cd $PWD
  }

  if {![file exists [file join $PWD tk]]} {
    copyDir $::odie_tk(src_dir) [file join $PWD tk]
    cd [file join $PWD tk $::odie(tcl_src_dir)]
    catch {domake distclean}
  }

  set tkConfig.sh  [file join $PWD tk $::odie(tcl_src_dir) tkConfig.sh]
  if {![file exists ${tkConfig.sh}]} {
    set opts {}
    cd [file join $PWD tk $::odie(tcl_src_dir)]
    if {$::odie(host) != $::odie(target)} {
      lappend opts --host=$::odie(target)
    }
    lappend opts {*}$::odie(tk_config_flags) --with-tcl=[file join $PWD tcl $::odie(tcl_src_dir)] --enable-shared=yes
    doexec sh configure {*}$opts
    domake binaries
    if { $::odie(platform) eq "windows" } {
      domake tk.res.o
      domake wish.res.o
    }
    cd $PWD
  }

  set ::KIT(OBJS) {}
  set ::KIT(INCLUDES) {}
  
  ###
  # Read tclConfig.sh and tkConfig.sh
  ###
  foreach {array pre file} [list ::TCL tcl ${tclConfig.sh} ::TK tk ${tkConfig.sh}] {
    set l [expr {[string length $pre]+1}]
    foreach {field dat} [read_Config.sh $file] {
      set field [string tolower $field]
      if {[string match ${pre}_* $field]} {
        set field [string range $field $l end]
      }
      set ${array}($field) $dat
      if {[info exists ::KIT($field)]} {
        if {$::KIT($field) ne $dat} {
          unset ::KIT($field)
        }
      } else {
        set ::KIT($field) $dat
      }
    }
  }

  ###
  # Add/synthesize bits
  ###
  lappend ::KIT(INCLUDES) [file join $PWD tk generic]
  lappend ::KIT(INCLUDES) [file join $PWD tk $::odie(tcl_src_dir)]
  lappend ::KIT(INCLUDES) [file join $PWD tk bitmaps]
  lappend ::KIT(INCLUDES) [file join $PWD tk xlib]
  
  lappend ::KIT(INCLUDES) [file join $PWD tcl generic]
  lappend ::KIT(INCLUDES) [file join $PWD tcl $::odie(tcl_src_dir)]
  #lappend ::KIT(INCLUDES) [file join $PWD tcl compat]
  lappend ::KIT(INCLUDES) [file join $PWD tcl compat zlib]
  
  lappend ::KIT(INCLUDES) [file join $HERE generic]
  lappend ::KIT(INCLUDES) [file join $HERE $::odie(tcl_src_dir)]
  
  if { $::odie(platform) eq "windows" } {
    set ::KIT(EXEEXT) .exe
    set ::KIT(LDFLAGS_CONSOLE) {-mconsole -pipe -static-libgcc}
    set ::KIT(LDFLAGS_WINDOW) {-mwindows -pipe -static-libgcc}
    set ::KIT(EXTRA_CFLAGS) {-DTCL_TOMMATH -DMP_PREC=4 -DUNICODE -D_UNICODE -DBUILD_tcl -DBUILD_tk -DBUILD_ttk}
    lappend ::KIT(OBJS) [file join $PWD tk $::odie(tcl_src_dir) tk.res.o] [file join $PWD tk $::odie(tcl_src_dir) wish.res.o] 
    lappend ::KIT(INCLUDES) [file join $PWD tk $::odie(tcl_src_dir) rc]
  } else {
    set ::KIT(EXEEXT) {}
    set ::KIT(LDFLAGS_CONSOLE) {}
    set ::KIT(LDFLAGS_WINDOW) {}
    set ::KIT(EXTRA_CFLAGS) {-DTCL_TOMMATH -DMP_PREC=4 -DBUILD_tk -DBUILD_ttk}
  }

  set ::KIT(LIBS) {}
  #lappend ::KIT(LIBS) {*}$::TCL(build_lib_spec) {*}$::TCL(build_stub_lib_spec) {*}$::TCL(libs)
  #{*}$::TK(build_lib_spec) {*}$::TCL(build_stub_lib_spec)
  #{*}$::TCL(build_stub_lib_spec) {*}$::TK(build_stub_lib_spec)
  set ::KIT(defs) $::TK(defs)
  
  set fout [open toadkit.rc w]
  puts $fout "array set ::TCL \{"
  foreach {field value} [lsort -stride 2 [array get ::TCL]] {
    puts $fout "  [list $field $value]"
  }
  puts $fout "\}"
  puts $fout "array set ::TK \{"
  foreach {field value} [lsort -stride 2 [array get ::TK]] {
    puts $fout "  [list $field $value]"
  }
  puts $fout "\}"
  puts $fout "array set ::KIT \{"
  foreach {field value} [lsort -stride 2 [array get ::KIT]] {
    puts $fout "  [list $field $value]"
  }
  puts $fout "\}"
  
  ###
  # Compile our C bits
  ###
  
  
  ###
  # Rig ourselves to statically build the bits of
  # zlib we need
  ###
  set cdir [file join $PWD tcl compat zlib]
  foreach file {
    adler32.c compress.c crc32.c
    deflate.c infback.c inffast.c
    inflate.c inftrees.c trees.c
    uncompr.c zutil.c
  } {
    COMPILE LIBTOADKIT [file join $cdir $file]
  }
  
  set cdir [file join $HERE generic]
  foreach file {
    password.c rc4.c tclkit_init.c zvfs.c zvfsboot.c
  } {
    COMPILE LIBTOADKIT [file join $cdir $file]
  }
  
  set cdir [file join $HERE $::odie(tcl_src_dir)]
  if { $::odie(platform) eq "windows" } {
    # tkwinico.c tlink32.c
    foreach file {
      tclsh_packages.c
    } {
      COMPILE LIBTOADKIT [file join $cdir $file]
    }
    #COMPILE LIBTOADKIT [file join $PWD tcl win tclWinReg.c] [list -DSTATIC_BUILD]
    #COMPILE LIBTOADKIT [file join $PWD tcl win tclWinDde.c] [list -DSTATIC_BUILD]
  
    COMPILE TCLSHELL [file join $PWD tcl win tclAppInit.c] [list -DTCL_LOCAL_MAIN_HOOK=Toadkit_MainHook -DTCL_LOCAL_APPINIT=Toadkit_AppInit]
    COMPILE WISHSHELL [file join $PWD tk win winMain.c] [list -DTK_LOCAL_MAIN_HOOK=Toadkit_MainHook -DTK_LOCAL_APPINIT=Toadkit_AppInit]
  } else {
    foreach file {
      tclsh_packages.c
    } {
      COMPILE LIBTOADKIT [file join $cdir $file]
    }
    COMPILE TCLSHELL [file join $PWD tcl unix tclAppInit.c] [list -DTCL_LOCAL_MAIN_HOOK=Toadkit_MainHook -DTCL_LOCAL_APPINIT=Toadkit_AppInit]
    COMPILE WISHSHELL [file join $PWD tk unix tclAppInit.c] [list -DTK_LOCAL_MAIN_HOOK=Toadkit_MainHook -DTK_LOCAL_APPINIT=Toadkit_AppInit]
  }
  
  
  ###
  # Link together our executable
  ###
  doexec ar cr libtoadkit.a {*}$::KIT(LIBTOADKIT_OBJS) [file join tcl  $::odie(tcl_src_dir) libtclstub86.a]
  doexec ranlib libtoadkit.a
  
  # Build a Tcl-only shell
  set cmd [list $::KIT(cc)  {*}$::KIT(cflags_optimize) {*}$::KIT(shlib_cflags)]
  lappend cmd {*}$::KIT(TCLSHELL_OBJS)
  set _TclSrcDir [file join tcl  $::odie(tcl_src_dir)]
  foreach item [glob ${_TclSrcDir}/*.a] {
    lappend cmd $item
  }
  lappend cmd libtoadkit.a {*}$::TCL(libs)
  lappend cmd -o tclkit_bare$::KIT(EXEEXT) {*}$::KIT(LDFLAGS_CONSOLE)
  doexec {*}$cmd
  
  ###
  # Build a starter VFS for both Tcl and wish
  ###
  set VFSROOT [file join $PWD tclkit.vfs]
  set PKGROOT [file join $PWD tclkit.pkg]

  foreach path [glob [file join $PWD tcl pkgs *]] {
    if {[string range [file tail $path] 0 3] eq "itcl"} continue
    if {![file isdirectory $path]} continue
    cd $path
    puts "$path"
    if {![file exists $path/Makefile]} {
      if {[file exists $path/Makefile.in]} {
        doexec sh configure --with-tcl=$PWD/tcl/$::odie(tcl_src_dir) --with-tclinclude=$PWD/tcl/generic --with-tzdata --enable-shared --enable-threads
      } else {
        continue
      }
    }
    puts "INSTALLING to VFS [file tail $path]"
    domake install DESTDIR=$PKGROOT
  }
  cd $PWD

  if {[file exists $VFSROOT]} {
    file delete -force $VFSROOT
  }
  copyDir $PKGROOT/usr/local/lib $VFSROOT/pkgs
  

  copyDir tcl/library $VFSROOT/boot/tcl
  if { $::odie(platform) eq "windows" } {
    set ddedll [glob -nocomplain tcl/win/tcldde*.dll]
    if {$ddedll != {}} {
      file copy $ddedll $VFSROOT/boot/tcl/dde
    }
    set regdll [glob -nocomplain tcl/win/tclreg*.dll]
    if {$regdll != {}} {
      file copy $regdll $VFSROOT/boot/tcl/reg
    }
  } else {
    file delete -force $VFSROOT/boot/tcl/dde
    file delete -force $VFSROOT/boot/tcl/reg
  }
  
  # For the following packages, cat their pkgIndex files to tclIndex
  if {$::tcl_platform(platform) eq {unix}} {
      file attributes [file join $VFSROOT boot tcl tclIndex] -permissions 0744
  } else {
      file attributes [file join $VFSROOT boot tcl tclIndex] -readonly 0
  }

  set fout [open [file join $VFSROOT boot tcl tclIndex] a]
  puts $fout {#
# MANIFEST OF INCLUDED PACKAGES
#
set VFSROOT $dir
}
  pkgIndexDir tcl/library $fout [file join $VFSROOT boot tcl]
  close $fout

  copyDir tk/library $VFSROOT/boot/tk
  if { $::odie(platform) eq "windows" } {
    set dllsrc tk/win/[string trim $::TK(dll_file) \"]
  } else {
    set dllsrc tk/unix/[string trim $::TK(dll_file) \"]
  }
  file copy -force $dllsrc [file join $VFSROOT BOOT tk]
  set fout [open [file join $VFSROOT BOOT tcl tclIndex] a]
  puts $fout [string map [list @TKVERSION@ $::TK(version)$::TK(patch_level) @TKDLL@ [string trim $::TK(dll_file) \"]] {
package ifneeded Tk @TKVERSION@ [list load $::tk_library/@TKDLL@ Tk]
  }]
  close $fout
}
cd $PWD

if {[lindex $argv 0] eq "toadkit"} {
  file copy -force tclkit_bare$::KIT(EXEEXT) toadkit$::KIT(EXEEXT) 
  puts [list AUTOPATH $::auto_path]
  package ifneeded zipfile::mkzip 1.2 [list source [file join $HERE mkzip.tcl]]
  package require zipfile::mkzip
  #file copy -force [file join $HERE default_tclsh.tcl] tclkit.vfs/main.tcl
  ::zipfile::mkzip::mkzip toadkit$::KIT(EXEEXT) -runtime tclkit_bare$::KIT(EXEEXT) -directory tclkit.vfs
}

if {[lindex $argv 0] eq "wrap"} {
  set name [lindex $argv 1]
  set path [lindex $argv 2]
  file copy -force tclkit_bare$::KIT(EXEEXT) toadkit$::KIT(EXEEXT) 
  puts [list AUTOPATH $::auto_path]
  package ifneeded zipfile::mkzip 1.2 [list source [file join $HERE mkzip.tcl]]
  package require zipfile::mkzip
  copyDir tclkit.vfs/boot $path/boot
  copyDir tclkit.vfs/lib $path/lib

  ::zipfile::mkzip::mkzip ${name}$::KIT(EXEEXT) -runtime tclkit_bare$::KIT(EXEEXT) -directory $path
}

###
# This TCL script generates a unique password used by this executable
# to encrypt or sign code
#
# Adapted from Dennis LaBelle's Freewrap
##
set here [file dirname [file normalize [info script]]]
set outfile [file join $here password.c]
if {[file exists $outfile]} {
  return
}
set curpwd [lindex $argv 0]
set curpwd {}
if { $curpwd eq {} } {
  set charset {*+-.0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_}
  set maxpos [string length $charset]
  set keylen [expr 8 + int(8 * rand())]
  set curpwd {}
  for {set idx 0} {$idx < $keylen} {incr idx} {
    append curpwd [string index $charset [expr int($maxpos * rand())]]
  }
} else {
  set keylen [string length $curpwd]
}
set fout [open $outfile w]
puts $fout "/* Automatically generated by setinfo.tcl - [clock format [clock seconds]]"
puts $fout {}
puts $fout "   This file defines the function that returns the encryption password."
puts $fout "   Its contents have been randomly generated to produce a password"
puts $fout "   that is difficult to extract from the compiled binary file."
puts $fout "*/"
puts $fout {}
puts $fout {char *getPwdKey(char *keybuf)}
puts $fout "\{"
for {set idx 0} {$idx < $keylen} {incr idx} {
    set cval [string index $curpwd $idx]
    scan $cval %c ival
    puts $fout "  keybuf\[$idx\] = $ival;"
}
puts $fout "  keybuf\[$keylen\] = 0;"
puts $fout {}
puts $fout "  return keybuf;"
puts $fout "\}"
close $fout
set fout [open [file rootname $outfile].txt w]
puts $fout $curpwd
close $fout

/* Automatically generated by setinfo.tcl - Wed Feb 25 12:41:47 EST 2015

   This file defines the function that returns the encryption password.
   Its contents have been randomly generated to produce a password
   that is difficult to extract from the compiled binary file.
*/

char *getPwdKey(char *keybuf)
{
  keybuf[0] = 53;
  keybuf[1] = 109;
  keybuf[2] = 101;
  keybuf[3] = 88;
  keybuf[4] = 104;
  keybuf[5] = 102;
  keybuf[6] = 105;
  keybuf[7] = 100;
  keybuf[8] = 0;

  return keybuf;
}

set here [file dirname [info script]]
puts [list SOURCED PASSWORD TCL]
# Retrieve or generate a hard coded password for the crypt_eval function
# We write the code here so that a DLL and an EXE built from the same source
# checkout will have the same internal password
if {![file exists [file join $here password.txt]]} {
  set charset {*+-.0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_}
  set maxpos [string length $charset]
  set keylen [expr 8 + int(8 * rand())]
  set curpwd {}
  for {set idx 0} {$idx < $keylen} {incr idx} {
    append curpwd [string index $charset [expr int($maxpos * rand())]]
  }
  set fout [open [file join $here password.txt] w]
  puts $fout $curpwd
  close $fout
} else {
  set fin [open [file join $here password.txt] r]
  set curpwd [string trim [read $fin]]
  set keylen [string length $curpwd]
  close $fin
}
# Write that password into a C function
set buffer {}
for {set idx 0} {$idx < $keylen} {incr idx} {
    set cval [string index $curpwd $idx]
    scan $cval %c ival
    ::practcl::cputs buffer "  keybuf\[$idx\] = $ival;"
}
::practcl::cputs buffer "  keybuf\[$keylen\] = 0;"
::practcl::cputs buffer "  return keybuf\;"

my c_function {char *getPwdKey(char *keybuf)} $buffer

5meXhfid

/*
** Implementation of an RC4 codec for TCL.
*/
#include "tcl.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>

char *getPwdKey(char *keybuf);

//#include <sqlite3.h>

/*
** An RC4 codec is an instance of the following structure.
*/
typedef struct Rc4Codec Rc4Codec;
struct Rc4Codec {
  unsigned char i, j;
  unsigned char s[256];
};
static Tcl_WideInt next_random_number = 1;

/*
** Initialize an RC4 codec with the given key sequence.
*/
static void rc4_init(Rc4Codec *p, int nByte, unsigned char *pKey){
  int k, l;
  unsigned char i, j, t, *s;
  i = j = p->i = p->j = 0;
  s = p->s;
  for(k=0; k<256; k++){
    s[k] = k;
  }
  l = 0;
  for(k=0; k<256; k++){
    t = s[k];
    j += t + pKey[l++];
    if( l>=nByte ) l = 0;
    s[k] = s[j];
    s[j] = t;
  }

  /* Discard the first 1024 bytes of key stream to thwart the
  ** Fluhrer-Mantin-Shamir attack.
  */
  for(k=0; k<1024; k++){
    t = s[++i];
    j += t;
    s[i] = s[j];
    s[j] = t;
  }
  p->j = j;
}

/*
** Encode/Decode nBytes bytes of traffic using the given codec.
*/
static void rc4_coder(Rc4Codec *p, int nByte, unsigned char *pData){
  register unsigned char ti, tj, i, j, *s;
  s = p->s;
  i = p->i;
  j = p->j;
  while( nByte-->0 ){
    ti = s[++i];
    j += ti;
    tj = s[i] = s[j];
    s[j] = ti;
    tj += ti;
    *(pData++) ^= s[tj];
  }
  p->i = i;
  p->j = j;
}

/*
** Usage:    NAME TEXT
**
** There is a separate TCL command created for each rc4 codec instance.
** This is the implementation of that command.  Apply the codec to the
** input and return the results.
*/
static int CodecObjCmd(
  void *pCodec,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  unsigned char *data;
  int nData;
  Tcl_Obj *pResult;
  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 2, objv, "TEXT");
    return TCL_ERROR;
  }
  data = Tcl_GetByteArrayFromObj(objv[1], &nData);
  pResult = Tcl_NewByteArrayObj(data, nData);
  data = Tcl_GetByteArrayFromObj(pResult, 0);
  rc4_coder((Rc4Codec*)pCodec, nData, data);
  Tcl_SetObjResult(interp, pResult);
  return TCL_OK;
}

/*
** Destructor for codec.
*/
static void CodecDestructor(void *pCodec){
  Tcl_Free(pCodec);
}

/*
** Usage:   rc4  NAME  PASSWORD
**
** Create a new rc4 codec called NAME and initialized using PASSWORD.
*/
static int Rc4ObjCmd(
  void *NotUsed,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Rc4Codec *pCodec;
  const char *zName;
  unsigned char *pKey;
  int nKey;

  if( objc!=3 ){
    Tcl_WrongNumArgs(interp, 2, objv, "NAME PASSWORD");
    return TCL_ERROR;
  }
  zName = Tcl_GetStringFromObj(objv[1], 0);
  pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
  pCodec = (Rc4Codec*)Tcl_Alloc( sizeof(*pCodec) );
  rc4_init(pCodec, nKey, pKey);
  Tcl_CreateObjCommand(interp, zName, CodecObjCmd, pCodec, CodecDestructor);
  return TCL_OK;
}

/*
** The characters used for HTTP base64 encoding.
*/
static const unsigned char zBase[] = 
  "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz~";

/*
** Encode a string using a base-64 encoding.
** The encoding can be reversed using the <b>decode64</b> function.
**
** Space to hold the result comes from Tcl_Alloc().
*/
static char *encode64(const char *zData, int nData, int *pnOut){
  char *z64;
  int i, n;

  if( nData<=0 ){
    nData = strlen(zData);
  }
  z64 = Tcl_Alloc( (nData*4)/3 + 6 );
  for(i=n=0; i+2<nData; i+=3){
    z64[n++] = zBase[ (zData[i]>>2) & 0x3f ];
    z64[n++] = zBase[ ((zData[i]<<4) & 0x30) | ((zData[i+1]>>4) & 0x0f) ];
    z64[n++] = zBase[ ((zData[i+1]<<2) & 0x3c) | ((zData[i+2]>>6) & 0x03) ];
    z64[n++] = zBase[ zData[i+2] & 0x3f ];
  }
  if( i+1<nData ){
    z64[n++] = zBase[ (zData[i]>>2) & 0x3f ];
    z64[n++] = zBase[ ((zData[i]<<4) & 0x30) | ((zData[i+1]>>4) & 0x0f) ];
    z64[n++] = zBase[ ((zData[i+1]<<2) & 0x3c) ];
  }else if( i<nData ){
    z64[n++] = zBase[ (zData[i]>>2) & 0x3f ];
    z64[n++] = zBase[ ((zData[i]<<4) & 0x30) ];
  }
  z64[n] = 0;
  if( pnOut ) *pnOut = n;
  return z64;
}

/*
** This function treats its input as a base-64 string and returns the
** decoded value of that string.  Characters of input that are not
** valid base-64 characters (such as spaces and newlines) are ignored.
**
** Space to hold the decoded string is obtained from Tcl_Alloc().
*/
char *decode64(const char *z64, int n64, int *pnOut){
  char *zData;
  int i, j;
  int a, b, c, d;
  static int isInit = 0;
  static int trans[128];

  if( !isInit ){
    for(i=0; i<128; i++){ trans[i] = 0; }
    for(i=0; zBase[i]; i++){ trans[zBase[i] & 0x7f] = i; }
    isInit = 1;
  }
  if( n64<0 ){
    n64 = strlen(z64);
  }
  while( n64>0 && z64[n64-1]=='=' ) n64--;
  zData = Tcl_Alloc( (n64*3)/4 + 4 );
  for(i=j=0; i+3<n64; i+=4){
    a = trans[z64[i] & 0x7f];
    b = trans[z64[i+1] & 0x7f];
    c = trans[z64[i+2] & 0x7f];
    d = trans[z64[i+3] & 0x7f];
    zData[j++] = ((a<<2) & 0xfc) | ((b>>4) & 0x03);
    zData[j++] = ((b<<4) & 0xf0) | ((c>>2) & 0x0f);
    zData[j++] = ((c<<6) & 0xc0) | (d & 0x3f);
  }
  if( i+2<n64 ){
    a = trans[z64[i] & 0x7f];
    b = trans[z64[i+1] & 0x7f];
    c = trans[z64[i+2] & 0x7f];
    zData[j++] = ((a<<2) & 0xfc) | ((b>>4) & 0x03);
    zData[j++] = ((b<<4) & 0xf0) | ((c>>2) & 0x0f);
  }else if( i+1<n64 ){
    a = trans[z64[i] & 0x7f];
    b = trans[z64[i+1] & 0x7f];
    zData[j++] = ((a<<2) & 0xfc) | ((b>>4) & 0x03);
  }
  zData[j] = 0;
  if( pnOut ) *pnOut = j;
  return zData;
}

static unsigned char randomByte(void) {
  char i;
  /* RAND_MAX assumed to be 256 */
  char repeat=(next_random_number % 10)+2;
  for(i=0;i<repeat;i++) {
    next_random_number = next_random_number * 1103515245 + 12345;
  }
  return ((unsigned)(next_random_number/256) % 256);
}

static void rc4_randomness(int N, void *pBuf) {
  unsigned char *zBuf = pBuf;
  while( N-- ){
    *(zBuf++) = randomByte();
  }
}

static int Rc4SeedObjCmd(
  void *NotUsed,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 2, objv, "SEEDINT");
    return TCL_ERROR;
  }
  if(Tcl_GetWideIntFromObj(interp,objv[1],&next_random_number)) {
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   rc4encrypt  PASSWORD   TEXT
**
** Encrypt TEXT using PASSWORD and a random nonce.  Encode the result
** as a single token using base64.
*/
static int Rc4EncryptObjCmd(
  void *NotUsed,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  const char *zPasswd;
  int nPasswd;
  char *zIn;
  int nIn;
  char *zBuf;
  char *zOut;
  int nOut;
  char zKey[256];
  Rc4Codec codec;
  extern void sqliteRandomness(int,void*);

  if( objc!=3 ){
    Tcl_WrongNumArgs(interp, 2, objv, "PASSWORD TEXT");
    return TCL_ERROR;
  }
  zPasswd = Tcl_GetStringFromObj(objv[1], &nPasswd);

  rc4_randomness(4, zKey);
  if( nPasswd>252 ) nPasswd = 252;
  memcpy(&zKey[4], zPasswd, nPasswd);
  rc4_init(&codec, nPasswd+4, (unsigned char*)zKey);
  zIn = Tcl_GetStringFromObj(objv[2], &nIn);
  zBuf = Tcl_Alloc( nIn + 5 );
  memcpy(zBuf, zKey, 4);
  memcpy(&zBuf[4], zIn, nIn);
  rc4_coder(&codec, nIn, (unsigned char*)&zBuf[4]);
  zOut = encode64(zBuf, nIn+4, &nOut);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(zOut, nOut));
  Tcl_Free((char *)zOut);
  Tcl_Free((char *)zBuf);
  return TCL_OK;
}

/*
** Usage:   rc4decrypt  PASSWORD   CYPHERTEXT
**
** Decrypt CYPHERTEXT using PASSWORD and a nonce found at the beginning of
** the cyphertext.  The cyphertext is base64 encoded.
*/
static int Rc4DecryptObjCmd(
  void *NotUsed,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  const char *zPasswd;
  int nPasswd;
  char *zIn;
  int nIn;
  char *zOut;
  int nOut;
  char zKey[256];
  Rc4Codec codec;

  if( objc!=3 ){
    Tcl_WrongNumArgs(interp, 2, objv, "PASSWORD TEXT");
    return TCL_ERROR;
  }
  zPasswd = Tcl_GetStringFromObj(objv[1], &nPasswd);
  zIn = Tcl_GetStringFromObj(objv[2], &nIn);
  zOut = decode64(zIn, nIn, &nOut);
  if( nOut<4 ){
    return TCL_OK;
  }
  memcpy(zKey, zOut, 4);
  if( nPasswd>252 ) nPasswd = 252;
  memcpy(&zKey[4], zPasswd, nPasswd);
  rc4_init(&codec, nPasswd+4, (unsigned char*)zKey);
  rc4_coder(&codec, nOut-4, (unsigned char*)&zOut[4]);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(&zOut[4], nOut-4));
  Tcl_Free(zOut);
  return TCL_OK;
}


/*
** Usage:   source_encrypt TEXT
**
** Encrypt TEXT using compiled in PASSWORD and a random nonce.  Encode the result
** as a single token using base64.
*/
static int Rc4EncryptSourceObjCmd(
  void *NotUsed,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  char zPasswd[32];
  int nPasswd;
  char *zIn;
  int nIn;
  char *zBuf;
  char *zOut;
  int nOut;
  char zKey[256];
  Rc4Codec codec;
  extern void sqliteRandomness(int,void*);

  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 2, objv, "TEXT");
    return TCL_ERROR;
  }
  getPwdKey(zPasswd);
  nPasswd=strlen(zPasswd);
  
  rc4_randomness(4, zKey);
  if( nPasswd>252 ) nPasswd = 252;
  memcpy(&zKey[4], zPasswd, nPasswd);
  rc4_init(&codec, nPasswd+4, (unsigned char*)zKey);
  zIn = Tcl_GetStringFromObj(objv[1], &nIn);
  zBuf = Tcl_Alloc( nIn + 5 );
  memcpy(zBuf, zKey, 4);
  memcpy(&zBuf[4], zIn, nIn);
  rc4_coder(&codec, nIn, (unsigned char*)&zBuf[4]);
  zOut = encode64(zBuf, nIn+4, &nOut);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(zOut, nOut));
  Tcl_Free((char *)zOut);
  Tcl_Free((char *)zBuf);
  return TCL_OK;
}

/*
** Usage:   source_decrypt   CYPHERTEXT
**
** Decrypt CYPHERTEXT using compiled in PASSWORD and a nonce
** found at the beginning of
** the cyphertext.  The cyphertext is base64 encoded.
*/
static int Rc4DecryptSourceObjCmd(
  void *NotUsed,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  char zPasswd[32];
  int nPasswd;
  char *zIn;
  int nIn;
  char *zOut;
  int nOut;
  char zKey[256];
  Rc4Codec codec;

  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 2, objv, "TEXT");
    return TCL_ERROR;
  }
  getPwdKey(zPasswd);
  nPasswd=strlen(zPasswd);

  zIn = Tcl_GetStringFromObj(objv[1], &nIn);
  zOut = decode64(zIn, nIn, &nOut);
  if( nOut<4 ){
    return TCL_OK;
  }
  memcpy(zKey, zOut, 4);
  if( nPasswd>252 ) nPasswd = 252;
  memcpy(&zKey[4], zPasswd, nPasswd);
  rc4_init(&codec, nPasswd+4, (unsigned char*)zKey);
  rc4_coder(&codec, nOut-4, (unsigned char*)&zOut[4]);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(&zOut[4], nOut-4));
  Tcl_Free(zOut);
  return TCL_OK;
}

/*
** Usage:   eval_decrypt   CYPHERTEXT
**
** Decrypt CYPHERTEXT using compiled in PASSWORD and a nonce
** found at the beginning of
** the cyphertext.  The cyphertext is base64 encoded.
*/
static int Rc4DecryptEvalObjCmd(
  void *NotUsed,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  char zPasswd[32];
  int nPasswd;
  char *zIn;
  int nIn;
  char *zOut;
  int nOut;
  char zKey[256];
  Rc4Codec codec;
  Tcl_Obj *cleartext;
  int code=TCL_OK;

  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 2, objv, "TEXT");
    return TCL_ERROR;
  }
  getPwdKey(zPasswd);
  nPasswd=strlen(zPasswd);

  zIn = Tcl_GetStringFromObj(objv[1], &nIn);
  zOut = decode64(zIn, nIn, &nOut);
  if( nOut<4 ){
    return TCL_OK;
  }
  memcpy(zKey, zOut, 4);
  if( nPasswd>252 ) nPasswd = 252;
  memcpy(&zKey[4], zPasswd, nPasswd);
  rc4_init(&codec, nPasswd+4, (unsigned char*)zKey);
  rc4_coder(&codec, nOut-4, (unsigned char*)&zOut[4]);
  cleartext=Tcl_NewStringObj(&zOut[4], nOut-4);
  Tcl_IncrRefCount(cleartext);
  code=Tcl_EvalObjEx(interp,cleartext,NULL);
  Tcl_DecrRefCount(cleartext);
  Tcl_Free(zOut);
  return code;
}

/*
** Initialize the rc4 codec subsystem.
*/
DLLEXPORT int Rc4_Init(Tcl_Interp *interp){
  Tcl_CreateObjCommand(interp, "rc4", Rc4ObjCmd, 0, 0);
  Tcl_CreateObjCommand(interp, "rc4seed", Rc4SeedObjCmd, 0, 0);
  Tcl_CreateObjCommand(interp, "rc4encrypt", Rc4EncryptObjCmd, 0, 0);
  Tcl_CreateObjCommand(interp, "rc4decrypt", Rc4DecryptObjCmd, 0, 0);
  Tcl_CreateObjCommand(interp, "source_encrypt", Rc4EncryptSourceObjCmd, 0, 0);
  //Tcl_CreateObjCommand(interp, "source_decrypt", Rc4DecryptSourceObjCmd, 0, 0);
  Tcl_CreateObjCommand(interp, "eval_decrypt", Rc4DecryptEvalObjCmd, 0, 0);
  Tcl_StaticPackage(interp, "rc4", "2.0", 0);

  return TCL_OK;
}

#include "toadkit.h"

/*
 * Toadkit_MainHook --
 * Performs the argument munging for the shell
 */
#ifdef _WIN32
int Toadkit_MainHook(int *argc, TCHAR ***argv)
#else
int Toadkit_MainHook(int *argc, char ***argv)
#endif
{
    Tcl_FindExecutable(*argv[0]);
    CONST char *cp=Tcl_GetNameOfExecutable();
    Tcl_Zvfs_Boot(cp,TOADKIT_VFSMOUNT,TOADKIT_INIT);
    return 0;
}

 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int Toadkit_AppInit(Tcl_Interp *interp) {
  if ((Tcl_Init)(interp) == TCL_ERROR) {
      return TCL_ERROR;
  }

  /*
  * Start up all extensions.
  */
  Tclkit_Packages_Init(interp);
  /*
   * Call Tcl_CreateCommand for application-specific commands, if
   * they weren't already created by the init procedures called above.

#include "tcl.h"
#include "tclInt.h"
#include "tclFileSystem.h"

#include <assert.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>

#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif

/*
** Provide a dummy Tcl_InitStubs if we are using this as a static
** library.
*/
#ifndef USE_TCL_STUBS
# undef  Tcl_InitStubs
# define Tcl_InitStubs(a,b,c) TCL_VERSION
#endif

/* Verbatim headers */
/*
 *generic/_macros.h 
*/
#define STATIC_BUILD 1
#undef USE_TCL_STUBS

#define TOADKIT_INIT     "main.tcl"
#define TOADKIT_VFSMOUNT "/zvfs"

/* Make sure the stubbed variants of those are never used. */
#undef Tcl_ObjSetVar2
#undef Tcl_NewStringObj
#undef Tk_Init
#undef Tk_MainEx
#undef Tk_SafeInit

int Tcl_Zvfs_Boot(const char *,const char *,const char *);
int Zvfs_Init(Tcl_Interp *);
int Zvfs_SafeInit(Tcl_Interp *);
int Tclkit_Packages_Init(Tcl_Interp *);
int Rc4_Init(Tcl_Interp *interp);
char *getPwdKey(char *keybuf);
char *decode64(const char *z64,int n64,int *pnOut);

#define TCL_LOCAL_APPINIT Toadkit_AppInit
#define TCL_LOCAL_MAIN_HOOK Toadkit_MainHook

        Tcl_DStringAppend(&preinit,"\nset tcl_library ",-1);
        Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstcllib));
      }
      if(Tcl_FSAccess(vfstklib,F_OK)==0) {
        Tcl_DStringAppend(&preinit,"\nset tk_library ",-1);
        Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstklib));
      }
      Tcl_DStringAppend(&preinit,"\nlappend ::auto_path [file join $::SRCDIR pkgs]",-1);
      
      vfspreinit=Tcl_NewStringObj(Tcl_DStringValue(&preinit),-1);
      /* NOTE: We never decr this refcount, lest the contents of the script be deallocated */
      Tcl_IncrRefCount(vfspreinit);
      TclSetPreInitScript(Tcl_GetString(vfspreinit));

      Tcl_DecrRefCount(vfsinitscript);
      Tcl_DecrRefCount(vfstcllib);

# -*- tcl -*-
# mkzip.tcl -- Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
#        Create ZIP archives in Tcl.
#
# Create a zipkit using mkzip filename.zkit -zipkit -directory xyz.vfs
# or a zipfile using mkzip filename.zip -directory dirname -exclude "*~"
#
## BSD License
##
# Package providing commands for the generation of a zip archive.
# version 1.2

package require Tcl 8.6

namespace eval ::zipfile {}
namespace eval ::zipfile::decode {}
namespace eval ::zipfile::encode {}
namespace eval ::zipfile::mkzip {}

proc ::zipfile::mkzip::setbinary chan {
  fconfigure $chan \
      -encoding    binary \
      -translation binary \
      -eofchar     {}

}

# zip::timet_to_dos
#
#        Convert a unix timestamp into a DOS timestamp for ZIP times.
#
#   DOS timestamps are 32 bits split into bit regions as follows:
#                  24                16                 8                 0
#   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
#   |Y|Y|Y|Y|Y|Y|Y|m| |m|m|m|d|d|d|d|d| |h|h|h|h|h|m|m|m| |m|m|m|s|s|s|s|s|
#   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
#
proc ::zipfile::mkzip::timet_to_dos {time_t} {
    set s [clock format $time_t -format {%Y %m %e %k %M %S}]
    scan $s {%d %d %d %d %d %d} year month day hour min sec
    expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) 
          | ($hour << 11) | ($min << 5) | ($sec >> 1)}
}

# zip::pop --
#
#        Pop an element from a list
#
proc ::zipfile::mkzip::pop {varname {nth 0}} {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
}

# zip::walk --
#
#        Walk a directory tree rooted at 'path'. The excludes list can be
#        a set of glob expressions to match against files and to avoid.
#        The match arg is internal.
#        eg: walk library {CVS/* *~ .#*} to exclude CVS and emacs cruft.
#
proc ::zipfile::mkzip::walk {base {excludes ""} {match *} {path {}}} {
    set result {}
    set imatch [file join $path $match]
    set files [glob -nocomplain -tails -types f -directory $base $imatch]
    foreach file $files {
        set excluded 0
        foreach glob $excludes {
            if {[string match $glob $file]} {
                set excluded 1
                break
            }
        }
        if {!$excluded} {lappend result $file}
    }
    foreach dir [glob -nocomplain -tails -types d -directory $base $imatch] {
        set subdir [walk $base $excludes $match $dir]
        if {[llength $subdir]>0} {
            set result [concat $result [list $dir] $subdir]
        }
    }
    return $result
}

# zipfile::encode::add_file_to_archive --
#
#        Add a single file to a zip archive. The zipchan channel should
#        already be open and binary. You may provide a comment for the
#        file The return value is the central directory record that
#        will need to be used when finalizing the zip archive.
#
# FIX ME: should  handle the current offset for non-seekable channels
#
proc ::zipfile::mkzip::add_file_to_archive {zipchan base path {comment ""}} {
    set fullpath [file join $base $path]
    set mtime [timet_to_dos [file mtime $fullpath]]
    if {[file isdirectory $fullpath]} {
        append path /
    }
    set utfpath [encoding convertto utf-8 $path]
    set utfcomment [encoding convertto utf-8 $comment]
    set flags [expr {(1<<11)}] ;# utf-8 comment and path
    set method 0               ;# store 0, deflate 8
    set attr 0                 ;# text or binary (default binary)
    set version 20             ;# minumum version req'd to extract
    set extra ""
    set crc 0
    set size 0
    set csize 0
    set data ""
    set seekable [expr {[tell $zipchan] != -1}]
    if {[file isdirectory $fullpath]} {
        set attrex 0x41ff0010  ;# 0o040777 (drwxrwxrwx)
    } elseif {[file executable $fullpath]} {
        set attrex 0x81ff0080  ;# 0o100777 (-rwxrwxrwx)
    } else {
        set attrex 0x81b60020  ;# 0o100666 (-rw-rw-rw-)
        if {[file extension $fullpath] in {".tcl" ".txt" ".c"}} {
            set attr 1         ;# text
        }
    }
  
    if {[file isfile $fullpath]} {
        set size [file size $fullpath]
        if {!$seekable} {set flags [expr {$flags | (1 << 3)}]}
    }
  
    set offset [tell $zipchan]
    set local [binary format a4sssiiiiss PK\03\04 \
                   $version $flags $method $mtime $crc $csize $size \
                   [string length $utfpath] [string length $extra]]
    append local $utfpath $extra
    puts -nonewline $zipchan $local
  
    if {[file isfile $fullpath]} {
        # If the file is under 2MB then zip in one chunk, otherwize we use
        # streaming to avoid requiring excess memory. This helps to prevent
        # storing re-compressed data that may be larger than the source when
        # handling PNG or JPEG or nested ZIP files.
        if {$size < 0x00200000} {
            set fin [::open $fullpath rb]
            setbinary $fin
            set data [::read $fin]
            set crc [::zlib crc32 $data]
            set cdata [::zlib deflate $data]
            if {[string length $cdata] < $size} {
                set method 8
                set data $cdata
            }
            close $fin
            set csize [string length $data]
            puts -nonewline $zipchan $data
        } else {
            set method 8
            set fin [::open $fullpath rb]
            setbinary $fin
            set zlib [::zlib stream deflate]
            while {![eof $fin]} {
                set data [read $fin 4096]
                set crc [zlib crc32 $data $crc]
                $zlib put $data
                if {[string length [set zdata [$zlib get]]]} {
                    incr csize [string length $zdata]
                    puts -nonewline $zipchan $zdata
                }
            }
            close $fin
            $zlib finalize
            set zdata [$zlib get]
            incr csize [string length $zdata]
            puts -nonewline $zipchan $zdata
            $zlib close
        }
    
        if {$seekable} {
            # update the header if the output is seekable
            set local [binary format a4sssiiii PK\03\04 \
                           $version $flags $method $mtime $crc $csize $size]
            set current [tell $zipchan]
            seek $zipchan $offset
            puts -nonewline $zipchan $local
            seek $zipchan $current
        } else {
            # Write a data descriptor record
            set ddesc [binary format a4iii PK\7\8 $crc $csize $size]
            puts -nonewline $zipchan $ddesc
        }
    }
  
    set hdr [binary format a4ssssiiiisssssii PK\01\02 0x0317 \
                 $version $flags $method $mtime $crc $csize $size \
                 [string length $utfpath] [string length $extra]\
                 [string length $utfcomment] 0 $attr $attrex $offset]
    append hdr $utfpath $extra $utfcomment
    return $hdr
}

# zipfile::encode::mkzip --
#
#        Create a zip archive in 'filename'. If a file already exists it will be
#        overwritten by a new file. If '-directory' is used, the new zip archive
#        will be rooted in the provided directory.
#        -runtime can be used to specify a prefix file. For instance, 
#        zip myzip -runtime unzipsfx.exe -directory subdir
#        will create a self-extracting zip archive from the subdir/ folder.
#        The -comment parameter specifies an optional comment for the archive.
#
#        eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
# 
proc ::zipfile::mkzip::mkzip {filename args} {
  array set opts {
      -zipkit 0 -runtime "" -comment "" -directory ""
      -exclude {CVS/* */CVS/* *~ ".#*" "*/.#*"}
      -verbose 0
  }
  
  while {[string match -* [set option [lindex $args 0]]]} {
      switch -exact -- $option {
          -verbose { set opts(-verbose) 1}
          -zipkit  { set opts(-zipkit) 1 }
          -comment { set opts(-comment) [encoding convertto utf-8 [pop args 1]] }
          -runtime { set opts(-runtime) [pop args 1] }
          -directory {set opts(-directory) [file normalize [pop args 1]] }
          -exclude {set opts(-exclude) [pop args 1] }
          -- { pop args ; break }
          default {
              break
          }
      }
      pop args
  }

  set zf [::open $filename wb]
  setbinary $zf
  if {$opts(-runtime) ne ""} {
      set rt [::open $opts(-runtime) rb]
      setbinary $rt
      fcopy $rt $zf
      close $rt
  } elseif {$opts(-zipkit)} {
      set zkd "#!/usr/bin/env tclkit\n\# This is a zip-based Tcl Module\n"
      append zkd "package require vfs::zip\n"
      append zkd "vfs::zip::Mount \[info script\] \[info script\]\n"
      append zkd "if {\[file exists \[file join \[info script\] main.tcl\]\]} \{\n"
      append zkd "    source \[file join \[info script\] main.tcl\]\n"
      append zkd "\}\n"
      append zkd \x1A
      puts -nonewline $zf $zkd
  }

  set count 0
  set cd ""

  if {$opts(-directory) ne ""} {
      set paths [walk $opts(-directory) $opts(-exclude)]
  } else {
      set paths [glob -nocomplain {*}$args]
  }
  foreach path $paths {
      if {[string is true $opts(-verbose)]} {
        puts $path
      }
      append cd [add_file_to_archive $zf $opts(-directory) $path]
      incr count
  }
  set cdoffset [tell $zf]
  set endrec [binary format a4ssssiis PK\05\06 0 0 \
                  $count $count [string length $cd] $cdoffset\
                  [string length $opts(-comment)]]
  append endrec $opts(-comment)
  puts -nonewline $zf $cd
  puts -nonewline $zf $endrec
  close $zf

  return
}

# ### ### ### ######### ######### #########
## Ready
package provide zipfile::mkzip 1.2

/*
** This is just a template. Replace with your own
*/
#include "tcl.h"
#include "toadkit.h"

/*
** Declare INIT functions here
*/

int Odielib_Init_static(Tcl_Interp *);

/*
** Call initialization code for all extensions
*/
int
Tclkit_Packages_Init(interp)
    Tcl_Interp *interp;		/* Interpreter for application. */
{
  if(Zvfs_Init(interp)) return TCL_ERROR;
  Tcl_StaticPackage(interp, "zvfs", Zvfs_Init, Zvfs_SafeInit);

  if(Rc4_Init(interp)) return TCL_ERROR;
  Tcl_StaticPackage(interp, "rc4", Rc4_Init, NULL);
  return TCL_OK;
}

/*
** This is just a template. Replace with your own
*/
#include "tcl.h"
#include "toadkit.h"
/*
** Declare INIT functions here
*/

extern Tcl_PackageInitProc Odielib_Init;

extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
extern Tcl_PackageInitProc Zvfs_Init;
extern Tcl_PackageInitProc Zvfs_SafeInit;
extern Tcl_PackageInitProc Rc4_Init;

//extern int Tlink_Init(Tcl_Interp*);
//extern int Winico_Init(Tcl_Interp*);

/*
** Call initialization code for all extensions
*/
int
Tclkit_Packages_Init(Tcl_Interp *interp) {


  if(Zvfs_Init(interp)) return TCL_ERROR;
  Tcl_StaticPackage(interp, "zvfs", Zvfs_Init, Zvfs_SafeInit);
  #ifdef NEVER
  if (Registry_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
  }
  Tcl_StaticPackage(interp, "registry", Registry_Init, 0);
  if (Dde_Init(interp) == TCL_ERROR) {
    return TCL_ERROR;

  }
  Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
  #endif
  if(Rc4_Init(interp)) return TCL_ERROR;
  Tcl_StaticPackage(interp, "rc4", Rc4_Init, NULL);
  return TCL_OK;
}