AppBox
Check-in [44d2557fd1]
Login
HomeDownloadsSource CodeTicketsWiki
Overview
Comment:Added start of build system (CAEL)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 44d2557fd1bf1cfbba18cf213f4fd8cfabee3663
User & Date: rkeene on 2012-08-07 00:29:58
Other Links: manifest | tags
Context
2012-08-07
14:32
Added first stab at dietlibc build check-in: 216375cf37 user: rkeene tags: trunk
00:29
Added start of build system (CAEL) check-in: 44d2557fd1 user: rkeene tags: trunk
2012-08-05
21:38
Brought system to basic bootable state (early-boot) check-in: 1dddebba6a user: rkeene tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added build-process version [e224b9e043]. 







1
2
3
4
5

+
+
+
+
+

1. Create kernel
2. Create initrd
4. Create system image
	a. Create apps
	b. Tar up








Added components/package-maker/bin/build version [8470d40cf4].














































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906

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

#! /usr/bin/env tclsh

set domain "appbox.rkeene.org"
set packages $argv

lappend auto_path [file join [file dirname [info script]] .. lib]

package require tax
package require csv
package require sha1
package require md5

namespace eval ::cael::build {
	variable pkgmap_fields [list name type owner group mode mtime size sha1 linkdest]
	variable pkginfodir [file join [file dirname [info script]] .. pkginfo]
	variable buildonlyvars [list destroot buildroot metadataroot extraroot]
	variable have_tclx 0
	variable default_scripts {
		compile {
			/bin/sh {
				./configure "--prefix=${_APPBOX_PREFIX}" "--sysconfdir=${_APPBOX_SYSCONFDIR}"  || exit 1

				make || exit 1

				exit 0
			}
		}
		install {
			/bin/sh {
				make "DESTDIR=${destroot}" install || exit 1

				exit 0
			}
		}
	}
}

catch {
	package require Tclx
	set ::cael::build::have_tclx 1
}

if {!$::cael::build::have_tclx} {
	proc recursive_glob {dirlist globlist} {
		set result {}
		set recurse {}

		foreach dir $dirlist {
			if ![file isdirectory $dir] {
				error "\"$dir\" is not a directory"
			}

			foreach pattern $globlist {
				set result [concat $result  [glob -nocomplain -- [file join $dir $pattern]]]
			}

			foreach file [glob -nocomplain -tails -directory $dir * .*] {
				set file [file join $dir $file]
				if [file isdirectory $file] {
					set fileTail [file tail $file]
					if {$fileTail != "." && $fileTail != ".."} {
						lappend recurse $file
					}
				}
			}
		}

		if {[llength $recurse] != 0} {
			set result [concat $result [recursive_glob $recurse $globlist]]
		}

		return $result
	}
}

proc ::cael::build::_parse_pkgXML {tag isClosing isSelfClosing props_list body} {
	if {[string match "!--*" $tag]} {
		return
	}

	if {$isClosing} {
		set lastOpened [lindex $::cael::build::_xml_stack end]

		if {$tag != $lastOpened} {
			return -code error "XML Parsing Error: Got close for tag \"${tag}\", but last opened was \"${lastOpened}\""
		}

		set fulltag [join $::cael::build::_xml_stack .]

		switch -- $fulltag {
			root.package.releases.release {
				unset -nocomplain currversioninfo

				# Convert array-like list into an array
				foreach {var val} $::cael::build::_currversion {
					switch -- $var {
						"urls" - "sigs" - "alt" {
							# These elements form lists
							lappend currversioninfo($var) $val
						}
						default {
							# All other elements form strings
							set currversioninfo($var) $val
						}
					}
				}

				lappend ::cael::build::_parse_array(versions) [array get currversioninfo]

				unset ::cael::build::_currversion
			}
			root.package.variants.variant {
				set ::cael::build::_ignoreTags_until_variant 0
			}
			root.package.releases {
				# If a default URL was specified, go back through every release and add an "urls" list if none are present 
				if {[info exists ::cael::build::_parse_array(urls)] && [info exists ::cael::build::_parse_array(versions)]} {
					set newversions [list]
					foreach version_ent_list $::cael::build::_parse_array(versions) {
						array set tmpversinfo $version_ent_list

						if {![info exists tmpversinfo(urls)]} {
							set tmpversinfo(urls) $::cael::build::_parse_array(urls)
						}

						lappend newversions [array get tmpversinfo]
					}

					set ::cael::build::_parse_array(versions) $newversions
				}
			}
			root.package {
				foreach {scriptname} [lsort -dictionary [array name ::cael::build::_script_array]] {
					set script_frags $::cael::build::_script_array($scriptname)
					set interp $::cael::build::_script_info($scriptname)

					set script_list [list]
					foreach script_frag $script_frags {
						foreach line [split $script_frag "\n"] {
							lappend script_list $line
						}
					}
					set script [join $script_list "\n"]

					lappend ::cael::build::_parse_array(scripts) $scriptname [list $interp $script]
				}
			}
		}

		set ::cael::build::_xml_stack [lrange $::cael::build::_xml_stack 0 end-1]

		return
	}

	regsub -all {\&ob;} $body \{ body
	regsub -all {\&cb;} $body \} body

	lappend ::cael::build::_xml_stack $tag

	set fulltag [join $::cael::build::_xml_stack .]
	array set props $props_list

	if {$::cael::build::_ignoreTags_until_variant} {
		set fulltag "__IGNORED__"
	}

	switch -- $fulltag {
		__IGNORED__ {}
		root.package {
			set pkgname $props(name)

			set pkgname [string trim $pkgname]

			set ::cael::build::_parse_array(name) $pkgname
		}
		root.package.description {
			set short_desc $props(short)
			set long_desc $body

			set short_desc [string trim $short_desc]
			set long_desc [string trim $long_desc]

			set ::cael::build::_parse_array(short_desc) $short_desc
			set ::cael::build::_parse_array(long_desc) $long_desc
		}
		root.package.releases.release {
			set ::cael::build::_currversion [list version $props(version)]
		}
		root.package.releases.release.alt {
			lappend ::cael::build::_currversion alt $body
		}
		root.package.releases.release.source.url {
			lappend ::cael::build::_currversion urls $body
		}
		root.package.releases.release.source.sig {
			lappend ::cael::build::_currversion sigs $body
		}
		root.package.releases.release.sha1 {
			lappend ::cael::build::_currversion sha1 [string trim $body]
		}
		root.package.releases.source.url {
			lappend ::cael::build::_parse_array(urls) $body
		}
		root.package.releases.source.sig {
			lappend ::cael::build::_parse_array(sigs) $body
		}
		root.package.variants.variant {
			lappend ::cael::build::_parse_array(variants) $props(name)

			if {$props(name) != $::cael::build::_variant} {
				set ::cael::build::_ignoreTags_until_variant 1
			} else {
				set ::cael::build::_parse_array(variant) $props(name)
			}
		}
		root.package.var - root.package.variants.variant.var {
			lappend ::cael::build::_parse_array(env_vars) $props(name) $props(value)
		}
		root.package.script - root.package.variants.variant.script {
			if {![info exists props(name)] && ![info exists props(names)]} {
				set props(name) "immediate-$::cael::build::_script_num"
				incr ::cael::build::_script_num
			}

			if {[info exists props(names)]} {
				if {[info exists props(name)]} {
					return -code error "May not specify both the \"name\" and \"names\" properties for a script"
				}
				set script_names [split $props(names) ","]
			} else {
				set script_names [list $props(name)]
			}

			foreach script_name $script_names {
				set script_name [string trim $script_name]

				if {[info exists props(interp)]} {
					set ::cael::build::_script_info($script_name) $props(interp)
				} else {
					if {![info exists ::cael::build::_script_info($script_name)]} {
						# The first reference to a script must include the interp
						return -code error "Script \"$script_name\" has no interpreter (first reference must include an \"interp\" property to specify the interpreter)"
					}
				}

				lappend ::cael::build::_script_array($script_name) $body
			}
		}
		root.package.files.default {
			set permslist [list]
			foreach prop [list owner group filemode dirmode] {
				lappend permslist $prop $props($prop)
			}
			set ::cael::build::_parse_array(default-file) $permslist
		}
		root.package.files.file {
			set permslist [list]
			foreach prop [list owner group mode] {
				lappend permslist $prop $props($prop)
			}
			lappend ::cael::build::_parse_array(files) $props(name) $permslist
		}
		root.package.buildflags.static - root.package.variants.variant.buildflags.static {
			lappend ::cael::build::_parse_array(buildflags) "static"
		}
		root - \
		  root.package.releases - \
		  root.package.releases.release.source - \
		  root.package.releases.source - \
		  root.package.variants - \
		  root.package.buildflags - \
		  root.package.variants.variant.buildflags - \
		  root.package.files {
			# We don't handle these tags
		}
		default {
			puts stderr "Unhandled Tag: <${fulltag} props=$props_list, body=[string trim $body]>"
		}
	}

	if {$isSelfClosing} {
		set ::cael::build::_xml_stack [lrange $::cael::build::_xml_stack 0 end-1]
	}

	return
}

proc ::cael::build::_parse_pkgXML_init {variant} {
	set ::cael::build::_script_num 0
	set ::cael::build::_xml_stack ""
	set ::cael::build::_variant $variant
	set ::cael::build::_ignoreTags_until_variant 0

	unset -nocomplain ::cael::build::_parse_array ::cael::build::_currversion
	set ::cael::build::_parse_array(variant) default
}

proc ::cael::build::_version_sort {a b} {
	set foundval [lindex [lsort -dictionary [list $a $b]] 0]

	if {$foundval == "$a"} {
		return -1
	}

	return 1
}

proc ::cael::build::_parse_pkg {pkgname {version "latest"} {variant "default"}} {
	set file [file join $::cael::build::pkginfodir "${pkgname}.xml"]

	# Read in XML document
	set fd [open $file r]
	set document [read $fd]
	close $fd

	# Cleanup internal XML structures
	::cael::build::_parse_pkgXML_init $variant

	# Parse XML Document
	::tax::parse ::cael::build::_parse_pkgXML $document root

	# Populate version information
	## Determine the latest version if it is requested
	set versions [list]
	array set allversinfo [list]
	foreach versinfo_list $::cael::build::_parse_array(versions) {
		unset -nocomplain versinfo
		array set versinfo $versinfo_list

		set item_version $versinfo(version)

		lappend versions $item_version
		set allversinfo($item_version) $versinfo_list
	}
	if {$version == "latest"} {
		set version [lindex [lsort -decreasing -command ::cael::build::_version_sort $versions] 0]
	}
	set ::cael::build::_parse_array(versinfo) $allversinfo($version)

	# Generate return value
	set retval [array get ::cael::build::_parse_array]

	# Cleanup
	unset ::cael::build::_parse_array

	return $retval
}

proc ::cael::build::_url_subst {url env version} {
	# Create a safe interp to run the substitutions in

	set interp [interp create -safe]

	foreach {var val} $env {
		$interp eval [list set $var $val]
	}

	set retval [$interp eval [list subst $url]]

	interp delete $interp

	return $retval
}

proc ::cael::build::script_gen_execute {shell args} {
	# Determine the properties of this shell
	switch -glob -- $shell {
		"*/csh" {
			lappend escapeMapping {'} {'"'"'}
			set quoteOpen "'"
			set quoteClose "'"

			set abortSuffix " || exit 1"

			set commentChar "#"
			set execCmd ""
		}
		"*/tclsh" {
			lappend escapeMapping "\\" "\\\\" "\"" "\\\"" "{" "\\\{" "}" "\\\}" "\$" "\\\$" "\[" "\\\[" "\]" "\\\]"
			set quoteOpen "\""
			set quoteClose "\""

			set abortSuffix ""

			set commentChar "#"
			set execCmd "exec "
		}
		default {
			# Bourne-like shells
			lappend escapeMapping {'} {'"'"'}
			set quoteOpen "'"
			set quoteClose "'"

			set abortSuffix " || exit 1"

			set commentChar "#"
			set execCmd ""
		}
	}

	# Set a default value if we are unable to emit usable actions
	set ret "echo \"Unable to determine how to \\\"[join $args " "]\\\"\"\nexit 1"

	# Determine output
	set cmd [lindex $args 0]
	switch -- $cmd {
		"set" {
			set var [lindex $args 1]
			set val [string map $escapeMapping [lindex $args 2]]

			switch -glob -- $shell {
				"*/csh" {
					set ret "setenv $var='$val'"
				}
				"*/tclsh" {
					set ret "set $var \"$val\""
				}
				default {
					set ret "$var='$val'; export $var"
				}
			}
		}
		"mkdir" {
			set dir [string map $escapeMapping [lindex $args 1]]

			switch -glob -- $shell {
				"*/tclsh" {
					set ret "file mkdir -- \"$dir\""
				}
				default {
					set ret "mkdir -p '$dir' || exit 1"
				}
			}
		}
		"mv" {
			set src [string map $escapeMapping [lindex $args 1]]
			set dst [string map $escapeMapping [lindex $args 2]]

			switch -glob -- $shell {
				"*/tclsh" {
					set ret "file rename -- \"$src\" \"$dst\""
				}
				default {
					set ret "mv '$src' '$dst' || exit 1"
				}
			}
		}
		"cd_one_dir" {
			switch -glob -- $shell {
				"*/csh" {
					# XXX: TODO
				}
				"*/tclsh" {
					# XXX: TODO
				}
				default {
					set ret "_tmp_build_num_dirs=\"\`ls -1a | wc -l`\"\n"
					append ret "if \[ \"x\${_tmp_build_num_dirs}\" = \"x3\" ]; then\n"
					append ret "\tcd *\n"
					append ret "fi\n"
					append ret "unset _tmp_build_num_dirs\n"
				}
			}
		}
		"sha1check" {
			set file [string map $escapeMapping [lindex $args 1]]
			set sha1 [string map $escapeMapping [lindex $args 2]]

			switch -glob -- $shell {
				"*/csh" {
					# XXX: TODO
				}
				"*/tclsh" {
					# XXX: TODO
				}
				default {
					set ret "_tmp_sha1sum=\"`sha1sum '${file}' | awk '{ print \$1 }'`\"\n"
					append ret "if \[ \"x\${_tmp_sha1sum}\" != 'x${sha1}' \]; then\n"
					append ret "\techo 'Checksum of \"${file}\" failed.  Aborting.\'\n"
					append ret "\texit 1\n"
					append ret "fi\n"
					append ret "unset _tmp_sha1sum\n"
				}
			}
		}
		"wget" {
			set file [string map $escapeMapping [lindex $args 1]]
			set urls [lindex $args 2]

			switch -glob -- $shell {
				"*/tclsh" {
					# XXX: TODO
				}
				default {
					set ret "wget -O '${file}' '[string map $escapeMapping [lindex $urls 0]]' || \\\n"
					foreach url [lrange $urls 1 end] {
						append ret "\twget -O '${file}' '[string map $escapeMapping $url]' || \\\n"
					}
					append ret "\texit 1\n"
				}
			}
		}
		"extract" {
			set file [string map $escapeMapping [lindex $args 1]]

			switch -glob -- $shell {
				"*/tclsh" {
					# XXX: TODO
				}
				default {
					set ret "${execCmd}tar -xf ${quoteOpen}${file}${quoteClose} || \\\n"
					append ret "\t${execCmd}xz -dc ${quoteOpen}${file}${quoteClose} | tar -xf - || \\\n"
					append ret "\t${execCmd}unzip ${quoteOpen}${file}${quoteClose}${abortSuffix}"
				}
			}
		}
		"cd" {
			set dir [string map $escapeMapping [lindex $args 1]]

			set ret "cd ${quoteOpen}${dir}${quoteClose}${abortSuffix}"
		}
	}

	return $ret
}

proc ::cael::build::gen_scripts {pkgname version variant workdir instrootdir versinfo_list pkginfo_list scripts_list} {
	array set versinfo $versinfo_list
	array set pkginfo $pkginfo_list

	set ret [list]

	set scriptdir [file join $workdir build-scripts]
	set builddir [file join $workdir build]
	set srcdir [file join $workdir src]

	file mkdir $scriptdir
	file mkdir $srcdir

	foreach {script scriptval} $scripts_list {
		# Sanitize script name to create script name
		set script [file tail $script]

		# Determine script file name
		set file [file join $scriptdir "${script}"]

		# Record script name and file for later use
		lappend ret $script $file

		set init 0
		if {![file exists $file]} {
			set init 1
		}

		set fd [open $file a+]

		if {$init} {
			set shell [lindex $scriptval 0]

			# Create generic preamble
			puts $fd "#!${shell}"
			puts $fd ""
			set export_vars [list]
			foreach {var val} $pkginfo(env_vars) {
				# Exclude build-related variables from
				# non-build-related scripts
				switch -- $script {
					"compile" - "install" {
					}
					default {
						if {[lsearch -exact $::cael::build::buildonlyvars $var] != -1} {
							continue
						}
					}
				}

				puts $fd [script_gen_execute $shell set $var $val]
			}

			# Do script-specific preamble
			switch -- $script {
				"compile" - "install" {
					puts $fd [script_gen_execute $shell mkdir $workdir]
					puts $fd [script_gen_execute $shell cd $workdir]
					puts $fd ""
				}
			}

			# Do script-specific stuff
			switch -- $script {
				"compile" {
					puts $fd [script_gen_execute $shell mkdir $srcdir]
					puts $fd ""

					set outfile [file join $srcdir "${pkgname}-$versinfo(version).src"]

					# Download archive
					set urls [list]
					foreach url $versinfo(urls) {
						lappend urls [_url_subst $url $pkginfo(env_vars) $versinfo(version)]
					}
					puts $fd [script_gen_execute $shell wget "${outfile}.new" $urls]
					puts $fd [script_gen_execute $shell sha1check "${outfile}.new" $versinfo(sha1)]
					puts $fd "mv '${outfile}.new' '${outfile}'"
					puts $fd ""

					# Extract archive
					puts $fd [script_gen_execute $shell mkdir $builddir]
					puts $fd [script_gen_execute $shell cd $builddir]
					puts $fd [script_gen_execute $shell extract $outfile]
					puts $fd ""

					# Change to working directory within archive, if available
					puts $fd [script_gen_execute $shell cd_one_dir]
				}
				"install" {
					# Change to working directory within archive
					puts $fd [script_gen_execute $shell cd $builddir]
					puts $fd [script_gen_execute $shell cd_one_dir]
					puts $fd ""

					# Create the installation root directory
					puts $fd [script_gen_execute $shell mkdir $instrootdir]
					puts $fd ""
				}
			}
		}

		foreach part [lrange $scriptval 1 end] {
			puts $fd $part
		}

		close $fd
	}

	return $ret
}

proc ::cael::build::gen_meta {pkgname pkgdomain version variant workdir instrootdir instmetadir versinfo_list pkginfo_list scripts_list} {
	array set versinfo $versinfo_list
	array set pkginfo $pkginfo_list

	array set fileinfo [list]
	if {[info exists pkginfo_list(files)]} {
		array set fileinfo $pkginfo_list(files)
	}

	## Create meta directory
	file mkdir $instmetadir

	## Create Description file
	set pkgdescfile [file join $instmetadir desc]
	set fd [open $pkgdescfile w]
	puts $fd "[join [split $pkginfo(short_desc) "\n"] " "]"
	puts $fd "$pkginfo(long_desc)"
	close $fd

	## Create Package Map file
	### Generate list of all files
	set filelist [recursive_glob [list $instrootdir] [list *]]

	### Determine how to modify the file name to be what is available
	### to the system
	set strip_file_names [string length $instrootdir]

	### Create default file information if it was not provided
	if {![info exists pkginfo(default-file)]} {
		set pkginfo(default-file) [list]
	}

	### Create mapping
	set pkgmapfile [file join $instmetadir map]
	set fd [open $pkgmapfile w]
	foreach file $filelist {
		#### Ensure that we do not get data from another file if we fail
		#### to create a field
		unset -nocomplain destfile

		#### Get current file information
		file lstat $file srcfile

		#### Set reasonable defaults
		set destfile(owner) 0
		set destfile(group) 0
		set destfile(mode) [expr {$srcfile(mode) & 0777}]

		#### Set derived parameters
		set destfile(name) [string range $file $strip_file_names end]
		set destfile(type) $srcfile(type)
		set destfile(mtime) $srcfile(mtime)

		if {$destfile(type) == "file"} {
			set destfile(size) $srcfile(size)
			set destfile(sha1) [sha1::sha1 -hex -file $file]
		}

		if {$destfile(type) == "link"} {
			set linkdest [file link $file]
			##### If the link points inside the package directory,
			##### rewrite it
			if {[string range $linkdest 0 [expr {$strip_file_names - 1}]] == [string range $file 0 [expr {$strip_file_names - 1}]]} {
				set linkdest [string range $linkdest $strip_file_names end]
			}

			set destfile(linkdest) $linkdest
		}

		#### Set the default values
		foreach {var val} $pkginfo(default-file) {
			switch -- $var {
				"owner" - "group" {
					set destfile($var) $val
				}
				"filemode" {
					if {$destfile(type) != "directory"} {
						set destfile(mode) $val
					}
				}
				"dirmode" {
					if {$destfile(type) == "directory"} {
						set destfile(mode) $val
					}
				}
			}
		}

		#### Set the values specified for this specific file
		if {[info exists fileinfo($destfile(name))]} {
			array set destfile $fileinfo($destfile(name))
		}

		#### Take the data and format it into a list in the order specified
		set destline_data [list]
		foreach field $::cael::build::pkgmap_fields {
			if {![info exists destfile($field)]} {
				lappend destline_data ""

				continue
			}

			lappend destline_data $destfile($field)
		}

		set destline [csv::join $destline_data]

		puts $fd $destline
	}
	close $fd

	## Create package information file
	### XXX: TODO
	set pkginfofile [file join $instmetadir info]
	set fd [open $pkginfofile w]

	### Domain
	puts $fd "domain: $pkgdomain"

	### Name
	puts $fd "name: $pkgname"

	### Version
	puts $fd "version: $version"

	### Variant
	puts $fd "variant: $variant"

	### Arch
	#### XXX: TODO: Figure this out somehow
	puts $fd "arch: ..."

	### Release
	#### XXX: TODO: Need to pull this from the build database
	puts $fd "release: ..."

	### Flags
	#### XXX: TODO: Figure out how this will be formatted
	puts $fd "flags: ..."

	### Compiler (if not static)
	#### XXX: TODO: Needed ?  Could this be a flag (.e.g, compiler=blah) ?
	close $fd

	## Create Dependencies list file
	### XXX: TODO

	## Create Conflict list file
	### XXX: TODO
}

proc ::cael::build::build {pkgname pkgdomain {version "latest"} {variant "default"}} {
	# Parse package data
	array set pkginfo [_parse_pkg $pkgname $version $variant]

	if {[info exists pkginfo(scripts)]} {
		array set scripts $pkginfo(scripts)
	} else {
		array set scripts [list]
	}

	array set versinfo $pkginfo(versinfo)

	# Add missing values
	if {![info exists pkginfo(env_vars)]} {
		set pkginfo(env_vars) ""
	}

	# Create working directory
	set tmpdir "/tmp"
	if {[info exists ::env(TMPDIR)]} {
		set tmpdir $::env(TMPDIR)
	}

	set random [string map [list "." ""] [expr {rand() * 10.0}][expr {rand() * 10.0}]]
	set workdir [file join $tmpdir "build-${random}"]
	set extradir [file join $workdir "extra"]
	set pkgdir [file join $workdir "pkgroot"]
	set instrootdir [file join $pkgdir "root"]
	set instmetadir [file join $pkgdir "install"]
	set instlogdir [file join $instmetadir "logs"]

	# Create extra data, if any
	set extradir_src [file join  $::cael::build::pkginfodir $pkgname]
	if {[file isdirectory $extradir_src]} {
		file mkdir $extradir

		foreach copyfile [glob -directory $extradir_src *] {
			file copy -force -- $copyfile $extradir
		}

		lappend pkginfo(env_vars) extraroot $extradir
	}

	# Update package data
	lappend pkginfo(env_vars) version $versinfo(version) destroot $instrootdir buildroot $workdir metadataroot $instmetadir

	# Update with paths to installation
	lappend pkginfo(env_vars) _APPBOX_PREFIX /apps/${pkgname}/$versinfo(version) _APPBOX_SYSCONFDIR /system/config/apps/$pkgname

	# Include default scripts if needed
	foreach {default_script_name default_script} $::cael::build::default_scripts {
		if {![info exists scripts($default_script_name)]} {
			set scripts($default_script_name) $default_script
		}
	}

	# Create build scripts
	set scripts_files_list [gen_scripts $pkgname $version $variant $workdir $instrootdir [array get versinfo] [array get pkginfo] [array get scripts]]
	array set scripts_files $scripts_files_list

	# Execute build scripts
	## Execute immediate scripts
	### XXX: TODO

	## Execute scripts related to building and installing
	foreach script [list compile install] {
		if {![info exists scripts_files($script)]} {
			continue
		}

		file attributes $scripts_files($script) -permissions +x
		set compile_ret [exec $scripts_files($script) 2>@1]

		### Log script outputs
		set logfile "$scripts_files($script).log"
		set fd [open $logfile w]
		puts $fd $compile_ret
		close $fd
	}

	# Create package metadata
	gen_meta $pkgname $pkgdomain $version $variant $workdir $instrootdir $instmetadir [array get versinfo] [array get pkginfo] [array get scripts]

	# Put package scripts in package meta-data directory
	foreach script [list post-install post-remove pre-install pre-remove] {
		if {![info exists scripts_files($script)]} {
			continue
		}

		file attributes $scripts_files($script) -permissions +x
		file copy $scripts_files($script) $instmetadir
	}

	# Put package log files in package meta-data directory
	file mkdir $instlogdir
	foreach {script script_file} [array get scripts_files] {
		set log_file "${script_file}.log"

		if {![file exists $log_file]} {
			continue
		}

		file copy -- $log_file $instlogdir
	}

	# Create package file
	## Create tarball
	set pkgfilename "${pkgname}-$versinfo(version).tgz"
	exec tar -C $pkgdir -zcf $pkgfilename .

	# Cleanup
	file delete -force -- $workdir
}

foreach package $packages {
	::cael::build::build $package $domain
}








Added components/package-maker/lib/csv0.7.2/csv.tcl version [c2aac32fc0].
















































































































































































































































































































































































































































































































































































































































































































































































































































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
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812

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

# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
# -- Tcl Module

# @@ Meta Begin
# Package csv 0.7.2
# Meta as::build::date 2010-12-10
# Meta as::origin      http://sourceforge.net/projects/tcllib
# Meta category        CSV processing
# Meta description     Procedures to handle CSV data.
# Meta license         BSD
# Meta platform        tcl
# Meta require         {Tcl 8.3}
# Meta subject         package csv queue matrix tcllib
# Meta summary         csv
# @@ Meta End


# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS

package require Tcl 8.3

# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS

# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE

package provide csv 0.7.2

# ACTIVESTATE TEAPOT-PKG END DECLARE
# ACTIVESTATE TEAPOT-PKG END TM
# csv.tcl --
#
#	Tcl implementations of CSV reader and writer
#
# Copyright (c) 2001      by Jeffrey Hobbs
# Copyright (c) 2001-2008 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: csv.tcl,v 1.27 2010/01/19 20:21:57 andreas_kupries Exp $

package require Tcl 8.3
package provide csv 0.7.2

namespace eval ::csv {
    namespace export join joinlist read2matrix read2queue report 
    namespace export split split2matrix split2queue writematrix writequeue
}

# ::csv::join --
#
#	Takes a list of values and generates a string in CSV format.
#
# Arguments:
#	values		A list of the values to join
#	sepChar		The separator character, defaults to comma
#
# Results:
#	A string containing the values in CSV format.

proc ::csv::join {values {sepChar ,} {delChar \"}} {
    set out ""
    set sep {}
    foreach val $values {
	if {[string match "*\[${delChar}$sepChar\]*" $val]} {
	    append out $sep${delChar}[string map [list $delChar ${delChar}${delChar}] $val]${delChar}
	} else {
	    append out $sep${val}
	}
	set sep $sepChar
    }
    return $out
}

# ::csv::joinlist --
#
#	Takes a list of lists of values and generates a string in CSV
#	format. Each item in the list is made into a single CSV
#	formatted record in the final string, the records being
#	separated by newlines.
#
# Arguments:
#	values		A list of the lists of the values to join
#	sepChar		The separator character, defaults to comma
#
# Results:
#	A string containing the values in CSV format, the records
#	separated by newlines.

proc ::csv::joinlist {values {sepChar ,} {delChar \"}} {
    set out ""
    foreach record $values {
	# note that this is ::csv::join
	append out "[join $record $sepChar $delChar]\n"
    }
    return $out
}

# ::csv::joinmatrix --
#
#	Takes a matrix object following the API specified for the
#	struct::matrix package. Each row of the matrix is converted
#	into a single CSV formatted record in the final string, the
#	records being separated by newlines.
#
# Arguments:
#	matrix		Matrix object command.
#	sepChar		The separator character, defaults to comma
#
# Results:
#	A string containing the values in CSV format, the records
#	separated by newlines.

proc ::csv::joinmatrix {matrix {sepChar ,} {delChar \"}} {
    return [joinlist [$matrix get rect 0 0 end end] $sepChar $delChar]
}

# ::csv::iscomplete --
#
#	A predicate checking if the argument is a complete csv record.
#
# Arguments
#	data	The (partial) csv record to check.
#
# Results:
#	A boolean flag indicating the completeness of the data. The
#	result is true if the data is complete.

proc ::csv::iscomplete {data} {
    expr {1 - [regexp -all \" $data] % 2}
}

# ::csv::read2matrix --
#
#	A wrapper around "Split2matrix" reading CSV formatted
#	lines from the specified channel and adding it to the given
#	matrix.
#
# Arguments:
#	m		The matrix to add the read data too.
#	chan		The channel to read from.
#	sepChar		The separator character, defaults to comma
#	expand		The expansion mode. The default is none
#
# Results:
#	A list of the values in 'line'.

proc ::csv::read2matrix {args} {
    # FR #481023
    # See 'split2matrix' for the available expansion modes.

    # Argument syntax:
    #
    #2)            chan m
    #3)            chan m sepChar
    #3) -alternate chan m
    #4) -alternate chan m sepChar
    #4)            chan m sepChar expand
    #5) -alternate chan m sepChar expand

    set alternate 0
    set sepChar   ,
    set expand    none

    switch -exact -- [llength $args] {
	2 {
	    foreach {chan m} $args break
	}
	3 {
	    foreach {a b c} $args break
	    if {[string equal $a "-alternate"]} {
		set alternate 1
		set chan      $b
		set m         $c
	    } else {
		set chan    $a
		set m       $b
		set sepChar $c
	    }
	}
	4 {
	    foreach {a b c d} $args break
	    if {[string equal $a "-alternate"]} {
		set alternate 1
		set chan      $b
		set m         $c
		set sepChar   $d
	    } else {
		set chan    $a
		set m       $b
		set sepChar $c
		set expand  $d
	    }
	}
	5 {
	    foreach {a b c d e} $args break
	    if {![string equal $a "-alternate"]} {
		return -code error "wrong#args: Should be ?-alternate? chan m ?separator? ?expand?"
	    }
	    set alternate 1

	    set chan    $b
	    set m       $c
	    set sepChar $d
	    set expand  $e
	}
	0 - 1 -
	default {
	    return -code error "wrong#args: Should be ?-alternate? chan m ?separator? ?expand?"
	}
    }

    if {[string length $sepChar] < 1} {
	return -code error "illegal separator character \"$sepChar\", is empty"
    } elseif {[string length $sepChar] > 1} {
	return -code error "illegal separator character \"$sepChar\", is a string"
    }

    set data ""
    while {![eof $chan]} {
	if {[gets $chan line] < 0} {continue}

	# Why skip empty lines? They may be in data. Except if the
	# buffer is empty, i.e. we are between records.
	if {$line == {} && $data == {}} {continue}

       append data $line
       if {![iscomplete $data]} {
           # Odd number of quotes - must have embedded newline
           append data \n
           continue
       }

       Split2matrix $alternate $m $data $sepChar $expand
       set data ""
    }
    return
}

# ::csv::read2queue --
#
#	A wrapper around "::csv::split2queue" reading CSV formatted
#	lines from the specified channel and adding it to the given
#	queue.
#
# Arguments:
#	q		The queue to add the read data too.
#	chan		The channel to read from.
#	sepChar		The separator character, defaults to comma
#
# Results:
#	A list of the values in 'line'.

proc ::csv::read2queue {args} {
    # Argument syntax:
    #
    #2)            chan q
    #3)            chan q sepChar
    #3) -alternate chan q
    #4) -alternate chan q sepChar

    set alternate 0
    set sepChar   ,

    switch -exact -- [llength $args] {
	2 {
	    foreach {chan q} $args break
	}
	3 {
	    foreach {a b c} $args break
	    if {[string equal $a "-alternate"]} {
		set alternate 1
		set chan      $b
		set q         $c
	    } else {
		set chan    $a
		set q       $b
		set sepChar $c
	    }
	}
	4 {
	    foreach {a b c d} $args break
	    if {![string equal $a "-alternate"]} {
		return -code error "wrong#args: Should be ?-alternate? chan q ?separator?"
	    }
	    set alternate 1
	    set chan    $b
	    set q       $c
	    set sepChar $d
	}
	0 - 1 -
	default {
	    return -code error "wrong#args: Should be ?-alternate? chan q ?separator?"
	}
    }

    if {[string length $sepChar] < 1} {
	return -code error "illegal separator character \"$sepChar\", is empty"
    } elseif {[string length $sepChar] > 1} {
	return -code error "illegal separator character \"$sepChar\", is a string"
    }

    set data ""
    while {![eof $chan]} {
	if {[gets $chan line] < 0} {continue}

	# Why skip empty lines? They may be in data. Except if the
	# buffer is empty, i.e. we are between records.
	if {$line == {} && $data == {}} {continue}

	append data $line
	if {![iscomplete $data]} {
	    # Odd number of quotes - must have embedded newline
	    append data \n
	    continue
	}

	$q put [Split $alternate $data $sepChar]
	set data ""
    }
    return
}

# ::csv::report --
#
#	A report command which can be used by the matrix methods
#	"format-via" and "format2chan-via". For the latter this
#	command delegates the work to "::csv::writematrix". "cmd" is
#	expected to be either "printmatrix" or
#	"printmatrix2channel". The channel argument, "chan", has to
#	be present for the latter and must not be present for the first.
#
# Arguments:
#	cmd		Either 'printmatrix' or 'printmatrix2channel'
#	matrix		The matrix to format.
#	args		0 (chan): The channel to write to
#
# Results:
#	None for 'printmatrix2channel', else the CSV formatted string.

proc ::csv::report {cmd matrix args} {
    switch -exact -- $cmd {
	printmatrix {
	    if {[llength $args] > 0} {
		return -code error "wrong # args:\
			::csv::report printmatrix matrix"
	    }
	    return [joinlist [$matrix get rect 0 0 end end]]
	}
	printmatrix2channel {
	    if {[llength $args] != 1} {
		return -code error "wrong # args:\
			::csv::report printmatrix2channel matrix chan"
	    }
	    writematrix $matrix [lindex $args 0]
	    return ""
	}
	default {
	    return -code error "Unknown method $cmd"
	}
    }
}

# ::csv::split --
#
#	Split a string according to the rules for CSV processing.
#	This assumes that the string contains a single line of CSVs
#
# Arguments:
#	line		The string to split
#	sepChar		The separator character, defaults to comma
#
# Results:
#	A list of the values in 'line'.

proc ::csv::split {args} {
    # Argument syntax:
    #
    # (1)            line
    # (2)            line sepChar
    # (2) -alternate line
    # (3) -alternate line sepChar

    # (3)            line sepChar delChar
    # (4) -alternate line sepChar delChar

    set alternate 0
    set sepChar   ,
    set delChar   \"

    switch -exact -- [llength $args] {
	1 {
	    set line [lindex $args 0]
	}
	2 {
	    foreach {a b} $args break
	    if {[string equal $a "-alternate"]} {
		set alternate 1
		set line     $b
	    } else {
		set line    $a
		set sepChar $b
	    }
	}
	3 {
	    foreach {a b c} $args break
	    if {[string equal $a "-alternate"]} {
	        set alternate 1
		set line    $b
		set sepChar $c
	    } else {
		set line    $a
		set sepChar $b
		set delChar $c
            }
	}
	4 {
	    foreach {a b c d} $args break
	    if {![string equal $a "-alternate"]} {
		return -code error "wrong#args: Should be ?-alternate? line ?separator? ?delimiter?"
	    }
	    set alternate 1
	    set line    $b
	    set sepChar $c
	    set delChar $d
	}
	0 -
	default {
	    return -code error "wrong#args: Should be ?-alternate? line ?separator? ?delimiter?"
	}
    }

    if {[string length $sepChar] < 1} {
	return -code error "illegal separator character ${delChar}$sepChar${delChar}, is empty"
    } elseif {[string length $sepChar] > 1} {
	return -code error "illegal separator character ${delChar}$sepChar${delChar}, is a string"
    }

    if {[string length $delChar] < 1} {
	return -code error "illegal separator character \"$delChar\", is empty"
    } elseif {[string length $delChar] > 1} {
	return -code error "illegal separator character \"$delChar\", is a string"
    }

    return [Split $alternate $line $sepChar $delChar]
}

proc ::csv::Split {alternate line sepChar {delChar \"}} {
    # Protect the sepchar from special interpretation by
    # the regex calls below.

    set sepRE \\$sepChar
    set delRE \\$delChar

    if {$alternate} {
	# The alternate syntax requires a different parser.
	# A variation of the string map / regsub parser for the
	# regular syntax was tried but does not handle embedded
	# doubled " well (testcase csv-91.3 was 'knownBug', sole
	# one, still a bug). Now we just tokenize the input into
	# the primary parts (sep char, "'s and the rest) and then
	# use an explicitly coded state machine (DFA) to parse
	# and convert token sequences.

	## puts 1->>$line<<
	set line [string map [list \
		$sepChar \0$sepChar\0 \
		$delChar \0${delChar}\0 \
		] $line]

	## puts 2->>$line<<
	set line [string map [list \0\0 \0] $line]
	regsub "^\0" $line {} line
	regsub "\0$" $line {} line

	## puts 3->>$line<<

	set val ""
	set res ""
	set state base

	## puts 4->>[::split $line \0]
	foreach token [::split $line \0] {

	    ## puts "\t*= $state\t>>$token<<"
	    switch -exact -- $state {
		base {
		    if {[string equal $token "${delChar}"]} {
			set state qvalue
			continue
		    }
		    if {[string equal $token $sepChar]} {
			lappend res $val
			set val ""
			continue
		    }
		    append val $token
		}
		qvalue {
		    if {[string equal $token "${delChar}"]} {
			# May end value, may be a doubled "
			set state endordouble
			continue
		    }
		    append val $token
		}
		endordouble {
		    if {[string equal $token "${delChar}"]} {
			# Doubled ", append to current value
			append val ${delChar} 
			set state qvalue
			continue
		    }
		    # Last " was end of quoted value. Close it.
		    # We expect current as $sepChar

		    lappend res $val
		    set          val ""
		    set state base

		    if {[string equal $token $sepChar]} {continue}

		    # Undoubled " in middle of text. Just assume that
		    # remainder is another qvalue.
		    set state qvalue
		}
		default {
		    return -code error "Internal error, illegal parsing state"
		}
	    }
	}

	## puts "/= $state\t>>$val<<"

	lappend res $val

	## puts 5->>$res<<
	return $res
    } else {
	regsub -- "$sepRE${delRE}${delRE}$" $line $sepChar\0${delChar}${delChar}\0 line
	regsub -- "^${delRE}${delRE}$sepRE" $line \0${delChar}${delChar}\0$sepChar line
	regsub -all -- {(^${delChar}|${delChar}$)} $line \0 line

	set line [string map [list \
		$sepChar${delChar}${delChar}${delChar} $sepChar\0${delChar} \
		${delChar}${delChar}${delChar}$sepChar ${delChar}\0$sepChar \
		${delChar}${delChar}           ${delChar} \
		${delChar}             \0 \
		] $line]

	set end 0
	while {[regexp -indices -start $end -- {(\0)[^\0]*(\0)} $line \
		-> start end]} {
	    set start [lindex $start 0]
	    set end   [lindex $end 0]
	    set range [string range $line $start $end]
	    if {[string first $sepChar $range] >= 0} {
		set line [string replace $line $start $end \
			[string map [list $sepChar \1] $range]]
	    }
	    incr end
	}
	set line [string map [list $sepChar \0 \1 $sepChar \0 {} ] $line]
	return [::split $line \0]

    }
}

# ::csv::split2matrix --
#
#	Split a string according to the rules for CSV processing.
#	This assumes that the string contains a single line of CSVs.
#	The resulting list of values is appended to the specified
#	matrix, as a new row. The code assumes that the matrix provides
#	the same interface as the queue provided by the 'struct'
#	module of tcllib, "add row" in particular.
#
# Arguments:
#	m		The matrix to write the resulting list to.
#	line		The string to split
#	sepChar		The separator character, defaults to comma
#	expand		The expansion mode. The default is none
#
# Results:
#	A list of the values in 'line', written to 'q'.

proc ::csv::split2matrix {args} {
    # FR #481023

    # Argument syntax:
    #
    #2)            m line
    #3)            m line sepChar
    #3) -alternate m line
    #4) -alternate m line sepChar
    #4)            m line sepChar expand
    #5) -alternate m line sepChar expand

    set alternate 0
    set sepChar   ,
    set expand    none

    switch -exact -- [llength $args] {
	2 {
	    foreach {m line} $args break
	}
	3 {
	    foreach {a b c} $args break
	    if {[string equal $a "-alternate"]} {
		set alternate 1
		set m         $b
		set line      $c
	    } else {
		set m       $a
		set line    $b
		set sepChar $c
	    }
	}
	4 {
	    foreach {a b c d} $args break
	    if {[string equal $a "-alternate"]} {
		set alternate 1
		set m         $b
		set line      $c
		set sepChar   $d
	    } else {
		set m       $a
		set line    $b
		set sepChar $c
		set expand  $d
	    }
	}
	4 {
	    foreach {a b c d e} $args break
	    if {![string equal $a "-alternate"]} {
		return -code error "wrong#args: Should be ?-alternate? m line ?separator? ?expand?"
	    }
	    set alternate 1

	    set m       $b
	    set line    $c
	    set sepChar $d
	    set expand  $e
	}
	0 - 1 -
	default {
	    return -code error "wrong#args: Should be ?-alternate? m line ?separator? ?expand?"
	}
    }

    if {[string length $sepChar] < 1} {
	return -code error "illegal separator character \"$sepChar\", is empty"
    } elseif {[string length $sepChar] > 1} {
	return -code error "illegal separator character \"$sepChar\", is a string"
    }

    Split2matrix $alternate $m $line $sepChar $expand
    return
}

proc ::csv::Split2matrix {alternate m line sepChar expand} {
    set csv [Split $alternate $line $sepChar]

    # Expansion modes
    # - none  : default, behaviour of original implementation.
    #           no expansion is done, lines are silently truncated
    #           to the number of columns in the matrix.
    #
    # - empty : A matrix without columns is expanded to the number
    #           of columns in the first line added to it. All
    #           following lines are handled as if "mode == none"
    #           was set.
    #
    # - auto  : Full auto-mode. The matrix is expanded as needed to
    #           hold all columns of all lines.

    switch -exact -- $expand {
	none {}
	empty {
	    if {[$m columns] == 0} {
		$m add columns [llength $csv]
	    }
	}
	auto {
	    if {[$m columns] < [llength $csv]} {
		$m add columns [expr {[llength $csv] - [$m columns]}]
	    }
	}
    }
    $m add row $csv
    return
}

# ::csv::split2queue --
#
#	Split a string according to the rules for CSV processing.
#	This assumes that the string contains a single line of CSVs.
#	The resulting list of values is appended to the specified
#	queue, as a single item. IOW each item in the queue represents
#	a single CSV record. The code assumes that the queue provides
#	the same interface as the queue provided by the 'struct'
#	module of tcllib, "put" in particular.
#
# Arguments:
#	q		The queue to write the resulting list to.
#	line		The string to split
#	sepChar		The separator character, defaults to comma
#
# Results:
#	A list of the values in 'line', written to 'q'.

proc ::csv::split2queue {args} {
    # Argument syntax:
    #
    #2)            q line
    #3)            q line sepChar
    #3) -alternate q line
    #4) -alternate q line sepChar

    set alternate 0
    set sepChar   ,

    switch -exact -- [llength $args] {
	2 {
	    foreach {q line} $args break
	}
	3 {
	    foreach {a b c} $args break
	    if {[string equal $a "-alternate"]} {
		set alternate 1
		set q         $b
		set line      $c
	    } else {
		set q       $a
		set line    $b
		set sepChar $c
	    }
	}
	4 {
	    foreach {a b c d} $args break
	    if {![string equal $a "-alternate"]} {
		return -code error "wrong#args: Should be ?-alternate? q line ?separator?"
	    }
	    set alternate 1

	    set q       $b
	    set line    $c
	    set sepChar $d
	}
	0 - 1 -
	default {
	    return -code error "wrong#args: Should be ?-alternate? q line ?separator?"
	}
    }

    if {[string length $sepChar] < 1} {
	return -code error "illegal separator character \"$sepChar\", is empty"
    } elseif {[string length $sepChar] > 1} {
	return -code error "illegal separator character \"$sepChar\", is a string"
    }

    $q put [Split $alternate $line $sepChar]
    return
}

# ::csv::writematrix --
#
#	A wrapper around "::csv::join" taking the rows in a matrix and
#	writing them as CSV formatted lines into the channel.
#
# Arguments:
#	m		The matrix to take the data to write from.
#	chan		The channel to write into.
#	sepChar		The separator character, defaults to comma
#
# Results:
#	None.

proc ::csv::writematrix {m chan {sepChar ,} {delChar \"}} {
    set n [$m rows]
    for {set r 0} {$r < $n} {incr r} {
	puts $chan [join [$m get row $r] $sepChar $delChar]
    }

    # Memory intensive alternative:
    # puts $chan [joinlist [m get rect 0 0 end end] $sepChar $delChar]
    return
}

# ::csv::writequeue --
#
#	A wrapper around "::csv::join" taking the rows in a queue and
#	writing them as CSV formatted lines into the channel.
#
# Arguments:
#	q		The queue to take the data to write from.
#	chan		The channel to write into.
#	sepChar		The separator character, defaults to comma
#
# Results:
#	None.

proc ::csv::writequeue {q chan {sepChar ,} {delChar \"}} {
    while {[$q size] > 0} {
	puts $chan [join [$q get] $sepChar $delChar]
    }

    # Memory intensive alternative:
    # puts $chan [joinlist [$q get [$q size]] $sepChar $delChar]
    return
}









Added components/package-maker/lib/csv0.7.2/pkgIndex.tcl version [758158279e].





1

+

package ifneeded csv 0.7.2 [list source [file join $dir csv.tcl]]








Added components/package-maker/lib/md52.0.7/md5.tcl version [67f33d14c9].

















































































































































































































































































































































































































































































































































































































































































































































































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
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749

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

# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
# -- Tcl Module

# @@ Meta Begin
# Package md5 2.0.7
# Meta as::build::date 2010-02-25
# Meta as::origin      http://sourceforge.net/projects/tcllib
# Meta category        MD5 Message-Digest Algorithm
# Meta description     MD5 Message-Digest Algorithm
# Meta license         BSD
# Meta platform        tcl
# Meta recommend       Trf
# Meta recommend       tcllibc
# Meta require         {Tcl 8.2}
# Meta subject         security {rfc 1320} {rfc 2104} {rfc 1321}
# Meta subject         message-digest hashing md5
# Meta summary         md5
# @@ Meta End


# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS

package require Tcl 8.2

# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS

# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE

package provide md5 2.0.7

# ACTIVESTATE TEAPOT-PKG END DECLARE
# ACTIVESTATE TEAPOT-PKG END TM
# md5.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# MD5  defined by RFC 1321, "The MD5 Message-Digest Algorithm"
# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
#
# This is an implementation of MD5 based upon the example code given in
# RFC 1321 and upon the tcllib MD4 implementation and taking some ideas
# from the earlier tcllib md5 version by Don Libes.
#
# This implementation permits incremental updating of the hash and 
# provides support for external compiled implementations either using
# critcl (md5c) or Trf.
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
#
# $Id: md5x.tcl,v 1.19 2008/07/04 18:27:00 andreas_kupries Exp $

package require Tcl 8.2;                # tcl minimum version

namespace eval ::md5 {
    variable version 2.0.7
    variable rcsid {$Id: md5x.tcl,v 1.19 2008/07/04 18:27:00 andreas_kupries Exp $}
    variable accel
    array set accel {critcl 0 cryptkit 0 trf 0}

    namespace export md5 hmac MD5Init MD5Update MD5Final

    variable uid
    if {![info exists uid]} {
        set uid 0
    }
}

# -------------------------------------------------------------------------

# MD5Init --
#
#   Create and initialize an MD5 state variable. This will be
#   cleaned up when we call MD5Final
#
proc ::md5::MD5Init {} {
    variable accel
    variable uid
    set token [namespace current]::[incr uid]
    upvar #0 $token state

    # RFC1321:3.3 - Initialize MD5 state structure
    array set state \
        [list \
             A [expr {0x67452301}] \
             B [expr {0xefcdab89}] \
             C [expr {0x98badcfe}] \
             D [expr {0x10325476}] \
             n 0 i "" ]
    if {$accel(cryptkit)} {
        cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_MD5
    } elseif {$accel(trf)} {
        set s {}
        switch -exact -- $::tcl_platform(platform) {
            windows { set s [open NUL w] }
            unix    { set s [open /dev/null w] }
        }
        if {$s != {}} {
            fconfigure $s -translation binary -buffering none
            ::md5 -attach $s -mode write \
                -read-type variable \
                -read-destination [subst $token](trfread) \
                -write-type variable \
                -write-destination [subst $token](trfwrite)
            array set state [list trfread 0 trfwrite 0 trf $s]
        }
    }
    return $token
}

# MD5Update --
#
#   This is called to add more data into the hash. You may call this
#   as many times as you require. Note that passing in "ABC" is equivalent
#   to passing these letters in as separate calls -- hence this proc 
#   permits hashing of chunked data
#
#   If we have a C-based implementation available, then we will use
#   it here in preference to the pure-Tcl implementation.
#
proc ::md5::MD5Update {token data} {
    variable accel
    upvar #0 $token state

    if {$accel(critcl)} {
        if {[info exists state(md5c)]} {
            set state(md5c) [md5c $data $state(md5c)]
        } else {
            set state(md5c) [md5c $data]
        }
        return
    } elseif {[info exists state(ckctx)]} {
        if {[string length $data] > 0} {
            cryptkit::cryptEncrypt $state(ckctx) $data
        }
        return
    } elseif {[info exists state(trf)]} {
        puts -nonewline $state(trf) $data
        return
    }

    # Update the state values
    incr state(n) [string length $data]
    append state(i) $data

    # Calculate the hash for any complete blocks
    set len [string length $state(i)]
    for {set n 0} {($n + 64) <= $len} {} {
        MD5Hash $token [string range $state(i) $n [incr n 64]]
    }

    # Adjust the state for the blocks completed.
    set state(i) [string range $state(i) $n end]
    return
}

# MD5Final --
#
#    This procedure is used to close the current hash and returns the
#    hash data. Once this procedure has been called the hash context
#    is freed and cannot be used again.
#
#    Note that the output is 128 bits represented as binary data.
#
proc ::md5::MD5Final {token} {
    upvar #0 $token state

    # Check for either of the C-compiled versions.
    if {[info exists state(md5c)]} {
        set r $state(md5c)
        unset state
        return $r
    } elseif {[info exists state(ckctx)]} {
        cryptkit::cryptEncrypt $state(ckctx) ""
        cryptkit::cryptGetAttributeString $state(ckctx) \
            CRYPT_CTXINFO_HASHVALUE r 16
        cryptkit::cryptDestroyContext $state(ckctx)
        # If nothing was hashed, we get no r variable set!
        if {[info exists r]} {
            unset state
            return $r
        }
    } elseif {[info exists state(trf)]} {
        close $state(trf)
        set r $state(trfwrite)
        unset state
        return $r
    }

    # RFC1321:3.1 - Padding
    #
    set len [string length $state(i)]
    set pad [expr {56 - ($len % 64)}]
    if {$len % 64 > 56} {
        incr pad 64
    }
    if {$pad == 0} {
        incr pad 64
    }
    append state(i) [binary format a$pad \x80]

    # RFC1321:3.2 - Append length in bits as little-endian wide int.
    append state(i) [binary format ii [expr {8 * $state(n)}] 0]

    # Calculate the hash for the remaining block.
    set len [string length $state(i)]
    for {set n 0} {($n + 64) <= $len} {} {
        MD5Hash $token [string range $state(i) $n [incr n 64]]
    }

    # RFC1321:3.5 - Output
    set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)]
    unset state
    return $r
}

# -------------------------------------------------------------------------
# HMAC Hashed Message Authentication (RFC 2104)
#
# hmac = H(K xor opad, H(K xor ipad, text))
#

# HMACInit --
#
#    This is equivalent to the MD5Init procedure except that a key is
#    added into the algorithm
#
proc ::md5::HMACInit {K} {

    # Key K is adjusted to be 64 bytes long. If K is larger, then use
    # the MD5 digest of K and pad this instead.
    set len [string length $K]
    if {$len > 64} {
        set tok [MD5Init]
        MD5Update $tok $K
        set K [MD5Final $tok]
        set len [string length $K]
    }
    set pad [expr {64 - $len}]
    append K [string repeat \0 $pad]

    # Cacluate the padding buffers.
    set Ki {}
    set Ko {}
    binary scan $K i16 Ks
    foreach k $Ks {
        append Ki [binary format i [expr {$k ^ 0x36363636}]]
        append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]]
    }

    set tok [MD5Init]
    MD5Update $tok $Ki;                 # initialize with the inner pad
    
    # preserve the Ko value for the final stage.
    # FRINK: nocheck
    set [subst $tok](Ko) $Ko

    return $tok
}

# HMACUpdate --
#
#    Identical to calling MD5Update
#
proc ::md5::HMACUpdate {token data} {
    MD5Update $token $data
    return
}

# HMACFinal --
#
#    This is equivalent to the MD5Final procedure. The hash context is
#    closed and the binary representation of the hash result is returned.
#
proc ::md5::HMACFinal {token} {
    upvar #0 $token state

    set tok [MD5Init];                  # init the outer hashing function
    MD5Update $tok $state(Ko);          # prepare with the outer pad.
    MD5Update $tok [MD5Final $token];   # hash the inner result
    return [MD5Final $tok]
}

# -------------------------------------------------------------------------
# Description:
#  This is the core MD5 algorithm. It is a lot like the MD4 algorithm but
#  includes an extra round and a set of constant modifiers throughout.
# 
# Note:
#  This function body is substituted later on to inline some of the 
#  procedures and to make is a bit more comprehensible.
#
set ::md5::MD5Hash_body {
    variable $token
    upvar 0 $token state

    # RFC1321:3.4 - Process Message in 16-Word Blocks
    binary scan $msg i* blocks
    foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks {
        set A $state(A)
        set B $state(B)
        set C $state(C)
        set D $state(D)

        # Round 1
        # Let [abcd k s i] denote the operation
        #   a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s).
        # Do the following 16 operations.
        # [ABCD  0  7  1]  [DABC  1 12  2]  [CDAB  2 17  3]  [BCDA  3 22  4]
        set A [expr {$B + (($A + [F $B $C $D] + $X0 + $T01) <<< 7)}]
        set D [expr {$A + (($D + [F $A $B $C] + $X1 + $T02) <<< 12)}]
        set C [expr {$D + (($C + [F $D $A $B] + $X2 + $T03) <<< 17)}]
        set B [expr {$C + (($B + [F $C $D $A] + $X3 + $T04) <<< 22)}]
        # [ABCD  4  7  5]  [DABC  5 12  6]  [CDAB  6 17  7]  [BCDA  7 22  8]
        set A [expr {$B + (($A + [F $B $C $D] + $X4 + $T05) <<< 7)}]
        set D [expr {$A + (($D + [F $A $B $C] + $X5 + $T06) <<< 12)}]
        set C [expr {$D + (($C + [F $D $A $B] + $X6 + $T07) <<< 17)}]
        set B [expr {$C + (($B + [F $C $D $A] + $X7 + $T08) <<< 22)}]
        # [ABCD  8  7  9]  [DABC  9 12 10]  [CDAB 10 17 11]  [BCDA 11 22 12]
        set A [expr {$B + (($A + [F $B $C $D] + $X8 + $T09) <<< 7)}]
        set D [expr {$A + (($D + [F $A $B $C] + $X9 + $T10) <<< 12)}]
        set C [expr {$D + (($C + [F $D $A $B] + $X10 + $T11) <<< 17)}]
        set B [expr {$C + (($B + [F $C $D $A] + $X11 + $T12) <<< 22)}]
        # [ABCD 12  7 13]  [DABC 13 12 14]  [CDAB 14 17 15]  [BCDA 15 22 16]
        set A [expr {$B + (($A + [F $B $C $D] + $X12 + $T13) <<< 7)}]
        set D [expr {$A + (($D + [F $A $B $C] + $X13 + $T14) <<< 12)}]
        set C [expr {$D + (($C + [F $D $A $B] + $X14 + $T15) <<< 17)}]
        set B [expr {$C + (($B + [F $C $D $A] + $X15 + $T16) <<< 22)}]

        # Round 2.
        # Let [abcd k s i] denote the operation
        #   a = b + ((a + G(b,c,d) + X[k] + Ti) <<< s)
        # Do the following 16 operations.
        # [ABCD  1  5 17]  [DABC  6  9 18]  [CDAB 11 14 19]  [BCDA  0 20 20]
        set A [expr {$B + (($A + [G $B $C $D] + $X1  + $T17) <<<  5)}]
        set D [expr {$A + (($D + [G $A $B $C] + $X6  + $T18) <<<  9)}]
        set C [expr {$D + (($C + [G $D $A $B] + $X11 + $T19) <<< 14)}]
        set B [expr {$C + (($B + [G $C $D $A] + $X0  + $T20) <<< 20)}]
        # [ABCD  5  5 21]  [DABC 10  9 22]  [CDAB 15 14 23]  [BCDA  4 20 24]
        set A [expr {$B + (($A + [G $B $C $D] + $X5  + $T21) <<<  5)}]
        set D [expr {$A + (($D + [G $A $B $C] + $X10 + $T22) <<<  9)}]
        set C [expr {$D + (($C + [G $D $A $B] + $X15 + $T23) <<< 14)}]
        set B [expr {$C + (($B + [G $C $D $A] + $X4  + $T24) <<< 20)}]
        # [ABCD  9  5 25]  [DABC 14  9 26]  [CDAB  3 14 27]  [BCDA  8 20 28]
        set A [expr {$B + (($A + [G $B $C $D] + $X9  + $T25) <<<  5)}]
        set D [expr {$A + (($D + [G $A $B $C] + $X14 + $T26) <<<  9)}]
        set C [expr {$D + (($C + [G $D $A $B] + $X3  + $T27) <<< 14)}]
        set B [expr {$C + (($B + [G $C $D $A] + $X8  + $T28) <<< 20)}]
        # [ABCD 13  5 29]  [DABC  2  9 30]  [CDAB  7 14 31]  [BCDA 12 20 32]
        set A [expr {$B + (($A + [G $B $C $D] + $X13 + $T29) <<<  5)}]
        set D [expr {$A + (($D + [G $A $B $C] + $X2  + $T30) <<<  9)}]
        set C [expr {$D + (($C + [G $D $A $B] + $X7  + $T31) <<< 14)}]
        set B [expr {$C + (($B + [G $C $D $A] + $X12 + $T32) <<< 20)}]
        
        # Round 3.
        # Let [abcd k s i] denote the operation
        #   a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s)
        # Do the following 16 operations.
        # [ABCD  5  4 33]  [DABC  8 11 34]  [CDAB 11 16 35]  [BCDA 14 23 36]
        set A [expr {$B + (($A + [H $B $C $D] + $X5  + $T33) <<<  4)}]
        set D [expr {$A + (($D + [H $A $B $C] + $X8  + $T34) <<< 11)}]
        set C [expr {$D + (($C + [H $D $A $B] + $X11 + $T35) <<< 16)}]
        set B [expr {$C + (($B + [H $C $D $A] + $X14 + $T36) <<< 23)}]
        # [ABCD  1  4 37]  [DABC  4 11 38]  [CDAB  7 16 39]  [BCDA 10 23 40]
        set A [expr {$B + (($A + [H $B $C $D] + $X1  + $T37) <<<  4)}]
        set D [expr {$A + (($D + [H $A $B $C] + $X4  + $T38) <<< 11)}]
        set C [expr {$D + (($C + [H $D $A $B] + $X7  + $T39) <<< 16)}]
        set B [expr {$C + (($B + [H $C $D $A] + $X10 + $T40) <<< 23)}]
        # [ABCD 13  4 41]  [DABC  0 11 42]  [CDAB  3 16 43]  [BCDA  6 23 44]
        set A [expr {$B + (($A + [H $B $C $D] + $X13 + $T41) <<<  4)}]
        set D [expr {$A + (($D + [H $A $B $C] + $X0  + $T42) <<< 11)}]
        set C [expr {$D + (($C + [H $D $A $B] + $X3  + $T43) <<< 16)}]
        set B [expr {$C + (($B + [H $C $D $A] + $X6  + $T44) <<< 23)}]
        # [ABCD  9  4 45]  [DABC 12 11 46]  [CDAB 15 16 47]  [BCDA  2 23 48]
        set A [expr {$B + (($A + [H $B $C $D] + $X9  + $T45) <<<  4)}]
        set D [expr {$A + (($D + [H $A $B $C] + $X12 + $T46) <<< 11)}]
        set C [expr {$D + (($C + [H $D $A $B] + $X15 + $T47) <<< 16)}]
        set B [expr {$C + (($B + [H $C $D $A] + $X2  + $T48) <<< 23)}]

        # Round 4.
        # Let [abcd k s i] denote the operation
        #   a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s)
        # Do the following 16 operations.
        # [ABCD  0  6 49]  [DABC  7 10 50]  [CDAB 14 15 51]  [BCDA  5 21 52]
        set A [expr {$B + (($A + [I $B $C $D] + $X0  + $T49) <<<  6)}]
        set D [expr {$A + (($D + [I $A $B $C] + $X7  + $T50) <<< 10)}]
        set C [expr {$D + (($C + [I $D $A $B] + $X14 + $T51) <<< 15)}]
        set B [expr {$C + (($B + [I $C $D $A] + $X5  + $T52) <<< 21)}]
        # [ABCD 12  6 53]  [DABC  3 10 54]  [CDAB 10 15 55]  [BCDA  1 21 56]
        set A [expr {$B + (($A + [I $B $C $D] + $X12 + $T53) <<<  6)}]
        set D [expr {$A + (($D + [I $A $B $C] + $X3  + $T54) <<< 10)}]
        set C [expr {$D + (($C + [I $D $A $B] + $X10 + $T55) <<< 15)}]
        set B [expr {$C + (($B + [I $C $D $A] + $X1  + $T56) <<< 21)}]
        # [ABCD  8  6 57]  [DABC 15 10 58]  [CDAB  6 15 59]  [BCDA 13 21 60]
        set A [expr {$B + (($A + [I $B $C $D] + $X8  + $T57) <<<  6)}]
        set D [expr {$A + (($D + [I $A $B $C] + $X15 + $T58) <<< 10)}]
        set C [expr {$D + (($C + [I $D $A $B] + $X6  + $T59) <<< 15)}]
        set B [expr {$C + (($B + [I $C $D $A] + $X13 + $T60) <<< 21)}]
        # [ABCD  4  6 61]  [DABC 11 10 62]  [CDAB  2 15 63]  [BCDA  9 21 64]
        set A [expr {$B + (($A + [I $B $C $D] + $X4  + $T61) <<<  6)}]
        set D [expr {$A + (($D + [I $A $B $C] + $X11 + $T62) <<< 10)}]
        set C [expr {$D + (($C + [I $D $A $B] + $X2  + $T63) <<< 15)}]
        set B [expr {$C + (($B + [I $C $D $A] + $X9  + $T64) <<< 21)}]

        # Then perform the following additions. (That is, increment each
        # of the four registers by the value it had before this block
        # was started.)
        incr state(A) $A
        incr state(B) $B
        incr state(C) $C
        incr state(D) $D
    }

    return
}

proc ::md5::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}}
proc ::md5::bytes {v} { 
    #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v]
    format %c%c%c%c \
        [expr {0xFF & $v}] \
        [expr {(0xFF00 & $v) >> 8}] \
        [expr {(0xFF0000 & $v) >> 16}] \
        [expr {((0xFF000000 & $v) >> 24) & 0xFF}]
}

# 32bit rotate-left
proc ::md5::<<< {v n} {
    return [expr {((($v << $n) \
                        | (($v >> (32 - $n)) \
                               & (0x7FFFFFFF >> (31 - $n))))) \
                      & 0xFFFFFFFF}]
}

# Convert our <<< pseudo-operator into a procedure call.
regsub -all -line \
    {\[expr {(\$[ABCD]) \+ \(\((.*)\)\s+<<<\s+(\d+)\)}\]} \
    $::md5::MD5Hash_body \
    {[expr {int(\1 + [<<< [expr {\2}] \3])}]} \
    ::md5::MD5Hash_body

# RFC1321:3.4 - function F
proc ::md5::F {X Y Z} {
    return [expr {($X & $Y) | ((~$X) & $Z)}]
}

# Inline the F function
regsub -all -line \
    {\[F (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \
    $::md5::MD5Hash_body \
    {( (\1 \& \2) | ((~\1) \& \3) )} \
    ::md5::MD5Hash_body
    
# RFC1321:3.4 - function G
proc ::md5::G {X Y Z} {
    return [expr {(($X & $Z) | ($Y & (~$Z)))}]
}

# Inline the G function
regsub -all -line \
    {\[G (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \
    $::md5::MD5Hash_body \
    {(((\1 \& \3) | (\2 \& (~\3))))} \
    ::md5::MD5Hash_body

# RFC1321:3.4 - function H
proc ::md5::H {X Y Z} {
    return [expr {$X ^ $Y ^ $Z}]
}

# Inline the H function
regsub -all -line \
    {\[H (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \
    $::md5::MD5Hash_body \
    {(\1 ^ \2 ^ \3)} \
    ::md5::MD5Hash_body

# RFC1321:3.4 - function I
proc ::md5::I {X Y Z} {
    return [expr {$Y ^ ($X | (~$Z))}]
}

# Inline the I function
regsub -all -line \
    {\[I (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \
    $::md5::MD5Hash_body \
    {(\2 ^ (\1 | (~\3)))} \
    ::md5::MD5Hash_body


# RFC 1321:3.4 step 4: inline the set of constant modifiers.
namespace eval md5 {
    foreach tName {
        T01 T02 T03 T04 T05 T06 T07 T08 T09 T10 
        T11 T12 T13 T14 T15 T16 T17 T18 T19 T20 
        T21 T22 T23 T24 T25 T26 T27 T28 T29 T30 
        T31 T32 T33 T34 T35 T36 T37 T38 T39 T40 
        T41 T42 T43 T44 T45 T46 T47 T48 T49 T50 
        T51 T52 T53 T54 T55 T56 T57 T58 T59 T60 
        T61 T62 T63 T64 
    }  tVal {
        0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee
        0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501
        0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be
        0x6b901122 0xfd987193 0xa679438e 0x49b40821
        
        0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa
        0xd62f105d 0x2441453  0xd8a1e681 0xe7d3fbc8
        0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed
        0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a
        
        0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c
        0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70
        0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05
        0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665
        
        0xf4292244 0x432aff97 0xab9423a7 0xfc93a039
        0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1
        0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1
        0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391
    } {
        lappend map \$$tName $tVal
    }
    set ::md5::MD5Hash_body [string map $map $::md5::MD5Hash_body]
    unset map tName tVal
}

# Define the MD5 hashing procedure with inline functions.
proc ::md5::MD5Hash {token msg} $::md5::MD5Hash_body
unset ::md5::MD5Hash_body

# -------------------------------------------------------------------------

if {[package provide Trf] != {}} {
    interp alias {} ::md5::Hex {} ::hex -mode encode --
} else {
    proc ::md5::Hex {data} {
        binary scan $data H* result
        return [string toupper $result]
    }
}

# -------------------------------------------------------------------------

# LoadAccelerator --
#
#	This package can make use of a number of compiled extensions to
#	accelerate the digest computation. This procedure manages the
#	use of these extensions within the package. During normal usage
#	this should not be called, but the test package manipulates the
#	list of enabled accelerators.
#
proc ::md5::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require md5c}]} {
                set r [expr {[info command ::md5::md5c] != {}}]
            }
        }
        cryptkit {
            if {![catch {package require cryptkit}]} {
                set r [expr {![catch {cryptkit::cryptInit}]}]
            }
        }
        trf {
            if {![catch {package require Trf}]} {
                set r [expr {![catch {::md5 aa} msg]}]
            }
        }
        default {
            return -code error "invalid accelerator package:\
                must be one of [join [array names accel] {, }]"
        }
    }
    set accel($name) $r
}

# -------------------------------------------------------------------------

# Description:
#  Pop the nth element off a list. Used in options processing.
#
proc ::md5::Pop {varname {nth 0}} {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
}

# -------------------------------------------------------------------------

# fileevent handler for chunked file hashing.
#
proc ::md5::Chunk {token channel {chunksize 4096}} {
    upvar #0 $token state
    
    if {[eof $channel]} {
        fileevent $channel readable {}
        set state(reading) 0
    }
        
    MD5Update $token [read $channel $chunksize]
}

# -------------------------------------------------------------------------

proc ::md5::md5 {args} {
    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
    while {[string match -* [set option [lindex $args 0]]]} {
        switch -glob -- $option {
            -hex       { set opts(-hex) 1 }
            -file*     { set opts(-filename) [Pop args 1] }
            -channel   { set opts(-channel) [Pop args 1] }
            -chunksize { set opts(-chunksize) [Pop args 1] }
            default {
                if {[llength $args] == 1} { break }
                if {[string compare $option "--"] == 0} { Pop args; break }
                set err [join [lsort [array names opts]] ", "]
                return -code error "bad option $option:\
                    must be one of $err\nlen: [llength $args]"
            }
        }
        Pop args
    }

    if {$opts(-filename) != {}} {
        set opts(-channel) [open $opts(-filename) r]
        fconfigure $opts(-channel) -translation binary
    }

    if {$opts(-channel) == {}} {

        if {[llength $args] != 1} {
            return -code error "wrong # args:\
                should be \"md5 ?-hex? -filename file | string\""
        }
        set tok [MD5Init]
        MD5Update $tok [lindex $args 0]
        set r [MD5Final $tok]

    } else {

        set tok [MD5Init]
        # FRINK: nocheck
        set [subst $tok](reading) 1
        fileevent $opts(-channel) readable \
            [list [namespace origin Chunk] \
                 $tok $opts(-channel) $opts(-chunksize)]
        vwait [subst $tok](reading)
        set r [MD5Final $tok]

        # If we opened the channel - we should close it too.
        if {$opts(-filename) != {}} {
            close $opts(-channel)
        }
    }
    
    if {$opts(-hex)} {
        set r [Hex $r]
    }
    return $r
}

# -------------------------------------------------------------------------

proc ::md5::hmac {args} {
    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
    while {[string match -* [set option [lindex $args 0]]]} {
        switch -glob -- $option {
            -key       { set opts(-key) [Pop args 1] }
            -hex       { set opts(-hex) 1 }
            -file*     { set opts(-filename) [Pop args 1] }
            -channel   { set opts(-channel) [Pop args 1] }
            -chunksize { set opts(-chunksize) [Pop args 1] }
            default {
                if {[llength $args] == 1} { break }
                if {[string compare $option "--"] == 0} { Pop args; break }
                set err [join [lsort [array names opts]] ", "]
                return -code error "bad option $option:\
                    must be one of $err"
            }
        }
        Pop args
    }

    if {![info exists opts(-key)]} {
        return -code error "wrong # args:\
            should be \"hmac ?-hex? -key key -filename file | string\""
    }

    if {$opts(-filename) != {}} {
        set opts(-channel) [open $opts(-filename) r]
        fconfigure $opts(-channel) -translation binary
    }

    if {$opts(-channel) == {}} {

        if {[llength $args] != 1} {
            return -code error "wrong # args:\
                should be \"hmac ?-hex? -key key -filename file | string\""
        }
        set tok [HMACInit $opts(-key)]
        HMACUpdate $tok [lindex $args 0]
        set r [HMACFinal $tok]

    } else {

        set tok [HMACInit $opts(-key)]
        # FRINK: nocheck
        set [subst $tok](reading) 1
        fileevent $opts(-channel) readable \
            [list [namespace origin Chunk] \
                 $tok $opts(-channel) $opts(-chunksize)]
        vwait [subst $tok](reading)
        set r [HMACFinal $tok]

        # If we opened the channel - we should close it too.
        if {$opts(-filename) != {}} {
            close $opts(-channel)
        }
    }
    
    if {$opts(-hex)} {
        set r [Hex $r]
    }
    return $r
}

# -------------------------------------------------------------------------

# Try and load a compiled extension to help.
namespace eval ::md5 {
    variable e
    foreach  e {critcl cryptkit trf} { if {[LoadAccelerator $e]} { break } }
    unset    e
}

package provide md5 $::md5::version

# -------------------------------------------------------------------------
# Local Variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:










Added components/package-maker/lib/md52.0.7/pkgIndex.tcl version [5e700d5bb5].





1

+

package ifneeded md5 2.0.7 [list source [file join $dir md5.tcl]]








Added components/package-maker/lib/sha12.0.3/pkgIndex.tcl version [6f6c09ab55].





1

+

package ifneeded sha1 2.0.3 [list source [file join $dir sha1.tcl]]








Added components/package-maker/lib/sha12.0.3/sha1.tcl version [4983a86456].






















































































































































































































































































































































































































































































































































































































































































































































































































































































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
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850

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

# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
# -- Tcl Module

# @@ Meta Begin
# Package sha1 2.0.3
# Meta as::build::date 2010-12-10
# Meta as::origin      http://sourceforge.net/projects/tcllib
# Meta category        SHA-x Message-Digest Algorithm
# Meta description     SHA1 Message-Digest Algorithm
# Meta license         BSD
# Meta platform        tcl
# Meta recommend       Trf
# Meta recommend       tcllibc
# Meta require         {Tcl 8.2}
# Meta subject         security {FIPS 180-1} sha1 {rfc 2104} message-digest
# Meta subject         hashing
# Meta summary         sha1
# @@ Meta End


# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS

package require Tcl 8.2

# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS

# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE

package provide sha1 2.0.3

# ACTIVESTATE TEAPOT-PKG END DECLARE
# ACTIVESTATE TEAPOT-PKG END TM
# sha1.tcl - 
#
# Copyright (C) 2001 Don Libes <libes@nist.gov>
# Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm"
# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
#
# This is an implementation of SHA1 based upon the example code given in
# FIPS 180-1 and upon the tcllib MD4 implementation and taking some ideas
# and methods from the earlier tcllib sha1 version by Don Libes.
#
# This implementation permits incremental updating of the hash and 
# provides support for external compiled implementations either using
# critcl (sha1c) or Trf.
#
# ref: http://www.itl.nist.gov/fipspubs/fip180-1.htm
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
#
# $Id: sha1.tcl,v 1.22 2009/05/07 00:35:10 patthoyts Exp $

# @mdgen EXCLUDE: sha1c.tcl

package require Tcl 8.2;                # tcl minimum version

namespace eval ::sha1 {
    variable  version 2.0.3
    variable  rcsid {$Id: sha1.tcl,v 1.22 2009/05/07 00:35:10 patthoyts Exp $}

    variable  accel
    array set accel {tcl 0 critcl 0 cryptkit 0 trf 0}
    variable  loaded {}
    variable  active
    array set active {tcl 0 critcl 0 cryptkit 0 trf 0}

    namespace export sha1 hmac SHA1Init SHA1Update SHA1Final

    variable uid
    if {![info exists uid]} {
        set uid 0
    }
}

# -------------------------------------------------------------------------
# Management of sha1 implementations.

# LoadAccelerator --
#
#	This package can make use of a number of compiled extensions to
#	accelerate the digest computation. This procedure manages the
#	use of these extensions within the package. During normal usage
#	this should not be called, but the test package manipulates the
#	list of enabled accelerators.
#
proc ::sha1::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        tcl {
            # Already present (this file)
            set r 1
        }
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require sha1c}]} {
                set r [expr {[info command ::sha1::sha1c] != {}}]
            }
        }
        cryptkit {
            if {![catch {package require cryptkit}]} {
                set r [expr {![catch {cryptkit::cryptInit}]}]
            }
        }
        trf {
            if {![catch {package require Trf}]} {
                set r [expr {![catch {::sha1 aa} msg]}]
            }
        }
        default {
            return -code error "invalid accelerator $key:\
                must be one of [join [KnownImplementations] {, }]"
        }
    }
    set accel($name) $r
    return $r
}

# ::sha1::Implementations --
#
#	Determines which implementations are
#	present, i.e. loaded.
#
# Arguments:
#	None.
#
# Results:
#	A list of implementation keys.

proc ::sha1::Implementations {} {
    variable accel
    set res {}
    foreach n [array names accel] {
	if {!$accel($n)} continue
	lappend res $n
    }
    return $res
}

# ::sha1::KnownImplementations --
#
#	Determines which implementations are known
#	as possible implementations.
#
# Arguments:
#	None.
#
# Results:
#	A list of implementation keys. In the order
#	of preference, most prefered first.

proc ::sha1::KnownImplementations {} {
    return {critcl cryptkit trf tcl}
}

proc ::sha1::Names {} {
    return {
	critcl   {tcllibc based}
        cryptkit {cryptkit based}
        trf      {Trf based}
	tcl      {pure Tcl}
    }
}

# ::sha1::SwitchTo --
#
#	Activates a loaded named implementation.
#
# Arguments:
#	key	Name of the implementation to activate.
#
# Results:
#	None.

proc ::sha1::SwitchTo {key} {
    variable accel
    variable active
    variable loaded

    if {[string equal $key $loaded]} {
	# No change, nothing to do.
	return
    } elseif {![string equal $key ""]} {
	# Validate the target implementation of the switch.

	if {![info exists accel($key)]} {
	    return -code error "Unable to activate unknown implementation \"$key\""
	} elseif {![info exists accel($key)] || !$accel($key)} {
	    return -code error "Unable to activate missing implementation \"$key\""
	}
    }

    if {![string equal $loaded ""]} {
        set active($loaded) 0
    }
    if {![string equal $key ""]} {
        set active($key) 1
    }

    # Remember the active implementation, for deactivation by future
    # switches.

    set loaded $key
    return
}

# -------------------------------------------------------------------------

# SHA1Init --
#
#   Create and initialize an SHA1 state variable. This will be
#   cleaned up when we call SHA1Final
#

proc ::sha1::SHA1Init {} {
    variable active
    variable uid
    set token [namespace current]::[incr uid]
    upvar #0 $token state

    # FIPS 180-1: 7 - Initialize the hash state
    array set state \
        [list \
             A [expr {int(0x67452301)}] \
             B [expr {int(0xEFCDAB89)}] \
             C [expr {int(0x98BADCFE)}] \
             D [expr {int(0x10325476)}] \
             E [expr {int(0xC3D2E1F0)}] \
             n 0 i "" ]
    if {$active(cryptkit)} {
        cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_SHA
    } elseif {$active(trf)} {
        set s {}
        switch -exact -- $::tcl_platform(platform) {
            windows { set s [open NUL w] }
            unix    { set s [open /dev/null w] }
        }
        if {$s != {}} {
            fconfigure $s -translation binary -buffering none
            ::sha1 -attach $s -mode write \
                -read-type variable \
                -read-destination [subst $token](trfread) \
                -write-type variable \
                -write-destination [subst $token](trfwrite)
            array set state [list trfread 0 trfwrite 0 trf $s]
        }
    }
    return $token
}

# SHA1Update --
#
#   This is called to add more data into the hash. You may call this
#   as many times as you require. Note that passing in "ABC" is equivalent
#   to passing these letters in as separate calls -- hence this proc 
#   permits hashing of chunked data
#
#   If we have a C-based implementation available, then we will use
#   it here in preference to the pure-Tcl implementation.
#
proc ::sha1::SHA1Update {token data} {
    variable active
    upvar #0 $token state

    if {$active(critcl)} {
        if {[info exists state(sha1c)]} {
            set state(sha1c) [sha1c $data $state(sha1c)]
        } else {
            set state(sha1c) [sha1c $data]
        }
        return
    } elseif {[info exists state(ckctx)]} {
        if {[string length $data] > 0} {
            cryptkit::cryptEncrypt $state(ckctx) $data
        }
        return
    } elseif {[info exists state(trf)]} {
        puts -nonewline $state(trf) $data
        return
    }

    # Update the state values
    incr state(n) [string length $data]
    append state(i) $data

    # Calculate the hash for any complete blocks
    set len [string length $state(i)]
    for {set n 0} {($n + 64) <= $len} {} {
        SHA1Transform $token [string range $state(i) $n [incr n 64]]
    }

    # Adjust the state for the blocks completed.
    set state(i) [string range $state(i) $n end]
    return
}

# SHA1Final --
#
#    This procedure is used to close the current hash and returns the
#    hash data. Once this procedure has been called the hash context
#    is freed and cannot be used again.
#
#    Note that the output is 160 bits represented as binary data.
#
proc ::sha1::SHA1Final {token} {
    upvar #0 $token state

    # Check for either of the C-compiled versions.
    if {[info exists state(sha1c)]} {
        set r $state(sha1c)
        unset state
        return $r
    } elseif {[info exists state(ckctx)]} {
        cryptkit::cryptEncrypt $state(ckctx) ""
        cryptkit::cryptGetAttributeString $state(ckctx) \
            CRYPT_CTXINFO_HASHVALUE r 20
        cryptkit::cryptDestroyContext $state(ckctx)
        # If nothing was hashed, we get no r variable set!
        if {[info exists r]} {
            unset state
            return $r
        }
    } elseif {[info exists state(trf)]} {
        close $state(trf)
        set r $state(trfwrite)
        unset state
        return $r
    }

    # Padding
    #
    set len [string length $state(i)]
    set pad [expr {56 - ($len % 64)}]
    if {$len % 64 > 56} {
        incr pad 64
    }
    if {$pad == 0} {
        incr pad 64
    }
    append state(i) [binary format a$pad \x80]

    # Append length in bits as big-endian wide int.
    set dlen [expr {8 * $state(n)}]
    append state(i) [binary format II 0 $dlen]

    # Calculate the hash for the remaining block.
    set len [string length $state(i)]
    for {set n 0} {($n + 64) <= $len} {} {
        SHA1Transform $token [string range $state(i) $n [incr n 64]]
    }

    # Output
    set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)]
    unset state
    return $r
}

# -------------------------------------------------------------------------
# HMAC Hashed Message Authentication (RFC 2104)
#
# hmac = H(K xor opad, H(K xor ipad, text))
#

# HMACInit --
#
#    This is equivalent to the SHA1Init procedure except that a key is
#    added into the algorithm
#
proc ::sha1::HMACInit {K} {

    # Key K is adjusted to be 64 bytes long. If K is larger, then use
    # the SHA1 digest of K and pad this instead.
    set len [string length $K]
    if {$len > 64} {
        set tok [SHA1Init]
        SHA1Update $tok $K
        set K [SHA1Final $tok]
        set len [string length $K]
    }
    set pad [expr {64 - $len}]
    append K [string repeat \0 $pad]

    # Cacluate the padding buffers.
    set Ki {}
    set Ko {}
    binary scan $K i16 Ks
    foreach k $Ks {
        append Ki [binary format i [expr {$k ^ 0x36363636}]]
        append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]]
    }

    set tok [SHA1Init]
    SHA1Update $tok $Ki;                 # initialize with the inner pad
    
    # preserve the Ko value for the final stage.
    # FRINK: nocheck
    set [subst $tok](Ko) $Ko

    return $tok
}

# HMACUpdate --
#
#    Identical to calling SHA1Update
#
proc ::sha1::HMACUpdate {token data} {
    SHA1Update $token $data
    return
}

# HMACFinal --
#
#    This is equivalent to the SHA1Final procedure. The hash context is
#    closed and the binary representation of the hash result is returned.
#
proc ::sha1::HMACFinal {token} {
    upvar #0 $token state

    set tok [SHA1Init];                 # init the outer hashing function
    SHA1Update $tok $state(Ko);         # prepare with the outer pad.
    SHA1Update $tok [SHA1Final $token]; # hash the inner result
    return [SHA1Final $tok]
}

# -------------------------------------------------------------------------
# Description:
#  This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but
#  includes an extra round and a set of constant modifiers throughout.
#
set ::sha1::SHA1Transform_body {
    upvar #0 $token state

    # FIPS 180-1: 7a: Process Message in 16-Word Blocks
    binary scan $msg I* blocks
    set blockLen [llength $blocks]
    for {set i 0} {$i < $blockLen} {incr i 16} {
        set W [lrange $blocks $i [expr {$i+15}]]
        
        # FIPS 180-1: 7b: Expand the input into 80 words
        # For t = 16 to 79 
        #   let Wt = (Wt-3 ^ Wt-8 ^ Wt-14 ^ Wt-16) <<< 1
        set t3  12
        set t8   7
        set t14  1
        set t16 -1
        for {set t 16} {$t < 80} {incr t} {
            set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \
                             [lindex $W [incr t14]] ^ [lindex $W [incr t16]]}]
            lappend W [expr {int(($x << 1) | (($x >> 31) & 1))}]
        }
        
        # FIPS 180-1: 7c: Copy hash state.
        set A $state(A)
        set B $state(B)
        set C $state(C)
        set D $state(D)
        set E $state(E)

        # FIPS 180-1: 7d: Do permutation rounds
        # For t = 0 to 79 do
        #   TEMP = (A<<<5) + ft(B,C,D) + E + Wt + Kt;
        #   E = D; D = C; C = S30(B); B = A; A = TEMP;

        # Round 1: ft(B,C,D) = (B & C) | (~B & D) ( 0 <= t <= 19)
        for {set t 0} {$t < 20} {incr t} {
            set TEMP [F1 $A $B $C $D $E [lindex $W $t]]
            set E $D
            set D $C
            set C [rotl32 $B 30]
            set B $A
            set A $TEMP
        }

        # Round 2: ft(B,C,D) = (B ^ C ^ D) ( 20 <= t <= 39)
        for {} {$t < 40} {incr t} {
            set TEMP [F2 $A $B $C $D $E [lindex $W $t]]
            set E $D
            set D $C
            set C [rotl32 $B 30]
            set B $A
            set A $TEMP
        }

        # Round 3: ft(B,C,D) = ((B & C) | (B & D) | (C & D)) ( 40 <= t <= 59)
        for {} {$t < 60} {incr t} {
            set TEMP [F3 $A $B $C $D $E [lindex $W $t]]
            set E $D
            set D $C
            set C [rotl32 $B 30]
            set B $A
            set A $TEMP
         }

        # Round 4: ft(B,C,D) = (B ^ C ^ D) ( 60 <= t <= 79)
        for {} {$t < 80} {incr t} {
            set TEMP [F4 $A $B $C $D $E [lindex $W $t]]
            set E $D
            set D $C
            set C [rotl32 $B 30]
            set B $A
            set A $TEMP
        }

        # Then perform the following additions. (That is, increment each
        # of the four registers by the value it had before this block
        # was started.)
        incr state(A) $A
        incr state(B) $B
        incr state(C) $C
        incr state(D) $D
        incr state(E) $E
    }

    return
}

proc ::sha1::F1 {A B C D E W} {
    expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \
               + ($D ^ ($B & ($C ^ $D))) + $E + $W + 0x5a827999) & 0xffffffff}
}

proc ::sha1::F2 {A B C D E W} {
    expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \
               + ($B ^ $C ^ $D) + $E + $W + 0x6ed9eba1) & 0xffffffff}
}

proc ::sha1::F3 {A B C D E W} {
    expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \
               + (($B & $C) | ($D & ($B | $C))) + $E + $W + 0x8f1bbcdc) & 0xffffffff}
}

proc ::sha1::F4 {A B C D E W} {
    expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \
               + ($B ^ $C ^ $D) + $E + $W + 0xca62c1d6) & 0xffffffff}
}

proc ::sha1::rotl32 {v n} {
    return [expr {((($v << $n) \
                        | (($v >> (32 - $n)) \
                               & (0x7FFFFFFF >> (31 - $n))))) \
                      & 0xFFFFFFFF}]
}


# -------------------------------------------------------------------------
# 
# In order to get this code to go as fast as possible while leaving
# the main code readable we can substitute the above function bodies
# into the transform procedure. This inlines the code for us an avoids
# a procedure call overhead within the loops.
#
# We can do some minor tweaking to improve speed on Tcl < 8.5 where we
# know our arithmetic is limited to 64 bits. On > 8.5 we may have 
# unconstrained integer arithmetic and must avoid letting it run away.
#

regsub -all -line \
    {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body \
    {[expr {(rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999) \& 0xffffffff}]} \
    ::sha1::SHA1Transform_body_tmp

regsub -all -line \
    {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body_tmp \
    {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1) \& 0xffffffff}]} \
    ::sha1::SHA1Transform_body_tmp

regsub -all -line \
    {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body_tmp \
    {[expr {(rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc) \& 0xffffffff}]} \
    ::sha1::SHA1Transform_body_tmp

regsub -all -line \
    {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body_tmp \
    {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6) \& 0xffffffff}]} \
    ::sha1::SHA1Transform_body_tmp

regsub -all -line \
    {rotl32\(\$A,5\)} \
    $::sha1::SHA1Transform_body_tmp \
    {((($A << 5) \& 0xffffffff) | (($A >> 27) \& 0x1f))} \
    ::sha1::SHA1Transform_body_tmp

regsub -all -line \
    {\[rotl32 \$B 30\]} \
    $::sha1::SHA1Transform_body_tmp \
    {[expr {int(($B << 30) | (($B >> 2) \& 0x3fffffff))}]} \
    ::sha1::SHA1Transform_body_tmp
#
# Version 2 avoids a few truncations to 32 bits in non-essential places.
#
regsub -all -line \
    {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body \
    {[expr {rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999}]} \
    ::sha1::SHA1Transform_body_tmp2

regsub -all -line \
    {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body_tmp2 \
    {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1}]} \
    ::sha1::SHA1Transform_body_tmp2

regsub -all -line \
    {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body_tmp2 \
    {[expr {rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc}]} \
    ::sha1::SHA1Transform_body_tmp2

regsub -all -line \
    {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \
    $::sha1::SHA1Transform_body_tmp2 \
    {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6}]} \
    ::sha1::SHA1Transform_body_tmp2

regsub -all -line \
    {rotl32\(\$A,5\)} \
    $::sha1::SHA1Transform_body_tmp2 \
    {(($A << 5) | (($A >> 27) \& 0x1f))} \
    ::sha1::SHA1Transform_body_tmp2

regsub -all -line \
    {\[rotl32 \$B 30\]} \
    $::sha1::SHA1Transform_body_tmp2 \
    {[expr {($B << 30) | (($B >> 2) \& 0x3fffffff)}]} \
    ::sha1::SHA1Transform_body_tmp2

if {[package vsatisfies [package provide Tcl] 8.5]} {
    proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp
} else {
    proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp2
}

unset ::sha1::SHA1Transform_body
unset ::sha1::SHA1Transform_body_tmp
unset ::sha1::SHA1Transform_body_tmp2

# -------------------------------------------------------------------------

proc ::sha1::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}}
proc ::sha1::bytes {v} { 
    #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v]
    format %c%c%c%c \
        [expr {((0xFF000000 & $v) >> 24) & 0xFF}] \
        [expr {(0xFF0000 & $v) >> 16}] \
        [expr {(0xFF00 & $v) >> 8}] \
        [expr {0xFF & $v}]
}

# -------------------------------------------------------------------------

proc ::sha1::Hex {data} {
    binary scan $data H* result
    return $result
}

# -------------------------------------------------------------------------

# Description:
#  Pop the nth element off a list. Used in options processing.
#
proc ::sha1::Pop {varname {nth 0}} {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
}

# -------------------------------------------------------------------------

# fileevent handler for chunked file hashing.
#
proc ::sha1::Chunk {token channel {chunksize 4096}} {
    upvar #0 $token state
    
    if {[eof $channel]} {
        fileevent $channel readable {}
        set state(reading) 0
    }
        
    SHA1Update $token [read $channel $chunksize]
}

# -------------------------------------------------------------------------

proc ::sha1::sha1 {args} {
    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
    if {[llength $args] == 1} {
        set opts(-hex) 1
    } else {
        while {[string match -* [set option [lindex $args 0]]]} {
            switch -glob -- $option {
                -hex       { set opts(-hex) 1 }
                -bin       { set opts(-hex) 0 }
                -file*     { set opts(-filename) [Pop args 1] }
                -channel   { set opts(-channel) [Pop args 1] }
                -chunksize { set opts(-chunksize) [Pop args 1] }
                default {
                    if {[llength $args] == 1} { break }
                    if {[string compare $option "--"] == 0} { Pop args; break }
                    set err [join [lsort [concat -bin [array names opts]]] ", "]
                    return -code error "bad option $option:\
                    must be one of $err"
                }
            }
            Pop args
        }
    }

    if {$opts(-filename) != {}} {
        set opts(-channel) [open $opts(-filename) r]
        fconfigure $opts(-channel) -translation binary
    }

    if {$opts(-channel) == {}} {

        if {[llength $args] != 1} {
            return -code error "wrong # args:\
                should be \"sha1 ?-hex? -filename file | string\""
        }
        set tok [SHA1Init]
        SHA1Update $tok [lindex $args 0]
        set r [SHA1Final $tok]

    } else {

        set tok [SHA1Init]
        # FRINK: nocheck
        set [subst $tok](reading) 1
        fileevent $opts(-channel) readable \
            [list [namespace origin Chunk] \
                 $tok $opts(-channel) $opts(-chunksize)]
        # FRINK: nocheck
        vwait [subst $tok](reading)
        set r [SHA1Final $tok]

        # If we opened the channel - we should close it too.
        if {$opts(-filename) != {}} {
            close $opts(-channel)
        }
    }
    
    if {$opts(-hex)} {
        set r [Hex $r]
    }
    return $r
}

# -------------------------------------------------------------------------

proc ::sha1::hmac {args} {
    array set opts {-hex 1 -filename {} -channel {} -chunksize 4096}
    if {[llength $args] != 2} {
        while {[string match -* [set option [lindex $args 0]]]} {
            switch -glob -- $option {
                -key       { set opts(-key) [Pop args 1] }
                -hex       { set opts(-hex) 1 }
                -bin       { set opts(-hex) 0 }
                -file*     { set opts(-filename) [Pop args 1] }
                -channel   { set opts(-channel) [Pop args 1] }
                -chunksize { set opts(-chunksize) [Pop args 1] }
                default {
                    if {[llength $args] == 1} { break }
                    if {[string compare $option "--"] == 0} { Pop args; break }
                    set err [join [lsort [array names opts]] ", "]
                    return -code error "bad option $option:\
                    must be one of $err"
                }
            }
            Pop args
        }
    }

    if {[llength $args] == 2} {
        set opts(-key) [Pop args]
    }

    if {![info exists opts(-key)]} {
        return -code error "wrong # args:\
            should be \"hmac ?-hex? -key key -filename file | string\""
    }

    if {$opts(-filename) != {}} {
        set opts(-channel) [open $opts(-filename) r]
        fconfigure $opts(-channel) -translation binary
    }

    if {$opts(-channel) == {}} {

        if {[llength $args] != 1} {
            return -code error "wrong # args:\
                should be \"hmac ?-hex? -key key -filename file | string\""
        }
        set tok [HMACInit $opts(-key)]
        HMACUpdate $tok [lindex $args 0]
        set r [HMACFinal $tok]

    } else {

        set tok [HMACInit $opts(-key)]
        # FRINK: nocheck
        set [subst $tok](reading) 1
        fileevent $opts(-channel) readable \
            [list [namespace origin Chunk] \
                 $tok $opts(-channel) $opts(-chunksize)]
        # FRINK: nocheck
        vwait [subst $tok](reading)
        set r [HMACFinal $tok]

        # If we opened the channel - we should close it too.
        if {$opts(-filename) != {}} {
            close $opts(-channel)
        }
    }
    
    if {$opts(-hex)} {
        set r [Hex $r]
    }
    return $r
}

# -------------------------------------------------------------------------

# Try and load a compiled extension to help.
namespace eval ::sha1 {
    variable e {}
    foreach e [KnownImplementations] {
	if {[LoadAccelerator $e]} {
	    SwitchTo $e
	    break
	}
    }
    unset e
}

package provide sha1 $::sha1::version

# -------------------------------------------------------------------------
# Local Variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:








Added components/package-maker/lib/tax0.2/pkgIndex.tcl version [fd4349bc17].















1
2
3
4
5
6
7
8
9
10
11

+
+
+
+
+
+
+
+
+
+
+

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded tax 0.2 [list source [file join $dir tax.tcl]]








Added components/package-maker/lib/tax0.2/tax.tcl version [e5247d7c34].

































































































































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

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

#! /usr/bin/env tclsh

namespace eval ::tax {}

# ::tax::__cleanprops -- Clean parsed XML properties
#
#	This command cleans parsed XML properties by removing the
#	trailing slash and replacing equals by spaces so as to produce
#	a list that is suitable for an array set command.
#
# Arguments:
#	props	Parsed XML properties
#
# Results:
#	Return an event list that is suitable for an array set
#
# Side Effects:
#	None.
proc ::tax::__cleanprops { props } {
    set name {([A-Za-z_:]|[^\x00-\x7F])([A-Za-z0-9_:.-]|[^\x00-\x7F])*}
    set attval {"[^"]*"|'[^']*'|\w}; # "... Makes emacs happy
    set ret [regsub -all -- "($name)\\s*=\\s*($attval)" \
		[regsub "/$" $props ""] "\\1 \\4"]
    return $ret
}

# ::tax::parse -- Low-level 10 lines magic parser
#
#	This procedure is the core of the tiny XML parser and does its
#	job in 10 lines of "hairy" code.  The command will call the
#	command passed as an argument for each XML tag that is found
#	in the XML code passed as an argument.  Error checking is less
#	than minimum!  The command will be called with the following
#	respective arguments: name of the tag, boolean telling whether
#	it is a closing tag or not, boolean telling whether it is a
#	self-closing tag or not, list of property (array set-style)
#	and body of tag, if available.
#
# Arguments:
#	cmd	Command to call for each tag found.
#	xml	String containing the XML to be parsed.
#	start	Name of the pseudo tag marking the beginning/ending of document
#
# Results:
#	None.
#
# Side Effects:
#	None.
proc ::tax::parse {cmd xml {start docstart}} {
    # Convert CDATA sections to variable references to ensure that nothing
    # modifies them along the way
    set newxml ""
    for {set idx 0} {1} {set idx $endidx} {
        # Determine previous start index
        set previdx $idx

        # Determine where CDATA section begins
        set idx [string first {<![CDATA[} $xml $idx]
        if {$idx == -1} {
            break
        }

        # Determine where CDATA section ends
        set endidx [string first {]]>} $xml $idx]
        if {$endidx == "-1"} {
            set endidx [expr {[string length $xml] - 1}]
        }

        # Determine where the the XML ends
        set xmlendidx [expr {$idx - 1}]

        # Determine where the CDATA body begins
        set idx [expr {$idx + 9}]

        # Determine where the CDATA body ends
        set endidx [expr {$endidx - 1}]

        # Select the CDATA body from the XML
        set data [string range $xml $idx $endidx]

        # Adjust the end index to include the end of the tag since it will be
        # used for exclusion later
        set endidx [expr {$endidx + 4}]

        # Store data associated with this start index
        set key "@!@CDATA-${idx}@!@"
        set cdata($key) $data

        # Remove the whole CDATA tag+body from the XML
        append newxml [string range $xml $previdx $xmlendidx]
        append newxml $key
    }

    # Append the trailing data (if any)
    append newxml [string range $xml $previdx end]

    # Put the redacted data back into place
    set xml $newxml
    unset newxml

    # Replace open and close braces with XML entities to prevent them from
    # interfering with command formation
    regsub -all \{ $xml {\&ob;} xml
    regsub -all \} $xml {\&cb;} xml

    # Create regular expresion that matches tags and replaces them with valid
    # Tcl commands
    set exp {<(/?)([^\s/>]+)\s*([^>]*)>}
    set sub "\}\n$cmd {\\2} \[expr \{{\\1} ne \"\"\}\] \[regexp \{/$\} {\\3}\] \
             \[::tax::__cleanprops \{\\3\}\] \{"
    regsub -all $exp $xml $sub xml

    # Re-introduce CDATA sections into XML, which has been converted to a set
    # of Tcl commands.  This will fail if the CDATA contains unbalanced curly
    # braces.
    set xml [string map [array get cdata] $xml]

    # Evaluate generated commands
    eval "$cmd {$start} 0 0 {} \{$xml\}"

    # Evaluate the document start close tag
    eval "$cmd {$start} 1 0 {} {}"
}

package provide tax 0.2








Added components/package-maker/pkginfo/glibc.xml version [8e22eb30a0].





































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

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

<package name="glibc">
	<description short="GNU C Library">GNU C Library</description>

	<releases>
		<release version="2.16.0">
			<alt>2.16</alt>
			<sha1>9d4fffc9c4ac93e7919e124fa38bb51dcaff5216</sha1>
		</release>

		<source>
			<url>http://ftp.gnu.org/gnu/glibc/glibc-$version.tar.xz</url>
		</source>
	</releases>

	<script name="compile" interp="/bin/sh">
		mkdir glibc_requires_separate_build_directory
		cd glibc_requires_separate_build_directory

		../configure "--prefix=${_APPBOX_PREFIX}" "--sysconfdir=${_APPBOX_SYSCONFDIR}"  || exit 1

		make || exit 1

		exit 0
	</script>

	<script name="install" interp="/bin/sh">
		cd glibc_requires_separate_build_directory || exit 1

		make "install_root=${destroot}" install || exit 1

		exit 0
	</script>
</package>

















Powered by Fossil · RSS