Tcl Library Source Code

# md5tcc.tcl - 
#
# Wrapper for RSA's Message Digest in C
#
# Written by Jean-Claude Wippler <[email protected]>
# Adapted for tcc by Mark Janssen
#

package require tcc4tcl;                 # needs tcc4tcl
package provide md5tcc 0.0.1;              # 

namespace eval ::md5 {
  set handle [tcc4tcl::new]
 
  set source_dir [file dirname [info script]] 
  $handle add_include_path $source_dir
  $handle ccode {#include "md5.c"}

  $handle ccommand md5tcc_final {dummy ip objc objv} {
      MD5_CTX *mp;
      unsigned char *data;
      unsigned char buf[16];
      int size;
      Tcl_Obj *obj;
      if (objc != 2) {
        Tcl_WrongNumArgs(ip, 1, objv, "context");
        return TCL_ERROR;
      }
      obj = objv[1];
      mp = (MD5_CTX *) Tcl_GetByteArrayFromObj(obj,NULL);
      MD5Final(buf, mp);
      size = sizeof buf;
      Tcl_SetObjResult(ip, Tcl_NewByteArrayObj(buf,size));
      return TCL_OK;

  }
  $handle ccommand md5tcc {dummy ip objc objv} {
      MD5_CTX *mp;
      unsigned char *data;
      int size;
      Tcl_Obj *obj;

      if (objc < 2 || objc > 3) {
        Tcl_WrongNumArgs(ip, 1, objv, "data ?context?");
        return TCL_ERROR;
      }

      if (objc == 3) {
        obj = objv[2];
        if (Tcl_IsShared(obj)) {
          obj = Tcl_DuplicateObj(obj);
        }
      } else {
        obj = Tcl_NewByteArrayObj(NULL, sizeof *mp);
        mp = (MD5_CTX *) Tcl_GetByteArrayFromObj(obj,NULL);
        MD5Init(mp);
      }

      mp = (MD5_CTX *) Tcl_GetByteArrayFromObj(obj,NULL);
      data = Tcl_GetByteArrayFromObj(objv[1], &size);
      Tcl_InvalidateStringRep(obj);
      MD5Update(mp, data, size);
      Tcl_SetObjResult(ip, obj);
      return TCL_OK;
    }

  $handle go
}

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------

package require Tcl 8.2;                # tcl minimum version

namespace eval ::md5 {
    variable  accel
    array set accel {tcc 0 critcl 0 cryptkit 0 trf 0}

    namespace export md5 hmac MD5Init MD5Update MD5Final

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

#
#   If we have a C-based implementation available, then we will use
#   it here in preference to the pure-Tcl implementation.
#
proc ::md5::MD5Update {token data} {
    variable accel
    upvar #0 $token state
    if {$accel(tcc)} {
        if {[info exists state(md5tcc)]} {
            set state(md5tcc) [md5tcc $data $state(md5tcc)]
        } else {
            set state(md5tcc) [md5tcc $data]
        }
        return
    } elseif {$accel(critcl)} {
        if {[info exists state(md5c)]} {
            set state(md5c) [md5c $data $state(md5c)]
        } else {
            set state(md5c) [md5c $data]
        }
        return
    } elseif {[info exists state(ckctx)]} {

#
#    Note that the output is 128 bits represented as binary data.
#
proc ::md5::MD5Final {token} {
    upvar #0 $token state

    # Check for either of the C-compiled versions.
    if {[info exists state(md5tcc)]} {
      set r [md5::md5tcc_final $state(md5tcc)]
      unset state
      return $r
    } elseif {[info exists state(md5c)]} {
        set r $state(md5c)
        unset state
        return $r
    } elseif {[info exists state(ckctx)]} {
        cryptkit::cryptEncrypt $state(ckctx) ""
        cryptkit::cryptGetAttributeString $state(ckctx) \
            CRYPT_CTXINFO_HASHVALUE r 16

#	this should not be called, but the test package manipulates the
#	list of enabled accelerators.
#
proc ::md5::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        tcc {
            if {![catch {package require tcc4tcl}] &&
                ! [catch {package require md5tcc}]} {
                set r [expr {[info commands ::md5::md5tcc] != {}}]
            }
        }
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require md5c}]} {
                set r [expr {[info commands ::md5::md5c] != {}}]
            }
        }
        cryptkit {

}

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

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

package provide md5 2.0.7

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

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded md5 2.0.7 [list source [file join $dir md5x.tcl]]
package ifneeded md5 1.4.4 [list source [file join $dir md5.tcl]]
package ifneeded md5tcc 0.0.1 [list source [file join $dir md5tcc.tcl]]