Changes On Branch kitscript
Not logged in
HomePackagesLeavesTimelineBranchesTagsTicketsWikiLogin
Patch Side-by-Side Diff
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com or submit via the online form
by Aug 20.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch kitscript Excluding Merge-Ins

This is equivalent to a diff from 572d26a300 to 11180b89ba

2016-02-18
15:36
Pulling in the kitscript branch check-in: bc81bcba25 user: hypnotoad tags: trunk
2016-02-17
20:34
Fixes to condense all kitbuilding activity to a single Tcl scripts Closed-Leaf check-in: 11180b89ba user: hypnotoad tags: kitscript
2015-09-25
15:34
Updates some file paths check-in: c49d6db579 user: hypnotoad tags: trunk
2015-08-10
13:20
Updates to the window build process check-in: 572d26a300 user: hypnotoad tags: trunk
2015-06-01
18:27
Fixed the "install sherpa" command check-in: 5e24e26760 user: hypnotoad tags: trunk

Changes to Makefile.
︙
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48
49
50
51

52
53
54
55
56
57

58
59
60
61
62
63
64

14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48
49
50

51
52
53
54
55
56

57
58
59
60
61
62
63
64








-
+









-
+








-
+










-
+





-
+









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} 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:
	$(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

$(ODIE_MKHDR):
︙
Changes to autosetup/lib/cthulhu.tcl.
︙
516
517
518
519
520
521
522

523
524



525
526
527
528
529
530
531

516
517
518
519
520
521
522
523


524
525
526
527
528
529
530
531
532
533








+
-
-
+
+
+








  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
            lappend ::project(modules) $funcname        
            break
          }
        }
      }
    }
  }
}

proc cthulhu_find_mkhdr {} {
︙
Changes to odie.komodoproject. 
1
2
3
4

5
6

7

8
9

1
2
3

4
5

6
7
8
9
10




-
+

-
+

+



<?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">
<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;*%*;tmp*.html;.DS_Store;.fslckout;cthulhu.rc;*.vfs;embedded</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>
Deleted scripts/make_basekit.tcl. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28






























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#!/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
Changes to scripts/make_tcl.sh. 
1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29





















30
31
32
33
34
35
36
37


38
39
40
41
42
43
44

1
2
3
4


5
6
7
8





















9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35


36
37
38
39
40
41
42
43
44





-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
+
+








#! /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}
else
    sh ./configure --enable-shared=no --with-tzdata ${TCL_CONFIG_FLAGS}
︙
59
60
61
62
63
64
65
66
67


68
69
70
71
72
73
74

59
60
61
62
63
64
65


66
67
68
69
70
71
72
73
74








-
-
+
+








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 ${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
︙
Deleted src/toadkit/Makefile.in. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133







































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

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. 

















































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
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.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145



















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

###
# 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.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25



























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#define STATIC_BUILD 1
#undef USE_TCL_STUBS

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

/* 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.























































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
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.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27





























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/*
** 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.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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.







































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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.







1

+

5meXhfid






Added src/toadkit/generic/rc4.c.

























































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
** 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;
}






Changes to src/toadkit/generic/tclkit_init.c.





1
2
3
4
5
6
7
8

9
10

11
12
13
14
15
16
17

1
2
3
4
5
6
7

8
9

10
11
12
13
14
15
16
17








-
+

-
+








#include "toadkit.h"

/*
 * 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);
    return 0;
}




︙


32
33
34
35
36
37
38
39

40
41
42

43
44
45
46
47
48
49

32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
47
48
49
50








-
+



+








 *
 * Side effects:
 *	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);
  /*
   * Call Tcl_CreateCommand for application-specific commands, if
   * they weren't already created by the init procedures called above.




︙





Changes to src/toadkit/generic/toadkit.h.





1

2
3






4
5
6
7
8
















9
10
11
12
13
14
15
16
17
18
19
20
21
22








23
24


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40




41
42
43
44
45
46
47
48
49
50

-
+


+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
-
-
-
+
+
+
+
+
+
+
+



#include <tcl.h>
#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

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






Changes to src/toadkit/generic/zvfsboot.c.






︙


66
67
68
69
70
71
72


73
74
75
76
77
78
79

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81








+
+








        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);




︙





Deleted src/toadkit/mkVfs.tcl.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134








































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

###
# 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.
































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- 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






Changes to src/toadkit/unix/tclsh_packages.c.





1
2
3
4

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24


25
26

1
2
3

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21



22
23
24
25




-
+

















-
-
-
+
+



/*
** This is just a template. Replace with your own
*/
#include <tcl.h>
#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(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;
}






Changes to src/toadkit/win/tclsh_packages.c.





1
2
3
4
5


6
7
8
9
10

11
12
13
14
15
16


17
18
19
20
21
22
23
24

25
26
27
28

29
30
31
32

33

34
35





36
37

1
2
3


4
5
6
7
8
9

10

11
12
13
14
15
16
17
18
19
20
21
22
23
24

25


26
27
28
29
30
31
32
33

34


35
36
37
38
39
40
41




-
-
+
+




-
+
-





+
+







-
+
-
-


+




+
-
+
-
-
+
+
+
+
+



/*
** This is just a template. Replace with your own
*/
#include <tcl.h>
#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)
Tclkit_Packages_Init(Tcl_Interp *interp) {
    Tcl_Interp *interp;		/* Interpreter for application. */
{
  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) {
  if(Odie_staticlib_Init_static(interp)) return TCL_ERROR;
    return TCL_ERROR;
  Tcl_StaticPackage(interp, "odielib", Odie_staticlib_Init_static, 0);

  }
  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;
}











Fossil version [935cd45f03] 2025-02-06 15:57:56