Skip to content

Instantly share code, notes, and snippets.

@greggirwin
Created May 30, 2016 03:20
Show Gist options
  • Save greggirwin/bf9806f512dcd50874b663961a11e550 to your computer and use it in GitHub Desktop.
Save greggirwin/bf9806f512dcd50874b663961a11e550 to your computer and use it in GitHub Desktop.
;-- In %natives.reds
checksum*: func [
check? [logic!]
_tcp [integer!]
_hash [integer!]
_method [integer!]
_key [integer!]
/local
arg [red-value!]
str [red-string!]
bin [red-binary!]
method [red-word!]
key [byte-ptr!]
data [byte-ptr!]
b [byte-ptr!]
len [integer!]
type [integer!]
key-len [integer!]
hash-size [red-integer!]
][
#typecheck [checksum _tcp _hash _method _key]
arg: stack/arguments
len: -1
switch TYPE_OF(arg) [
TYPE_STRING [
str: as red-string! arg
;-- Passing len of -1 tells to-utf8 to convert all chars,
; and it mods len to hold the length of the UTF8 result.
data: as byte-ptr! unicode/to-utf8 str :len
]
default [
;print-line "** Script Error: checksum expected data argument of type: string! binary! file!"
fire [TO_ERROR(script invalid-arg) data]
]
]
case [
_tcp >= 0 [
integer/box crypto/CRC_IP data len
]
_hash >= 0 [
hash-size: as red-integer! arg + _hash
integer/box crypto/HASH_STRING data len hash-size/value
]
any [_method >= 0 _key >= 0] [
method: as red-word! arg + _method
type: symbol/resolve method/symbol
if not crypto/known-method? type [
fire [TO_ERROR(script invalid-arg) method]
exit
]
b: either _key >= 0 [
key-len: -1 ;-- Tell to-utf8 to decode everything
key: as byte-ptr! unicode/to-utf8 as red-string! arg + _key :key-len
;-- Now key-len contains the decoded key length
crypto/calc-hmac type data len key key-len
][
crypto/calc-hash type data len
]
;!! len is reused here, being set to the expected result size of
; the hash call. So you can't set it before making that call.
case [
type = crypto/_md5 [len: 16]
type = crypto/_sha1 [len: 20]
type = crypto/_sha256 [len: 32]
type = crypto/_sha384 [len: 48]
type = crypto/_sha512 [len: 64]
type = crypto/_crc32 [integer/box as integer! b exit]
type = crypto/_tcp [integer/box as integer! b exit]
true [
fire [TO_ERROR(script invalid-arg) method]
exit
]
]
stack/set-last as red-value! binary/load b len
]
true [
integer/box crypto/CRC32 data len
]
]
]
;-- In %crypto.reds
CRC_IP: func [
"Calculate IP CRC per RFC1071"
data [byte-ptr!]
len [integer!]
return: [integer!]
/local
sum [integer!]
][
sum: 0
while [len > 1][
;-- Operate on 2 separate bytes. We don't have a UINT16 type.
sum: sum + (((as-integer data/1) << 8) or as-integer data/2)
data: data + 2
len: len - 2
]
;-- Add left-over byte, if any
if len > 0 [sum: sum + data/value]
;-- Fold 32-bit sum to 16 bits
sum: (sum >> 16) + (sum and FFFFh) ;-- Add high-16 to low-16
sum: sum + (sum >> 16) ;-- Add carry
FFFFh and not sum ;-- 1's complement, then truncate
]
calc-hash: func [
alg-sym [integer!] "Algorithm symbol value"
data [byte-ptr!]
len [integer!]
return: [byte-ptr!]
][
case [
alg-sym = _crc32 [as byte-ptr! CRC32 data len]
alg-sym = _tcp [as byte-ptr! CRC_IP data len]
true [get-digest data len alg-from-symbol alg-sym]
]
]
calc-hmac: func [
alg-sym [integer!] "Algorithm symbol value"
data [byte-ptr!]
len [integer!]
key-data [byte-ptr!]
key-len [integer!]
return: [byte-ptr!]
][
either any [alg-sym = _crc32 alg-sym = _tcp][
print-line "The selected algorithm doesn't support HMAC calculation"
return as byte-ptr! ""
][
get-hmac data len key-data key-len alg-from-symbol alg-sym
]
]
get-hmac: func [
data [byte-ptr!] ;-- message
len [integer!]
key-data [byte-ptr!] ;-- key/password
key-len [integer!]
type [crypto-algorithm!]
return: [byte-ptr!]
/local
block-size [integer!]
n [integer!]
hash-len [integer!] ;-- set based on the algorithm used
hkey-data [byte-ptr!] ;-- hashed key (used if key > block-size)
ipad [byte-ptr!] ;-- inner padding - key XORd with ipad
opad [byte-ptr!] ;-- outer padding - key XORd with opad
idata [byte-ptr!] ;-- holds ipad+data for hashing
odata [byte-ptr!] ;-- holds opad+ihash for hashing
ihash [byte-ptr!] ;-- hash of ipad+data
ohash [byte-ptr!] ;-- hash of opad+ihash
][
block-size: 64 ;-- 64 works for MD5 and SHA1-512
hash-len: alg-hash-size type
hkey-data: null
if key-len > block-size [ ;-- Keys longer than block size get digested
key-data: get-digest key-data key-len type
hkey-data: key-data ;-- Use this to free hashed key later
key-len: hash-len
]
ipad: allocate block-size ;-- Set up inner and outer padding blocks
opad: allocate block-size
set-memory ipad #"^@" block-size ;-- Zero them out
set-memory opad #"^@" block-size
copy-memory ipad key-data key-len ;-- Put the key data in them
copy-memory opad key-data key-len
n: 0
loop block-size [ ;-- XOR the padding blocks with their fixed byte value
n: n + 1
ipad/n: ipad/n xor #"^(36)"
opad/n: opad/n xor #"^(5C)"
]
;-- Pseudocode of what we want to do to get the final result:
; return hash(join opad hash(join ipad data))
idata: allocate block-size + len ;-- Space for ipad + message-data
set-memory idata #"^@" block-size + len
copy-memory idata ipad block-size ;-- Put ipad data in
copy-memory (idata + block-size) data len ;-- Append message data
ihash: get-digest idata (block-size + len) type ;-- Hash ipad+data
odata: allocate block-size + hash-len ;-- Space for opad + hash result
set-memory odata #"^@" block-size + hash-len
copy-memory odata opad block-size ;-- Put opad data in
copy-memory (odata + block-size) ihash hash-len ;-- Append ipad + message-data hash result
ohash: get-digest odata (block-size + hash-len) type ;-- Hash opad + hash(ipad data)
if hkey-data <> null [free hkey-data] ;-- Only done if the key was big and got hashed
free ipad
free opad
free idata
free odata
free ihash
ohash ;?? Who frees this?
]
HASH_STRING: func [
;"Return a case insensitive hash value"
;"Return a case sensitive hash value"
data [byte-ptr!]
len [integer!] "Data length"
size [integer!] "Size of the hash table."
return: [integer!]
][
print-line "** /hash support not yet implemented; algorithm TBD."
if size < 1 [size: 1]
return 0
]
known-method?: func [
"Return true if the given symbol is supported."
sym [integer!]
return: [logic!]
][
any [
sym = _tcp
sym = _crc32
sym = _md5
sym = _sha1
sym = _sha256
sym = _sha384
sym = _sha512
]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment