src/Pure/General/sha1_polyml.ML
author haftmann
Thu, 11 Mar 2010 09:09:51 +0100
changeset 35709 267e15230a31
parent 35628 f1456d045151
child 35713 428284ee1465
permissions -rw-r--r--
merged
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/General/sha1_polyml.ML
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     2
    Author:     Sascha Boehme, TU Muenchen
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     3
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     4
Digesting strings according to SHA-1 (see RFC 3174) -- based on an
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     5
external implementation in C with a fallback to an internal
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     6
implementation.
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     7
*)
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     8
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
     9
structure SHA1: SHA1 =
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    10
struct
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    11
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    12
fun hex_digit i = if i < 10 then chr (ord "0" + i) else chr (ord "a" + i - 10);
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    13
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    14
fun hex_string arr i =
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    15
  let val c = CInterface.fromCchar (CInterface.offset i CInterface.Cchar arr)
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    16
  in (op ^) (pairself hex_digit (Integer.div_mod (Char.ord c) 16)) end
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    17
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    18
fun digest_external str =
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    19
  let
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    20
    val digest = CInterface.alloc 20 CInterface.Cchar;
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    21
    val _ = CInterface.call3 (CInterface.get_sym "sha1" "sha1_buffer")
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    22
      (CInterface.STRING, CInterface.INT, CInterface.POINTER)
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    23
      CInterface.POINTER (str, size str, CInterface.address digest);
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    24
  in fold (suffix o hex_string digest) (0 upto 19) "" end;
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    25
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    26
fun digest str = digest_external str
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    27
  handle CInterface.Foreign _ => SHA1.digest str;
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    28
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    29
end;