REBOL [
	Title:   "MD5 Message-Digest Algorithm"
	Author:  "Marco Antoniazzi"
	file: %md5.r
	Rights:  "derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm"
	email: [luce80 AT libero DOT it]
	date: 16-12-2012
	version: 2.0.1
	Purpose: {Returns a MD5 "message digest" of an input string as a binary!}
	History: [
		0.0.1 [11-11-2012 "Start"]
		1.0.0 [24-11-2012 "Works"]
		1.0.1 [03-12-2012 "Revised leftrotate"]
		2.0.0 [15-12-2012 "Added incremental behaviour and hmac-md5"]
		2.0.1 [16-12-2012 "Fixed to-uint32 and length calc"]
	]
	library: [
		level: 'intermediate
		platform: 'all
		type: 'tool
		domain: [encryption]
		tested-under: [View 2.7.8.3.1]
		support: none
		License: "http://en.wikipedia.org/wiki/Wikipedia:Text_of_Creative_Commons_Attribution-ShareAlike_3.0_Unported_License"
	]
	Notes: {
		taken from: http://en.wikipedia.org/wiki/MD5
		using symbols found in RFC 1321
		Not fast but compact
		
		NO WARRANTIES. USE AT YOUR OWN RISK.
		
		Bugs: length of message must be < 2^63 bytes
	}
]

ctx-md5: context [
	; convenience functions
	int-to-bin: func [num [integer!]][reverse debase/base to-hex num 16] ; reversed
	to-uint32: func [num [decimal!]][while [num < 0] [num: num + 4294967296] while [num > 2147483647] [num: num - 4294967296] to integer! num]

	;leftrotate function definition ;(x << c) or (x >> (32 - c))
	leftrotate: func [x [integer!] c [integer!] /local a b] [
		(shift/left x c) or shift/logical x (32 - c)
	]

	;Note: All variables are unsigned 32 bit and wrap modulo 2^32 when calculating

	;s specifies the per-round shift amounts
	s:	[7 12 17 22 7 12 17 22 7 12 17 22 7 12 17 22
		 5  9 14 20 5  9 14 20 5  9 14 20 5  9 14 20
		 4 11 16 23 4 11 16 23 4 11 16 23 4 11 16 23
		 6 10 15 21 6 10 15 21 6 10 15 21 6 10 15 21]

	T: copy []
	;Use binary integer part of the sines of integers (Radians) as constants:
	for i 1 64 1 [
		sin: abs (sine/radians i) * 4294967296
		sin: to-decimal head clear find form sin "." ; integer part
		append T to-uint32 sin
	]

	set 'md5 func [[catch]
		{Returns a "message digest" of the input string as binary!}
		message [any-string!] "input string"
		/with md5-context [block!] "initial context"
		/local
		final-length
		AA BB CC DD
		i j X-j byte
		A B C D F X
		temp n pad?
		][

		message: to-binary message

		final-length: round/ceiling/to (length? message) + 1 + 8 64 ; At least 1 byte for padding single 1 bit and 8 bytes for message length (in bits)
		temp: length? message
		pad?: true

		either none? md5-context [
			md5-context: copy [0  0 0 0 0]
		][
			if 5 <> length? md5-context [throw make error! "md5-context length must be 5"]
			if md5-context/1 = 0 [
				if 0 <> mod temp 64 [throw make error! "message length must be a multiple of 64 bytes"]
				final-length: temp
				pad?: false
			]
		]

		either md5-context/1 = 0 [
			temp: 8.0 * temp ; length in bits of message
			md5-context/2: 1732584193
			md5-context/3: -271733879
			md5-context/4: -1732584194
			md5-context/5: 271733878
		][
			temp: 8 * temp + md5-context/1
		]
		i: to-integer temp / 4294967296 ; high 32 bits
		j: to-integer temp - (i * 4294967296) ; low 32 bits
		md5-context/1: temp

		if pad? [

		;Step 1. Append Padding Bits
			;Pre-processing: adding a single 1 bit and padding with zeros until message length in bit is multiple of 512
			insert tail message #{80} ; padding single 1 bit
			insert/dup tail message #{00} final-length - (length? message) - 8

		;Step 2. Append Length
			temp: join int-to-bin j int-to-bin i
			; put length mod (2 pow 64) to message
			message: head insert tail message temp
		]

		;Step 3. Initialize MD Buffer
			;Initialize variables:
			A: md5-context/2
			B: md5-context/3
			C: md5-context/4
			D: md5-context/5

		;Step 4. Process Message in 16-Word Blocks
			;Process the message in successive 512-bit chunks:
			;for each 512-bit chunk of message
			for byte 1 final-length 64 [
				;break chunk into sixteen 32-bit words X[j] 0 <= j <= 15
					X-j: at message byte
				;Initialize hash value for this chunk:
					AA: A
					BB: B
					CC: C
					DD: D
				;Main loop:
					for i 0 63 1 [
						case [
							all [0 <= i i <= 15] [
								F: (B and C) or ((complement B) and D)
								j: i
							]
							all [16 <= i i <= 31] [
								F: (B and D) or (C and (complement D))
								j: mod (5 * i + 1) 16
							]
							all [32 <= i i <= 47] [
								F: B xor C xor D
								j: mod (3 * i + 5) 16
							]
							all [48 <= i i <= 63] [
								F: C xor (B or (complement D))
								j: mod (7 * i) 16
							]
						]

						X: to-integer reverse copy/part at X-j (j * 4 + 1) 4
						temp: D
						D: C
						C: B
						;B: B + leftrotate (A + F + X + T/(i + 1))  s/(i + 1)
						n: to-uint32 0.0 + A + F + X + T/(i + 1)
						B: to-uint32 0.0 + B + leftrotate n s/(i + 1)
						A: temp
					]

	     			;Add this chunk's hash to result so far:
				    A: to-uint32 0.0 + A + AA
				    B: to-uint32 0.0 + B + BB
				    C: to-uint32 0.0 + C + CC
				    D: to-uint32 0.0 + D + DD
			]

			md5-context/2: A
			md5-context/3: B
			md5-context/4: C
			md5-context/5: D

		;Step 5. Output ;
			rejoin [int-to-bin A int-to-bin B int-to-bin C int-to-bin D]
	]
	
	{ Krawczyk, et. al. RFC 2104
	** Function: hmac_md5
	}

	set 'hmac-md5 func [
		text [any-string!] { data stream }
		key [any-string!] { authentication key }
		/local
		k_ipad
		k_opad
		i
		][
		k_ipad: copy #{} { inner padding - key XORd with ipad}
		k_opad: copy #{} { outer padding - key XORd with opad}

		; if key is longer than 64 bytes reset it to key=MD5 key
		if (length? key) > 64 [key: md5 key]

		{
			* the HMAC_MD5 transform looks like:
			*
			* MD5(K XOR opad, MD5(K XOR ipad, text)) 
			*
			* where K is an n byte key
			* ipad is the byte 54 repeated 64 times
			* opad is the byte 92 repeated 64 times
			* and text is the data being protected
		}

		; XOR key with ipad and opad values 
		for i 1 64 1 [
			insert tail k_ipad to-char (any [key/:i 0]) xor 54
			insert tail k_opad to-char (any [key/:i 0]) xor 92
		]

		md5 join k_opad md5 join k_ipad text
	]
]

;comment [
do [
probe md5 ""
probe md5 "a"
probe md5 "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
md5-ctx: [0  0 0 0 0] ; initialize md5 context
md5/with "1234567890123456789012345678901234567890123456789012345678901234" md5-ctx
probe md5/with "5678901234567890" md5-ctx
probe hmac-md5 "what do ya want for nothing?" "Jefe"
halt
]