← Back to branch summary

~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to lib/md5c/md5c.tcl

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
Import upstream version 3.1.9

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/md5c/md5c.tcl
 
1
# Wrapper for RSA's Message Digest in C
 
2
 
 
3
package provide md5c 0.11
 
4
package require critcl
 
5
 
 
6
critcl::cheaders md5c_c/md5.h
 
7
critcl::csources md5c_c/md5.c
 
8
 
 
9
critcl::ccode {
 
10
  #include "md5.h"
 
11
  #include <malloc.h>
 
12
  #include <memory.h>
 
13
  #include <assert.h>
 
14
 
 
15
  static
 
16
  Tcl_ObjType md5_type; /* fast internal access representation */
 
17
 
 
18
  static void 
 
19
  md5_free_rep(Tcl_Obj* obj)
 
20
  {
 
21
    MD5_CTX* mp = (MD5_CTX*) obj->internalRep.otherValuePtr;
 
22
    free(mp);
 
23
  }
 
24
       
 
25
  static void
 
26
  md5_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup)
 
27
  {
 
28
    MD5_CTX* mp = (MD5_CTX*) obj->internalRep.otherValuePtr;
 
29
    dup->internalRep.otherValuePtr = malloc(sizeof *mp);
 
30
    memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp);
 
31
    dup->typePtr = &md5_type;
 
32
  }
 
33
   
 
34
  static void
 
35
  md5_string_rep(Tcl_Obj* obj)
 
36
  {
 
37
    unsigned char buf[16];
 
38
    Tcl_Obj* temp;
 
39
    char* str;
 
40
    MD5_CTX dup = *(MD5_CTX*) obj->internalRep.otherValuePtr;
 
41
 
 
42
    MD5Final(buf, &dup);
 
43
 
 
44
      /* convert via a byte array to properly handle null bytes */
 
45
    temp = Tcl_NewByteArrayObj(buf, sizeof buf);
 
46
    Tcl_IncrRefCount(temp);
 
47
 
 
48
    str = Tcl_GetStringFromObj(temp, &obj->length);
 
49
    obj->bytes = Tcl_Alloc(obj->length + 1);
 
50
    memcpy(obj->bytes, str, obj->length + 1);
 
51
 
 
52
    Tcl_DecrRefCount(temp);
 
53
  }
 
54
   
 
55
  static int
 
56
  md5_from_any(Tcl_Interp* ip, Tcl_Obj* obj)
 
57
  {
 
58
    assert(0);
 
59
    return TCL_ERROR;
 
60
  }
 
61
 
 
62
  static
 
63
  Tcl_ObjType md5_type = {
 
64
    "md5c", md5_free_rep, md5_dup_rep, md5_string_rep, md5_from_any
 
65
  };
 
66
}
 
67
 
 
68
critcl::ccommand md5c {dummy ip objc objv} {
 
69
  MD5_CTX* mp;
 
70
  unsigned char* data;
 
71
  int size;
 
72
  Tcl_Obj* obj;
 
73
 
 
74
  //Tcl_RegisterObjType(&md5_type);
 
75
 
 
76
  if (objc < 2 || objc > 3) {
 
77
    Tcl_WrongNumArgs(ip, 1, objv, "data ?context?");
 
78
    return TCL_ERROR;
 
79
  }
 
80
 
 
81
  if (objc == 3) {
 
82
    if (objv[2]->typePtr != &md5_type && md5_from_any(ip, objv[2]) != TCL_OK)
 
83
      return TCL_ERROR;
 
84
    obj = objv[2];
 
85
    if (Tcl_IsShared(obj))
 
86
      obj = Tcl_DuplicateObj(obj);
 
87
  } else {
 
88
    obj = Tcl_NewObj();
 
89
    mp = (MD5_CTX*) malloc(sizeof *mp);
 
90
    MD5Init(mp);
 
91
 
 
92
    if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL)
 
93
      obj->typePtr->freeIntRepProc(obj);
 
94
 
 
95
    obj->internalRep.otherValuePtr = mp;
 
96
    obj->typePtr = &md5_type;
 
97
  }
 
98
 
 
99
  Tcl_SetObjResult(ip, obj);
 
100
  Tcl_IncrRefCount(obj); //!! huh?
 
101
 
 
102
  Tcl_InvalidateStringRep(obj);
 
103
  mp = (MD5_CTX*) obj->internalRep.otherValuePtr;
 
104
 
 
105
  data = Tcl_GetByteArrayFromObj(objv[1], &size);
 
106
  MD5Update(mp, data, size);
 
107
 
 
108
  return TCL_OK;
 
109
}
 
110
 
 
111
if {[info exists pkgtest] && $pkgtest} {
 
112
 
 
113
  proc md5c_try {} {
 
114
    foreach {msg expected} {
 
115
      ""
 
116
      "d41d8cd98f00b204e9800998ecf8427e"
 
117
      "a"
 
118
      "0cc175b9c0f1b6a831c399e269772661"
 
119
      "abc"
 
120
      "900150983cd24fb0d6963f7d28e17f72"
 
121
      "message digest"
 
122
      "f96b697d7cb7938d525a2f31aaf161d0"
 
123
      "abcdefghijklmnopqrstuvwxyz"
 
124
      "c3fcd3d76192e4007dfb496cca67e13b"
 
125
      "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
 
126
      "d174ab98d277d9f5a5611c2c9f419d9f"
 
127
      "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
 
128
      "57edf4a22be3c955ac49da2e2107b67a"
 
129
    } {
 
130
      puts "testing: md5 \"$msg\""
 
131
      binary scan [md5c $msg] H* computed
 
132
      puts "computed: $computed"
 
133
      if {0 != [string compare $computed $expected]} {
 
134
        puts "expected: $expected"
 
135
        puts "FAILED"
 
136
      }
 
137
    }
 
138
 
 
139
    foreach len {10 50 100 500 1000 5000 10000} {
 
140
      set blanks [format %$len.0s ""]
 
141
      puts "input length $len: [time {md5c $blanks} 1000]"
 
142
    }
 
143
  }
 
144
 
 
145
  md5c_try
 
146
}