diff options
| author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
|---|---|---|
| committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
| commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
| tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/crc | |
| parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
| parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
| download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 | |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/crc')
24 files changed, 3268 insertions, 0 deletions
diff --git a/tcllib/modules/crc/ChangeLog b/tcllib/modules/crc/ChangeLog new file mode 100644 index 0000000..7599b36 --- /dev/null +++ b/tcllib/modules/crc/ChangeLog @@ -0,0 +1,321 @@ +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2012-01-23 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc16: bug #3477684: handle data with leading hyphen. + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2009-05-07 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sum.tcl: Fixed poor idiom setting interp result. + +2009-05-06 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.tcl: Remove unecessary read-type from Trf implementation + and tidied the critcl code a little. Bump to 1.3.1. + +2009-04-21 Andreas Kupries <andreask@activestate.com> + + * cksum.tcl (::crc::CksumFinal): Added the missing 'unset state' + * cksum.man: command which caused the memory leak reported by Phil + * pkgIndex.tcl: Dietz <pedietz@users.sourceforge.net> as + [Bug 2686560]. Bumped version to 1.1.3. + +2009-03-04 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.man: Add note on feeding crc32 values in as -seed. + * crc32.test: Tests to ensure -seed usage is as expected. + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2008-06-14 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * cksum.pcx: New files. Syntax definitions for the public + * crc16.pcx: commands of the various crc packages. + * crc32.pcx: + * sum.pcx: + +2008-04-11 Andreas Kupries <andreask@activestate.com> + + * crc16.man: Marked name of crc32 up as package. + +2008-04-08 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc16.man: document the xmodem command (bug #1895277) + +2008-03-09 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * cksum.tcl (::crc::cksum): Fixed handling of options -chunksize + * cksum.man: and -channel. Bumped version of cksum to 1.1.2. + * pkgIndex.tcl + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sum.man: Fixed all warnings due to use of now deprecated + * cksum.man: commands. Added a section about how to give feedback. + * crc16.man: + * crc32.man: + +2006-11-04 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crcc.tcl: Silence critcl warning. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-09-19 Andreas Kupries <andreask@activestate.com> + + * cksum.tcl: Bumped version to 1.1.1 + * cksum.man: + * pkgIndex.tcl: + +2006-06-29 Aaron Faupell <afaupell@users.sourceforge.net> + + * cksum.tcl: fixed typo koin->join + +2006-01-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * cksum.test: More boilerplate simplified via use of test support. + * crc16.test: + * crc32.test: + * crc32bugs.test: + * sum.test: + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * cksum.test: Hooked into the new common test support code. + * crc16.test: + * crc32.test: + * crc32bugs.test: + * sum.test: + +2005-10-24 Andreas Kupries <andreask@activestate.com> + + * cksum.bench: New files. Basic benchmark tests + * crc16.bench: of the crc and derived commands. + * crc32.bench: + * sum.bench: + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-08-26 Andreas Kupries <andreask@activestate.com> + + * crc16.tcl: Accepted Don Porter's patch attached to [Tcllib SF + * crc32.tcl: Bug 1274120], fixing the creative-writing problem for + variable v and restricting the value to 32bit ints. Additionally + added an [unset v] after the initialization, as the variable is + not needed beyond that part of the code. + +2005-08-25 Andreas Kupries <andreask@activestate.com> + + * crc32.tcl (::crc::Crc32Final): Restrict result of Trf to 32bit + range, or the [format] at the end of crc32 will blow this up + into a 64bit number. This is an additional fix for [Tcllib SF + Bug 1042420]. + +2005-03-12 Pat Thoyts <patthoyts@users.sourceforge.net> + + * cksum.tcl: Refactored to use a context for better support of + * cksum.man: summing data in chunks. Updated man page and + * cksum.test: tests. Set version to 1.1.0 + + * crc32.tcl: Refactored the package to use a context structure + * crc32.man: as done for the hash modules. This makes it easier + * crc32.test: to work which chunks and event systems. We now + * crc32bugs.test: can support Trf for chunking too and have properly + hooked up the critcl code. Tests now test all + available implementations. + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * crc32.tcl: Updated version number to sync with 1.6.1 + * crc32.man: release. + * pkgIndex.tcl: + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * crc32.tcl: Rel. engineering. Updated version number + * crc32.man: of crc32 to reflect its changes, to 1.1.1. + * pkgIndex.tcl: + +2004-04-01 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.tcl: Cope with data begining with hyphen when using + Trf (SF bug #914278) + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2003-05-27 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc16.tcl: Added XMODEM CRC algorithm - as used in the + XMODEM-CRC protocol. (Simple XMODEM uses a SysV type checksum). + Also added a -channel option to the crc command. + +2003-05-09 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crcc.tcl: Added placeholder to get a module library for all the + critcl code segments from the crc module + * crc32.tcl: Added -channel option + * crc32.test: + * crc32bugs.test: Tidied up the tests + * sum.tcl: Refactored the code to permit chunking and reading from + a channel. Added critcl-dependent C code implementations. + * sum.test: Added new tests and generally tidied up. + * sum.man: Added new items to the documentation. + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-02 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.test: Fix for bug #709375 - test failures for bigEndian + systems when using Trf crc-zlib. + * crc32bugs.test: Additional test file used to isolate byte + ordering problems. + +2003-02-11 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.man, cksum.man, crc16.man, crc32.man: Added the new + copyright markup to the doctools pages. + * crc32.tcl: Enforce 32 bit calculations. + +2003-02-02 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc16.tcl: Fixed a bug in the option handling error info. + +2003-01-25 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.tcl: + * cksum.tcl: + * crc16.tcl: + * sum.tcl: Added tcl package requirement for 8.2+ and hiked + versions to 1.0.1 + +2003-01-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * crc32.man: More semantic markup, less visual one. + * cksum.man: + * sum.man: + +2003-01-07 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.test: Fixed another 8.3 - 8.4 wide integer problem. + +2003-01-06 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc16.tcl: Fix for bug #620612: the crc16 CRC calculation failed + for 32 bit CRC widths for tcl < 8.4. Masked off high bits after shift + +2003-01-03 Pat Thoyts <patthoyts@users.sourceforge.net> + + * cksum.tcl: Enabled processing in chunks to reduce memory + consumption. + +2002-09-26 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.tcl: Fix to SF bug #579026: implementing file processing + in small chunks to reduce memory usage. + +2002-01-23 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc16.tcl, crc16.test, crc16.man: Added CRC16 package + +2002-01-23 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.test, sum.test, cksum.test: Fixed SF bug #507242: failing + tests when running 'make test' + +2002-01-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.n: formatting fixes + * sum.n: added new manual page for package sum + +2002-01-16 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.tcl: added -seed and -implementation options. + * crc32.n: updated for the -seed and -impl options + * crc32.test: added tests for the -seed and -impl options. + +2002-01-15 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sum.tcl: initial version of crc::sum command + * sum.test: initial version of crc::sum command tests + * cksum.tcl: intial version of crc::cksum command + * cksum.n: initial version of crc::cksum manual page + * cksum.test: initial version of crc::cksum command tests + * crc32.tcl: compatability with sum and cksum commands + * crc32.test: compatability with sum and cksum tests + * crc32.n: compatability with sum and cksum manuals + +2002-01-11 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.tcl: implemented usage of Trf crc-zlib if available. + +2002-01-09 Pat Thoyts <patthoyts@users.sourceforge.net> + + * crc32.tcl: initial version modified from the Wiki source. + * crc32.n: initial version of man page + * crc32.test: initial version of crc32 tests. diff --git a/tcllib/modules/crc/cksum.bench b/tcllib/modules/crc/cksum.bench new file mode 100644 index 0000000..9a4c73b --- /dev/null +++ b/tcllib/modules/crc/cksum.bench @@ -0,0 +1,38 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'crc32' module. +# This allow developers to monitor/gauge/track package performance. +# +# (c) 2005 Andreas Kupries <andreas_kupries@users.sourceforge.net> + +# We need at least version 8.2 for the package and thus the +# benchmarks. + +if {![package vsatisfies [package provide Tcl] 8.2]} { + return +} + +# ### ### ### ######### ######### ######### ########################### +## Setting up the environment ... + +set moddir [file dirname [file dirname [info script]]] +lappend auto_path $moddir + +package forget cksum +catch {namespace delete ::crc} +source [file join [file dirname [info script]] cksum.tcl] + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "CKSUM $n" -pre { + set str [string repeat " " $n] + } -body { + crc::cksum $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/crc/cksum.man b/tcllib/modules/crc/cksum.man new file mode 100644 index 0000000..fd55a04 --- /dev/null +++ b/tcllib/modules/crc/cksum.man @@ -0,0 +1,131 @@ +[vset CKSUM_VERSION 1.1.4] +[manpage_begin cksum n [vset CKSUM_VERSION]] +[see_also crc32(n)] +[see_also sum(n)] +[keywords checksum] +[keywords cksum] +[keywords crc] +[keywords crc32] +[keywords {cyclic redundancy check}] +[keywords {data integrity}] +[keywords security] +[copyright {2002, Pat Thoyts}] +[moddesc {Cyclic Redundancy Checks}] +[titledesc {Calculate a cksum(1) compatible checksum}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require cksum [opt [vset CKSUM_VERSION]]] +[description] +[para] + +This package provides a Tcl implementation of the cksum(1) algorithm +based upon information provided at in the GNU implementation of this +program as part of the GNU Textutils 2.0 package. + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd "::crc::cksum"] \ + [opt [arg "-format format"]] \ + [opt [arg "-chunksize size"]] \ + [lb] [arg "-channel chan"] | \ + [arg "-filename file"] | [arg "string" ] [rb]] + +The command takes string data or a channel or file name and returns a +checksum value calculated using the [syscmd cksum(1)] algorithm. The +result is formatted using the [arg format](n) specifier provided or as +an unsigned integer (%u) by default. + +[list_end] + +[section OPTIONS] + +[list_begin definitions] + +[def "-channel [arg name]"] + +Return a checksum for the data read from a channel. The command will +read data from the channel until the [cmd "eof"] is true. If you need +to be able to process events during this calculation see the +[sectref {PROGRAMMING INTERFACE}] section + +[def "-filename [arg name]"] + +This is a convenience option that opens the specified file, sets the +encoding to binary and then acts as if the [arg -channel] option had +been used. The file is closed on completion. + +[def "-format [arg string]"] + +Return the checksum using an alternative format template. + +[list_end] + +[section {PROGRAMMING INTERFACE}] + +The cksum package implements the checksum using a context variable to +which additional data can be added at any time. This is expecially +useful in an event based environment such as a Tk application or a web +server package. Data to be checksummed may be handled incrementally +during a [cmd fileevent] handler in discrete chunks. This can improve +the interactive nature of a GUI application and can help to avoid +excessive memory consumption. + +[list_begin definitions] + +[call [cmd "::crc::CksumInit"]] + +Begins a new cksum context. Returns a token ID that must be used for the +remaining functions. An optional seed may be specified if required. + +[call [cmd "::crc::CksumUpdate"] [arg "token"] [arg "data"]] + +Add data to the checksum identified by token. Calling +[emph {CksumUpdate $token "abcd"}] is equivalent to calling +[emph {CksumUpdate $token "ab"}] followed by +[emph {CksumUpdate $token "cb"}]. See [sectref {EXAMPLES}]. + +[call [cmd "::crc::CksumFinal"] [arg "token"]] + +Returns the checksum value and releases any resources held by this +token. Once this command completes the token will be invalid. The +result is a 32 bit integer value. + +[list_end] + +[section EXAMPLES] + +[para] +[example { +% crc::cksum "Hello, World!" +2609532967 +}] + +[para] +[example { +% crc::cksum -format 0x%X "Hello, World!" +0x9B8A5027 +}] + +[para] +[example { +% crc::cksum -file cksum.tcl +1828321145 +}] + +[para] +[example { +% set tok [crc::CksumInit] +% crc::CksumUpdate $tok "Hello, " +% crc::CksumUpdate $tok "World!" +% crc::CksumFinal $tok +2609532967 +}] + +[section AUTHORS] +Pat Thoyts + +[vset CATEGORY crc] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/crc/cksum.pcx b/tcllib/modules/crc/cksum.pcx new file mode 100644 index 0000000..a93f83c --- /dev/null +++ b/tcllib/modules/crc/cksum.pcx @@ -0,0 +1,37 @@ +# -*- tcl -*- cksum.pcx +# Syntax of the commands provided by package cksum. + +# For use by TclDevKit's static syntax checker. +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the documentation describing the format of the code contained in this file +# + +package require pcx +pcx::register cksum +pcx::tcldep 1.1.1 needs tcl 8.2 + +namespace eval ::cksum {} + +#pcx::message FOO {... text ...} type +#pcx::scan <VERSION> <NAME> <RULE> + +pcx::check 1.1.1 std ::crc::cksum \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-command {checkProcCall 0}} + {-timeout checkWholeNum} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} + +# Initialization via pcx::init. +# Use a ::cksum::init procedure for non-standard initialization. +pcx::complete diff --git a/tcllib/modules/crc/cksum.tcl b/tcllib/modules/crc/cksum.tcl new file mode 100644 index 0000000..6ff4e51 --- /dev/null +++ b/tcllib/modules/crc/cksum.tcl @@ -0,0 +1,200 @@ +# cksum.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Provides a Tcl only implementation of the unix cksum(1) command. This is +# similar to the sum(1) command but the algorithm is better defined and +# standardized across multiple platforms by POSIX 1003.2/D11.2 +# +# This command has been verified against the cksum command from the GNU +# textutils package version 2.0 +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +package require Tcl 8.2; # tcl minimum version + +namespace eval ::crc { + namespace export cksum + + variable cksum_tbl [list 0x0 \ + 0x04C11DB7 0x09823B6E 0x0D4326D9 0x130476DC 0x17C56B6B \ + 0x1A864DB2 0x1E475005 0x2608EDB8 0x22C9F00F 0x2F8AD6D6 \ + 0x2B4BCB61 0x350C9B64 0x31CD86D3 0x3C8EA00A 0x384FBDBD \ + 0x4C11DB70 0x48D0C6C7 0x4593E01E 0x4152FDA9 0x5F15ADAC \ + 0x5BD4B01B 0x569796C2 0x52568B75 0x6A1936C8 0x6ED82B7F \ + 0x639B0DA6 0x675A1011 0x791D4014 0x7DDC5DA3 0x709F7B7A \ + 0x745E66CD 0x9823B6E0 0x9CE2AB57 0x91A18D8E 0x95609039 \ + 0x8B27C03C 0x8FE6DD8B 0x82A5FB52 0x8664E6E5 0xBE2B5B58 \ + 0xBAEA46EF 0xB7A96036 0xB3687D81 0xAD2F2D84 0xA9EE3033 \ + 0xA4AD16EA 0xA06C0B5D 0xD4326D90 0xD0F37027 0xDDB056FE \ + 0xD9714B49 0xC7361B4C 0xC3F706FB 0xCEB42022 0xCA753D95 \ + 0xF23A8028 0xF6FB9D9F 0xFBB8BB46 0xFF79A6F1 0xE13EF6F4 \ + 0xE5FFEB43 0xE8BCCD9A 0xEC7DD02D 0x34867077 0x30476DC0 \ + 0x3D044B19 0x39C556AE 0x278206AB 0x23431B1C 0x2E003DC5 \ + 0x2AC12072 0x128E9DCF 0x164F8078 0x1B0CA6A1 0x1FCDBB16 \ + 0x018AEB13 0x054BF6A4 0x0808D07D 0x0CC9CDCA 0x7897AB07 \ + 0x7C56B6B0 0x71159069 0x75D48DDE 0x6B93DDDB 0x6F52C06C \ + 0x6211E6B5 0x66D0FB02 0x5E9F46BF 0x5A5E5B08 0x571D7DD1 \ + 0x53DC6066 0x4D9B3063 0x495A2DD4 0x44190B0D 0x40D816BA \ + 0xACA5C697 0xA864DB20 0xA527FDF9 0xA1E6E04E 0xBFA1B04B \ + 0xBB60ADFC 0xB6238B25 0xB2E29692 0x8AAD2B2F 0x8E6C3698 \ + 0x832F1041 0x87EE0DF6 0x99A95DF3 0x9D684044 0x902B669D \ + 0x94EA7B2A 0xE0B41DE7 0xE4750050 0xE9362689 0xEDF73B3E \ + 0xF3B06B3B 0xF771768C 0xFA325055 0xFEF34DE2 0xC6BCF05F \ + 0xC27DEDE8 0xCF3ECB31 0xCBFFD686 0xD5B88683 0xD1799B34 \ + 0xDC3ABDED 0xD8FBA05A 0x690CE0EE 0x6DCDFD59 0x608EDB80 \ + 0x644FC637 0x7A089632 0x7EC98B85 0x738AAD5C 0x774BB0EB \ + 0x4F040D56 0x4BC510E1 0x46863638 0x42472B8F 0x5C007B8A \ + 0x58C1663D 0x558240E4 0x51435D53 0x251D3B9E 0x21DC2629 \ + 0x2C9F00F0 0x285E1D47 0x36194D42 0x32D850F5 0x3F9B762C \ + 0x3B5A6B9B 0x0315D626 0x07D4CB91 0x0A97ED48 0x0E56F0FF \ + 0x1011A0FA 0x14D0BD4D 0x19939B94 0x1D528623 0xF12F560E \ + 0xF5EE4BB9 0xF8AD6D60 0xFC6C70D7 0xE22B20D2 0xE6EA3D65 \ + 0xEBA91BBC 0xEF68060B 0xD727BBB6 0xD3E6A601 0xDEA580D8 \ + 0xDA649D6F 0xC423CD6A 0xC0E2D0DD 0xCDA1F604 0xC960EBB3 \ + 0xBD3E8D7E 0xB9FF90C9 0xB4BCB610 0xB07DABA7 0xAE3AFBA2 \ + 0xAAFBE615 0xA7B8C0CC 0xA379DD7B 0x9B3660C6 0x9FF77D71 \ + 0x92B45BA8 0x9675461F 0x8832161A 0x8CF30BAD 0x81B02D74 \ + 0x857130C3 0x5D8A9099 0x594B8D2E 0x5408ABF7 0x50C9B640 \ + 0x4E8EE645 0x4A4FFBF2 0x470CDD2B 0x43CDC09C 0x7B827D21 \ + 0x7F436096 0x7200464F 0x76C15BF8 0x68860BFD 0x6C47164A \ + 0x61043093 0x65C52D24 0x119B4BE9 0x155A565E 0x18197087 \ + 0x1CD86D30 0x029F3D35 0x065E2082 0x0B1D065B 0x0FDC1BEC \ + 0x3793A651 0x3352BBE6 0x3E119D3F 0x3AD08088 0x2497D08D \ + 0x2056CD3A 0x2D15EBE3 0x29D4F654 0xC5A92679 0xC1683BCE \ + 0xCC2B1D17 0xC8EA00A0 0xD6AD50A5 0xD26C4D12 0xDF2F6BCB \ + 0xDBEE767C 0xE3A1CBC1 0xE760D676 0xEA23F0AF 0xEEE2ED18 \ + 0xF0A5BD1D 0xF464A0AA 0xF9278673 0xFDE69BC4 0x89B8FD09 \ + 0x8D79E0BE 0x803AC667 0x84FBDBD0 0x9ABC8BD5 0x9E7D9662 \ + 0x933EB0BB 0x97FFAD0C 0xAFB010B1 0xAB710D06 0xA6322BDF \ + 0xA2F33668 0xBCB4666D 0xB8757BDA 0xB5365D03 0xB1F740B4 ] + + variable uid + if {![info exists uid]} {set uid 0} +} + +# crc::CksumInit -- +# +# Create and initialize a cksum context. This is cleaned up when we +# call CksumFinal to obtain the result. +# +proc ::crc::CksumInit {} { + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token state + array set state {t 0 l 0} + return $token +} + +proc ::crc::CksumUpdate {token data} { + variable cksum_tbl + upvar #0 $token state + set t $state(t) + binary scan $data c* r + foreach {n} $r { + set index [expr { (($t >> 24) ^ ($n & 0xFF)) & 0xFF }] + # Since the introduction of built-in bigInt support with Tcl + # 8.5, bit-shifting $t to the left no longer overflows, + # keeping it 32 bits long. The value grows bigger and bigger + # instead - a severe hit on performance. For this reason we + # do a bitwise AND against 0xFFFFFFFF at each step to keep the + # value within limits. + set t [expr {0xFFFFFFFF & (($t << 8) ^ [lindex $cksum_tbl $index])}] + incr state(l) + } + set state(t) $t + return +} + +proc ::crc::CksumFinal {token} { + variable cksum_tbl + upvar #0 $token state + set t $state(t) + for {set i $state(l)} {$i > 0} {set i [expr {$i>>8}]} { + set index [expr {(($t >> 24) ^ $i) & 0xFF}] + set t [expr {0xFFFFFFFF & (($t << 8) ^ [lindex $cksum_tbl $index])}] + } + unset state + return [expr {~$t & 0xFFFFFFFF}] +} + +# crc::Pop -- +# +# Pop the nth element off a list. Used in options processing. +# +proc ::crc::Pop {varname {nth 0}} { + upvar $varname args + set r [lindex $args $nth] + set args [lreplace $args $nth $nth] + return $r +} + +# Description: +# Provide a Tcl equivalent of the unix cksum(1) command. +# Options: +# -filename name - return a checksum for the specified file. +# -format string - return the checksum using this format string. +# -chunksize size - set the chunking read size +# +proc ::crc::cksum {args} { + array set opts [list -filename {} -channel {} -chunksize 4096 \ + -format %u -command {}] + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -file* { set opts(-filename) [Pop args 1] } + -chan* { set opts(-channel) [Pop args 1] } + -chunk* { set opts(-chunksize) [Pop args 1] } + -for* { set opts(-format) [Pop args 1] } + -command { set opts(-command) [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 $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\ + cksum ?-format string?\ + -channel chan | -filename file | string" + } + set tok [CksumInit] + CksumUpdate $tok [lindex $args 0] + set r [CksumFinal $tok] + + } else { + + set tok [CksumInit] + while {![eof $opts(-channel)]} { + CksumUpdate $tok [read $opts(-channel) $opts(-chunksize)] + } + set r [CksumFinal $tok] + + if {$opts(-filename) != {}} { + close $opts(-channel) + } + } + + return [format $opts(-format) $r] +} + +# ------------------------------------------------------------------------- + +package provide cksum 1.1.4 + +# ------------------------------------------------------------------------- +# Local variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/cksum.test b/tcllib/modules/crc/cksum.test new file mode 100644 index 0000000..a0cf03a --- /dev/null +++ b/tcllib/modules/crc/cksum.test @@ -0,0 +1,111 @@ +# cksum.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Tests for the Tcllib cksum command +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# RCS: @(#) $Id: cksum.test,v 1.7 2006/10/09 21:41:40 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.2 +testsNeedTcltest 1.0 + +testing { + useLocal cksum.tcl cksum ::crc +} + +# ------------------------------------------------------------------------- + +test cksum-1.0 {cksum with no parameters } { + catch {::crc::cksum} result + set result +} {wrong # args: should be cksum ?-format string? -channel chan | -filename file | string} + +# ------------------------------------------------------------------------- + +foreach {n msg expected} { + 1 "" + "4294967295" + 2 "a" + "1220704766" + 3 "abc" + "1219131554" + 4 "message digest" + "3644109718" + 5 "abcdefghijklmnopqrstuvwxyz" + "2713270184" + 6 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "81918263" + 7 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "1939911592" + 8 "\uFFFE\u0000\u0001\u0002" + "893385333" +} { + test cksum-2.$n {cksum and unsigned integer} { + ::crc::cksum $msg + } $expected +} + +# ------------------------------------------------------------------------- + +foreach {n msg expected} { + 1 "" + "0xFFFFFFFF" + 2 "a" + "0x48C279FE" + 3 "abc" + "0x48AA78A2" + 4 "message digest" + "0xD934B396" + 5 "abcdefghijklmnopqrstuvwxyz" + "0xA1B937A8" + 6 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "0x4E1F937" + 7 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "0x73A0B3A8" + 8 "\uFFFE\u0000\u0001\u0002" + "0x353FFA75" +} { + test cksum-3.$n {cksum as hexadecimal string} { + ::crc::cksum -format 0x%X $msg + } $expected +} + +# ------------------------------------------------------------------------- + +set crc::testfile [info script] + +proc crc::loaddata {filename} { + set f [open $filename r] + fconfigure $f -translation binary + set data [read $f] + close $f + return $data +} + +test cksum-4.0 {cksum file option} { + set r1 [crc::cksum -file $crc::testfile] + set r2 [crc::cksum [crc::loaddata $crc::testfile]] + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } +} {ok} + +# ------------------------------------------------------------------------- + +catch {unset crc::testfile} +testsuiteCleanup + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/crc16.bench b/tcllib/modules/crc/crc16.bench new file mode 100644 index 0000000..8365b0f --- /dev/null +++ b/tcllib/modules/crc/crc16.bench @@ -0,0 +1,38 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'crc16' module. +# This allow developers to monitor/gauge/track package performance. +# +# (c) 2005 Andreas Kupries <andreas_kupries@users.sourceforge.net> + +# We need at least version 8.2 for the package and thus the +# benchmarks. + +if {![package vsatisfies [package provide Tcl] 8.2]} { + return +} + +# ### ### ### ######### ######### ######### ########################### +## Setting up the environment ... + +set moddir [file dirname [file dirname [info script]]] +lappend auto_path $moddir + +package forget crc16 +catch {namespace delete ::crc} +source [file join [file dirname [info script]] crc16.tcl] + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "CRC16 $n" -pre { + set str [string repeat " " $n] + } -body { + crc::crc16 $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/crc/crc16.man b/tcllib/modules/crc/crc16.man new file mode 100644 index 0000000..b6bbce0 --- /dev/null +++ b/tcllib/modules/crc/crc16.man @@ -0,0 +1,142 @@ +[manpage_begin crc16 n 1.1.2] +[see_also cksum(n)] +[see_also crc32(n)] +[see_also sum(n)] +[keywords checksum] +[keywords cksum] +[keywords crc] +[keywords crc16] +[keywords crc32] +[keywords {cyclic redundancy check}] +[keywords {data integrity}] +[keywords security] +[copyright {2002, Pat Thoyts}] +[moddesc {Cyclic Redundancy Checks}] +[titledesc {Perform a 16bit Cyclic Redundancy Check}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require crc16 [opt 1.1.2]] +[description] +[para] + +This package provides a Tcl-only implementation of the CRC +algorithms based upon information provided at +http://www.microconsultants.com/tips/crc/crc.txt + +There are a number of permutations available for calculating CRC +checksums and this package can handle all of them. Defaults are set up +for the most common cases. + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd ::crc::crc16] [opt "-format [arg format]"] \ + [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] [arg message]] +[call [cmd ::crc::crc16] [opt "-format [arg format]"] \ + [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] "-filename [arg file]"] +[call [cmd ::crc::crc-ccitt] [opt "-format [arg format]"] \ + [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] [arg message]] +[call [cmd ::crc::crc-ccitt] [opt "-format [arg format]"] \ + [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] "-filename [arg file]"] +[call [cmd ::crc::xmodem] [opt "-format [arg format]"] \ + [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] [arg message]] +[call [cmd ::crc::xmodem] [opt "-format [arg format]"] \ + [opt "-seed [arg value]"] [opt "-implementation [arg procname]"] "-filename [arg file]"] + +The command takes either string data or a file name and returns a checksum +value calculated using the CRC algorithm. The command used sets up the +CRC polynomial, initial value and bit ordering for the desired +standard checksum calculation. The result is formatted +using the [arg format](n) specifier provided or as an unsigned integer +(%u) by default. + +[para] + +A number of common polynomials are in use with the CRC algorithm and +the most commonly used of these are included in this package. For +convenience each of these has a command alias in the crc namespace. + +[para] + +It is possible to implement the CRC-32 checksum using this crc16 +package as the implementation is sufficiently generic to extend to 32 +bit checksums. As an example this has been done already - however this +is not the fastest method to implement this algorithm in Tcl and a +separate [package crc32] package is available. + +[list_end] + +[section OPTIONS] + +[list_begin definitions] + +[def "-filename [arg name]"] + +Return a checksum for the file contents instead of for parameter data. + +[def "-format [arg string]"] + +Return the checksum using an alternative format template. + +[def "-seed [arg value]"] + +Select an alternative seed value for the CRC calculation. The default +is 0 for the CRC16 calculation and 0xFFFF for the CCITT version. +This can be useful for calculating the CRC for data +structures without first converting the whole structure into a +string. The CRC of the previous member can be used as the seed for +calculating the CRC of the next member. It is also used for +accumulating a checksum from fragments of a large message (or file) + +[def "-implementation [arg procname]"] + +This hook is provided to allow users to provide their own +implementation (perhaps a C compiled extension). The +procedure specfied is called with two parameters. The first is the +data to be checksummed and the second is the seed value. An +integer is expected as the result. +[para] +The package provides some implementations of standard CRC polynomials +for the XMODEM, CCITT and the usual CRC-16 checksum. For convenience, +additional commands have been provided that make use of these +implementations. + +[def "--"] + +Terminate option processing. + +[list_end] + +[section EXAMPLES] + +[para] +[example { +% crc::crc16 "Hello, World!" +64077 +}] + +[para] +[example { +% crc::crc-ccitt "Hello, World!" +26586 +}] + +[para] +[example { +% crc::crc16 -format 0x%X "Hello, World!" +0xFA4D +}] + +[para] +[example { +% crc::crc16 -file crc16.tcl +51675 +}] + +[section AUTHORS] +Pat Thoyts + +[vset CATEGORY crc] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/crc/crc16.pcx b/tcllib/modules/crc/crc16.pcx new file mode 100644 index 0000000..6006b39 --- /dev/null +++ b/tcllib/modules/crc/crc16.pcx @@ -0,0 +1,93 @@ +# -*- tcl -*- crc16.pcx +# Syntax of the commands provided by package crc16. + +# For use by TclDevKit's static syntax checker. +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the documentation describing the format of the code contained in this file +# + +package require pcx +pcx::register crc16 +pcx::tcldep 1.1.1 needs tcl 8.2 + +namespace eval ::crc16 {} + +#pcx::message FOO {... text ...} type +#pcx::scan <VERSION> <NAME> <RULE> + +pcx::check 1.1.1 std ::crc::crc \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-impl checkProcName} + {-seed checkWord} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} +pcx::check 1.1.1 std ::crc::crc-32 \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-seed checkWord} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} +pcx::check 1.1.1 std ::crc::crc-ccitt \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-seed checkWord} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} +pcx::check 1.1.1 std ::crc::crc16 \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-seed checkWord} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} +pcx::check 1.1.1 std ::crc::xmodem \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-seed checkWord} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} + +# Initialization via pcx::init. +# Use a ::crc16::init procedure for non-standard initialization. +pcx::complete diff --git a/tcllib/modules/crc/crc16.tcl b/tcllib/modules/crc/crc16.tcl new file mode 100644 index 0000000..d89375e --- /dev/null +++ b/tcllib/modules/crc/crc16.tcl @@ -0,0 +1,302 @@ +# crc16.tcl -- Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Cyclic Redundancy Check - this is a Tcl implementation of a general +# table-driven CRC implementation. This code should be able to generate +# the lookup table and implement the correct algorithm for most types +# of CRC. CRC-16, CRC-32 and the CCITT version of CRC-16. [1][2][3] +# Most transmission CRCs use the CCITT polynomial (including X.25, SDLC +# and Kermit). +# +# [1] http://www.microconsultants.com/tips/crc/crc.txt for the reference +# implementation +# [2] http://www.embedded.com/internet/0001/0001connect.htm +# for another good discussion of why things are the way they are. +# [3] "Numerical Recipes in C", Press WH et al. Chapter 20. +# +# Checks: a crc for the string "123456789" should give: +# CRC16: 0xBB3D +# CRC-CCITT: 0x29B1 +# XMODEM: 0x31C3 +# CRC-32: 0xCBF43926 +# +# eg: crc::crc16 "123456789" +# crc::crc-ccitt "123456789" +# or crc::crc16 -file tclsh.exe +# +# Note: +# The CCITT CRC can very easily be checked for the accuracy of transmission +# as the CRC of the message plus the CRC values will be 0. That is: +# % set msg {123456789] +# % set crc [crc::crc-ccitt $msg] +# % crc::crc-ccitt $msg[binary format S $crc] +# 0 +# +# The same is true of other CRCs but some operate in reverse bit order: +# % crc::crc16 $msg[binary format s [crc::crc16 $msg]] +# 0 +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +# @mdgen EXCLUDE: crcc.tcl + +package require Tcl 8.2; # tcl minimum version + +namespace eval ::crc { + namespace export crc16 crc-ccitt crc-32 + + # Standard CRC generator polynomials. + variable polynomial + set polynomial(crc16) [expr {(1<<16) | (1<<15) | (1<<2) | 1}] + set polynomial(ccitt) [expr {(1<<16) | (1<<12) | (1<<5) | 1}] + set polynomial(crc32) [expr {(1<<32) | (1<<26) | (1<<23) | (1<<22) + | (1<<16) | (1<<12) | (1<<11) | (1<<10) + | (1<<8) | (1<<7) | (1<<5) | (1<<4) + | (1<<2) | (1<<1) | 1}] + + # Array to hold the generated tables + variable table + if {![info exists table]} { array set table {}} + + # calculate the sign bit for the current platform. + variable signbit + if {![info exists signbit]} { + variable v + for {set v 1} {int($v) != 0} {set signbit $v; set v [expr {$v<<1}]} {} + unset v + } +} + +# ------------------------------------------------------------------------- +# Generate a CRC lookup table. +# This creates a CRC algorithm lookup table for a 'width' bits checksum +# using the 'poly' polynomial for all values of an input byte. +# Setting 'reflected' changes the bit order for input bytes. +# Returns a list or 255 elements. +# +# CRC-32: Crc_table 32 $crc::polynomial(crc32) 1 +# CRC-16: Crc_table 16 $crc::polynomial(crc16) 1 +# CRC16/CCITT: Crc_table 16 $crc::polynomial(ccitt) 0 +# +proc ::crc::Crc_table {width poly reflected} { + set tbl {} + if {$width < 32} { + set mask [expr {(1 << $width) - 1}] + set topbit [expr {1 << ($width - 1)}] + } else { + set mask 0xffffffff + set topbit 0x80000000 + } + + for {set i 0} {$i < 256} {incr i} { + if {$reflected} { + set r [reflect $i 8] + } else { + set r $i + } + set r [expr {$r << ($width - 8)}] + for {set k 0} {$k < 8} {incr k} { + if {[expr {$r & $topbit}] != 0} { + set r [expr {($r << 1) ^ $poly}] + } else { + set r [expr {$r << 1}] + } + } + if {$reflected} { + set r [reflect $r $width] + } + lappend tbl [expr {$r & $mask}] + } + return $tbl +} + +# ------------------------------------------------------------------------- +# Calculate the CRC checksum for the data in 's' using a precalculated +# table. +# s the input data +# width - the width in bits of the CRC algorithm +# table - the name of the variable holding the calculated table +# init - the start value (or the last CRC for sequential blocks) +# xorout - the final value may be XORd with this value +# reflected - a boolean indicating that the bit order is reversed. +# For hardware optimised CRC checks, the bits are handled +# in transmission order (ie: bit0, bit1, ..., bit7) +proc ::crc::Crc {s width table {init 0} {xorout 0} {reflected 0}} { + upvar $table tbl + variable signbit + set signmask [expr {~$signbit>>7}] + + if {$width < 32} { + set mask [expr {(1 << $width) - 1}] + set rot [expr {$width - 8}] + } else { + set mask 0xffffffff + set rot 24 + } + + set crc $init + binary scan $s c* data + foreach {datum} $data { + if {$reflected} { + set ndx [expr {($crc ^ $datum) & 0xFF}] + set lkp [lindex $tbl $ndx] + set crc [expr {($lkp ^ ($crc >> 8 & $signmask)) & $mask}] + } else { + set ndx [expr {(($crc >> $rot) ^ $datum) & 0xFF}] + set lkp [lindex $tbl $ndx] + set crc [expr {($lkp ^ ($crc << 8 & $signmask)) & $mask}] + } + } + + return [expr {$crc ^ $xorout}] +} + +# ------------------------------------------------------------------------- +# Reverse the bit ordering for 'b' bits of the input value 'v' +proc ::crc::reflect {v b} { + set t $v + for {set i 0} {$i < $b} {incr i} { + set v [expr {($t & 1) ? ($v | (1<<(($b-1)-$i))) : ($v & ~(1<<(($b-1)-$i))) }] + set t [expr {$t >> 1}] + } + return $v +} + +# ------------------------------------------------------------------------- +# Description: +# Pop the nth element off a list. Used in options processing. +# +proc ::crc::Pop {varname {nth 0}} { + upvar $varname args + set r [lindex $args $nth] + set args [lreplace $args $nth $nth] + return $r +} + +# ------------------------------------------------------------------------- +# Specialisation of the general crc procedure to perform the standard CRC16 +# checksum +proc ::crc::CRC16 {s {seed 0}} { + variable table + if {![info exists table(crc16)]} { + variable polynomial + set table(crc16) [Crc_table 16 $polynomial(crc16) 1] + } + + return [Crc $s 16 [namespace current]::table(crc16) $seed 0 1] +} + +# ------------------------------------------------------------------------- +# Specialisation of the general crc procedure to perform the CCITT telecoms +# flavour of the CRC16 checksum +proc ::crc::CRC-CCITT {s {seed 0} {xor 0}} { + variable table + if {![info exists table(ccitt)]} { + variable polynomial + set table(ccitt) [Crc_table 16 $polynomial(ccitt) 0] + } + + return [Crc $s 16 [namespace current]::table(ccitt) $seed $xor 0] +} + +# ------------------------------------------------------------------------- +# Demostrates the parameters used for the 32 bit checksum CRC-32. +# This can be used to show the algorithm is working right by comparison with +# other crc32 implementations +proc ::crc::CRC-32 {s {seed 0xFFFFFFFF}} { + variable table + if {![info exists table(crc32)]} { + variable polynomial + set table(crc32) [Crc_table 32 $polynomial(crc32) 1] + } + + return [Crc $s 32 [namespace current]::table(crc32) $seed 0xFFFFFFFF 1] +} + +# ------------------------------------------------------------------------- +# User level CRC command. +proc ::crc::crc {args} { + array set opts [list filename {} channel {} chunksize 4096 \ + format %u seed 0 \ + impl [namespace origin CRC16]] + + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -fi* { set opts(filename) [Pop args 1] } + -cha* { set opts(channel) [Pop args 1] } + -chu* { set opts(chunksize) [Pop args 1] } + -fo* { set opts(format) [Pop args 1] } + -i* { set opts(impl) [uplevel 1 namespace origin [Pop args 1]] } + -s* { set opts(seed) [Pop args 1] } + default { + if {[llength $args] == 1} { break } + if {[string compare $option "--"] == 0} { Pop args; break } + set options [join [lsort [array names opts]] ", -"] + return -code error "bad option $option:\ + must be one of -$options" + } + } + Pop args + } + + if {$opts(filename) != {}} { + set opts(channel) [open $opts(filename) r] + fconfigure $opts(channel) -translation binary + } + + if {$opts(channel) != {}} { + set r $opts(seed) + set trans [fconfigure $opts(channel) -translation] + fconfigure $opts(channel) -translation binary + while {![eof $opts(channel)]} { + set chunk [read $opts(channel) $opts(chunksize)] + set r [$opts(impl) $chunk $r] + } + fconfigure $opts(channel) -translation $trans + if {$opts(filename) != {}} { + close $opts(channel) + } + } else { + if {[llength $args] != 1} { + return -code error "wrong \# args: should be\ + \"crc16 ?-format string? ?-seed value? ?-impl procname?\ + -file name | data\"" + } + set r [$opts(impl) [lindex $args 0] $opts(seed)] + } + return [format $opts(format) $r] +} + +# ------------------------------------------------------------------------- +# The user commands. See 'crc' +# +proc ::crc::crc16 {args} { + return [eval [list crc -impl [namespace origin CRC16]] $args] +} + +proc ::crc::crc-ccitt {args} { + return [eval [list crc -impl [namespace origin CRC-CCITT] -seed 0xFFFF]\ + $args] +} + +proc ::crc::xmodem {args} { + return [eval [list crc -impl [namespace origin CRC-CCITT] -seed 0] $args] +} + +proc ::crc::crc-32 {args} { + return [eval [list crc -impl [namespace origin CRC-32] -seed 0xFFFFFFFF]\ + $args] +} + +# ------------------------------------------------------------------------- + +package provide crc16 1.1.2 + +# ------------------------------------------------------------------------- +# +# Local variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/crc16.test b/tcllib/modules/crc/crc16.test new file mode 100644 index 0000000..1dc032a --- /dev/null +++ b/tcllib/modules/crc/crc16.test @@ -0,0 +1,233 @@ +# crc16.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Tests for the crc16 commands +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# RCS: @(#) $Id: crc16.test,v 1.7 2012/01/23 20:28:11 patthoyts Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.2 +testsNeedTcltest 1.0 + +testing { + useLocal crc16.tcl crc16 ::crc +} + +# ------------------------------------------------------------------------- + +test crc16-1.0 {crc16 with no parameters } { + catch {::crc::crc16} result + string match "wrong # args: *" $result +} {1} + +test crc16-1.1 {crc16 with single parameter} { + list [catch {::crc::crc16 abc} err] $err +} {0 38712} + +test crc16-1.2 {crc16 with "--" parameter} { + list [catch {::crc::crc16 -- abc} err] $err +} {0 38712} + +test crc16-1.3 {crc16 with leading hyphen data} { + list [catch {::crc::crc16 -abc} err] $err +} {0 64305} + +test crc16-1.4 {crc16 with leading hyphen data and option separator} { + list [catch {::crc::crc16 -- -abc} err] $err +} {0 64305} + +test crc16-1.5 {crc16 with leading hyphen data and format option} { + list [catch {::crc::crc16 -format %04x -abc} err] $err +} {0 fb31} + +test crc16-1.6 {crc16 with leading hyphen data, format option separator} { + list [catch {::crc::crc16 -format %04x -- -abc} err] $err +} {0 fb31} + +test crc16-1.7 {crc-ccitt with leading hyphen data} { + list [catch {::crc::crc-ccitt -abc} err] $err +} {0 6110} + +test crc16-1.8 {crc-ccitt with leading hyphen data and option separator} { + list [catch {::crc::crc-ccitt -- -abc} err] $err +} {0 6110} + + +# ------------------------------------------------------------------------- +# CRC16 tests +# ------------------------------------------------------------------------- + +foreach {n msg expected} { + 1 "" + "0" + 2 "123456789" + "47933" + 3 "abc" + "38712" + 4 "ABC" + "17697" + 5 "This is a string" + "19524" + 8 "\uFFFE\u0000\u0001\u0002" + "47537" +} { + test crc16-2.$n {crc16 and unsigned integer} { + list [catch {::crc::crc16 $msg} res] $res + } [list 0 $expected] +} + +foreach {n msg expected} { + 1 "" + "0x0" + 2 "123456789" + "0xBB3D" + 3 "abc" + "0x9738" + 4 "ABC" + "0x4521" + 5 "This is a string" + "0x4C44" + 6 "\uFFFE\u0000\u0001\u0002" + "0xB9B1" +} { + test crc16-3.$n {crc16 as hexadecimal string} { + list [catch {::crc::crc16 -format 0x%X $msg} res] $res + } [list 0 $expected] +} + +# ------------------------------------------------------------------------- +# Implementation tests +# ------------------------------------------------------------------------- + +set ::crc::testfile [info script] + +proc crc::loaddata {filename} { + set f [open $filename r] + fconfigure $f -translation binary + set data [read $f] + close $f + return $data +} + +test crc16-4.0 {crc16 file option} { + set r1 [::crc::crc16 -file [info script]] + list [catch { + set r2 [::crc::crc16 [crc::loaddata [info script]]] + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } + } result] $result +} {0 ok} + +test crc16-4.1 {crc16 channel option} { + set r1 [::crc::crc16 [crc::loaddata $crc::testfile]] + list [catch { + set f [open $crc::testfile r] + set r2 [::crc::crc16 -channel $f] + close $f + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } + set r + } result] $result +} {0 ok} + +test crc16-5.0 {crc implementation option} { + proc crc::junk {s seed} { + return 0 + } + + list [catch {::crc::crc16 -impl crc::junk {Hello, World!}} res] $res +} {0 0} + +# ------------------------------------------------------------------------- +# CRC-CCITT tests +# ------------------------------------------------------------------------- + +foreach {n msg expected} { + 1 "" + "0xFFFF" + 2 "123456789" + "0x29B1" + 3 "abc" + "0x514A" + 4 "ABC" + "0xF508" + 5 "This is a string" + "0x4BE9" + 8 "\uFFFE\u0000\u0001\u0002" + "0xAAA4" +} { + test crc16-6.$n {crc-ccitt and unsigned integer} { + list [catch {::crc::crc-ccitt -format 0x%X $msg} res] $res + } [list 0 $expected] +} + +# ------------------------------------------------------------------------- +# CRC32 tests +# ------------------------------------------------------------------------- + +foreach {n msg expected} { + 1 "" + "0x0" + 2 "123456789" + "0xCBF43926" + 3 "abc" + "0x352441C2" + 4 "ABC" + "0xA3830348" + 5 "This is a string" + "0x876633F" + 8 "\uFFFE\u0000\u0001\u0002" + "0xB0E8EEE5" +} { + test crc16-7.$n {crc-32 from the crc16 algorithms} { + list [catch {::crc::crc-32 -format 0x%X $msg} res] $res + } [list 0 $expected] +} + +# ------------------------------------------------------------------------- +# XMODEM CRC tests +# ------------------------------------------------------------------------- + +foreach {n msg expected} { + 1 "" + "0x0" + 2 "T" + "0x1A71" + 3 "123456789" + "0x31C3" + 4 "abc" + "0x9DD6" + 5 "ABC" + "0x3994" + 6 "This is a string" + "0x21E3" + 7 "\uFFFE\u0000\u0001\u0002" + "0x2E64" +} { + test crc16-8.$n {XMODEM CRCs as hexadecimal string} { + list [catch {::crc::xmodem -format 0x%X $msg} res] $res + } [list 0 $expected] +} +# ------------------------------------------------------------------------- + +catch {unset crc::filename} +testsuiteCleanup + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/crc32.bench b/tcllib/modules/crc/crc32.bench new file mode 100644 index 0000000..bf31a91 --- /dev/null +++ b/tcllib/modules/crc/crc32.bench @@ -0,0 +1,38 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'crc32' module. +# This allow developers to monitor/gauge/track package performance. +# +# (c) 2005 Andreas Kupries <andreas_kupries@users.sourceforge.net> + +# We need at least version 8.2 for the package and thus the +# benchmarks. + +if {![package vsatisfies [package provide Tcl] 8.2]} { + return +} + +# ### ### ### ######### ######### ######### ########################### +## Setting up the environment ... + +set moddir [file dirname [file dirname [info script]]] +lappend auto_path $moddir + +package forget crc32 +catch {namespace delete ::crc} +source [file join [file dirname [info script]] crc32.tcl] + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "CRC32 $n" -pre { + set str [string repeat " " $n] + } -body { + crc::crc32 $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/crc/crc32.man b/tcllib/modules/crc/crc32.man new file mode 100644 index 0000000..4de5bc5 --- /dev/null +++ b/tcllib/modules/crc/crc32.man @@ -0,0 +1,152 @@ +[vset VERSION 1.3.2] +[manpage_begin crc32 n [vset VERSION]] +[see_also cksum(n)] +[see_also crc16(n)] +[see_also sum(n)] +[keywords checksum] +[keywords cksum] +[keywords crc] +[keywords crc32] +[keywords {cyclic redundancy check}] +[keywords {data integrity}] +[keywords security] +[copyright {2002, Pat Thoyts}] +[moddesc {Cyclic Redundancy Checks}] +[titledesc {Perform a 32bit Cyclic Redundancy Check}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require crc32 [opt [vset VERSION]]] +[description] +[para] + +This package provides a Tcl implementation of the CRC-32 +algorithm based upon information provided at +http://www.naaccr.org/standard/crc32/document.html + +If either the [package critcl] package or the [package Trf] package +are available then a compiled version may be used internally to +accelerate the checksum calculation. + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd "::crc::crc32"] \ + [opt "-format [arg format]"] \ + [opt "-seed [arg value]"] \ + [lb] [arg "-channel chan"] | \ + [arg "-filename file"] | \ + [arg message] [rb]] + +The command takes either string data or a channel or file name and +returns a checksum value calculated using the CRC-32 algorithm. The +result is formatted using the [arg format](n) specifier provided. The +default is to return the value as an unsigned integer (format %u). + +[list_end] + +[section OPTIONS] + +[list_begin definitions] + +[def "-channel [arg name]"] + +Return a checksum for the data read from a channel. The command will +read data from the channel until the [cmd "eof"] is true. If you need +to be able to process events during this calculation see the +[sectref {PROGRAMMING INTERFACE}] section + +[def "-filename [arg name]"] + +This is a convenience option that opens the specified file, sets the +encoding to binary and then acts as if the [arg -channel] option had +been used. The file is closed on completion. + +[def "-format [arg string]"] + +Return the checksum using an alternative format template. + +[def "-seed [arg value]"] + +Select an alternative seed value for the CRC calculation. The default +is 0xffffffff. This can be useful for calculating the CRC for data +structures without first converting the whole structure into a +string. The CRC of the previous member can be used as the seed for +calculating the CRC of the next member. + +Note that the crc32 algorithm includes a final XOR step. If +incremental processing is desired then this must be undone before +using the output of the algorithm as the seed for further +processing. A simpler alternative is to use the +[sectref {PROGRAMMING INTERFACE}] which is intended for this mode of +operation. + +[list_end] + +[section {PROGRAMMING INTERFACE}] + +The CRC-32 package implements the checksum using a context variable to +which additional data can be added at any time. This is expecially +useful in an event based environment such as a Tk application or a web +server package. Data to be checksummed may be handled incrementally +during a [cmd fileevent] handler in discrete chunks. This can improve +the interactive nature of a GUI application and can help to avoid +excessive memory consumption. + +[list_begin definitions] + +[call [cmd "::crc::Crc32Init"] [opt [arg "seed"]]] + +Begins a new CRC32 context. Returns a token ID that must be used for the +remaining functions. An optional seed may be specified if required. + +[call [cmd "::crc::Crc32Update"] [arg "token"] [arg "data"]] + +Add data to the checksum identified by token. Calling +[emph {Crc32Update $token "abcd"}] is equivalent to calling +[emph {Crc32Update $token "ab"}] followed by +[emph {Crc32Update $token "cb"}]. See [sectref {EXAMPLES}]. + +[call [cmd "::crc::Crc32Final"] [arg "token"]] + +Returns the checksum value and releases any resources held by this +token. Once this command completes the token will be invalid. The +result is a 32 bit integer value. + +[list_end] + +[section EXAMPLES] + +[para] +[example { +% crc::crc32 "Hello, World!" +3964322768 +}] + +[para] +[example { +% crc::crc32 -format 0x%X "Hello, World!" +0xEC4AC3D0 +}] + +[para] +[example { +% crc::crc32 -file crc32.tcl +483919716 +}] + +[para] +[example { +% set tok [crc::Crc32Init] +% crc::Crc32Update $tok "Hello, " +% crc::Crc32Update $tok "World!" +% crc::Crc32Final $tok +3964322768 +}] + +[section AUTHORS] +Pat Thoyts + +[vset CATEGORY crc] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/crc/crc32.pcx b/tcllib/modules/crc/crc32.pcx new file mode 100644 index 0000000..732c766 --- /dev/null +++ b/tcllib/modules/crc/crc32.pcx @@ -0,0 +1,37 @@ +# -*- tcl -*- crc32.pcx +# Syntax of the commands provided by package crc32. + +# For use by TclDevKit's static syntax checker. +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the documentation describing the format of the code contained in this file +# + +package require pcx +pcx::register crc32 +pcx::tcldep 1.3 needs tcl 8.2 + +namespace eval ::crc32 {} + +#pcx::message FOO {... text ...} type +#pcx::scan <VERSION> <NAME> <RULE> + +pcx::check 1.3 std ::crc::crc32 \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-seed checkWord} + {-timeout checkWholeNum} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} + +# Initialization via pcx::init. +# Use a ::crc32::init procedure for non-standard initialization. +pcx::complete diff --git a/tcllib/modules/crc/crc32.tcl b/tcllib/modules/crc/crc32.tcl new file mode 100644 index 0000000..ffc1f36 --- /dev/null +++ b/tcllib/modules/crc/crc32.tcl @@ -0,0 +1,377 @@ +# crc32.tcl -- Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# CRC32 Cyclic Redundancy Check. +# (for algorithm see http://www.rad.com/networks/1994/err_con/crc.htm) +# +# From http://mini.net/tcl/2259.tcl +# Written by Wayland Augur and Pat Thoyts. +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +package require Tcl 8.2 + +namespace eval ::crc { + variable accel + array set accel {critcl 0 trf 0} + + namespace export crc32 + + variable crc32_tbl [list 0x00000000 0x77073096 0xEE0E612C 0x990951BA \ + 0x076DC419 0x706AF48F 0xE963A535 0x9E6495A3 \ + 0x0EDB8832 0x79DCB8A4 0xE0D5E91E 0x97D2D988 \ + 0x09B64C2B 0x7EB17CBD 0xE7B82D07 0x90BF1D91 \ + 0x1DB71064 0x6AB020F2 0xF3B97148 0x84BE41DE \ + 0x1ADAD47D 0x6DDDE4EB 0xF4D4B551 0x83D385C7 \ + 0x136C9856 0x646BA8C0 0xFD62F97A 0x8A65C9EC \ + 0x14015C4F 0x63066CD9 0xFA0F3D63 0x8D080DF5 \ + 0x3B6E20C8 0x4C69105E 0xD56041E4 0xA2677172 \ + 0x3C03E4D1 0x4B04D447 0xD20D85FD 0xA50AB56B \ + 0x35B5A8FA 0x42B2986C 0xDBBBC9D6 0xACBCF940 \ + 0x32D86CE3 0x45DF5C75 0xDCD60DCF 0xABD13D59 \ + 0x26D930AC 0x51DE003A 0xC8D75180 0xBFD06116 \ + 0x21B4F4B5 0x56B3C423 0xCFBA9599 0xB8BDA50F \ + 0x2802B89E 0x5F058808 0xC60CD9B2 0xB10BE924 \ + 0x2F6F7C87 0x58684C11 0xC1611DAB 0xB6662D3D \ + 0x76DC4190 0x01DB7106 0x98D220BC 0xEFD5102A \ + 0x71B18589 0x06B6B51F 0x9FBFE4A5 0xE8B8D433 \ + 0x7807C9A2 0x0F00F934 0x9609A88E 0xE10E9818 \ + 0x7F6A0DBB 0x086D3D2D 0x91646C97 0xE6635C01 \ + 0x6B6B51F4 0x1C6C6162 0x856530D8 0xF262004E \ + 0x6C0695ED 0x1B01A57B 0x8208F4C1 0xF50FC457 \ + 0x65B0D9C6 0x12B7E950 0x8BBEB8EA 0xFCB9887C \ + 0x62DD1DDF 0x15DA2D49 0x8CD37CF3 0xFBD44C65 \ + 0x4DB26158 0x3AB551CE 0xA3BC0074 0xD4BB30E2 \ + 0x4ADFA541 0x3DD895D7 0xA4D1C46D 0xD3D6F4FB \ + 0x4369E96A 0x346ED9FC 0xAD678846 0xDA60B8D0 \ + 0x44042D73 0x33031DE5 0xAA0A4C5F 0xDD0D7CC9 \ + 0x5005713C 0x270241AA 0xBE0B1010 0xC90C2086 \ + 0x5768B525 0x206F85B3 0xB966D409 0xCE61E49F \ + 0x5EDEF90E 0x29D9C998 0xB0D09822 0xC7D7A8B4 \ + 0x59B33D17 0x2EB40D81 0xB7BD5C3B 0xC0BA6CAD \ + 0xEDB88320 0x9ABFB3B6 0x03B6E20C 0x74B1D29A \ + 0xEAD54739 0x9DD277AF 0x04DB2615 0x73DC1683 \ + 0xE3630B12 0x94643B84 0x0D6D6A3E 0x7A6A5AA8 \ + 0xE40ECF0B 0x9309FF9D 0x0A00AE27 0x7D079EB1 \ + 0xF00F9344 0x8708A3D2 0x1E01F268 0x6906C2FE \ + 0xF762575D 0x806567CB 0x196C3671 0x6E6B06E7 \ + 0xFED41B76 0x89D32BE0 0x10DA7A5A 0x67DD4ACC \ + 0xF9B9DF6F 0x8EBEEFF9 0x17B7BE43 0x60B08ED5 \ + 0xD6D6A3E8 0xA1D1937E 0x38D8C2C4 0x4FDFF252 \ + 0xD1BB67F1 0xA6BC5767 0x3FB506DD 0x48B2364B \ + 0xD80D2BDA 0xAF0A1B4C 0x36034AF6 0x41047A60 \ + 0xDF60EFC3 0xA867DF55 0x316E8EEF 0x4669BE79 \ + 0xCB61B38C 0xBC66831A 0x256FD2A0 0x5268E236 \ + 0xCC0C7795 0xBB0B4703 0x220216B9 0x5505262F \ + 0xC5BA3BBE 0xB2BD0B28 0x2BB45A92 0x5CB36A04 \ + 0xC2D7FFA7 0xB5D0CF31 0x2CD99E8B 0x5BDEAE1D \ + 0x9B64C2B0 0xEC63F226 0x756AA39C 0x026D930A \ + 0x9C0906A9 0xEB0E363F 0x72076785 0x05005713 \ + 0x95BF4A82 0xE2B87A14 0x7BB12BAE 0x0CB61B38 \ + 0x92D28E9B 0xE5D5BE0D 0x7CDCEFB7 0x0BDBDF21 \ + 0x86D3D2D4 0xF1D4E242 0x68DDB3F8 0x1FDA836E \ + 0x81BE16CD 0xF6B9265B 0x6FB077E1 0x18B74777 \ + 0x88085AE6 0xFF0F6A70 0x66063BCA 0x11010B5C \ + 0x8F659EFF 0xF862AE69 0x616BFFD3 0x166CCF45 \ + 0xA00AE278 0xD70DD2EE 0x4E048354 0x3903B3C2 \ + 0xA7672661 0xD06016F7 0x4969474D 0x3E6E77DB \ + 0xAED16A4A 0xD9D65ADC 0x40DF0B66 0x37D83BF0 \ + 0xA9BCAE53 0xDEBB9EC5 0x47B2CF7F 0x30B5FFE9 \ + 0xBDBDF21C 0xCABAC28A 0x53B39330 0x24B4A3A6 \ + 0xBAD03605 0xCDD70693 0x54DE5729 0x23D967BF \ + 0xB3667A2E 0xC4614AB8 0x5D681B02 0x2A6F2B94 \ + 0xB40BBE37 0xC30C8EA1 0x5A05DF1B 0x2D02EF8D] + + # calculate the sign bit for the current platform. + variable signbit + if {![info exists signbit]} { + variable v + for {set v 1} {int($v) != 0} {set signbit $v; set v [expr {$v<<1}]} {} + unset v + } + + variable uid ; if {![info exists uid]} {set uid 0} +} + +# ------------------------------------------------------------------------- + +# crc::Crc32Init -- +# +# Create and initialize a crc32 context. This is cleaned up +# when we we call Crc32Final to obtain the result. +# +proc ::crc::Crc32Init {{seed 0xFFFFFFFF}} { + variable uid + variable accel + set token [namespace current]::[incr uid] + upvar #0 $token state + array set state [list sum $seed] + # If the initial seed is set to some other value we cannot use Trf. + if {$accel(trf) && $seed == 0xFFFFFFFF} { + 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 + ::crc-zlib -attach $s -mode write \ + -write-type variable \ + -write-destination ${token}(trfwrite) + array set state [list trfread 0 trfwrite 0 trf $s] + } + } + return $token +} + +# crc::Crc32Update -- +# +# This is called to add more data into the checksum. 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 summing 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 ::crc::Crc32Update {token data} { + variable accel + upvar #0 $token state + set sum $state(sum) + if {$accel(critcl)} { + set sum [Crc32_c $data $sum] + } elseif {[info exists state(trf)]} { + puts -nonewline $state(trf) $data + return + } else { + set sum [Crc32_tcl $data $sum] + } + set state(sum) [expr {$sum ^ 0xFFFFFFFF}] + return +} + +# crc::Crc32Final -- +# +# This procedure is used to close the context and returns the +# checksum value. Once this procedure has been called the checksum +# context is freed and cannot be used again. +# +proc ::crc::Crc32Final {token} { + upvar #0 $token state + if {[info exists state(trf)]} { + close $state(trf) + binary scan $state(trfwrite) i sum + set sum [expr {$sum & 0xFFFFFFFF}] + } else { + set sum [expr {($state(sum) ^ 0xFFFFFFFF) & 0xFFFFFFFF}] + } + unset state + return $sum +} + +# crc::Crc32_tcl -- +# +# The pure-Tcl implementation of a table based CRC-32 checksum. +# The seed should always be 0xFFFFFFFF to begin with, but for +# successive chunks of data the seed should be set to the result +# of the last chunk. +# +proc ::crc::Crc32_tcl {data {seed 0xFFFFFFFF}} { + variable crc32_tbl + variable signbit + set signmask [expr {~$signbit>>7}] + set crcval $seed + + binary scan $data c* nums + foreach {n} $nums { + set ndx [expr {($crcval ^ $n) & 0xFF}] + set lkp [lindex $crc32_tbl $ndx] + set crcval [expr {($lkp ^ ($crcval >> 8 & $signmask)) & 0xFFFFFFFF}] + } + + return [expr {$crcval ^ 0xFFFFFFFF}] +} + +# crc::Crc32_c -- +# +# A C version of the CRC-32 code using the same table. This is +# designed to be compiled using critcl. +# +if {[package provide critcl] != {}} { + namespace eval ::crc { + critcl::ccommand Crc32_c {dummy interp objc objv} { + int r = TCL_OK; + unsigned long t = 0xFFFFFFFFL; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "data ?seed?"); + return TCL_ERROR; + } + + if (objc == 3) { + r = Tcl_GetLongFromObj(interp, objv[2], (long *)&t); + } + + if (r == TCL_OK) { + int cn, size, ndx; + unsigned char *data; + unsigned long lkp; + Tcl_Obj *tblPtr, *lkpPtr; + + tblPtr = Tcl_GetVar2Ex(interp, "::crc::crc32_tbl", NULL, + TCL_LEAVE_ERR_MSG ); + if (tblPtr == NULL) { + r = TCL_ERROR; + } + if (r == TCL_OK) { + data = Tcl_GetByteArrayFromObj(objv[1], &size); + } + for (cn = 0; r == TCL_OK && cn < size; cn++) { + ndx = (t ^ data[cn]) & 0xFF; + r = Tcl_ListObjIndex(interp, tblPtr, ndx, &lkpPtr); + if (r == TCL_OK) { + r = Tcl_GetLongFromObj(interp, lkpPtr, (long*) &lkp); + } + if (r == TCL_OK) { + t = lkp ^ (t >> 8); + } + } + } + + if (r == TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewLongObj(t ^ 0xFFFFFFFF)); + } + return r; + } + } +} + +# 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 ::crc::LoadAccelerator {name} { + variable accel + set r 0 + switch -exact -- $name { + critcl { + if {![catch {package require tcllibc}] + || ![catch {package require crcc}]} { + set r [expr {[info commands ::crc::Crc32_c] != {}}] + } + } + trf { + if {![catch {package require Trf}]} { + set r [expr {![catch {::crc-zlib aa} msg]}] + } + } + default { + return -code error "invalid accelerator package:\ + must be one of [join [array names accel] {, }]" + } + } + set accel($name) $r +} + +# crc::Pop -- +# +# Pop the nth element off a list. Used in options processing. +# +proc ::crc::Pop {varname {nth 0}} { + upvar $varname args + set r [lindex $args $nth] + set args [lreplace $args $nth $nth] + return $r +} + +# crc::crc32 -- +# +# Provide a Tcl implementation of a crc32 checksum similar to the +# cksum and sum unix commands. +# +# Options: +# -filename name - return a checksum for the specified file. +# -format string - return the checksum using this format string. +# -seed value - seed the algorithm using value (default is 0xffffffff) +# +proc ::crc::crc32 {args} { + array set opts [list -filename {} -format %u -seed 0xffffffff \ + -channel {} -chunksize 4096 -timeout 30000] + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -file* { set opts(-filename) [Pop args 1] } + -for* { set opts(-format) [Pop args 1] } + -chan* { set opts(-channel) [Pop args 1] } + -chunk* { set opts(-chunksize) [Pop args 1] } + -time* { set opts(-timeout) [Pop args 1] } + -seed { set opts(-seed) [Pop args 1] } + -impl* { set junk [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 $err" + } + } + Pop args + } + + # If a file was given - open it + 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 \ + \"crc32 ?-format string? ?-seed value? \ + -channel chan | -file name | data\"" + } + set tok [Crc32Init $opts(-seed)] + Crc32Update $tok [lindex $args 0] + set r [Crc32Final $tok] + + } else { + + set r $opts(-seed) + set tok [Crc32Init $opts(-seed)] + while {![eof $opts(-channel)]} { + Crc32Update $tok [read $opts(-channel) $opts(-chunksize)] + } + set r [Crc32Final $tok] + + if {$opts(-filename) != {}} { + close $opts(-channel) + } + } + + return [format $opts(-format) $r] +} + +# ------------------------------------------------------------------------- + +# Try and load a compiled extension to help (note - trf is fastest) +namespace eval ::crc { + variable e {} + foreach e {trf critcl} { + if {[LoadAccelerator $e]} break + } + unset e +} + +package provide crc32 1.3.2 + +# ------------------------------------------------------------------------- +# +# Local variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/crc32.test b/tcllib/modules/crc/crc32.test new file mode 100644 index 0000000..f2366eb --- /dev/null +++ b/tcllib/modules/crc/crc32.test @@ -0,0 +1,222 @@ +# crc32.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Tests for the crc32 commands +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# RCS: @(#) $Id: crc32.test,v 1.12 2009/03/04 01:01:42 patthoyts Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.2 +testsNeedTcltest 1.0 + +testing { + useLocal crc32.tcl crc32 ::crc +} + +# ------------------------------------------------------------------------- + +if {[::crc::LoadAccelerator critcl]} { + puts "> critcl based" +} +if {[::crc::LoadAccelerator trf]} { + puts "> Trf based" +} +puts "> pure Tcl" + +# ------------------------------------------------------------------------- +# Handle multiple implementation testing +# + +array set preserve [array get ::crc::accel] + +proc implementations {} { + variable ::crc::accel + foreach {a v} [array get accel] {if {$v} {lappend r $a}} + lappend r tcl; set r +} + +proc select_implementation {impl} { + variable ::crc::accel + foreach e [array names accel] { set accel($e) 0 } + if {[string compare "tcl" $impl] != 0} { + set accel($impl) 1 + } +} + +proc reset_implementation {} { + variable ::crc::accel + array set accel [array get ::preserve] +} + +# ------------------------------------------------------------------------- + +test crc32-1.0 {crc32 with no parameters } { + catch {::crc::crc32} result + string match "wrong # args: *" $result +} {1} + +# ------------------------------------------------------------------------- + +set tests { + 1 "" + "0" + 2 "a" + "3904355907" + 3 "abc" + "891568578" + 4 "message digest" + "538287487" + 5 "abcdefghijklmnopqrstuvwxyz" + "1277644989" + 6 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "532866770" + 7 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "2091469426" + 8 "\uFFFE\u0000\u0001\u0002" + "2968055525" + 9 "-" + "2547889144" + 10 "--" + "606868581" +} +foreach impl [implementations] { + select_implementation $impl + foreach {n msg expected} $tests { + test crc32-$impl-2.$n "crc32 as unsigned integer ($impl)" { + list [catch {::crc::crc32 $msg} err] $err + } [list 0 $expected] + } + reset_implementation +} + +# ------------------------------------------------------------------------- + +set tests { + 1 "" + "0x0" + 2 "a" + "0xE8B7BE43" + 3 "abc" + "0x352441C2" + 4 "message digest" + "0x20159D7F" + 5 "abcdefghijklmnopqrstuvwxyz" + "0x4C2750BD" + 6 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "0x1FC2E6D2" + 7 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "0x7CA94A72" + 8 "\uFFFE\u0000\u0001\u0002" + "0xB0E8EEE5" + 9 "-" + "0x97DDB3F8" + 10 "--" + "0x242C1465" +} + +foreach impl [implementations] { + select_implementation $impl + foreach {n msg expected} $tests { + test crc32-$impl-3.$n "crc32 as hexadecimal string ($impl)" { + list [catch {::crc::crc32 -format 0x%X $msg} err] $err + } [list 0 $expected] + } + reset_implementation +} + +# ------------------------------------------------------------------------- + +set crc::testfile [info script] + +proc crc::loaddata {filename} { + set f [open $filename r] + fconfigure $f -translation binary + set data [read $f] + close $f + return $data +} + +foreach impl [implementations] { + select_implementation $impl + test crc32-$impl-4.0 "crc32 file option ($impl)" { + set r1 [::crc::crc32 -file $crc::testfile] + set r2 [::crc::crc32 [crc::loaddata $crc::testfile]] + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } + } {ok} + reset_implementation +} + +# ------------------------------------------------------------------------- + +set tests { + 1 0 "" + "4294967295" + 2 1 "" + "4294967294" + 3 0 "Hello, World!" + "482441901" + 4 1 "Hello, World!" + "3243746088" + 5 0 "-" + "3122701194" +} +foreach impl [implementations] { + select_implementation $impl + foreach {n seed msg expected} $tests { + test crc32-$impl-5.$n "crc32 initial seed option ($impl)" { + list [catch {::crc::crc32 -seed $seed $msg} err] $err + } [list 0 $expected] + } + reset_implementation +} + +# ------------------------------------------------------------------------- + +set tests { + 1 "a" "bc" + "891568578" + 2 "message" " digest" + "538287487" + 3 "abcdefghijkl" "mnopqrstuvwxyz" + "1277644989" + 4 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz012345678" "9" + "532866770" + 5 "1234567890" + "1234567890123456789012345678901234567890123456789012345678901234567890" + "2091469426" + 6 "\uFFFE\u0000" "\u0001\u0002" + "2968055525" +} +foreach impl [implementations] { + select_implementation $impl + foreach {n msgA msgB expected} $tests { + test crc32-$impl-6.$n "crc32 using -seed ($impl)" { + list [catch { + ::crc::crc32 -seed [expr {[::crc::crc32 $msgA] ^ 0xffffffff}] $msgB + } err] $err + } [list 0 $expected] + } + reset_implementation +} + +# ------------------------------------------------------------------------- + +catch {unset crc::filename} +testsuiteCleanup + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/crc32bugs.test b/tcllib/modules/crc/crc32bugs.test new file mode 100644 index 0000000..e750077 --- /dev/null +++ b/tcllib/modules/crc/crc32bugs.test @@ -0,0 +1,104 @@ +# crc32bugs.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sf.net> +# +# Bug finding for crc32 module. +# In particular we are looking for byte order problems, and issues between +# the trf code and tcl-only code. +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# RCS: @(#) $Id: crc32bugs.test,v 1.8 2006/10/09 21:41:40 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.2 +testsNeedTcltest 1.0 + +catch {namespace delete ::crc} +support { + useLocal crc16.tcl crc16 +} +testing { + useLocal crc32.tcl crc32 +} + +# ------------------------------------------------------------------------- + +puts "> $::tcl_platform(byteOrder)" + +if {[::crc::LoadAccelerator critcl]} { + puts "> bugs, critcl based" +} +if {[::crc::LoadAccelerator trf]} { + puts "> bugs, Trf based" +} +puts "> bugs, pure Tcl" + +# ------------------------------------------------------------------------- +# Handle multiple implementation testing +# + +array set preserve [array get ::crc::accel] + +proc implementations {} { + variable ::crc::accel + foreach {a v} [array get accel] {if {$v} {lappend r $a}} + lappend r tcl; set r +} + +proc select_implementation {impl} { + variable ::crc::accel + foreach e [array names accel] { set accel($e) 0 } + if {[string compare "tcl" $impl] != 0} { + set accel($impl) 1 + } +} + +proc reset_implementation {} { + variable ::crc::accel + array set accel [array get ::preserve] +} + +# ------------------------------------------------------------------------- + +set tests { + 1 "" "0" + 2 "\x00" "d202ef8d" + 3 "\x00\x00" "41d912ff" + 4 "\x00\x00\x00" "ff41d912" + 5 "\x00\x00\x00\x00" "2144df1c" + 6 "\xFF" "ff000000" + 7 "\xFF\xFF" "ffff0000" + 8 "\xFF\xFF\xFF" "ffffff00" + 9 "\xFF\xFF\xFF\xFF" "ffffffff" + 10 "\x00\x00\x00\x01" "5643ef8a" + 11 "\x80\x00\x00\x00" "cc1d6927" +} + +foreach impl [implementations] { + select_implementation $impl + foreach {n msg expected} $tests { + test crc32bugs-$impl-1.$n "crc32 (crc32 and crc16 comparison)" { + set r [catch { + list [::crc::crc32 -format %x $msg] \ + [::crc::crc-32 -format %x $msg] + } err] + if {$r} {lappend err $::errorInfo} + list $r $err + } [list 0 [list $expected $expected]] + } +} + +# ------------------------------------------------------------------------- + +testsuiteCleanup + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/crcc.tcl b/tcllib/modules/crc/crcc.tcl new file mode 100644 index 0000000..a1b34a0 --- /dev/null +++ b/tcllib/modules/crc/crcc.tcl @@ -0,0 +1,22 @@ +# crcc.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Place holder for building a critcl C module for this tcllib module. +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# $Id: crcc.tcl,v 1.4 2008/03/25 07:15:35 andreas_kupries Exp $ + +package require critcl + +namespace eval ::crc { + variable rcsid {$Id: crcc.tcl,v 1.4 2008/03/25 07:15:35 andreas_kupries Exp $} + + critcl::ccode { + /* no code required in this file */ + } +} + +# @sak notprovided crcc +package provide crcc 1.0.0
\ No newline at end of file diff --git a/tcllib/modules/crc/pkgIndex.tcl b/tcllib/modules/crc/pkgIndex.tcl new file mode 100644 index 0000000..fe33b2e --- /dev/null +++ b/tcllib/modules/crc/pkgIndex.tcl @@ -0,0 +1,5 @@ +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded cksum 1.1.4 [list source [file join $dir cksum.tcl]] +package ifneeded crc16 1.1.2 [list source [file join $dir crc16.tcl]] +package ifneeded crc32 1.3.2 [list source [file join $dir crc32.tcl]] +package ifneeded sum 1.1.2 [list source [file join $dir sum.tcl]] diff --git a/tcllib/modules/crc/sum.bench b/tcllib/modules/crc/sum.bench new file mode 100644 index 0000000..aa3f1b1 --- /dev/null +++ b/tcllib/modules/crc/sum.bench @@ -0,0 +1,38 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'crc32' module. +# This allow developers to monitor/gauge/track package performance. +# +# (c) 2005 Andreas Kupries <andreas_kupries@users.sourceforge.net> + +# We need at least version 8.2 for the package and thus the +# benchmarks. + +if {![package vsatisfies [package provide Tcl] 8.2]} { + return +} + +# ### ### ### ######### ######### ######### ########################### +## Setting up the environment ... + +set moddir [file dirname [file dirname [info script]]] +lappend auto_path $moddir + +package forget sum +catch {namespace delete ::crc} +source [file join [file dirname [info script]] sum.tcl] + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "SUM $n" -pre { + set str [string repeat " " $n] + } -body { + crc::sum $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/crc/sum.man b/tcllib/modules/crc/sum.man new file mode 100644 index 0000000..bae7f12 --- /dev/null +++ b/tcllib/modules/crc/sum.man @@ -0,0 +1,108 @@ +[vset SUM_VERSION 1.1.2] +[manpage_begin sum n [vset SUM_VERSION]] +[see_also cksum(n)] +[see_also crc32(n)] +[see_also sum(1)] +[keywords checksum] +[keywords cksum] +[keywords crc] +[keywords crc32] +[keywords {cyclic redundancy check}] +[keywords {data integrity}] +[keywords security] +[keywords sum] +[copyright {2002, Pat Thoyts <patthoyts@users.sourceforge.net>}] +[moddesc {Cyclic Redundancy Checks}] +[titledesc {Calculate a sum(1) compatible checksum}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require sum [opt [vset SUM_VERSION]]] +[description] +[para] + +This package provides a Tcl-only implementation of the sum(1) command +which calculates a 16 bit checksum value from the input data. The BSD +sum algorithm is used by default but the SysV algorithm is also +available. + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd "::crc::sum"] \ + [opt "[arg -bsd] | [arg -sysv]"] \ + [opt [arg "-format fmt"]] \ + [opt [arg "-chunksize size"]] \ + [lb] [arg "-filename file"] | \ + [arg "-channel chan"] | [arg "string"] [rb]] + +The command takes string data or a file name or a channel and returns +a checksum value calculated using the [syscmd sum(1)] algorithm. The +result is formatted using the [arg format](n) specifier provided or as +an unsigned integer (%u) by default. + +[list_end] + +[section OPTIONS] + +[list_begin definitions] + +[def "-sysv"] + +The SysV algorithm is fairly naive. The byte values are summed and any +overflow is discarded. The lowest 16 bits are returned as the +checksum. Input with the same content but different ordering will +give the same result. + +[def "-bsd"] + +This algorithm is similar to the SysV version but includes a bit rotation +step which provides a dependency on the order of the data values. + +[def "-filename [arg name]"] + +Return a checksum for the file contents instead of for parameter data. + +[def "-channel [arg chan]"] + +Return a checksum for the contents of the specified channel. The +channel must be open for reading and should be configured for binary +translation. The channel will no be closed on completion. + +[def "-chunksize [arg size]"] + +Set the block size used when reading data from either files or +channels. This value defaults to 4096. + +[def "-format [arg string]"] + +Return the checksum using an alternative format template. + +[list_end] + +[section EXAMPLES] + +[para] +[example { +% crc::sum "Hello, World!" +37287 +}] + +[para] +[example { +% crc::sum -format 0x%X "Hello, World!" +0x91A7 +}] + +[para] +[example { +% crc::sum -file sum.tcl +13392 +}] + +[section AUTHORS] +Pat Thoyts + +[vset CATEGORY crc] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/crc/sum.pcx b/tcllib/modules/crc/sum.pcx new file mode 100644 index 0000000..1168d68 --- /dev/null +++ b/tcllib/modules/crc/sum.pcx @@ -0,0 +1,38 @@ +# -*- tcl -*- sum.pcx +# Syntax of the commands provided by package sum. + +# For use by TclDevKit's static syntax checker. +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the documentation describing the format of the code contained in this file +# + +package require pcx +pcx::register sum +pcx::tcldep 1.1.0 needs tcl 8.2 + +namespace eval ::sum {} + +#pcx::message FOO {... text ...} type +#pcx::scan <VERSION> <NAME> <RULE> + +pcx::check 1.1.0 std ::crc::sum \ + {checkConstrained {checkSimpleArgs 1 -1 { + {checkSwitches 1 { + -bsd + -sysv + {-channel {checkSetConstraint fn checkChannelID}} + {-chunksize checkInt} + {-filename {checkSetConstraint fn checkFileName}} + {-format checkWord} + {-timeout checkWholeNum} + -- + } {checkConstraint { + {fn {checkSimpleArgs 0 0 {}}} + {!fn {checkSimpleArgs 1 1 checkWord}} + } {}}} + }}} + +# Initialization via pcx::init. +# Use a ::sum::init procedure for non-standard initialization. +pcx::complete diff --git a/tcllib/modules/crc/sum.tcl b/tcllib/modules/crc/sum.tcl new file mode 100644 index 0000000..a35aa8f --- /dev/null +++ b/tcllib/modules/crc/sum.tcl @@ -0,0 +1,285 @@ +# sum.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Provides a Tcl only implementation of the unix sum(1) command. There are +# a number of these and they use differing algorithms to get a checksum of +# the input data. We provide two: one using the BSD algorithm and the other +# using the SysV algorithm. More consistent results across multiple +# implementations can be obtained by using cksum(1). +# +# These commands have been checked against the GNU sum program from the GNU +# textutils package version 2.0 to ensure the same results. +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +package require Tcl 8.2; # tcl minimum version + +catch {package require tcllibc}; # critcl enhancements to tcllib +#catch {package require crcc}; # critcl enhanced crc module + +namespace eval ::crc { + namespace export sum + + variable uid + if {![info exists uid]} { + set uid 0 + } +} + +# ------------------------------------------------------------------------- +# Description: +# The SysV algorithm is fairly naive. The byte values are summed and any +# overflow is discarded. The lowest 16 bits are returned as the checksum. +# Notes: +# Input with the same content but different ordering will give the same +# result. +# +proc ::crc::SumSysV {s {seed 0}} { + set t $seed + binary scan $s c* r + foreach n $r { + incr t [expr {$n & 0xFF}] + } + + set t [expr {$t & 0xffffffff}] + set t [expr {($t & 0xffff) + ($t >> 16)}] + set t [expr {($t & 0xffff) + ($t >> 16)}] + + return $t +} + +# ------------------------------------------------------------------------- +# Description: +# This algorithm is similar to the SysV version but includes a bit rotation +# step which provides a dependency on the order of the data values. +# +proc ::crc::SumBsd {s {seed 0}} { + set t $seed + binary scan $s c* r + foreach n $r { + set t [expr {($t & 1) ? (($t >> 1) + 0x8000) : ($t >> 1)}] + set t [expr {($t + ($n & 0xFF)) & 0xFFFF}] + } + return $t +} + +# ------------------------------------------------------------------------- + +if {[package provide critcl] != {}} { + namespace eval ::crc { + critcl::ccommand SumSysV_c {dummy interp objc objv} { + int r = TCL_OK; + unsigned int t = 0; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "data ?seed?"); + return TCL_ERROR; + } + + if (objc == 3) + r = Tcl_GetIntFromObj(interp, objv[2], (int *)&t); + + if (r == TCL_OK) { + int cn, size; + unsigned char *data; + + data = Tcl_GetByteArrayFromObj(objv[1], &size); + for (cn = 0; cn < size; cn++) + t += data[cn]; + } + + t = t & 0xffffffffLU; + t = (t & 0xffff) + (t >> 16); + t = (t & 0xffff) + (t >> 16); + + Tcl_SetObjResult(interp, Tcl_NewIntObj(t)); + return r; + } + + critcl::ccommand SumBsd_c {dummy interp objc objv} { + int r = TCL_OK; + unsigned int t = 0; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "data ?seed?"); + return TCL_ERROR; + } + + if (objc == 3) + r = Tcl_GetIntFromObj(interp, objv[2], (int *)&t); + + if (r == TCL_OK) { + int cn, size; + unsigned char *data; + + data = Tcl_GetByteArrayFromObj(objv[1], &size); + for (cn = 0; cn < size; cn++) { + t = (t & 1) ? ((t >> 1) + 0x8000) : (t >> 1); + t = (t + data[cn]) & 0xFFFF; + } + } + + Tcl_SetObjResult(interp, Tcl_NewIntObj(t & 0xFFFF)); + return r; + } + } +} + +# ------------------------------------------------------------------------- +# Switch from pure tcl to compiled if available. +# +if {[info commands ::crc::SumBsd_c] == {}} { + interp alias {} ::crc::sum-bsd {} ::crc::SumBsd +} else { + interp alias {} ::crc::sum-bsd {} ::crc::SumBsd_c +} + +if {[info commands ::crc::SumSysV_c] == {}} { + interp alias {} ::crc::sum-sysv {} ::crc::SumSysV +} else { + interp alias {} ::crc::sum-sysv {} ::crc::SumSysV_c +} + +# ------------------------------------------------------------------------- +# Description: +# Pop the nth element off a list. Used in options processing. +# +proc ::crc::Pop {varname {nth 0}} { + upvar $varname args + set r [lindex $args $nth] + set args [lreplace $args $nth $nth] + return $r +} + +# ------------------------------------------------------------------------- +# timeout handler for the chunked file handling +# This avoids us waiting for ever +# +proc ::crc::SumTimeout {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + set state(error) "operation timed out" + set state(reading) 0 +} + +# ------------------------------------------------------------------------- +# fileevent handler for chunked file handling. +# +proc ::crc::SumChunk {token channel} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[eof $channel]} { + fileevent $channel readable {} + set state(reading) 0 + } + + after cancel $state(after) + set state(after) [after $state(timeout) \ + [list [namespace origin SumTimeout] $token]] + set state(result) [$state(algorithm) \ + [read $channel $state(chunksize)] \ + $state(result)] +} + +# ------------------------------------------------------------------------- +# Description: +# Provide a Tcl equivalent of the unix sum(1) command. We default to the +# BSD algorithm and return a checkum for the input string unless a filename +# has been provided. Using sum on a file should give the same results as +# the unix sum command with equivalent algorithm. +# Options: +# -bsd - use the BSD algorithm to calculate the checksum (default) +# -sysv - use the SysV algorithm to calculate the checksum +# -filename name - return a checksum for the specified file +# -format string - return the checksum using this format string +# +proc ::crc::sum {args} { + array set opts [list -filename {} -channel {} -chunksize 4096 \ + -timeout 30000 -bsd 1 -sysv 0 -format %u \ + algorithm [namespace origin sum-bsd]] + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -bsd { set opts(-bsd) 1 ; set opts(-sysv) 0 } + -sysv { set opts(-bsd) 0 ; set opts(-sysv) 1 } + -file* { set opts(-filename) [Pop args 1] } + -for* { set opts(-format) [Pop args 1] } + -chan* { set opts(-channel) [Pop args 1] } + -chunk* { set opts(-chunksize) [Pop args 1] } + -time* { set opts(-timeout) [Pop args 1] } + -- { Pop args ; break } + default { + set err [join [lsort [array names opts -*]] ", "] + return -code error "bad option $option:\ + must be one of $err" + } + } + Pop args + } + + # Set the correct sum algorithm + if {$opts(-sysv)} { + set opts(algorithm) [namespace origin sum-sysv] + } + + # If a file was given - open it for binary reading. + 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 \ + \"sum ?-bsd|-sysv? ?-format string? ?-chunksize size? \ + ?-timeout ms? -file name | -channel chan | data\"" + } + set r [$opts(algorithm) [lindex $args 0]] + + } else { + + # Create a unique token for the event handling + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token tok + array set tok [list reading 1 result 0 timeout $opts(-timeout) \ + chunksize $opts(-chunksize) \ + algorithm $opts(algorithm)] + set tok(after) [after $tok(timeout) \ + [list [namespace origin SumTimeout] $token]] + + fileevent $opts(-channel) readable \ + [list [namespace origin SumChunk] $token $opts(-channel)] + vwait [subst $token](reading) + + # If we opened the channel we must close it too. + if {$opts(-filename) != {}} { + close $opts(-channel) + } + + # Extract the result or error message if there was a problem. + set r $tok(result) + if {[info exists tok(error)]} { + return -code error $tok(error) + } + + unset tok + } + + return [format $opts(-format) $r] +} + +# ------------------------------------------------------------------------- + +package provide sum 1.1.2 + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/crc/sum.test b/tcllib/modules/crc/sum.test new file mode 100644 index 0000000..88f938d --- /dev/null +++ b/tcllib/modules/crc/sum.test @@ -0,0 +1,196 @@ +# sum.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Tests for the Tcllib sum command +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# RCS: @(#) $Id: sum.test,v 1.8 2006/10/09 21:41:40 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 2.0 + +testing { + useLocal sum.tcl sum ::crc +} + +# ------------------------------------------------------------------------- + +if {[info commands ::crc::SumBsd_c] == {}} { + puts "> pure tcl" +} else { + puts "> critcl based" +} + +# ------------------------------------------------------------------------- + +test sum-1.0 {sum with no parameters} -body { + ::crc::sum +} -returnCodes error -result {wrong # args: should be "sum ?-bsd|-sysv? ?-format string? ?-chunksize size? ?-timeout ms? -file name | -channel chan | data"} + +test sum-1.1 {sum with incorrect parameters} -body { + ::crc::sum -zxcv +} -returnCodes error -result {bad option -zxcv: must be one of -bsd, -channel, -chunksize, -filename, -format, -sysv, -timeout} + +# ------------------------------------------------------------------------- + +foreach {n msg expected} { + 1 "" + "0" + 2 "a" + "97" + 3 "abc" + "16556" + 4 "cba" + "49322" + 5 "message digest" + "26423" + 6 "abcdefghijklmnopqrstuvwxyz" + "53553" + 7 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "25587" + 8 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "21845" + 9 "\uFFFE\u0000\u0001\u0002" + "16418" +} { + test sum-2.$n {sum using BSD algorithm and unsigned integer} -body { + ::crc::sum -bsd $msg + } -result $expected +} + +# ------------------------------------------------------------------------- +foreach {n msg expected} { + 1 "" + "0" + 2 "a" + "97" + 3 "abc" + "294" + 4 "cba" + "294" + 5 "message digest" + "1413" + 6 "abcdefghijklmnopqrstuvwxyz" + "2847" + 7 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "5387" + 8 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "4200" + 9 "\uFFFE\u0000\u0001\u0002" + "257" +} { + test sum-3.$n {sum using SysV algorithm and unsigned integer} -body { + ::crc::sum -sysv $msg + } -result $expected +} + +# ------------------------------------------------------------------------- + +set crc::testfile [info script] + +proc ::crc::loaddata {filename} { + set f [open $filename r] + fconfigure $f -translation binary + set data [read $f] + close $f + return $data +} + +test sum-4.0 {sum file option (BSD)} -body { + set r1 [::crc::sum -bsd -file $::crc::testfile] + set r2 [::crc::sum -bsd [::crc::loaddata $::crc::testfile]] + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } +} -result ok + +test sum-4.1 {sum file option (SysV)} -body { + set r1 [::crc::sum -sysv -file $::crc::testfile] + set r2 [::crc::sum -sysv [::crc::loaddata $crc::testfile]] + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } +} -result ok + +test sum-4.2 {sum -channel option (BSD)} -body { + set r1 [::crc::sum -bsd [::crc::loaddata $::crc::testfile]] + set f [open $::crc::testfile r] + fconfigure $f -translation binary + set r2 [::crc::sum -bsd -channel $f] + close $f + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } +} -result ok + +test sum-4.3 {sum -channel option (SysV)} -body { + set r1 [::crc::sum -sysv -file $::crc::testfile] + set f [open $::crc::testfile r] + fconfigure $f -translation binary + set r2 [::crc::sum -sysv -channel $f] + close $f + if {$r1 != $r2} { + set r "differing results: $r1 != $r2" + } else { + set r ok + } +} -result ok + +# ------------------------------------------------------------------------- + +test sum-5.0 {sum format option (BSD)} -body { + ::crc::sum -bsd -format 0x%X [string repeat x 200] +} -result 0xF8EE + +test sum-5.1 {sum format option (SysV)} -body { + ::crc::sum -sysv -format 0x%X [string repeat x 200] +} -result 0x5DC0 + +# ------------------------------------------------------------------------- +# ticket a80e60deb1 vectors - data over 1 KB length. + +foreach {n expected base count} { + 0 58625 a 1280 + 1 11010 fx 640 + 2 62980 \xfe 1280 +} { + test sum-6.$n {sum (sysv) over 1 K} -body { + crc::sum -sysv -- [string repeat $base $count] + } -result $expected +} + +# ------------------------------------------------------------------------- +# ticket 0a3d5dfe52 + +foreach {n expected base count suffix} { + 0 65535 X 1489 & +} { + test sum-7.$n "sum (sysv) ${base}*${count}" -body { + crc::sum -sysv -- [string repeat $base $count]$suffix + } -result $expected +} + +# ------------------------------------------------------------------------- + +catch {unset ::crc::testfile} +testsuiteCleanup + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: + |