1structure SHA1_ML :> SHA1_ML = 2struct 3 4 (* taken from 5 git@github.com:srdqty/sml-sha1.git 6 *) 7 8(* Copyright (c) 2014 Sophia Donataccio, The MIT License (MIT) *) 9 10(* A good explanation of the sha1 algorithm is available at 11 https://en.wikipedia.org/wiki/SHA-1 *) 12 13 type 'a byte_reader = 'a * int -> Word8Vector.vector * 'a 14 15 local 16 fun toBitSize x = Word64.*(x, 0w8) 17 18 fun explodeSize size (* in bits *) = 19 let 20 val s7 = Word64.>>(Word64.<<(size, 0w56), 0w56) 21 val s6 = Word64.>>(Word64.<<(size, 0w48), 0w56) 22 val s5 = Word64.>>(Word64.<<(size, 0w40), 0w56) 23 val s4 = Word64.>>(Word64.<<(size, 0w32), 0w56) 24 val s3 = Word64.>>(Word64.<<(size, 0w24), 0w56) 25 val s2 = Word64.>>(Word64.<<(size, 0w16), 0w56) 26 val s1 = Word64.>>(Word64.<<(size, 0w08), 0w56) 27 val s0 = Word64.>>(size , 0w56) 28 in 29 ( Word8.fromLarge (Word64.toLarge s0) 30 , Word8.fromLarge (Word64.toLarge s1) 31 , Word8.fromLarge (Word64.toLarge s2) 32 , Word8.fromLarge (Word64.toLarge s3) 33 , Word8.fromLarge (Word64.toLarge s4) 34 , Word8.fromLarge (Word64.toLarge s5) 35 , Word8.fromLarge (Word64.toLarge s6) 36 , Word8.fromLarge (Word64.toLarge s7)) 37 end 38 39 fun createLastChunk (chunk, messageByteSize) = 40 let 41 val chunkSize = Word8Vector.length chunk 42 val (s0, s1, s2, s3, s4, s5, s6, s7) = 43 (* Size in bits is stored in the chunk *) 44 explodeSize (toBitSize messageByteSize) 45 fun buildChunk i = 46 if i < chunkSize then Word8Vector.sub (chunk, i) 47 else if i = chunkSize then 0wx80 48 else if i = 56 then s0 49 else if i = 57 then s1 50 else if i = 58 then s2 51 else if i = 59 then s3 52 else if i = 60 then s4 53 else if i = 61 then s5 54 else if i = 62 then s6 55 else if i = 63 then s7 56 else 0w0 57 in 58 Word8Vector.tabulate (64, buildChunk) 59 end 60 61 fun addPadding chunk = 62 let 63 val chunkSize = Word8Vector.length chunk 64 fun buildChunk i = 65 if i < chunkSize then Word8Vector.sub (chunk, i) 66 else if i = chunkSize then 0wx80 67 else 0w0 68 in 69 Word8Vector.tabulate (64, buildChunk) 70 end 71 72 fun createPadChunk messageByteSize = 73 let 74 val (s0, s1, s2, s3, s4, s5, s6, s7) = 75 (* Size in bits is stored in the chunk *) 76 explodeSize (toBitSize messageByteSize) 77 fun buildChunk i = 78 if i < 56 then 0w0 79 else if i = 56 then s0 80 else if i = 57 then s1 81 else if i = 58 then s2 82 else if i = 59 then s3 83 else if i = 60 then s4 84 else if i = 61 then s5 85 else if i = 62 then s6 86 else if i = 63 then s7 87 else raise (Fail "createPadChunk: invalid chunk size") 88 in 89 Word8Vector.tabulate (64, buildChunk) 90 end 91 92 datatype 'a ChunkReaderState = 93 Reading of 'a byte_reader * 'a * Word64.word 94 | PadChunk of Word8Vector.vector 95 | Empty 96 97 in (* local *) 98 99 fun makeInitChunkStreamState (byteReader, byteStreamState) = 100 Reading (byteReader, byteStreamState, 0w0) 101 102 fun readChunk Empty = NONE 103 | readChunk (PadChunk chunk) = SOME (chunk, Empty) 104 | readChunk (Reading(byteReader, byteStreamState, totalBytesRead)) = 105 let 106 val (chunk, nextByteStreamState) = byteReader (byteStreamState, 64) 107 val chunkSize = Word8Vector.length chunk 108 val nextTotalBytesRead = 109 Word64.+(Word64.fromInt chunkSize, totalBytesRead) 110 in 111 if chunkSize = 64 then SOME (chunk, Reading(byteReader, 112 nextByteStreamState, nextTotalBytesRead)) 113 else if chunkSize < 56 then SOME(createLastChunk (chunk, 114 nextTotalBytesRead), Empty) 115 else (* 56 < chunkSize <= 64 *) 116 SOME(addPadding chunk, PadChunk (createPadChunk nextTotalBytesRead)) 117 end 118 end 119 120 structure Word32Array = Array 121 122 local 123 fun initializeWorkingArrayWithDataFromChunk (chunk, wArray) = 124 let 125 fun sub (c, i) = 126 Word32.fromLarge(PackWord32Big.subVec (c, i)) 127 fun calcW i = 128 let 129 val w1 = Word32Array.sub(wArray, i - 3) 130 val w2 = Word32Array.sub(wArray, i - 8) 131 val w3 = Word32Array.sub(wArray, i - 14) 132 val w4 = Word32Array.sub(wArray, i - 16) 133 fun lrot1 w = Word32.orb(Word32.<<(w, 0w1), Word32.>>(w, 0w31)) 134 in 135 lrot1 (Word32.xorb(Word32.xorb(Word32.xorb(w1, w2), w3), w4)) 136 end 137 fun loop1 i = 138 if 0 <= i andalso i <= 15 then 139 (Word32Array.update (wArray, i, sub (chunk, i)) 140 ; loop1 (i + 1)) 141 else () 142 fun loop2 i = 143 if 16 <= i andalso i <= 79 then 144 (Word32Array.update (wArray, i, calcW i) 145 ; loop2 (i + 1)) 146 else () 147 in 148 ( loop1 0 149 ; loop2 16) 150 end 151 152 fun packHashResultIntoByteVector (h0, h1, h2, h3, h4) = 153 let 154 val result = Word8Array.array (20, 0wx0) 155 in 156 (PackWord32Big.update(result, 0, Word32.toLarge h0) 157 ; PackWord32Big.update(result, 1, Word32.toLarge h1) 158 ; PackWord32Big.update(result, 2, Word32.toLarge h2) 159 ; PackWord32Big.update(result, 3, Word32.toLarge h3) 160 ; PackWord32Big.update(result, 4, Word32.toLarge h4) 161 ; Word8Array.vector result) 162 end 163 164 (* Given the current hash state values and the current 165 chunk (preprocessed into a working array by fillWorkingArray), 166 this function updates the hash state values according to the 167 sha1 algorithm *) 168 fun processChunkData (wArray, h0, h1, h2, h3, h4) = 169 let 170 fun loop (i, a, b, c, d, e) = 171 let 172 fun lrot5 w = 173 let 174 val lsb5 = Word32.>>(w, 0w27) 175 val msb27 = Word32.<<(w, 0w5) 176 in 177 Word32.orb(msb27, lsb5) 178 end 179 fun lrot30 w = 180 let 181 val lsb30 = Word32.>>(w, 0w2) 182 val msb2 = Word32.<<(w, 0w30) 183 in 184 Word32.orb(msb2, lsb30) 185 end 186 fun calcF (i, b, c, d) = 187 if 0 <= i andalso i <= 19 then 188 Word32.orb(Word32.andb(b, c), 189 Word32.andb(Word32.notb b, d)) 190 else if 20 <= i andalso i <= 39 then 191 Word32.xorb(Word32.xorb(b, c), d) 192 else if 40 <= i andalso i <= 59 then 193 Word32.orb(Word32.orb(Word32.andb(b, c), 194 Word32.andb(b, d)), 195 Word32.andb(c, d)) 196 else (* 60 <= i <= 79 *) 197 Word32.xorb(Word32.xorb(b, c), d) 198 fun calcK i = 199 if 0 <= i andalso i <= 19 then 0wx5a827999 200 else if 20 <= i andalso i <= 39 then 0wx6ed9eba1 201 else if 40 <= i andalso i <= 59 then 0wx8f1bbcdc 202 else (* 60 <= i <= 79 *) 0wxca62c1d6 203 fun calcA (a, f, e, k, w) = 204 Word32.+(Word32.+(Word32.+(Word32.+(lrot5 a, f), e), k), w) 205 in 206 if 0 <= i andalso i <= 79 then 207 let 208 val f = calcF (i, b, c, d) 209 val k = calcK i 210 val a' = calcA (a, f, e, k, Word32Array.sub(wArray, i)) 211 val b' = a 212 val c' = lrot30 b 213 val d' = c 214 val e' = d 215 in 216 loop (i + 1, a', b', c', d', e') 217 end 218 else 219 (h0 + a, h1 + b, h2 + c, h3 + d, h4 + e) 220 end 221 in 222 loop (0, h0, h1, h2, h3, h4) 223 end 224 225 in (* local *) 226 227 fun sha1 byteReader byteStreamState = 228 let 229 (* The initial values of the hash result state. These are defined 230 by the sha1 algorithm. *) 231 val initH0 : Word32.word = 0wx67452301 232 val initH1 : Word32.word = 0wxefcdab89 233 val initH2 : Word32.word = 0wx98badcfe 234 val initH3 : Word32.word = 0wx10325476 235 val initH4 : Word32.word = 0wxc3d2e1f0 236 237 (* An array that will be used for temporary space repeatedly 238 to process each chunk *) 239 val workingArray = Word32Array.array (80, 0wx0) 240 241 fun loopOverChunks (chunkStreamState, h0, h1, h2, h3, h4) = 242 case readChunk chunkStreamState of 243 NONE => packHashResultIntoByteVector (h0, h1, h2, h3, h4) 244 | SOME (chunk, nextChunkStreamState) => 245 let 246 val _ = 247 initializeWorkingArrayWithDataFromChunk (chunk, workingArray) 248 249 (* Process the data in the working array (filled 250 with the current chunk's data) using the sha1 251 hash algorithm *) 252 val (h0', h1', h2', h3', h4') = 253 processChunkData (workingArray, h0, h1, h2, h3, h4) 254 in 255 loopOverChunks (nextChunkStreamState, h0', h1', h2', h3', h4') 256 end 257 in 258 loopOverChunks (makeInitChunkStreamState (byteReader, byteStreamState), 259 initH0, initH1, initH2, initH3, initH4) 260 end 261 end 262 263 fun sha1String byteReader byteStreamState = let 264 val hashVector = sha1 byteReader byteStreamState 265 266 fun ithNibbleToHexDigitChar i = let 267 fun getNibble i = let 268 fun isEven n = n mod 2 = 0 269 fun getMostSignificantNibble byte = Word8.>>(byte, 0w4) 270 fun getLeastSignificantNibble byte = Word8.andb(byte, 0wx0f) 271 val byteI = Word8Vector.sub (hashVector, i div 2) 272 in 273 if isEven i 274 then getMostSignificantNibble byteI 275 else getLeastSignificantNibble byteI 276 end 277 278 fun nibbleToHexDigitChar nibble = 279 case Char.fromString (Word8.toString nibble) of 280 NONE => raise (Fail "sha1String: invalid hex digit") 281 | SOME ch => Char.toLower ch 282 283 in 284 nibbleToHexDigitChar (getNibble i) 285 end 286 287 in 288 CharVector.tabulate (40, ithNibbleToHexDigitChar) 289 end 290 291 fun sha1_file0 {filename} = 292 let 293 val fstream = BinIO.openIn filename 294 val fstream' = BinIO.getInstream fstream 295 in 296 sha1String BinIO.StreamIO.inputN fstream' before 297 BinIO.closeIn fstream 298 end 299 300 fun sha1_file {filename} = 301 if OS.FileSys.access("/usr/bin/shasum", [OS.FileSys.A_EXEC]) then 302 case Mosml.run "/usr/bin/shasum" [Systeml.protect filename] "" of 303 Mosml.Success s => hd (String.tokens Char.isSpace s) 304 | Mosml.Failure _ => sha1_file0 {filename=filename} 305 else 306 sha1_file0 {filename=filename} 307 308end 309