REBOL [
	Title:   "SHA1 Message-Digest Algorithm"
	Author:  "Marco Antoniazzi"
	file: %sha1.r
	email: [luce80 AT libero DOT it]
	date: 16-12-2012
	version: 1.0.0
	Purpose: {Returns a sha1 "message digest" of an input string as a binary!}
	History: [
		1.0.0 [16-12-2012 "Started and finished"]
	]
	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: FIPS 180-1
		taken from: http://en.wikipedia.org/wiki/sha-1
		Not fast but compact
		
		NO WARRANTIES. USE AT YOUR OWN RISK.
		
		Bugs: length of message must be < 2^63 bytes
	}
]

ctx-sha1: context [
	; convenience functions
	int-to-bin: func [num [integer!]][debase/base to-hex num 16] ; big-endian
	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 1: All variables are unsigned 32 bits and wrap modulo 2^32 when calculating
	;Note 2: All constants in this code are in big endian. 
	;        Within each word, the most significant byte is stored in the leftmost byte position

	set 'sha1 func [[catch]
		{Returns a SHA1 "message digest" of the input string as binary!}
		message [any-string!] "input string"
		/with sha1-context [block!] "initial context"
		/local
		final-length
		a b c d e
		i j w-t w
		h0 h1 h2 h3 h4 f byte
		temp 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? sha1-context [
			sha1-context: copy [0  0 0 0 0 0]
		][
			if 6 <> length? sha1-context [throw make error! "sha1-context length must be 6"]
			if sha1-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 sha1-context/1 = 0 [
			temp: 8.0 * temp ; length in bits of message
			sha1-context/2: 1732584193
			sha1-context/3: -271733879
			sha1-context/4: -1732584194
			sha1-context/5: 271733878
			sha1-context/6: -1009589776
		][
			temp: 8 * temp + sha1-context/1
		]
		i: to-integer temp / 4294967296 ; high 32 bits
		j: to-integer temp - (i * 4294967296) ; low 32 bits
		sha1-context/1: temp

		if pad? [

		;Step 1. Append Padding Bits
			;Pre-processing:
			;append the bit '1' to the message
			insert tail message #{80} ; padding single 1 bit
			;append 0 = k < 512 bits '0', so that the resulting message length (in bits)
			;   is congruent to 448 (mod 512)
			insert/dup tail message #{00} final-length - (length? message) - 8

		;Step 2. Append Length
			;append length of message (before pre-processing), in bits, as 64-bit big-endian integer
			message: head insert tail message join int-to-bin i int-to-bin j
		]

		;Step 3. Initialize main Buffer
			;Initialize variables:
			h0: sha1-context/2
			h1: sha1-context/3
			h2: sha1-context/4
			h3: sha1-context/5
			h4: sha1-context/6

		;Step 4. Process Message in 16-Word Blocks
			w: array 80
			;Process the message in successive 512-bit chunks:
			;break message into 512-bit chunks
			for byte 1 final-length 64 [
				;break chunk into sixteen 32-bit big-endian words w[i], 0 <= i <= 15
					w-t: at message byte
				;Extend the sixteen 32-bit words into eighty 32-bit words:
					for i 1 80 1 [
						either i <= 16 [
							w/(i): to-integer copy/part at w-t (i * 4 - 3) 4
						][
							w/(i): leftrotate (w/(i - 3) xor w/(i - 8) xor w/(i - 14) xor w/(i - 16)) 1
						]
					]
				;Initialize hash value for this chunk:
					a: h0
					b: h1
					c: h2
					d: h3
					e: h4
				;Main loop:
					for i 0 79 1 [
						case [
							all [0 <= i i <= 19] [
								f: (b and c) or ((complement b) and d)
								k: 1518500249
							]
							all [20 <= i i <= 39] [
								f: b xor c xor d
								k: 1859775393
							]
							all [40 <= i i <= 59] [
								f: (b and c) or (b and d) or (c and d) 
								k: -1894007588
							]
							all [60 <= i i <= 79] [
								f: b xor c xor d
								k: -899497514
							]
						]

						temp: to-uint32 0.0 + (leftrotate a 5) + f + e + k + w/(i + 1)
						e: d
						d: c
						c: leftrotate b 30
						b: a
						a: temp
					]

				;Add this chunk's hash to result so far:
					h0: to-uint32 0.0 + h0 + a
					h1: to-uint32 0.0 + h1 + b 
					h2: to-uint32 0.0 + h2 + c
					h3: to-uint32 0.0 + h3 + d
					h4: to-uint32 0.0 + h4 + e
			]

			sha1-context/2: h0
			sha1-context/3: h1
			sha1-context/4: h2
			sha1-context/5: h3
			sha1-context/6: h4

		;Step 5. Output ;
			;Produce the final hash value (big-endian):
			rejoin [int-to-bin h0 int-to-bin h1 int-to-bin h2 int-to-bin h3 int-to-bin h4]
	]
	
]

;comment [
do [
	probe sha1 ""
	probe sha1 "abc"
	probe sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
	probe sha1 "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
	sha1-ctx: [0  0 0 0 0 0] ; initialize sha1 context
	sha1/with "1234567890123456789012345678901234567890123456789012345678901234" sha1-ctx
	probe sha1/with "5678901234567890" sha1-ctx
	halt
]