[ENH] MD5 128-bit one-way hash

Duane Maxwell dmaxwell at entrypoint.com
Fri Jan 21 02:19:13 UTC 2000


'From Squeak2.7 of 5 January 2000 [latest update: #1762] on 20 January 2000
at 6:11:19 pm'!
"Change Set:		MD5
Date:			20 January 2000
Author:			Duane Maxwell/EntryPoint

This changeset implements the MD5 128-bit one-way hash function.  It relies
on the ThirtyTwoBitRegister class supplied as part of the Digital
Signatures functionality included in Squeak 2.7.  As of this date
(1/20/2000), the U.S. Government has lifted many of the previous
restrictions on the export of encryption software, but you should check
before exporting anything including this code.  MD5 is commonly used for
some secure Internet protocols, including authentication in HTTP, which is
why I wrote it.

Submitted by Duane Maxwell"!

-------------- next part --------------
'From Squeak2.7 of 5 January 2000 [latest update: #1762] on 20 January 2000
at 6:11:19 pm'!
"Change Set:		MD5
Date:			20 January 2000
Author:			Duane Maxwell/EntryPoint

This changeset implements the MD5 128-bit one-way hash function.  It relies
on the ThirtyTwoBitRegister class supplied as part of the Digital
Signatures functionality included in Squeak 2.7.  As of this date
(1/20/2000), the U.S. Government has lifted many of the previous
restrictions on the export of encryption software, but you should check
before exporting anything including this code.  MD5 is commonly used for
some secure Internet protocols, including authentication in HTTP, which is
why I wrote it.

Submitted by Duane Maxwell"!

Object subclass: #MD5
	instanceVariableNames: 'state '
	classVariableNames: 'ABCDTable IndexTable ShiftTable SinTable '
	poolDictionaries: ''
	category: 'System-MD5'!

!MD5 commentStamp: 'DSM 1/20/2000 14:08' prior: 0!
This class implements the MD5 128-bit one-way hash function.  It relies on
the ThirtyTwoBitRegister class supplied as part of the "Digital Signatures"
functionality included in Squeak 2.7.  As of this date (1/20/2000), the
U.S. Government has lifted many of the previous restrictions on the export
of encryption software, but you should check before exporting anything
including this code.  MD5 is commonly used for some secure Internet
protocols, including authentication in HTTP, which is why I wrote it.

Submitted by Duane Maxwell

!

!MD5 reorganize!
('initialization' initialize)
('public' hashMessage: hashStream:)
('private-functions' fX:Y:Z: ffA:B:C:D:M:S:T: gX:Y:Z: ggA:B:C:D:M:S:T:
hX:Y:Z: hhA:B:C:D:M:S:T: iX:Y:Z: iiA:B:C:D:M:S:T: step:template:selector:)
('private-buffers' finalValue processBuffer: processFinalBuffer:bitLength:
storeLength:in:)
('private-rounds' round:selector:round: rounds:)
!


!MD5 methodsFor: 'initialization' stamp: 'DSM 1/20/2000 17:56'!
initialize
	"Some magic numbers to get the process started"
	state _ OrderedCollection newFrom: {
		(ThirtyTwoBitRegister new load: 16r67452301).
		(ThirtyTwoBitRegister new load: 16rEFCDAB89).
		(ThirtyTwoBitRegister new load: 16r98BADCFE).
		(ThirtyTwoBitRegister new load: 16r10325476)}.

! !

!MD5 methodsFor: 'public' stamp: 'DSM 1/20/2000 15:29'!
hashMessage: aStringOrByteArray
	"MD5 new hashMessage: 'foo'"
	^ self hashStream: (ReadStream on: aStringOrByteArray asByteArray)
! !

!MD5 methodsFor: 'public' stamp: 'DSM 1/20/2000 01:33'!
hashStream: aPositionableStream
	"MD5 new hashStream: (ReadStream on: 'foo')"
	| startPosition buf bitLength |
	self initialize.

	"aPositionableStream atEnd ifTrue: [self error: 'empty stream']."

	startPosition _ aPositionableStream position.
	[aPositionableStream atEnd] whileFalse: [
		buf _ aPositionableStream next: 64.
		(aPositionableStream atEnd not and: [buf size = 64])
			ifTrue: [self processBuffer: buf]
			ifFalse: [
				bitLength _ (aPositionableStream position -
startPosition) * 8.
				self processFinalBuffer: buf bitLength:
bitLength]].

	^ self finalValue
! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:47'!
fX: x Y: y Z: z
	" compute 'xy or (not x)z'"
	^ x copy bitAnd: y; bitOr: (x copy bitInvert; bitAnd: z)

	! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:38'!
ffA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + f(b,c,d) + m + t) <<< s)"
	^ a += (self fX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:48'!
gX: x Y: y Z: z
	" compute 'xz or y(not z)'"
	^ x copy bitAnd: z; bitOr: (z copy bitInvert; bitAnd: y)

	! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:38'!
ggA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + g(b,c,d) + m + t) <<< s)"
	^ a += (self gX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:48'!
hX: x Y: y Z: z
	" compute 'x xor y xor z'"
	^ x copy bitXor: y; bitXor: z

	! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:38'!
hhA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + h(b,c,d) + m + t) <<< s)"
	^ a += (self hX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 01:48'!
iX: x Y: y Z: z
	" compute 'y xor (x or (not z))'"
	^ y copy bitXor: (z copy bitInvert; bitOr: x)
! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 13:39'!
iiA: a B: b C: c D: d M: m S: s T: t
	"compute a = b + ((a + i(b,c,d) + m + t) <<< s)"
	^ a += (self iX: b Y: c Z: d); += m; += t; leftRotateBy: s; += b.
! !

!MD5 methodsFor: 'private-functions' stamp: 'DSM 1/20/2000 17:58'!
step: data template: item selector: selector
	"Perform one step in the round"

	| args |
	args _  {
		state at: (item at: 1).
		state at: (item at: 2).
		state at: (item at: 3).
		state at: (item at: 4).
		data at: (item at: 5).
		item at: 6.
		item at: 7
		}.
	(self perform: selector withArguments: args).
! !

!MD5 methodsFor: 'private-buffers' stamp: 'DSM 1/20/2000 17:56'!
finalValue
	"Concatenate the state values to produce the 128-bite result"
	^ (( state at: 1) asReverseInteger bitShift: 96) +
	  (( state at: 2) asReverseInteger bitShift: 64) +
	  (( state at: 3) asReverseInteger bitShift: 32) +
	  (( state at: 4) asReverseInteger)! !

!MD5 methodsFor: 'private-buffers' stamp: 'DSM 1/20/2000 17:18'!
processBuffer: aByteArray
	"Process a 64-byte buffer"

	| saveState data |
	saveState _ state collect: [ :item | item copy ].
	data _ Array new: 16.
	1 to: 16 do: [ :index |
		data at: index put:
			(ThirtyTwoBitRegister new reverseLoadFrom:
aByteArray at: (index * 4) - 3)].
	self rounds: data.
	1 to: 4 do: [ :index | (state at: index) += (saveState at: index) ].
! !

!MD5 methodsFor: 'private-buffers' stamp: 'DSM 1/20/2000 17:55'!
processFinalBuffer: aByteArray bitLength: bitLength
	"Pad the buffer until we have an even 64 bytes, then transform"

	| out |
	out _ ByteArray new: 64.
	out replaceFrom: 1 to: aByteArray size with: aByteArray startingAt: 1.
	aByteArray size < 56 ifTrue: [
		out at: aByteArray size + 1 put: 128. "trailing bit"
		self storeLength: bitLength in: out.
		self processBuffer: out.
		^ self].

	"not enough room for the length, so just pad this one, then..."
	aByteArray size < 64 ifTrue: [ out at: aByteArray size + 1 put: 128 ].
	self processBuffer: out.

	"process one additional block of padding ending with the length"
	out _ ByteArray new: 64.  "filled with zeros"
	aByteArray size = 64 ifTrue: [ out at: 1 put: 128].
	self storeLength: bitLength in: out.
	self processBuffer: out.
! !

!MD5 methodsFor: 'private-buffers' stamp: 'DSM 1/20/2000 17:19'!
storeLength: bitLength in: aByteArray
	"Fill in the final 8 bytes of the given ByteArray with a 64-bit
	little-endian representation of the original message length in bits."

	| n i |
	n _ bitLength.
	i _ aByteArray size - 8 + 1.
	[n > 0] whileTrue: [
		aByteArray at: i put: (n bitAnd: 16rFF).
		n _ n bitShift: -8.
		i _ i + 1].
! !

!MD5 methodsFor: 'private-rounds' stamp: 'DSM 1/20/2000 17:57'!
round: data selector: selector round: round
	"Do one round with the given function"

	| shiftIndex template abcd |
	1 to: 16 do: [ :i |
		shiftIndex _ (i - 1) \\ 4 + 1.
		abcd _ ABCDTable at: shiftIndex.
		template _ {
			abcd at: 1. abcd at: 2. abcd at: 3. abcd at: 4.
			(IndexTable at: round) at: i.
			(ShiftTable at: round) at: shiftIndex.
			SinTable at: round - 1 * 16 + i }.
		self step: data template: template selector: selector ].
! !

!MD5 methodsFor: 'private-rounds' stamp: 'DSM 1/20/2000 17:58'!
rounds: data
	"Perform the four rounds with different functions"
	#(
	ffA:B:C:D:M:S:T:
	ggA:B:C:D:M:S:T:
	hhA:B:C:D:M:S:T:
	iiA:B:C:D:M:S:T:
	) doWithIndex: [ :selector :index |
		self round: data selector: selector round: index.]
! !


!MD5 class reorganize!
('utilities' hashMessage: hashStream:)
('testing' test)
('class initialization' initialize)
!


!MD5 class methodsFor: 'utilities' stamp: 'DSM 1/20/2000 18:03'!
hashMessage: aStringOrByteArray
	^ self new hashMessage: aStringOrByteArray! !

!MD5 class methodsFor: 'utilities' stamp: 'DSM 1/20/2000 18:03'!
hashStream: aPositionableStream
	^ self new hashStream: aPositionableStream! !

!MD5 class methodsFor: 'testing' stamp: 'DSM 1/20/2000 18:06'!
test
	"MD5 test"

	(MD5 hashMessage: 'a') = 16r0CC175B9C0F1B6A831C399E269772661
		ifFalse: [ self error: 'failed'].
	(MD5 hashMessage: 'abc') = 16r900150983CD24FB0D6963F7D28E17F72
		ifFalse: [ self error: 'failed'].
	(MD5 hashMessage: 'message digest') =
16rF96B697D7CB7938D525A2F31AAF161D0
		ifFalse: [ self error: 'failed'].
	(MD5 hashMessage:
		'abcdefghijklmnopqrstuvwxyz') =
16rC3FCD3D76192E4007DFB496CCA67E13B
		ifFalse: [ self error: 'failed'].
	(MD5 hashMessage:

	'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789') =
		16rD174AB98D277D9F5A5611C2C9F419D9F
		ifFalse: [ self error: 'failed'].
	(MD5 hashMessage:
	'123456789012345678901234567890123456789012345678901234567890123456789012345678
90') = 		16r57EDF4A22BE3C955AC49DA2E2107B67A
		ifFalse: [ self error: 'failed'].
! !

!MD5 class methodsFor: 'class initialization' stamp: 'DSM 1/20/2000 18:08'!
initialize
	"MD5 initialize"

	"Obscure fact: those magic hex numbers that are hard to type in
correctly are
	actually the result of a simple trigonometric function and are
therefore
	easier to compute than proofread.  Laziness is sometimes a virtue."

	| c |
	c _ 2 raisedTo: 32.
	SinTable _ Array new: 64.
	1 to: 64 do: [ :i |
		SinTable
			at: i
			put: (ThirtyTwoBitRegister new load: (c * i sin
abs) truncated)].
	ShiftTable _ {
		#(7 12 17 22).
		#(5 9 14 20).
		#(4 11 16 23).
		#(6 10 15 21)
		}.
	IndexTable _ {
		#(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16).
		#(2 7 12 1 6 11 16 5 10 15 4 9 14 3 8 13).
		#(6 9 12 15 2 5 8 11 14 1 4 7 10 13 16 3).
		#(1 8 15 6 13 4 11 2 9 16 7 14 5 12 3 10)
		}.
	ABCDTable _ {
		#(1 2 3 4).
		#(4 1 2 3).
		#(3 4 1 2).
		#(2 3 4 1)
		}
! !


!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'DSM 1/20/2000 17:17'!
asReverseInteger
	"Answer the byte-swapped integer value of my current contents."

	^ ((low bitAnd: 16rFF) bitShift: 24) +
       ((low bitAnd: 16rFF00) bitShift: 8) +
	  ((hi bitAnd: 16rFF) bitShift: 8) +
       (hi bitShift: -8)
! !

!ThirtyTwoBitRegister methodsFor: 'accessing' stamp: 'DSM 1/20/2000 14:55'!
reverseLoadFrom: aByteArray at: index
	"Load my 32-bit value from the four bytes of the given ByteArray
starting at the given index. Consider the first byte to contain the most
significant bits of the word (i.e., use big-endian byte ordering)."

	hi _ ((aByteArray at: index + 3) bitShift: 8) + ( aByteArray at:
index + 2).
	low _ ((aByteArray at: index + 1) bitShift: 8) + ( aByteArray at:
index).
! !


MD5 removeSelector: #round1:!
MD5 removeSelector: #ggB:C:D:M:S:T:!
MD5 removeSelector: #round4:!
MD5 removeSelector: #iiB:C:D:M:S:T:!
MD5 removeSelector: #hhB:C:D:M:S:T:!
MD5 removeSelector: #ffB:C:D:M:S:T:!
MD5 removeSelector: #round3:!
MD5 removeSelector: #round2:!
MD5 class removeSelector: #example1!
MD5 initialize!
-------------- next part --------------
===================================================
Duane Maxwell          dmaxwell (at) entrypoint.com
CTO                       http://www.entrypoint.com
EntryPoint, Inc.    (858)348-3040  FAX(858)348-3100

Information contained herein is my personal opinion
     and not necessarily that of EntryPoint.
===================================================


More information about the Squeak-dev mailing list