1# md5cryptc.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
2#
3# This is a critcl-based wrapper to provide a Tcl implementation of the md5crypt
4# function. The C code here is based upon the OpenBSD source, which is in turn
5# derived from the original implementation by Poul-Henning Kamp
6#
7# The original C source license reads:
8#/*
9# * ----------------------------------------------------------------------------
10# * "THE BEER-WARE LICENSE" (Revision 42):
11# * <phk@login.dknet.dk> wrote this file.  As long as you retain this notice you
12# * can do whatever you want with this stuff. If we meet some day, and you think
13# * this stuff is worth it, you can buy me a beer in return.   Poul-Henning Kamp
14# * ----------------------------------------------------------------------------
15# */
16#
17# -------------------------------------------------------------------------
18# See the file "license.terms" for information on usage and redistribution
19# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20# -------------------------------------------------------------------------
21
22
23package require critcl
24# @sak notprovided md5cryptc
25package provide md5cryptc 1.0
26
27critcl::cheaders ../md5/md5.h
28#critcl::csources ../md5/md5.c
29
30namespace eval ::md5crypt {
31    critcl::ccode {
32#include "md5.h"
33#ifdef _MSC_VER
34#define snprintf _snprintf
35#endif
36        static unsigned char itoa64[] =
37            "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
38
39        static void to64(char *s, unsigned int v, int n)
40        {
41            while (--n >= 0) {
42                *s++ = itoa64[v&0x3f];
43                v >>= 6;
44            }
45        }
46
47        static void dump(const char *s, unsigned int len)
48        {
49            unsigned int i;
50            for (i = 0; i < len; i++)
51                printf("%02X", s[i]&0xFF);
52            putchar('\n');
53        }
54
55        static char * md5crypt(const char *pw,
56                               const char *salt,
57                               const char *magic)
58        {
59            static char     passwd[120], *p;
60            static const unsigned char *sp,*ep;
61            unsigned char	final[16];
62            int sl,pl,i;
63            MD5_CTX	ctx,ctx1;
64            unsigned long l;
65
66            /* Refine the Salt first */
67            sp = (const unsigned char *)salt;
68
69            /* If it starts with the magic string, then skip that */
70            if(!strncmp((const char *)sp,(const char *)magic,strlen((const char *)magic)))
71                sp += strlen((const char *)magic);
72
73            /* It stops at the first '$', max 8 chars */
74            for(ep=sp;*ep && *ep != '$' && ep < (sp+8);ep++)
75                continue;
76
77            /* get the length of the true salt */
78            sl = ep - sp;
79
80            MD5Init(&ctx);
81
82            /* The password first, since that is what is most unknown */
83            MD5Update(&ctx,(const unsigned char *)pw,strlen(pw));
84
85            /* Then our magic string */
86            MD5Update(&ctx,magic,strlen((const char *)magic));
87
88            /* Then the raw salt */
89            MD5Update(&ctx,sp,sl);
90
91            /* Then just as many characters of the MD5(pw,salt,pw) */
92            MD5Init(&ctx1);
93            MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw));
94            MD5Update(&ctx1,sp,sl);
95            MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw));
96            MD5Final(final,&ctx1);
97
98            for(pl = strlen(pw); pl > 0; pl -= 16) {
99                int tl = pl > 16 ? 16 : pl;
100                MD5Update(&ctx,final,pl>16 ? 16 : pl);
101            }
102
103            /* Don't leave anything around in vm they could use. */
104            memset(final,0,sizeof final);
105
106            /* Then something really weird... */
107            for (i = strlen(pw); i ; i >>= 1) {
108                if(i&1)
109                    MD5Update(&ctx, final, 1);
110                else
111                    MD5Update(&ctx, (const unsigned char *)pw, 1);
112            }
113
114            /* Now make the output string */
115            snprintf(passwd, sizeof(passwd), "%s%.*s$", (char *)magic,
116                    sl, (const char *)sp);
117
118            MD5Final(final,&ctx);
119
120            /*
121             * and now, just to make sure things don't run too fast
122             * On a 60 Mhz Pentium this takes 34 msec, so you would
123             * need 30 seconds to build a 1000 entry dictionary...
124             */
125            for(i=0;i<1000;i++) {
126                MD5Init(&ctx1);
127                if(i & 1)
128                    MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw));
129                else
130                    MD5Update(&ctx1,final,16);
131
132                if(i % 3)
133                    MD5Update(&ctx1,sp,sl);
134
135                if(i % 7)
136                    MD5Update(&ctx1,pw,strlen(pw));
137
138                if(i & 1)
139                    MD5Update(&ctx1,final,16);
140                else
141                    MD5Update(&ctx1,pw,strlen(pw));
142                MD5Final(final,&ctx1);
143            }
144
145            p = passwd + strlen(passwd);
146
147            l = (final[ 0]<<16) | (final[ 6]<<8) | final[12]; to64(p,l,4); p += 4;
148            l = (final[ 1]<<16) | (final[ 7]<<8) | final[13]; to64(p,l,4); p += 4;
149            l = (final[ 2]<<16) | (final[ 8]<<8) | final[14]; to64(p,l,4); p += 4;
150            l = (final[ 3]<<16) | (final[ 9]<<8) | final[15]; to64(p,l,4); p += 4;
151            l = (final[ 4]<<16) | (final[10]<<8) | final[ 5]; to64(p,l,4); p += 4;
152            l =		       final[11]		; to64(p,l,2); p += 2;
153            *p = '\0';
154
155            /* Don't leave anything around in vm they could use. */
156            memset(final,0,sizeof final);
157
158            return passwd;
159        }
160    }
161    critcl::cproc to64_c {Tcl_Interp* interp int v int n} ok {
162        char s[5];
163        to64(s, (unsigned int)v, n);
164        Tcl_SetObjResult(interp, Tcl_NewStringObj(s, n));
165        return TCL_OK;
166    }
167
168    critcl::cproc md5crypt_c {Tcl_Interp* interp char* magic char* pw char* salt} ok {
169        char* s = md5crypt(pw, salt, magic);
170        Tcl_SetObjResult(interp, Tcl_NewStringObj(s, strlen(s)));
171        return TCL_OK;
172    }
173}
174