Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -16,30 +16,30 @@ $(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} scripts/make_basekit.tcl + ${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} scripts/make_basekit.tcl + ${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} scripts/make_basekit.tcl + ${ODIE_BUILD_TCLSH} src/toadkit/build.tcl toadkit tcl: $(SHELL) scripts/make_tcl.sh rebuild: @@ -46,17 +46,17 @@ $(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} scripts/make_basekit.tcl + ${ODIE_BUILD_TCLSH} src/toadkit/build.tcl toadkit distclean: $(SHELL) scripts/make_distclean.sh basekit: - ${ODIE_BUILD_TCLSH} scripts/make_basekit.tcl + ${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 Index: autosetup/lib/cthulhu.tcl ================================================================== --- autosetup/lib/cthulhu.tcl +++ autosetup/lib/cthulhu.tcl @@ -518,12 +518,14 @@ 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]} { - lappend ::project(modules) $funcname - break + if {[lindex [split $funcname _] end] eq "Init"} { + lappend ::project(modules) $funcname + break + } } } } } } Index: odie.komodoproject ================================================================== --- odie.komodoproject +++ odie.komodoproject @@ -1,9 +1,10 @@ - - - - - - *.*~;*.bak;*.tmp;CVS;.#*;*.pyo;*.pyc;.svn;*%*;tmp*.html;.DS_Store;.fslckout;cthulhu.rc;*.vfs;embedded - auto.def;autosetup;*.c;Makefile*;*.tcl;*.h;cthulhu*;*.in;*.3;*.n;*.html;*.man;*.sh;*.m4;*.sql - - + + + + + + *.*~;*.bak;*.tmp;CVS;.#*;*.pyo;*.pyc;.svn;*%25*;tmp*.html;.DS_Store;.fslckout;cthulhu.rc;*.vfs;embedded + auto.def;autosetup;*.c;Makefile*;*.tcl;*.h;cthulhu*;*.in;*.3;*.n;*.html;*.man;*.sh;*.m4;*.sql + 1 + + DELETED scripts/make_basekit.tcl Index: scripts/make_basekit.tcl ================================================================== --- scripts/make_basekit.tcl +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/sh -# Copyright (c) 2006-2011 WorkWare Systems http://www.workware.net.au/ -# All rights reserved -# vim:se syntax=tcl: -# \ -dir=`dirname "$0"`; exec "`$dir/../autosetup/find-tclsh`" "$0" "$@" - -set path [file normalize [file join [file dirname [file normalize [info script]]] ..]] -source [file join $path scripts common.tcl] - -puts "BUILDING ZipVFS KITS" -set toadkits odie -# Only needed for pre-zipvfs enable Tcl/Tk -set TCL_STATIC_SRCPATH $::odie(sandbox)/tcl/$::odie(tcl_src_dir) -set TK_STATIC_SRCPATH $::odie(sandbox)/tk/$::odie(tcl_src_dir) - -if {$::odie(window_system) ne "none"} { - if { $::odie(platform) eq "windows" } { - cd [::realpath ${TK_STATIC_SRCPATH}] - domake tk.res.o - domake wish.res.o - } -} -cd [::realpath $::odie(src_dir)/src/toadkit] -puts "Building kits in [pwd]" -source configure.tcl -domake clean -domake install Index: scripts/make_tcl.sh ================================================================== --- scripts/make_tcl.sh +++ scripts/make_tcl.sh @@ -1,42 +1,42 @@ #! /bin/bash source odieConfig.sh -TCL_SRCPATH=${SANDBOX}/tcl/${ODIE_TCL_PLATFORM_DIR} -TK_SRCPATH=${SANDBOX}/tk/${ODIE_TCL_PLATFORM_DIR} +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 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 ${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} @@ -61,12 +61,12 @@ make binaries make install if [ "${TK_FOSSIL_BRANCH}" != "none" ] ; then echo "Building Local Tk" - cd ${SANDBOX}/tk - ${FOSSIL} update ${TK_FOSSIL_BRANCH} + #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 DELETED src/toadkit/Makefile.in Index: src/toadkit/Makefile.in ================================================================== --- src/toadkit/Makefile.in +++ /dev/null @@ -1,133 +0,0 @@ -include ../../odieConfig.sh - -NAME = @PKG_NAME@ -VER = @PKG_VER@ - -PKG_OBJECTS = @PKG_OBJECTS@ -PKG_SOURCES = @PKG_SOURCES@ - -TCL_SRCROOT=${SANDBOX}/tcl -TCL_SRCPATH=${SANDBOX}/tcl/${ODIE_TCL_PLATFORM_DIR} -TK_SRCROOT=${SANDBOX}/tk -TK_SRCPATH=${SANDBOX}/tk/${ODIE_TCL_PLATFORM_DIR} -ZIPSRC_SRC = ${ODIE_SRC_DIR}/src/zip30 -PWD=${ODIE_SRC_DIR}/src/toadkit -ZLIB_DIR = ${TCL_SRCROOT}/compat/zlib -ALLPROD=tclkit${EXE} zipkit.zip -TOADKIT_EXTRA_OBJS= -include ${exec_prefix}/lib/tclkitConfig.sh -ifneq ($(TK_FOSSIL_BRANCH),none) - include ${SANDBOX}/tk/${ODIE_TCL_PLATFORM_DIR}/tkConfig.sh - ifeq ($(ODIE_PLATFORM),windows) - TK_DYLIB=${TK_DLL_FILE} - else - TK_DYLIB=${TK_LIB_FILE} - endif -endif -TK_FULL_VERSION="$(strip $(subst ', , $(TK_VERSION)))$(strip $(subst ', , $(TK_PATCH_LEVEL)))" - -builddir=build - -CC=$(subst ', , $(TCL_CC)) -CCSWITCHES=-I -KIT_INCLUDE_SPEC=-I generic -I ${ZLIB_DIR} -I ${TCL_SRCROOT}/generic -I ${TCL_SRCROOT}/${ODIE_TCL_PLATFORM_DIR} -WKIT_INCLUDE_SPEC=-I ${TK_SRCROOT}/generic -I ${TK_SRCROOT}/${ODIE_TCL_PLATFORM_DIR} -KIT_DEFS=-DTCL_USE_STATIC_PACKAGES -DSTATIC_BUILD=1 -UUSE_TCL_STUBS -# Normal -#TCL_CC_SWITCHES = $(subst ', , $(TCL_CFLAGS_OPTIMIZE) $(TCL_EXTRA_CFLAGS) $(TCL_CFLAGS_WARNING) $(TCL_SHLIB_CFLAGS) $(TCL_INCLUDE_SPEC) ${KIT_INCLUDE_SPEC} $(TCL_DEFS) $(KIT_DEFS) -Igeneric -I${ODIE_TCL_PLATFORM_DIR}) -# Debugging -TCL_CC_SWITCHES = $(subst ', , $(TCL_CFLAGS_DEBUG) $(TCL_EXTRA_CFLAGS) $(TCL_CFLAGS_WARNING) $(TCL_SHLIB_CFLAGS) $(TCL_INCLUDE_SPEC) ${KIT_INCLUDE_SPEC} $(TCL_DEFS) $(KIT_DEFS) -Igeneric -I${ODIE_TCL_PLATFORM_DIR}) - -CFLAGS=$(subst ', , $(TCL_CFLAGS_DEBUG)) -#CFLAGS=-pipe $(subst ', , ${TCL_CFLAGS_OPTIMIZE}) -DEFS=$(KIT_DEFS) -COMPILE = $(CC) $(DEFS) $(INCLUDES) $(KIT_INCLUDE_SPEC) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) - - -ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ - Zinffast.o Zinflate.o Zinftrees.o Ztrees.o Zuncompr.o Zzutil.o -ZIPVFS_OBJS = $(ZLIB_OBJS) zvfs.o zvfsboot.o - -#ZIPVFS_OBJS = $(ZLIB_OBJS) zvfs.o zipmain.o \ -# crypt.o fileio.o globals.o \ -# ttyio.o util.o zbz2err.o zipfile.o zipup.o - -#ZIPVFS_OBJS = $(ZLIB_OBJS) zvfs.o zipmain.o \ -# crc32.o crypt.o deflate.o fileio.o globals.o trees.o \ -# ttyio.o util.o zbz2err.o zipfile.o zipup.o - -KIT_LIBS= - -ifeq ($(ODIE_PLATFORM),windows) - TOADKIT_EXTRA_OBJS+=$(TK_SRCPATH)/tk.res.o - TOADKIT_EXTRA_OBJS+=$(TK_SRCPATH)/wish.res.o - #ZIPVFS_OBJS += nt.o win32.o win32zip.o win32i64.o -endif - -all: ${ALLPROD} - -clean: - eval ${ODIE_RM} ${TCL_LIB_FILE} ${builddir} cthulhu.mk *.exe *.zip *.o *.c toadConfig.sh tclkit_bare${EXE} tclkit${EXE} tclkit.zip *.vfs zipkit* zzipsetup* - mkdir -p ${builddir} - -install: ${ALLPROD} - cp -f tclkit${EXE} ${ODIE_TCLKIT} - -cthulhu.mk: - $(ODIE_BUILD_TCLSH) configure.tcl - -include cthulhu.mk - -null.zip: - touch .empty - zip null.zip .empty - -tclkit_bare_OLD${EXE}: $(PKG_OBJECTS) - echo Built against ${TCL_FULL_VERSION} - echo KIT_LIBS $(KIT_LIBS) - $(CC) $(strip \ - $(subst ', , $(CFLAGS) $(TCL_EXTRA_CFLAGS) $(DEFS) $(TCL_LD_FLAGS) $(ODIE_LD_FLAGS)) \ - $(PKG_OBJECTS) \ - ${libdir}/${TCL_STUB_LIB_FILE} \ - ${ODIE_STATIC_TCLLIB} \ - $(subst ', , $(KIT_LIBS) $(TCL_LIBS) $(TCL_CC_SEARCH_FLAGS)) \ - $(TOADKIT_EXTRA_OBJS) \ - -o tclkit_bare${EXE}) - -tclkit_bare${EXE}: $(PKG_OBJECTS) - echo Built against ${TCL_FULL_VERSION} - echo KIT_LIBS $(KIT_LIBS) - $(CC) $(strip \ - $(subst ', , $(CFLAGS) $(TCL_EXTRA_CFLAGS) $(TCL_LD_FLAGS) $(ODIE_LD_FLAGS)) \ - $(PKG_OBJECTS) \ - ${ODIE_STATIC_TCLLIB} \ - ${libdir}/${TCL_STUB_LIB_FILE} \ - $(subst ', , $(KIT_LIBS) $(TCL_LIBS) $(TCL_CC_SEARCH_FLAGS)) \ - $(TOADKIT_EXTRA_OBJS) \ - -o tclkit_bare${EXE}) - -tclkit.vfs: -ifneq ($(TK_FOSSIL_BRANCH),none) - $(ODIE_BUILD_TCLSH) mkVfs.tcl ${ODIE_PLATFORM} "$(PWD)/tclkit.vfs/boot" "$(TCL_SRCROOT)" "$(TK_SRCROOT)" "$(TK_FULL_VERSION)" "$(TK_DYLIB)" -else - $(ODIE_BUILD_TCLSH) mkVfs.tcl ${ODIE_PLATFORM} "$(PWD)/tclkit.vfs/boot" "$(TCL_SRCROOT)" -endif - - -tclkit${EXE}: tclkit_bare${EXE} null.zip tclkit.vfs - cp tclkit_bare${EXE} tclkit.zip - cat null.zip >> tclkit.zip - cd $(PWD)/tclkit.vfs ; ${ZIP} -rAq ${PWD}/tclkit.zip . - mv tclkit.zip tclkit${EXE} - chmod a+x tclkit${EXE} - -zipkit.zip: - eval ${ODIE_RM} zipkit.vfs zipkit.tmp - mkdir -p zipkit.vfs - # Add files in the future... - touch zipkit.vfs/_ - cd zipkit.vfs ; $(ZIP) -rAq ../zipkit.tmp . - cp kitstrap.tcl zipkit.zip - cat zipkit.tmp >> zipkit.zip - rm zipkit.tmp - ADDED src/toadkit/build.tcl Index: src/toadkit/build.tcl ================================================================== --- /dev/null +++ src/toadkit/build.tcl @@ -0,0 +1,432 @@ +### +# 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 +} DELETED src/toadkit/configure.tcl Index: src/toadkit/configure.tcl ================================================================== --- src/toadkit/configure.tcl +++ /dev/null @@ -1,145 +0,0 @@ -### -# This file assembles the machine-generated portions of this -# extension -#### - -set path [file normalize [file dirname [info script]]] -set ::project(srcdir) $path -set ::project(path) [file normalize [file join $path .. ..]] -if {![info exists ::odie(host)]} { - source [file join $::project(path) scripts common.tcl] - puts "CALLED EXTERNALLY" -} -use cc system cthulhu - -if {$::odie(windows)} { - set ::project(name) odie_static - set ::project(pkgname) odielib_static -} else { - set ::project(name) odie - set ::project(pkgname) odielib -} -set ::project(pkgvers) 2.1 -set ::project(h_file) $::project(name).h -set ::project(h_file_int) $::project(name)Int.h -set ::project(c_file) lib${::project(name)}.c -set ::project(init_funct) [string totitle ${::project(name)}lib]_Init -set ::project(target) static -parray ::project -set ::project(standard_header) [subst { -/* -** This file is machine generated by the [info script] file -*/ -}] - -cthulhu_init -set ::project(h_file_int) odieInt.h - -if {![file exists [file join $::project(srcdir) build]]} { - file mkdir [file join $::project(srcdir) build] -} -cthulhu_add_cheader_verbatim [file join $::project(path) scripts cthulhu.h] -cthulhu_add_cheader_verbatim [file join $::project(srcdir) generic _macros.h] - -foreach file [glob -nocomplain build/*] { - file delete $file -} -set config {} - -# Exclude the following files from automatic scans -dict set config cthulhu-ignore-hfiles [list $::project(h_file_int) $::project(h_file)] -dict set config cthulhu-ignore-cfiles [list $::project(c_file) tree.c] -#dict set config cthulhu-ignore-cfiles {} - -dict set config_module math build-ignore-cfiles quaternion.c - -#cthulhu_add_directory [file join $::project(srcdir) build] $config -#cthulhu_add_directory [file join $::project(srcdir) generic] $config -#if {$::tcl_platform(platform) eq "unix"} { -# cthulhu_add_directory [file join $::project(srcdir) unix] $config -#} -#foreach path [lsort -dictionary [glob [file join $::odie(sandbox) odielib cmodules *]]] { -# if {[file exists [file join $path cthulhu.ini]]} { -# source [file join $path cthulhu.ini] -# } -#} - -#foreach dir {logicset odieutil} { -# set path [file join $::odie(sandbox) odielib cmodules $dir] -# if {[file exists [file join $path cthulhu.ini]]} { -# source [file join $path cthulhu.ini] -# } -#} - -### -# Add our Zip file system functions -### -cthulhu_add_csource [file join $::project(srcdir) generic zvfs.c] {scan 0} -cthulhu_add_csource [file join $::project(srcdir) generic zvfsboot.c] {scan 0} -foreach zfile { - adler32.c compress.c crc32.c deflate.c infback.c inffast.c inflate.c inftrees.c - trees.c uncompr.c zutil.c -} { - cthulhu_add_csource [file join $::odie(sandbox) tcl compat zlib $zfile] {scan 0} -} - -#cthulhu_include_directory [file join $::odie_build(sandbox) tcl compat zlib] -#cthulhu_include_directory [file join $::odie_build(sandbox) tcl generic] - -cthulhu_add_csource [file join $::project(srcdir) generic tclkit_init.c] {scan 0} -if {$::odie(windows)} { - #cthulhu_include_directory [file join $::odie_build(sandbox) tcl win] - cthulhu_add_csource [file join $::project(srcdir) win tclsh_packages.c] {scan 0} - cthulhu_add_csource [file join $::odie(sandbox) tcl win tclAppInit.c] {scan 0 extra {-DTCL_LOCAL_APPINIT=Toadkit_AppInit -DTCL_LOCAL_MAIN_HOOK=Toadkit_MainHook}} - #cthulhu_add_csource [file join $::odie_build(sandbox) tcl win tclWinDde.c] - cthulhu_add_csource [file join $::odie(sandbox) tcl win tclWinReg.c] -} else { - #cthulhu_include_directory [file join $::odie_build(sandbox) tcl unix] - cthulhu_add_csource [file join $::project(srcdir) unix tclsh_packages.c] {scan 0} - cthulhu_add_csource [file join $::odie(sandbox) tcl unix tclAppInit.c] {scan 0 extra {-DTCL_LOCAL_APPINIT=Toadkit_AppInit -DTCL_LOCAL_MAIN_HOOK=Toadkit_MainHook}} -} -if {$::odie(windows)} { - if {![file exists [file join $::odie(sandbox) odielib cmodules odieutil password.c]]} { - puts "BUILDING PASSWORD (toadkit)" - source [file join $::odie(sandbox) odielib cmodules odieutil mkPassword.tcl] - } - cthulhu_add_csource [file join $::odie(sandbox) odielib cmodules odieutil password.c] - cthulhu_add_csource [file join $::odie(sandbox) odielib cmodules odieutil memory.c] - cthulhu_add_csource [file join $::odie(sandbox) odielib cmodules odieutil md5.c] - cthulhu_add_csource [file join $::odie(sandbox) odielib cmodules odieutil rc4.c] - cthulhu_add_csource [file join $::odie(sandbox) odielib cmodules odieutil tclextra.c] -} else { - foreach path [lsort -dictionary [glob [file join $::odie(sandbox) odielib cmodules *]]] { - if {[file exists [file join $path cthulhu.ini]]} { - source [file join $path cthulhu.ini] - } - } -} - -### -# Build mkhdr if we don't have it -### -if {![file exists [::realpath $::odie(mkhdr)]]} { - cd $::build(odie_src_dir) - doexec $::odie(cc) -o mkhdr.o -c scripts/mkhdr.c - doexec $::odie(cc) mkhdr.o -o mkhdr$::odie(exe_suffix) - file copy -force mkhdr$::odie(exe_suffix) [::realpath ${exec_prefix}/bin/mkhdr$::odie(exe_suffix)] -} - -### -# Build our libinit.c file and internal.h file -### -set hout $::project(srcdir)/generic/$::project(h_file_int) -set docfileout $::project(srcdir)/build/cthulhu.rc -cd $::project(srcdir) -cthulhu_mkhdr_index $hout $docfileout -cthulhu_mk_app_init.c [file join $::project(srcdir) generic $::project(c_file)] -cthulhu_add_dynamic [file join $::project(srcdir) generic $::project(c_file)] [file join $::project(srcdir) configure.tcl] -cthulhu_add_csource [file join $::project(srcdir) generic $::project(c_file)] {scan 0} - -### -# Build our cthulhu.mk file -### -cthulhu_mk_sources build [file join $::project(srcdir) cthulhu.mk] -make-template [file join $::project(srcdir) Makefile.in] - DELETED src/toadkit/generic/_macros.h Index: src/toadkit/generic/_macros.h ================================================================== --- src/toadkit/generic/_macros.h +++ /dev/null @@ -1,25 +0,0 @@ -#define STATIC_BUILD 1 -#undef USE_TCL_STUBS - -#include "tcl.h" -#include -#include -#include -#include -#include - -/* Macros */ -#define ODIE_REAL_ZERO() Tcl_NewDoubleObj(0.0) -#define ODIE_INT_ZERO() Tcl_NewIntObj(0.0) -#define ODIE_INT_ONE() Tcl_NewIntObj(0.0) -#define ODIE_CONSTANT_STRING(A) Tcl_NewStringObj(A,-1) - -#define X_IDX 0 -#define Y_IDX 1 -#define Z_IDX 2 -#define W_IDX 3 - -#define I_IDX 0 -#define J_IDX 1 -#define K_IDX 2 -#define L_IDX 3 ADDED src/toadkit/generic/mkPassword.tcl Index: src/toadkit/generic/mkPassword.tcl ================================================================== --- /dev/null +++ src/toadkit/generic/mkPassword.tcl @@ -0,0 +1,49 @@ +### +# 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 + + DELETED src/toadkit/generic/packages.c.in Index: src/toadkit/generic/packages.c.in ================================================================== --- src/toadkit/generic/packages.c.in +++ /dev/null @@ -1,27 +0,0 @@ -/* -** This is just a template. Replace with your own -*/ -#include "toadkit.h" - -/* -** Declare INIT functions here -*/ - -/* -** int Vexpr_Init(Tcl_Interp *); -*/ -int Odielib_Init(Tcl_Interp *); - -/* -** Call initialization code for all extensions -*/ -int -Toadkit_Packages_Init(interp) - Tcl_Interp *interp; /* Interpreter for application. */ -{ - /* - ** if(Vexpr_Init(interp)) return TCL_ERROR; - */ - if(Odielib_Init(interp)) return TCL_ERROR; - return TCL_OK; -} ADDED src/toadkit/generic/password.c Index: src/toadkit/generic/password.c ================================================================== --- /dev/null +++ src/toadkit/generic/password.c @@ -0,0 +1,21 @@ +/* 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; +} ADDED src/toadkit/generic/password.tcl Index: src/toadkit/generic/password.tcl ================================================================== --- /dev/null +++ src/toadkit/generic/password.tcl @@ -0,0 +1,33 @@ +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 ADDED src/toadkit/generic/password.txt Index: src/toadkit/generic/password.txt ================================================================== --- /dev/null +++ src/toadkit/generic/password.txt @@ -0,0 +1,1 @@ +5meXhfid ADDED src/toadkit/generic/rc4.c Index: src/toadkit/generic/rc4.c ================================================================== --- /dev/null +++ src/toadkit/generic/rc4.c @@ -0,0 +1,499 @@ +/* +** Implementation of an RC4 codec for TCL. +*/ +#include "tcl.h" +#include +#include +#include + +char *getPwdKey(char *keybuf); + +//#include + +/* +** 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 decode64 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>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>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>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>4) & 0x03); + zData[j++] = ((b<<4) & 0xf0) | ((c>>2) & 0x0f); + zData[j++] = ((c<<6) & 0xc0) | (d & 0x3f); + } + if( i+2>4) & 0x03); + zData[j++] = ((b<<4) & 0xf0) | ((c>>2) & 0x0f); + }else if( i+1>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;i252 ) 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; +} Index: src/toadkit/generic/tclkit_init.c ================================================================== --- src/toadkit/generic/tclkit_init.c +++ src/toadkit/generic/tclkit_init.c @@ -3,13 +3,13 @@ /* * Toadkit_MainHook -- * Performs the argument munging for the shell */ #ifdef _WIN32 -MODULE_SCOPE int Toadkit_MainHook(int *argc, TCHAR ***argv) +int Toadkit_MainHook(int *argc, TCHAR ***argv) #else -MODULE_SCOPE int Toadkit_MainHook(int *argc, char ***argv) +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); @@ -34,14 +34,15 @@ * Depends on the startup script. * *---------------------------------------------------------------------- */ -MODULE_SCOPE int Toadkit_AppInit(Tcl_Interp *interp) { +int Toadkit_AppInit(Tcl_Interp *interp) { if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } + /* * Start up all extensions. */ Tclkit_Packages_Init(interp); /* Index: src/toadkit/generic/toadkit.h ================================================================== --- src/toadkit/generic/toadkit.h +++ src/toadkit/generic/toadkit.h @@ -1,13 +1,35 @@ -#include +#include "tcl.h" #include "tclInt.h" #include "tclFileSystem.h" + +#include +#include +#include +#include +#include #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 @@ -14,11 +36,15 @@ #undef Tcl_NewStringObj #undef Tk_Init #undef Tk_MainEx #undef Tk_SafeInit -MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); -MODULE_SCOPE int Zvfs_Init(Tcl_Interp *); -MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *); -MODULE_SCOPE int Tclkit_Packages_Init(Tcl_Interp *); +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 Index: src/toadkit/generic/zvfsboot.c ================================================================== --- src/toadkit/generic/zvfsboot.c +++ src/toadkit/generic/zvfsboot.c @@ -68,10 +68,12 @@ } 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)); DELETED src/toadkit/mkVfs.tcl Index: src/toadkit/mkVfs.tcl ================================================================== --- src/toadkit/mkVfs.tcl +++ /dev/null @@ -1,134 +0,0 @@ -### -# topic: c592732bb435d83ab1f70259fc56dbd7 -### -proc ::cat fname { - set fname [open $fname r] - set data [read $fname] - close $fname - return $data -} - -### -# topic: 64319f4600fb63c82b2258d908f9d066 -# description: Script to build the VFS file system -### -proc ::copyDir {d1 d2} { - - puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ - [file tail $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] - if {$::tcl_platform(platform) eq {unix}} { - file attributes [file join $d2 $ftail] -permissions 0644 - } else { - file attributes [file join $d2 $ftail] -readonly 1 - } - } - } - - if {$::tcl_platform(platform) eq {unix}} { - file attributes $d2 -permissions 0755 - } else { - file attributes $d2 -readonly 1 - } -} - -### -# 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] - } - } -} - -if {[llength $argv] < 3} { - puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM" - exit 1 -} -set PLATFORM [lindex $argv 0] -set BASE_DIR [lindex $argv 1] -set TCLSRC_ROOT [lindex $argv 2] -set TKSRC_ROOT [lindex $argv 3] -set TK_FULL_VERSION [string trim [lindex $argv 4] '] -set TK_DLL [string trim [lindex $argv 5] '] - -set TCL_SCRIPT_DIR [file join $BASE_DIR tcl] -file mkdir $TCL_SCRIPT_DIR -puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM" -copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR} - -if {$PLATFORM == "windows"} { - set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] - puts "DDE DLL $ddedll" - if {$ddedll != {}} { - file copy $ddedll ${TCL_SCRIPT_DIR}/dde - } - set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] - puts "REG DLL $ddedll" - if {$regdll != {}} { - file copy $regdll ${TCL_SCRIPT_DIR}/reg - } -} else { - # Remove the dde and reg package paths - file delete -force ${TCL_SCRIPT_DIR}/dde - file delete -force ${TCL_SCRIPT_DIR}/reg -} - -# For the following packages, cat their pkgIndex files to tclIndex -if {$::tcl_platform(platform) eq {unix}} { - file attributes [file join ${TCL_SCRIPT_DIR} tclIndex] -permissions 0744 -} else { - file attributes [file join ${TCL_SCRIPT_DIR} tclIndex] -readonly 0 -} -set fout [open [file join ${TCL_SCRIPT_DIR} tclIndex] a] -puts $fout {# -# MANIFEST OF INCLUDED PACKAGES -# -set VFSROOT $dir -} -pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} -close $fout - -if { $TKSRC_ROOT eq {} } { - exit 0 -} -set TK_SCRIPT_DIR [file join $BASE_DIR tk] -file mkdir $TK_SCRIPT_DIR - -puts "Building [file tail $TK_SCRIPT_DIR] for $PLATFORM" -copyDir ${TKSRC_ROOT}/library ${TK_SCRIPT_DIR} -if { $TK_DLL eq {} } { - exit 0 -} -puts "Injecting Tk DLL" -if {$PLATFORM eq "windows"} { - set dllsrc ${TKSRC_ROOT}/win/$TK_DLL -} else { - set dllsrc ${TKSRC_ROOT}/unix/$TK_DLL -} -puts [list CP $dllsrc $TK_SCRIPT_DIR/$TK_DLL] -file copy -force $dllsrc $TK_SCRIPT_DIR/$TK_DLL -set fout [open ${TCL_SCRIPT_DIR}/tclIndex a] -puts $fout [string map [list @TKVERSION@ $TK_FULL_VERSION @TKDLL@ $TK_DLL] { -package ifneeded Tk @TKVERSION@ [list load $::tk_library/@TKDLL@ Tk] -}] -close $fout -exit 0 - ADDED src/toadkit/mkzip.tcl Index: src/toadkit/mkzip.tcl ================================================================== --- /dev/null +++ src/toadkit/mkzip.tcl @@ -0,0 +1,282 @@ +# -*- tcl -*- +# mkzip.tcl -- Copyright (C) 2009 Pat Thoyts +# +# 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 Index: src/toadkit/unix/tclsh_packages.c ================================================================== --- src/toadkit/unix/tclsh_packages.c +++ src/toadkit/unix/tclsh_packages.c @@ -1,9 +1,9 @@ /* ** This is just a template. Replace with your own */ -#include +#include "tcl.h" #include "toadkit.h" /* ** Declare INIT functions here */ @@ -17,10 +17,9 @@ 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(Odielib_Init_static(interp)) return TCL_ERROR; - Tcl_StaticPackage(interp, "odielib", Odielib_Init_static, 0); + if(Rc4_Init(interp)) return TCL_ERROR; + Tcl_StaticPackage(interp, "rc4", Rc4_Init, NULL); return TCL_OK; } Index: src/toadkit/win/tclsh_packages.c ================================================================== --- src/toadkit/win/tclsh_packages.c +++ src/toadkit/win/tclsh_packages.c @@ -1,37 +1,41 @@ /* ** This is just a template. Replace with your own */ -#include -#include "odieInt.h" +#include "tcl.h" +#include "toadkit.h" /* ** Declare INIT functions here */ -int Odielib_Init(Tcl_Interp *); - +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(interp) - Tcl_Interp *interp; /* Interpreter for application. */ -{ +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(Odie_staticlib_Init_static(interp)) return TCL_ERROR; - Tcl_StaticPackage(interp, "odielib", Odie_staticlib_Init_static, 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; }