Check-in [5613f08f7e]
Overview
SHA1:5613f08f7e6941cfbef13ddc443652819700250c
Date: 2014-07-19 06:59:18
User: rkeene
Comment:Added basic web interface
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | folders | manifest
Tags And Properties
Context
2014-07-19
07:07
[e9692813d7] Updated web UI (user: rkeene, tags: trunk)
06:59
[5613f08f7e] Added basic web interface (user: rkeene, tags: trunk)
2014-07-10
16:56
[91e419adbd] Added EOF fixes for TLS package (user: rkeene, tags: trunk)
Changes

Modified .fossil-settings/ignore-glob from [2c3e9f6547] to [5261fbbc36].

     1      1   build/test/kits
     2      2   build/test/kits/*
            3  +build/web/queue
            4  +build/web/kitcreator.cgi
            5  +build/web/kitcreator.kit
     3      6   itcl/build
     4      7   itcl/build/*
     5      8   itcl/build.log
     6      9   itcl/inst
     7     10   itcl/inst/*
     8     11   itcl/out
     9     12   itcl/out/*
................................................................................
    89     92   tcc4tcl/build.log
    90     93   tcc4tcl/inst
    91     94   tcc4tcl/inst/*
    92     95   tcc4tcl/out
    93     96   tcc4tcl/out/*
    94     97   tcc4tcl/src
    95     98   tcc4tcl/src/*
           99  +tls/build
          100  +tls/build/*
          101  +tls/build.log
          102  +tls/inst
          103  +tls/inst/*
          104  +tls/out
          105  +tls/out/*
          106  +tls/src
          107  +tls/src/*
    96    108   kitdll/buildsrc/kitdll-0.0/starpack.vfs
    97    109   kitdll/buildsrc/kitdll-0.0/starpack.vfs/*
    98    110   kitdll/buildsrc/kitdll-0.0/test
    99    111   kitdll/buildsrc/kitdll-0.0/configure
   100    112   kitdll/buildsrc/kitdll-0.0/libtcl*.so
   101    113   kitdll/buildsrc/kitdll-0.0/Makefile
   102    114   kitdll/buildsrc/kitdll-0.0/*.o

Modified build/web/Makefile from [a7224e283a] to [ee429274c4].

     1      1   STARKIT2EXE = ../../../starkit2exe/starkit2exe
     2      2   RIVET2STARKIT = ../../../rivet/bin/rivet2starkit
            3  +WEBDIR = /web/customers/kitcreator.rkeene.org
            4  +WEBKITSDIR = $(WEBDIR)/kits
     3      5   
     4      6   kitcreator.cgi: kitcreator.kit
     5      7   	$(STARKIT2EXE) kitcreator.kit kitcreator.cgi
     6      8   
     7      9   kitcreator.kit: kitcreator.vfs kitcreator.vfs/index.rvt
     8     10   	$(RIVET2STARKIT) tclkit kitcreator.kit kitcreator.vfs
     9     11   
           12  +install: kitcreator.cgi building.cgi
           13  +	mkdir -p '$(WEBDIR)' '$(WEBKITSDIR)'
           14  +	cp kitcreator.cgi '$(WEBDIR)/'
           15  +	cp building.cgi '$(WEBKITSDIR)/'
           16  +	echo -n > '${WEBKITSDIR}/index.html'
           17  +
    10     18   clean:
    11     19   	rm -f kitcreator.kit kitcreator.cgi
    12     20   
    13     21   distclean: clean
    14     22   
    15         -.PHONY: clean distclean
           23  +.PHONY: clean distclean install

Added build/web/building.cgi version [df00af4fd1].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +set outdir "/web/customers/kitcreator.rkeene.org/kits"
            4  +set key ""
            5  +if {[info exists ::env(PATH_INFO)]} {
            6  +	set key [lindex [split $::env(PATH_INFO) "/"] 1]
            7  +}
            8  +
            9  +set status "Unknown"
           10  +set terminal 0
           11  +if {![regexp {^[0-9a-f]+$} $key]} {
           12  +	set status "Invalid Key"
           13  +
           14  +	unset key
           15  +}
           16  +
           17  +if {[info exists key]} {
           18  +	set workdir [file join $outdir $key]
           19  +}
           20  +
           21  +if {[info exists workdir]} {
           22  +	if {[file exists $workdir]} {
           23  +		set fd [open [file join $workdir filename]]
           24  +		set filename [gets $fd]
           25  +		close $fd
           26  +
           27  +		set outfile [file join $workdir $filename]
           28  +	} else {
           29  +		set status "Queued"
           30  +	}
           31  +}
           32  +
           33  +if {[info exists outfile]} {
           34  +	if {[file exists $outfile]} {
           35  +		set status "Complete"
           36  +
           37  +		set url "http://kitcreator.rkeene.org/kits/$key/$filename"
           38  +	} elseif {[file exists "${outfile}.buildfail"]} {
           39  +		set status "Failed"
           40  +
           41  +		set terminal 1
           42  +	} else {
           43  +		set status "Building"
           44  +	}
           45  +}
           46  +
           47  +puts "Content-Type: text/html"
           48  +if {[info exists url]} {
           49  +	puts "Location: $url"
           50  +} else {
           51  +	if {!$terminal} {
           52  +		puts "Refresh: 30;url=."
           53  +	}
           54  +}
           55  +puts ""
           56  +puts "<html>"
           57  +puts "\t<head>"
           58  +puts "\t\t<title>KitCreator, Web Interface</title>"
           59  +puts "\t</head>"
           60  +puts "\t<body>"
           61  +puts "\t\t<h1>KitCreator Web Interface</h1>"
           62  +puts "\t\t<p><b>Status:</b> $status</p>"
           63  +puts "\t</body>"
           64  +puts "</html>"

Modified build/web/kitcreator.vfs/index.rvt from [aaeb907791] to [0b791688aa].

     1      1   <?
            2  +	package require sha1
            3  +
            4  +	load_response args
            5  +
     2      6   	set sourcedir "/web/rkeene/devel/kitcreator/all"
            7  +	set queue "/home/rkeene/devel/kitcreator/build/web/queue"
            8  +	set secretfile "/home/rkeene/etc/kitcreator-web-secret"
            9  +
     3     10   	foreach file [glob -tails -nocomplain -directory $sourcedir "kitcreator-*.tar.gz"] {
     4     11   		regexp {^kitcreator-(.*).tar.gz$} $file -> vers
     5     12   		set kitcreator_versions($vers) $vers
     6     13   	}
     7     14   	set kitcreator_version_selected [lindex [lsort -dictionary [array names kitcreator_versions]] end]
     8     15   
     9     16   	set kitcreator_versions(trunk) "Fossil Trunk Tip"
    10     17   
    11         -	set tcl_versions(8.4.19) 8.4.19
    12         -	set tcl_versions(8.5.9) 8.5.9
    13         -	set tcl_versions(cvs_HEAD) "Fossil Trunk Tip"
           18  +	set tcl_versions(8.5.15) 8.5.15
           19  +	set tcl_versions(8.6.1) 8.6.1
           20  +	set tcl_versions(fossil_trunk) "Fossil Trunk Tip"
    14     21   
    15         -	set platforms(linux-x86) "Linux on x86"
    16         -	set platforms(linux-amd64) "Linux on amd64"
    17         -	set platforms(linux-mipsel) "Linux on MIPSEL"
    18         -	set platforms(windows-x86) "Windows on x86"
           22  +	set platforms(android-arm) "Android/ARM"
           23  +	set platforms(freebsd-amd64) "FreeBSD/amd64"
           24  +	set platforms(hpux-hppa64) "HP-UX/PA-RISC 2.0"
           25  +	set platforms(linux-amd64) "Linux/amd64"
           26  +	set platforms(linux-arm) "Linux/ARM"
           27  +	set platforms(linux-i386) "Linux/i386"
           28  +	set platforms(linux-mipsel) "Linux/MIPS"
           29  +	set platforms(netbsd-amd64) "NetBSD/amd64"
           30  +	set platforms(netbsd-i386) "NetBSD/i386"
           31  +	set platforms(solaris-amd64) "Solaris/amd64"
           32  +	set platforms(solaris-i386) "Solaris/i386"
           33  +	set platforms(solaris-sparc) "Solaris/SPARC"
           34  +	set platforms(solaris-sparc64) "Solaris/SPARC64"
           35  +	set platforms(win32) "Windows/i386"
           36  +	set platforms(win64) "Windows/amd64"
           37  +
           38  +	set packages(tk) "Tk"
           39  +	set packages(mk4tcl) "Metakit"
           40  +	set packages(tcc4tcl) "tcc4tcl"
           41  +	set packages(tls) TLS
           42  +	set packages(dbus) D-BUS
           43  +	set packages(tclx) TclX
    19     44   
    20     45   	set disable {
    21         -		platform linux-amd64 tk
    22         -		platform linux-mipsel tk
           46  +		platform linux-mipsel {tk tcc4tcl}
           47  +		platform android-arm tk
           48  +		platform netbsd-amd64 {tk tcc4tcl}
           49  +		platform netbsd-i386 {tk tcc4tcl}
           50  +		platform solaris-sparc tcc4tcl
           51  +		platform solaris-sparc64 tcc4tcl
           52  +		platform hpux-hppa64 tcc4tcl
    23     53   	}
    24     54   
    25     55   	set specific {
    26         -		platform windows-x86 file icon {Kit Icon}
    27         -		platform windows-x86 text description {Description}
           56  +		platform win32 file icon {Kit Icon}
           57  +		platform win32 text description {Description}
           58  +		platform win64 file icon {Kit Icon}
           59  +		platform win64 text description {Description}
    28     60   	}
           61  +
           62  +	if {[info exists args(platform)] && [info exists args(tcl_version)] && [info exist args(kitcreator_version)]} {
           63  +		# Read in arguments
           64  +		## Mandatory arguments
           65  +		set build_platform $args(platform)
           66  +		set build_tcl_version $args(tcl_version)
           67  +		set build_kitcreator_version $args(kitcreator_version)
           68  +
           69  +		## Optional Arguments
           70  +		set build_packages [list]
           71  +		set build_options(threaded) 0
           72  +		set build_options(kitdll) 0
           73  +		foreach arg [array names args] {
           74  +			switch -glob -- $arg {
           75  +				"option_package_*" {
           76  +					set package [join [lrange [split $arg _] 2 end] _]
           77  +
           78  +					lappend build_packages $package
           79  +				}
           80  +				"option_threaded" {
           81  +					set build_options(threaded) 1
           82  +				}
           83  +				"option_kitdll" {
           84  +					set build_options(kitdll) 1
           85  +				}
           86  +			}
           87  +		}
           88  +		set build_packages [lsort -dictionary $build_packages]
           89  +
           90  +		# Validate arguments
           91  +		if {![info exists platforms($build_platform)]} {
           92  +			unset build_platform
           93  +		}
           94  +
           95  +		if {![info exists tcl_versions($build_tcl_version)]} {
           96  +			unset build_tcl_version
           97  +		}
           98  +
           99  +		if {![info exists kitcreator_versions($build_kitcreator_version)]} {
          100  +			unset build_kitcreator_version
          101  +		}
          102  +
          103  +		foreach package $build_packages {
          104  +			if {![info exists packages($package)]} {
          105  +				unset build_packages
          106  +
          107  +				break
          108  +			}
          109  +		}
          110  +
          111  +		# Resolve version numbers to checkin IDs
          112  +		## XXX: TODO
          113  +		set cache_tcl_version $build_tcl_version
          114  +		if {$build_tcl_version == "fossil_trunk"} {
          115  +			set cache_tcl_version [clock seconds]
          116  +		}
          117  +
          118  +		set cache_kitcreator_version $build_kitcreator_version
          119  +		if {$build_kitcreator_version == "trunk"} {
          120  +			set cache_kitcreator_version [clock seconds]
          121  +		}
          122  +
          123  +		# Generate a serialized hash that represents the state of the build
          124  +		## Load a secret so keys cannot be pre-computed (but remain consistent)
          125  +		set secretfd [open $secretfile "r"]
          126  +		set secret [gets $secretfd]
          127  +		close $secretfd
          128  +
          129  +		## Compute basic key	
          130  +		set key [list $secret $build_platform $cache_tcl_version $cache_kitcreator_version $build_packages]
          131  +
          132  +		## Update key with options in deterministic order
          133  +		foreach option [lsort -dictionary [array names build_options]] {
          134  +			lappend key [list "option:$option" $build_options($option)]
          135  +		}
          136  +
          137  +		## Convert key to a user-consumable string via hashing
          138  +		set key [string tolower [sha1::sha1 -hex $key]]
          139  +
          140  +		# Determine filename
          141  +		if {$build_options(kitdll)} {
          142  +			set extension "so"
          143  +			switch -- $build_platform {
          144  +				"win32" - "win64" {
          145  +					set extension "dll"
          146  +				}
          147  +				"hpux-hppa64" {
          148  +					set extension "sl"
          149  +				}
          150  +			}
          151  +
          152  +			## XXX: TODO: The version here needs to match what's in the SONAME
          153  +			set filename "libtclkit[string map [list "." ""] ${cache_tcl_version}].${extension}"
          154  +		} else {
          155  +			set filename "tclkit"
          156  +
          157  +			switch -- $build_platform {
          158  +				"win32" - "win64" {
          159  +					append filename ".exe"
          160  +				}
          161  +			}
          162  +		}
          163  +
          164  +		# Queue build up and wait for it to complete
          165  +		set fd [open $queue a+]
          166  +		puts $fd [list filename $filename key $key platform $build_platform tcl_version $build_tcl_version kitcreator_version $build_kitcreator_version packages $build_packages options [array get build_options]]
          167  +		close $fd
          168  +
          169  +		set url "http://kitcreator.rkeene.org/kits/building/$key/"
          170  +
          171  +		headers redirect $url
          172  +?><html>
          173  +	<head>
          174  +		<title>KitCreator, Web Interface</title>
          175  +	</head>
          176  +	<body>
          177  +		<h1>KitCreator Web Interface</h1>
          178  +		<p>Build in progress, output will be: <a href="<? puts -nonewline $url ?>"><? puts -nonewline $url ?></a></p>
          179  +	</body>
          180  +</html>
          181  +<?
          182  +	} else {
    29    183   ?><html>
    30    184     <head>
    31    185       <title>KitCreator, Web Interface</title>
    32    186       <script>
    33    187   <!--
          188  +	function enablePackage(package) {
          189  +		var obj;
          190  +
          191  +		obj = document.getElementById('option_package_' + package);
          192  +		obj.disabled = false;
          193  +	}
          194  +
          195  +	function disablePackage(package) {
          196  +		var obj;
          197  +
          198  +		obj = document.getElementById('option_package_' + package);
          199  +		obj.checked = false;
          200  +		obj.disabled = true;
          201  +	}
          202  +
    34    203   	function verifyOptions() {
    35    204   		var kitcreator_version;
    36    205   		var tcl_version;
    37    206   		var platform;
    38    207   
    39    208   		kitcreator_version = document.getElementsByName('kitcreator_version')[0].value;
    40    209   		tcl_version = document.getElementsByName('tcl_version')[0].value;
    41    210   		platform = document.getElementsByName('platform')[0].value;
    42    211   
          212  +<?
          213  +		set alldisabledpackages [list]
          214  +		foreach {keyword value disablepackages} $disable {
          215  +			foreach package $disablepackages {
          216  +				if {[lsearch -exact $alldisabledpackages $package] == -1} {
          217  +					lappend alldisabledpackages $package
          218  +				}
          219  +			}
          220  +		}
          221  +
          222  +		foreach package $alldisabledpackages {
          223  +			puts "\t\tenablePackage(\"$package\");"
          224  +		}
          225  +
          226  +		foreach {keyword value disablepackages} $disable {
          227  +			puts "\t\tif ($keyword == \"$value\") \{"
          228  +
          229  +			foreach package $disablepackages {
          230  +				puts "\t\t\tdisablePackage(\"$package\");"
          231  +			}
          232  +
          233  +			puts "\t\t\}"
          234  +		}
          235  +?>
    43    236   	}
    44    237   -->
    45    238       </script>
    46    239     </head>
    47         -  <body>
          240  +  <body onLoad="verifyOptions();">
    48    241       <h1>KitCreator Web Interface</h1>
    49    242       <form method="post" enctype="multipart/form-data">
    50    243         <table>
    51    244           <tr>
    52    245             <td>KitCreator Version:</td>
    53    246             <td>
    54    247               <select name="kitcreator_version" onChange="verifyOptions();">
................................................................................
    93    286   ?>
    94    287               </select>
    95    288             </td>
    96    289           </tr>
    97    290           <tr>
    98    291             <td>Kit Options:</td>
    99    292             <td>
   100         -            <input type="checkbox" name="option_package_tk">Tk<br>
   101         -            <input type="checkbox" name="option_package_itcl">[incr Tcl]<br>
   102         -            <input type="checkbox" name="option_package_mk4tcl">Metakit<br>
   103         -            <input type="checkbox" name="option_threaded">Threaded<br>
   104         -            <input type="checkbox" name="option_kitdll">Build Library (KitDLL)<br>
          293  +<?  foreach package [lsort -dictionary [array names packages]] { ?>
          294  +            <input type="checkbox" name="option_package_<? puts -nonewline $package ?>" id="option_package_<? puts -nonewline $package ?>">Package: <? puts -nonewline $packages($package) ?><br>
          295  +<? } ?>
          296  +            <input type="checkbox" name="option_threaded">Kit: Threaded<br>
          297  +            <input type="checkbox" name="option_kitdll">Kit: Build Library (KitDLL)<br>
   105    298             </td>
   106    299           </tr>
   107    300           <tr>
   108    301             <td>Kit Icon:</td>
   109    302             <td>
   110         -            <input type="file" name="platform-windows-x86-icon">
          303  +            <input type="file" name="option_icon">
   111    304             </td>
   112    305           </tr>
   113    306           <tr>
   114    307             <td>Description:</td>
   115    308             <td>
   116         -            <input type="text" name="platform-windows-x86-desc">
          309  +            <input type="text" name="option_desc">
   117    310             </td>
   118    311           </tr>
   119    312         </table>
   120    313         <input type="submit" name="submit" value="Create">
   121    314       </form>
   122    315     </body>
   123         -</html>
          316  +</html><? } ?>

Added build/web/kitcreator.vfs/lib/.htaccess version [30ceba8f4e].

            1  +Deny from all

Added build/web/kitcreator.vfs/lib/sha1-2.0.3/pkgIndex.tcl version [6f6c09ab55].

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

Added build/web/kitcreator.vfs/lib/sha1-2.0.3/sha1.tcl version [778d9b332e].

            1  +# sha1.tcl - 
            2  +
            3  +# @@ Meta Begin
            4  +# Package sha1 2.0.3
            5  +# Meta platform           tcl
            6  +# Meta rsk::build::date   2011-03-30
            7  +# Meta description        Part of the Tclib sha1 module
            8  +# Meta require            {Tcl 8.2}
            9  +# @@ Meta End
           10  +
           11  +#
           12  +# Copyright (C) 2001 Don Libes <libes@nist.gov>
           13  +# Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
           14  +#
           15  +# SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm"
           16  +# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
           17  +#
           18  +# This is an implementation of SHA1 based upon the example code given in
           19  +# FIPS 180-1 and upon the tcllib MD4 implementation and taking some ideas
           20  +# and methods from the earlier tcllib sha1 version by Don Libes.
           21  +#
           22  +# This implementation permits incremental updating of the hash and 
           23  +# provides support for external compiled implementations either using
           24  +# critcl (sha1c) or Trf.
           25  +#
           26  +# ref: http://www.itl.nist.gov/fipspubs/fip180-1.htm
           27  +#
           28  +# -------------------------------------------------------------------------
           29  +# See the file "license.terms" for information on usage and redistribution
           30  +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
           31  +# -------------------------------------------------------------------------
           32  +#
           33  +# $Id: sha1.tcl,v 1.22 2009/05/07 00:35:10 patthoyts Exp $
           34  +
           35  +# @mdgen EXCLUDE: sha1c.tcl
           36  +
           37  +package require Tcl 8.2;                # tcl minimum version
           38  +
           39  +namespace eval ::sha1 {
           40  +    variable  version 2.0.3
           41  +    variable  rcsid {$Id: sha1.tcl,v 1.22 2009/05/07 00:35:10 patthoyts Exp $}
           42  +
           43  +    variable  accel
           44  +    array set accel {tcl 0 critcl 0 cryptkit 0 trf 0}
           45  +    variable  loaded {}
           46  +    variable  active
           47  +    array set active {tcl 0 critcl 0 cryptkit 0 trf 0}
           48  +
           49  +    namespace export sha1 hmac SHA1Init SHA1Update SHA1Final
           50  +
           51  +    variable uid
           52  +    if {![info exists uid]} {
           53  +        set uid 0
           54  +    }
           55  +}
           56  +
           57  +# -------------------------------------------------------------------------
           58  +# Management of sha1 implementations.
           59  +
           60  +# LoadAccelerator --
           61  +#
           62  +#	This package can make use of a number of compiled extensions to
           63  +#	accelerate the digest computation. This procedure manages the
           64  +#	use of these extensions within the package. During normal usage
           65  +#	this should not be called, but the test package manipulates the
           66  +#	list of enabled accelerators.
           67  +#
           68  +proc ::sha1::LoadAccelerator {name} {
           69  +    variable accel
           70  +    set r 0
           71  +    switch -exact -- $name {
           72  +        tcl {
           73  +            # Already present (this file)
           74  +            set r 1
           75  +        }
           76  +        critcl {
           77  +            if {![catch {package require tcllibc}]
           78  +                || ![catch {package require sha1c}]} {
           79  +                set r [expr {[info command ::sha1::sha1c] != {}}]
           80  +            }
           81  +        }
           82  +        cryptkit {
           83  +            if {![catch {package require cryptkit}]} {
           84  +                set r [expr {![catch {cryptkit::cryptInit}]}]
           85  +            }
           86  +        }
           87  +        trf {
           88  +            if {![catch {package require Trf}]} {
           89  +                set r [expr {![catch {::sha1 aa} msg]}]
           90  +            }
           91  +        }
           92  +        default {
           93  +            return -code error "invalid accelerator $key:\
           94  +                must be one of [join [KnownImplementations] {, }]"
           95  +        }
           96  +    }
           97  +    set accel($name) $r
           98  +    return $r
           99  +}
          100  +
          101  +# ::sha1::Implementations --
          102  +#
          103  +#	Determines which implementations are
          104  +#	present, i.e. loaded.
          105  +#
          106  +# Arguments:
          107  +#	None.
          108  +#
          109  +# Results:
          110  +#	A list of implementation keys.
          111  +
          112  +proc ::sha1::Implementations {} {
          113  +    variable accel
          114  +    set res {}
          115  +    foreach n [array names accel] {
          116  +	if {!$accel($n)} continue
          117  +	lappend res $n
          118  +    }
          119  +    return $res
          120  +}
          121  +
          122  +# ::sha1::KnownImplementations --
          123  +#
          124  +#	Determines which implementations are known
          125  +#	as possible implementations.
          126  +#
          127  +# Arguments:
          128  +#	None.
          129  +#
          130  +# Results:
          131  +#	A list of implementation keys. In the order
          132  +#	of preference, most prefered first.
          133  +
          134  +proc ::sha1::KnownImplementations {} {
          135  +    return {critcl cryptkit trf tcl}
          136  +}
          137  +
          138  +proc ::sha1::Names {} {
          139  +    return {
          140  +	critcl   {tcllibc based}
          141  +        cryptkit {cryptkit based}
          142  +        trf      {Trf based}
          143  +	tcl      {pure Tcl}
          144  +    }
          145  +}
          146  +
          147  +# ::sha1::SwitchTo --
          148  +#
          149  +#	Activates a loaded named implementation.
          150  +#
          151  +# Arguments:
          152  +#	key	Name of the implementation to activate.
          153  +#
          154  +# Results:
          155  +#	None.
          156  +
          157  +proc ::sha1::SwitchTo {key} {
          158  +    variable accel
          159  +    variable active
          160  +    variable loaded
          161  +
          162  +    if {[string equal $key $loaded]} {
          163  +	# No change, nothing to do.
          164  +	return
          165  +    } elseif {![string equal $key ""]} {
          166  +	# Validate the target implementation of the switch.
          167  +
          168  +	if {![info exists accel($key)]} {
          169  +	    return -code error "Unable to activate unknown implementation \"$key\""
          170  +	} elseif {![info exists accel($key)] || !$accel($key)} {
          171  +	    return -code error "Unable to activate missing implementation \"$key\""
          172  +	}
          173  +    }
          174  +
          175  +    if {![string equal $loaded ""]} {
          176  +        set active($loaded) 0
          177  +    }
          178  +    if {![string equal $key ""]} {
          179  +        set active($key) 1
          180  +    }
          181  +
          182  +    # Remember the active implementation, for deactivation by future
          183  +    # switches.
          184  +
          185  +    set loaded $key
          186  +    return
          187  +}
          188  +
          189  +# -------------------------------------------------------------------------
          190  +
          191  +# SHA1Init --
          192  +#
          193  +#   Create and initialize an SHA1 state variable. This will be
          194  +#   cleaned up when we call SHA1Final
          195  +#
          196  +
          197  +proc ::sha1::SHA1Init {} {
          198  +    variable active
          199  +    variable uid
          200  +    set token [namespace current]::[incr uid]
          201  +    upvar #0 $token state
          202  +
          203  +    # FIPS 180-1: 7 - Initialize the hash state
          204  +    array set state \
          205  +        [list \
          206  +             A [expr {int(0x67452301)}] \
          207  +             B [expr {int(0xEFCDAB89)}] \
          208  +             C [expr {int(0x98BADCFE)}] \
          209  +             D [expr {int(0x10325476)}] \
          210  +             E [expr {int(0xC3D2E1F0)}] \
          211  +             n 0 i "" ]
          212  +    if {$active(cryptkit)} {
          213  +        cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_SHA
          214  +    } elseif {$active(trf)} {
          215  +        set s {}
          216  +        switch -exact -- $::tcl_platform(platform) {
          217  +            windows { set s [open NUL w] }
          218  +            unix    { set s [open /dev/null w] }
          219  +        }
          220  +        if {$s != {}} {
          221  +            fconfigure $s -translation binary -buffering none
          222  +            ::sha1 -attach $s -mode write \
          223  +                -read-type variable \
          224  +                -read-destination [subst $token](trfread) \
          225  +                -write-type variable \
          226  +                -write-destination [subst $token](trfwrite)
          227  +            array set state [list trfread 0 trfwrite 0 trf $s]
          228  +        }
          229  +    }
          230  +    return $token
          231  +}
          232  +
          233  +# SHA1Update --
          234  +#
          235  +#   This is called to add more data into the hash. You may call this
          236  +#   as many times as you require. Note that passing in "ABC" is equivalent
          237  +#   to passing these letters in as separate calls -- hence this proc 
          238  +#   permits hashing of chunked data
          239  +#
          240  +#   If we have a C-based implementation available, then we will use
          241  +#   it here in preference to the pure-Tcl implementation.
          242  +#
          243  +proc ::sha1::SHA1Update {token data} {
          244  +    variable active
          245  +    upvar #0 $token state
          246  +
          247  +    if {$active(critcl)} {
          248  +        if {[info exists state(sha1c)]} {
          249  +            set state(sha1c) [sha1c $data $state(sha1c)]
          250  +        } else {
          251  +            set state(sha1c) [sha1c $data]
          252  +        }
          253  +        return
          254  +    } elseif {[info exists state(ckctx)]} {
          255  +        if {[string length $data] > 0} {
          256  +            cryptkit::cryptEncrypt $state(ckctx) $data
          257  +        }
          258  +        return
          259  +    } elseif {[info exists state(trf)]} {
          260  +        puts -nonewline $state(trf) $data
          261  +        return
          262  +    }
          263  +
          264  +    # Update the state values
          265  +    incr state(n) [string length $data]
          266  +    append state(i) $data
          267  +
          268  +    # Calculate the hash for any complete blocks
          269  +    set len [string length $state(i)]
          270  +    for {set n 0} {($n + 64) <= $len} {} {
          271  +        SHA1Transform $token [string range $state(i) $n [incr n 64]]
          272  +    }
          273  +
          274  +    # Adjust the state for the blocks completed.
          275  +    set state(i) [string range $state(i) $n end]
          276  +    return
          277  +}
          278  +
          279  +# SHA1Final --
          280  +#
          281  +#    This procedure is used to close the current hash and returns the
          282  +#    hash data. Once this procedure has been called the hash context
          283  +#    is freed and cannot be used again.
          284  +#
          285  +#    Note that the output is 160 bits represented as binary data.
          286  +#
          287  +proc ::sha1::SHA1Final {token} {
          288  +    upvar #0 $token state
          289  +
          290  +    # Check for either of the C-compiled versions.
          291  +    if {[info exists state(sha1c)]} {
          292  +        set r $state(sha1c)
          293  +        unset state
          294  +        return $r
          295  +    } elseif {[info exists state(ckctx)]} {
          296  +        cryptkit::cryptEncrypt $state(ckctx) ""
          297  +        cryptkit::cryptGetAttributeString $state(ckctx) \
          298  +            CRYPT_CTXINFO_HASHVALUE r 20
          299  +        cryptkit::cryptDestroyContext $state(ckctx)
          300  +        # If nothing was hashed, we get no r variable set!
          301  +        if {[info exists r]} {
          302  +            unset state
          303  +            return $r
          304  +        }
          305  +    } elseif {[info exists state(trf)]} {
          306  +        close $state(trf)
          307  +        set r $state(trfwrite)
          308  +        unset state
          309  +        return $r
          310  +    }
          311  +
          312  +    # Padding
          313  +    #
          314  +    set len [string length $state(i)]
          315  +    set pad [expr {56 - ($len % 64)}]
          316  +    if {$len % 64 > 56} {
          317  +        incr pad 64
          318  +    }
          319  +    if {$pad == 0} {
          320  +        incr pad 64
          321  +    }
          322  +    append state(i) [binary format a$pad \x80]
          323  +
          324  +    # Append length in bits as big-endian wide int.
          325  +    set dlen [expr {8 * $state(n)}]
          326  +    append state(i) [binary format II 0 $dlen]
          327  +
          328  +    # Calculate the hash for the remaining block.
          329  +    set len [string length $state(i)]
          330  +    for {set n 0} {($n + 64) <= $len} {} {
          331  +        SHA1Transform $token [string range $state(i) $n [incr n 64]]
          332  +    }
          333  +
          334  +    # Output
          335  +    set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)]
          336  +    unset state
          337  +    return $r
          338  +}
          339  +
          340  +# -------------------------------------------------------------------------
          341  +# HMAC Hashed Message Authentication (RFC 2104)
          342  +#
          343  +# hmac = H(K xor opad, H(K xor ipad, text))
          344  +#
          345  +
          346  +# HMACInit --
          347  +#
          348  +#    This is equivalent to the SHA1Init procedure except that a key is
          349  +#    added into the algorithm
          350  +#
          351  +proc ::sha1::HMACInit {K} {
          352  +
          353  +    # Key K is adjusted to be 64 bytes long. If K is larger, then use
          354  +    # the SHA1 digest of K and pad this instead.
          355  +    set len [string length $K]
          356  +    if {$len > 64} {
          357  +        set tok [SHA1Init]
          358  +        SHA1Update $tok $K
          359  +        set K [SHA1Final $tok]
          360  +        set len [string length $K]
          361  +    }
          362  +    set pad [expr {64 - $len}]
          363  +    append K [string repeat \0 $pad]
          364  +
          365  +    # Cacluate the padding buffers.
          366  +    set Ki {}
          367  +    set Ko {}
          368  +    binary scan $K i16 Ks
          369  +    foreach k $Ks {
          370  +        append Ki [binary format i [expr {$k ^ 0x36363636}]]
          371  +        append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]]
          372  +    }
          373  +
          374  +    set tok [SHA1Init]
          375  +    SHA1Update $tok $Ki;                 # initialize with the inner pad
          376  +    
          377  +    # preserve the Ko value for the final stage.
          378  +    # FRINK: nocheck
          379  +    set [subst $tok](Ko) $Ko
          380  +
          381  +    return $tok
          382  +}
          383  +
          384  +# HMACUpdate --
          385  +#
          386  +#    Identical to calling SHA1Update
          387  +#
          388  +proc ::sha1::HMACUpdate {token data} {
          389  +    SHA1Update $token $data
          390  +    return
          391  +}
          392  +
          393  +# HMACFinal --
          394  +#
          395  +#    This is equivalent to the SHA1Final procedure. The hash context is
          396  +#    closed and the binary representation of the hash result is returned.
          397  +#
          398  +proc ::sha1::HMACFinal {token} {
          399  +    upvar #0 $token state
          400  +
          401  +    set tok [SHA1Init];                 # init the outer hashing function
          402  +    SHA1Update $tok $state(Ko);         # prepare with the outer pad.
          403  +    SHA1Update $tok [SHA1Final $token]; # hash the inner result
          404  +    return [SHA1Final $tok]
          405  +}
          406  +
          407  +# -------------------------------------------------------------------------
          408  +# Description:
          409  +#  This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but
          410  +#  includes an extra round and a set of constant modifiers throughout.
          411  +#
          412  +set ::sha1::SHA1Transform_body {
          413  +    upvar #0 $token state
          414  +
          415  +    # FIPS 180-1: 7a: Process Message in 16-Word Blocks
          416  +    binary scan $msg I* blocks
          417  +    set blockLen [llength $blocks]
          418  +    for {set i 0} {$i < $blockLen} {incr i 16} {
          419  +        set W [lrange $blocks $i [expr {$i+15}]]
          420  +        
          421  +        # FIPS 180-1: 7b: Expand the input into 80 words
          422  +        # For t = 16 to 79 
          423  +        #   let Wt = (Wt-3 ^ Wt-8 ^ Wt-14 ^ Wt-16) <<< 1
          424  +        set t3  12
          425  +        set t8   7
          426  +        set t14  1
          427  +        set t16 -1
          428  +        for {set t 16} {$t < 80} {incr t} {
          429  +            set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \
          430  +                             [lindex $W [incr t14]] ^ [lindex $W [incr t16]]}]
          431  +            lappend W [expr {int(($x << 1) | (($x >> 31) & 1))}]
          432  +        }
          433  +        
          434  +        # FIPS 180-1: 7c: Copy hash state.
          435  +        set A $state(A)
          436  +        set B $state(B)
          437  +        set C $state(C)
          438  +        set D $state(D)
          439  +        set E $state(E)
          440  +
          441  +        # FIPS 180-1: 7d: Do permutation rounds
          442  +        # For t = 0 to 79 do
          443  +        #   TEMP = (A<<<5) + ft(B,C,D) + E + Wt + Kt;
          444  +        #   E = D; D = C; C = S30(B); B = A; A = TEMP;
          445  +
          446  +        # Round 1: ft(B,C,D) = (B & C) | (~B & D) ( 0 <= t <= 19)
          447  +        for {set t 0} {$t < 20} {incr t} {
          448  +            set TEMP [F1 $A $B $C $D $E [lindex $W $t]]
          449  +            set E $D
          450  +            set D $C
          451  +            set C [rotl32 $B 30]
          452  +            set B $A
          453  +            set A $TEMP
          454  +        }
          455  +
          456  +        # Round 2: ft(B,C,D) = (B ^ C ^ D) ( 20 <= t <= 39)
          457  +        for {} {$t < 40} {incr t} {
          458  +            set TEMP [F2 $A $B $C $D $E [lindex $W $t]]
          459  +            set E $D
          460  +            set D $C
          461  +            set C [rotl32 $B 30]
          462  +            set B $A
          463  +            set A $TEMP
          464  +        }
          465  +
          466  +        # Round 3: ft(B,C,D) = ((B & C) | (B & D) | (C & D)) ( 40 <= t <= 59)
          467  +        for {} {$t < 60} {incr t} {
          468  +            set TEMP [F3 $A $B $C $D $E [lindex $W $t]]
          469  +            set E $D
          470  +            set D $C
          471  +            set C [rotl32 $B 30]
          472  +            set B $A
          473  +            set A $TEMP
          474  +         }
          475  +
          476  +        # Round 4: ft(B,C,D) = (B ^ C ^ D) ( 60 <= t <= 79)
          477  +        for {} {$t < 80} {incr t} {
          478  +            set TEMP [F4 $A $B $C $D $E [lindex $W $t]]
          479  +            set E $D
          480  +            set D $C
          481  +            set C [rotl32 $B 30]
          482  +            set B $A
          483  +            set A $TEMP
          484  +        }
          485  +
          486  +        # Then perform the following additions. (That is, increment each
          487  +        # of the four registers by the value it had before this block
          488  +        # was started.)
          489  +        incr state(A) $A
          490  +        incr state(B) $B
          491  +        incr state(C) $C
          492  +        incr state(D) $D
          493  +        incr state(E) $E
          494  +    }
          495  +
          496  +    return
          497  +}
          498  +
          499  +proc ::sha1::F1 {A B C D E W} {
          500  +    expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \
          501  +               + ($D ^ ($B & ($C ^ $D))) + $E + $W + 0x5a827999) & 0xffffffff}
          502  +}
          503  +
          504  +proc ::sha1::F2 {A B C D E W} {
          505  +    expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \
          506  +               + ($B ^ $C ^ $D) + $E + $W + 0x6ed9eba1) & 0xffffffff}
          507  +}
          508  +
          509  +proc ::sha1::F3 {A B C D E W} {
          510  +    expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \
          511  +               + (($B & $C) | ($D & ($B | $C))) + $E + $W + 0x8f1bbcdc) & 0xffffffff}
          512  +}
          513  +
          514  +proc ::sha1::F4 {A B C D E W} {
          515  +    expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \
          516  +               + ($B ^ $C ^ $D) + $E + $W + 0xca62c1d6) & 0xffffffff}
          517  +}
          518  +
          519  +proc ::sha1::rotl32 {v n} {
          520  +    return [expr {((($v << $n) \
          521  +                        | (($v >> (32 - $n)) \
          522  +                               & (0x7FFFFFFF >> (31 - $n))))) \
          523  +                      & 0xFFFFFFFF}]
          524  +}
          525  +
          526  +
          527  +# -------------------------------------------------------------------------
          528  +# 
          529  +# In order to get this code to go as fast as possible while leaving
          530  +# the main code readable we can substitute the above function bodies
          531  +# into the transform procedure. This inlines the code for us an avoids
          532  +# a procedure call overhead within the loops.
          533  +#
          534  +# We can do some minor tweaking to improve speed on Tcl < 8.5 where we
          535  +# know our arithmetic is limited to 64 bits. On > 8.5 we may have 
          536  +# unconstrained integer arithmetic and must avoid letting it run away.
          537  +#
          538  +
          539  +regsub -all -line \
          540  +    {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          541  +    $::sha1::SHA1Transform_body \
          542  +    {[expr {(rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999) \& 0xffffffff}]} \
          543  +    ::sha1::SHA1Transform_body_tmp
          544  +
          545  +regsub -all -line \
          546  +    {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          547  +    $::sha1::SHA1Transform_body_tmp \
          548  +    {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1) \& 0xffffffff}]} \
          549  +    ::sha1::SHA1Transform_body_tmp
          550  +
          551  +regsub -all -line \
          552  +    {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          553  +    $::sha1::SHA1Transform_body_tmp \
          554  +    {[expr {(rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc) \& 0xffffffff}]} \
          555  +    ::sha1::SHA1Transform_body_tmp
          556  +
          557  +regsub -all -line \
          558  +    {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          559  +    $::sha1::SHA1Transform_body_tmp \
          560  +    {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6) \& 0xffffffff}]} \
          561  +    ::sha1::SHA1Transform_body_tmp
          562  +
          563  +regsub -all -line \
          564  +    {rotl32\(\$A,5\)} \
          565  +    $::sha1::SHA1Transform_body_tmp \
          566  +    {((($A << 5) \& 0xffffffff) | (($A >> 27) \& 0x1f))} \
          567  +    ::sha1::SHA1Transform_body_tmp
          568  +
          569  +regsub -all -line \
          570  +    {\[rotl32 \$B 30\]} \
          571  +    $::sha1::SHA1Transform_body_tmp \
          572  +    {[expr {int(($B << 30) | (($B >> 2) \& 0x3fffffff))}]} \
          573  +    ::sha1::SHA1Transform_body_tmp
          574  +#
          575  +# Version 2 avoids a few truncations to 32 bits in non-essential places.
          576  +#
          577  +regsub -all -line \
          578  +    {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          579  +    $::sha1::SHA1Transform_body \
          580  +    {[expr {rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999}]} \
          581  +    ::sha1::SHA1Transform_body_tmp2
          582  +
          583  +regsub -all -line \
          584  +    {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          585  +    $::sha1::SHA1Transform_body_tmp2 \
          586  +    {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1}]} \
          587  +    ::sha1::SHA1Transform_body_tmp2
          588  +
          589  +regsub -all -line \
          590  +    {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          591  +    $::sha1::SHA1Transform_body_tmp2 \
          592  +    {[expr {rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc}]} \
          593  +    ::sha1::SHA1Transform_body_tmp2
          594  +
          595  +regsub -all -line \
          596  +    {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \
          597  +    $::sha1::SHA1Transform_body_tmp2 \
          598  +    {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6}]} \
          599  +    ::sha1::SHA1Transform_body_tmp2
          600  +
          601  +regsub -all -line \
          602  +    {rotl32\(\$A,5\)} \
          603  +    $::sha1::SHA1Transform_body_tmp2 \
          604  +    {(($A << 5) | (($A >> 27) \& 0x1f))} \
          605  +    ::sha1::SHA1Transform_body_tmp2
          606  +
          607  +regsub -all -line \
          608  +    {\[rotl32 \$B 30\]} \
          609  +    $::sha1::SHA1Transform_body_tmp2 \
          610  +    {[expr {($B << 30) | (($B >> 2) \& 0x3fffffff)}]} \
          611  +    ::sha1::SHA1Transform_body_tmp2
          612  +
          613  +if {[package vsatisfies [package provide Tcl] 8.5]} {
          614  +    proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp
          615  +} else {
          616  +    proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp2
          617  +}
          618  +
          619  +unset ::sha1::SHA1Transform_body
          620  +unset ::sha1::SHA1Transform_body_tmp
          621  +unset ::sha1::SHA1Transform_body_tmp2
          622  +
          623  +# -------------------------------------------------------------------------
          624  +
          625  +proc ::sha1::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}}
          626  +proc ::sha1::bytes {v} { 
          627  +    #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v]
          628  +    format %c%c%c%c \
          629  +        [expr {((0xFF000000 & $v) >> 24) & 0xFF}] \
          630  +        [expr {(0xFF0000 & $v) >> 16}] \
          631  +        [expr {(0xFF00 & $v) >> 8}] \
          632  +        [expr {0xFF & $v}]
          633  +}
          634  +
          635  +# -------------------------------------------------------------------------
          636  +
          637  +proc ::sha1::Hex {data} {
          638  +    binary scan $data H* result
          639  +    return $result
          640  +}
          641  +
          642  +# -------------------------------------------------------------------------
          643  +
          644  +# Description:
          645  +#  Pop the nth element off a list. Used in options processing.
          646  +#
          647  +proc ::sha1::Pop {varname {nth 0}} {
          648  +    upvar $varname args
          649  +    set r [lindex $args $nth]
          650  +    set args [lreplace $args $nth $nth]
          651  +    return $r
          652  +}
          653  +
          654  +# -------------------------------------------------------------------------
          655  +
          656  +# fileevent handler for chunked file hashing.
          657  +#
          658  +proc ::sha1::Chunk {token channel {chunksize 4096}} {
          659  +    upvar #0 $token state
          660  +    
          661  +    if {[eof $channel]} {
          662  +        fileevent $channel readable {}
          663  +        set state(reading) 0
          664  +    }
          665  +        
          666  +    SHA1Update $token [read $channel $chunksize]
          667  +}
          668  +
          669  +# -------------------------------------------------------------------------
          670  +
          671  +proc ::sha1::sha1 {args} {
          672  +    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
          673  +    if {[llength $args] == 1} {
          674  +        set opts(-hex) 1
          675  +    } else {
          676  +        while {[string match -* [set option [lindex $args 0]]]} {
          677  +            switch -glob -- $option {
          678  +                -hex       { set opts(-hex) 1 }
          679  +                -bin       { set opts(-hex) 0 }
          680  +                -file*     { set opts(-filename) [Pop args 1] }
          681  +                -channel   { set opts(-channel) [Pop args 1] }
          682  +                -chunksize { set opts(-chunksize) [Pop args 1] }
          683  +                default {
          684  +                    if {[llength $args] == 1} { break }
          685  +                    if {[string compare $option "--"] == 0} { Pop args; break }
          686  +                    set err [join [lsort [concat -bin [array names opts]]] ", "]
          687  +                    return -code error "bad option $option:\
          688  +                    must be one of $err"
          689  +                }
          690  +            }
          691  +            Pop args
          692  +        }
          693  +    }
          694  +
          695  +    if {$opts(-filename) != {}} {
          696  +        set opts(-channel) [open $opts(-filename) r]
          697  +        fconfigure $opts(-channel) -translation binary
          698  +    }
          699  +
          700  +    if {$opts(-channel) == {}} {
          701  +
          702  +        if {[llength $args] != 1} {
          703  +            return -code error "wrong # args:\
          704  +                should be \"sha1 ?-hex? -filename file | string\""
          705  +        }
          706  +        set tok [SHA1Init]
          707  +        SHA1Update $tok [lindex $args 0]
          708  +        set r [SHA1Final $tok]
          709  +
          710  +    } else {
          711  +
          712  +        set tok [SHA1Init]
          713  +        # FRINK: nocheck
          714  +        set [subst $tok](reading) 1
          715  +        fileevent $opts(-channel) readable \
          716  +            [list [namespace origin Chunk] \
          717  +                 $tok $opts(-channel) $opts(-chunksize)]
          718  +        # FRINK: nocheck
          719  +        vwait [subst $tok](reading)
          720  +        set r [SHA1Final $tok]
          721  +
          722  +        # If we opened the channel - we should close it too.
          723  +        if {$opts(-filename) != {}} {
          724  +            close $opts(-channel)
          725  +        }
          726  +    }
          727  +    
          728  +    if {$opts(-hex)} {
          729  +        set r [Hex $r]
          730  +    }
          731  +    return $r
          732  +}
          733  +
          734  +# -------------------------------------------------------------------------
          735  +
          736  +proc ::sha1::hmac {args} {
          737  +    array set opts {-hex 1 -filename {} -channel {} -chunksize 4096}
          738  +    if {[llength $args] != 2} {
          739  +        while {[string match -* [set option [lindex $args 0]]]} {
          740  +            switch -glob -- $option {
          741  +                -key       { set opts(-key) [Pop args 1] }
          742  +                -hex       { set opts(-hex) 1 }
          743  +                -bin       { set opts(-hex) 0 }
          744  +                -file*     { set opts(-filename) [Pop args 1] }
          745  +                -channel   { set opts(-channel) [Pop args 1] }
          746  +                -chunksize { set opts(-chunksize) [Pop args 1] }
          747  +                default {
          748  +                    if {[llength $args] == 1} { break }
          749  +                    if {[string compare $option "--"] == 0} { Pop args; break }
          750  +                    set err [join [lsort [array names opts]] ", "]
          751  +                    return -code error "bad option $option:\
          752  +                    must be one of $err"
          753  +                }
          754  +            }
          755  +            Pop args
          756  +        }
          757  +    }
          758  +
          759  +    if {[llength $args] == 2} {
          760  +        set opts(-key) [Pop args]
          761  +    }
          762  +
          763  +    if {![info exists opts(-key)]} {
          764  +        return -code error "wrong # args:\
          765  +            should be \"hmac ?-hex? -key key -filename file | string\""
          766  +    }
          767  +
          768  +    if {$opts(-filename) != {}} {
          769  +        set opts(-channel) [open $opts(-filename) r]
          770  +        fconfigure $opts(-channel) -translation binary
          771  +    }
          772  +
          773  +    if {$opts(-channel) == {}} {
          774  +
          775  +        if {[llength $args] != 1} {
          776  +            return -code error "wrong # args:\
          777  +                should be \"hmac ?-hex? -key key -filename file | string\""
          778  +        }
          779  +        set tok [HMACInit $opts(-key)]
          780  +        HMACUpdate $tok [lindex $args 0]
          781  +        set r [HMACFinal $tok]
          782  +
          783  +    } else {
          784  +
          785  +        set tok [HMACInit $opts(-key)]
          786  +        # FRINK: nocheck
          787  +        set [subst $tok](reading) 1
          788  +        fileevent $opts(-channel) readable \
          789  +            [list [namespace origin Chunk] \
          790  +                 $tok $opts(-channel) $opts(-chunksize)]
          791  +        # FRINK: nocheck
          792  +        vwait [subst $tok](reading)
          793  +        set r [HMACFinal $tok]
          794  +
          795  +        # If we opened the channel - we should close it too.
          796  +        if {$opts(-filename) != {}} {
          797  +            close $opts(-channel)
          798  +        }
          799  +    }
          800  +    
          801  +    if {$opts(-hex)} {
          802  +        set r [Hex $r]
          803  +    }
          804  +    return $r
          805  +}
          806  +
          807  +# -------------------------------------------------------------------------
          808  +
          809  +# Try and load a compiled extension to help.
          810  +namespace eval ::sha1 {
          811  +    variable e {}
          812  +    foreach e [KnownImplementations] {
          813  +	if {[LoadAccelerator $e]} {
          814  +	    SwitchTo $e
          815  +	    break
          816  +	}
          817  +    }
          818  +    unset e
          819  +}
          820  +
          821  +package provide sha1 $::sha1::version
          822  +
          823  +# -------------------------------------------------------------------------
          824  +# Local Variables:
          825  +#   mode: tcl
          826  +#   indent-tabs-mode: nil
          827  +# End:

Added build/web/process_queue version [7bb2a1b520].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +set queue "/home/rkeene/devel/kitcreator/build/web/queue"
            4  +set outdir "/web/customers/kitcreator.rkeene.org/kits"
            5  +
            6  +if {![file exists "${queue}.old"]} {
            7  +	if {![file exists $queue]} {
            8  +		exit 0
            9  +	}
           10  +
           11  +	file rename "$queue" "${queue}.old"
           12  +}
           13  +set queue "${queue}.old"
           14  +
           15  +set fd [open $queue r]
           16  +set data [read $fd]
           17  +close $fd
           18  +
           19  +foreach line [split $data "\n"] {
           20  +	if {$line == ""} {
           21  +		continue
           22  +	}
           23  +
           24  +	unset -nocomplain buildinfo
           25  +
           26  +	array set buildinfo $line
           27  +
           28  +	set outfile [file join $outdir $buildinfo(key) $buildinfo(filename)]
           29  +
           30  +	# Skip if build completed
           31  +	if {[file exists $outfile]} {
           32  +		continue
           33  +	}
           34  +
           35  +	# Skip if build failed
           36  +	if {[file exists $outfile.buildfail]} {
           37  +		continue
           38  +	}
           39  +
           40  +	set workdir [file join $outdir $buildinfo(key) build]
           41  +	file delete -force $workdir
           42  +	file mkdir $workdir
           43  +	cd $workdir
           44  +
           45  +	set fd [open ../filename w]
           46  +	puts $fd $buildinfo(filename)
           47  +	close $fd
           48  +
           49  +	set tarball kitcreator-${buildinfo(kitcreator_version)}.tar.gz
           50  +	exec wget -q -O $tarball http://kitcreator.rkeene.org/fossil/tarball/${tarball}?uuid=${buildinfo(kitcreator_version)}
           51  +	exec gzip -dc $tarball | tar -xf -
           52  +	cd kitcreator-${buildinfo(kitcreator_version)}
           53  +
           54  +	set script "./build/make-kit-${buildinfo(platform)}"
           55  +	set args [list]
           56  +
           57  +	set ::env(KITCREATOR_PKGS) " [join $buildinfo(packages) " "] "
           58  +
           59  +	foreach {option value} $buildinfo(options) {
           60  +		switch -- $option {
           61  +			"kitdll" {
           62  +				if {$value} {
           63  +					set ::env(KITCREATOR_PKGS) "$::env(KITCREATOR_PKGS) kitdll"
           64  +				}
           65  +			}
           66  +			"threaded" {
           67  +				if {$value} {
           68  +					lappend args "--enable-threads"
           69  +				}
           70  +			}
           71  +		}
           72  +	}
           73  +
           74  +	catch {
           75  +		exec ./build/pre.sh
           76  +	}
           77  +
           78  +	catch {
           79  +		exec $script $buildinfo(tcl_version) {*}$args > "${outfile}.log" 2>@1
           80  +	}
           81  +
           82  +	catch {
           83  +		exec grep ^ {*}[glob */build.log] >> "${outfile}.log"
           84  +	}
           85  +
           86  +	foreach file [list tclkit-$buildinfo(tcl_version) {*}[glob -nocomplain libtclkit*]] {
           87  +		switch -glob -- $file {
           88  +			"*.dylib" - "*.so" - "*.sl" - "*.dll" { }
           89  +			"tclkit-*" {}
           90  +			default {
           91  +				continue
           92  +			}
           93  +		}
           94  +
           95  +		if {[file exists $file]} {
           96  +			file rename $file $outfile
           97  +
           98  +			break
           99  +		}
          100  +	}
          101  +
          102  +	if {![file exists $outfile]} {
          103  +		set fd [open $outfile.buildfail "w+"]
          104  +		puts $fd "$line"
          105  +		close $fd
          106  +	}
          107  +
          108  +	cd $outdir
          109  +
          110  +	file delete -force $workdir
          111  +}
          112  +
          113  +file delete $queue
          114  +
          115  +exit 0