ADDED build-process
Index: build-process
==================================================================
--- /dev/null
+++ build-process
@@ -0,0 +1,5 @@
+1. Create kernel
+2. Create initrd
+4. Create system image
+ a. Create apps
+ b. Tar up
ADDED components/package-maker/bin/build
Index: components/package-maker/bin/build
==================================================================
--- /dev/null
+++ components/package-maker/bin/build
@@ -0,0 +1,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
Index: components/package-maker/lib/csv0.7.2/csv.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/csv0.7.2/csv.tcl
@@ -0,0 +1,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
Index: components/package-maker/lib/csv0.7.2/pkgIndex.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/csv0.7.2/pkgIndex.tcl
@@ -0,0 +1,1 @@
+package ifneeded csv 0.7.2 [list source [file join $dir csv.tcl]]
ADDED components/package-maker/lib/md52.0.7/md5.tcl
Index: components/package-maker/lib/md52.0.7/md5.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/md52.0.7/md5.tcl
@@ -0,0 +1,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
Index: components/package-maker/lib/md52.0.7/pkgIndex.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/md52.0.7/pkgIndex.tcl
@@ -0,0 +1,1 @@
+package ifneeded md5 2.0.7 [list source [file join $dir md5.tcl]]
ADDED components/package-maker/lib/sha12.0.3/pkgIndex.tcl
Index: components/package-maker/lib/sha12.0.3/pkgIndex.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/sha12.0.3/pkgIndex.tcl
@@ -0,0 +1,1 @@
+package ifneeded sha1 2.0.3 [list source [file join $dir sha1.tcl]]
ADDED components/package-maker/lib/sha12.0.3/sha1.tcl
Index: components/package-maker/lib/sha12.0.3/sha1.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/sha12.0.3/sha1.tcl
@@ -0,0 +1,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
Index: components/package-maker/lib/tax0.2/pkgIndex.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/tax0.2/pkgIndex.tcl
@@ -0,0 +1,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
Index: components/package-maker/lib/tax0.2/tax.tcl
==================================================================
--- /dev/null
+++ components/package-maker/lib/tax0.2/tax.tcl
@@ -0,0 +1,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
Index: components/package-maker/pkginfo/glibc.xml
==================================================================
--- /dev/null
+++ components/package-maker/pkginfo/glibc.xml
@@ -0,0 +1,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>