src/Pure/General/sha1_polyml.ML
author blanchet
Wed, 18 Sep 2013 16:44:19 +0200
changeset 53697 221ec353bcc5
parent 53211 753b9fbe18be
child 57638 ed58e740a699
permissions -rw-r--r--
minor change related to code equations in primcorec
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
41954
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    12
(* digesting *)
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    13
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    14
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
    15
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    16
fun hex_string arr i =
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    17
  let val c = CInterface.fromCchar (CInterface.offset i CInterface.Cchar arr)
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    18
  in (op ^) (pairself hex_digit (Integer.div_mod (Char.ord c) 16)) end
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    19
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    20
val lib_path =
43948
8f5add916a99 explicit structure ML_System;
wenzelm
parents: 41954
diff changeset
    21
  ("$ML_HOME/" ^ (if ML_System.platform_is_cygwin then "sha1.dll" else "libsha1.so"))
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    22
  |> Path.explode;
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    23
53211
753b9fbe18be allow NUL characters in ML string passed to C library;
wenzelm
parents: 43948
diff changeset
    24
val STRING_INPUT_BYTES =
753b9fbe18be allow NUL characters in ML string passed to C library;
wenzelm
parents: 43948
diff changeset
    25
  CInterface.mkConversion undefined (CInterface.toCbytes o Byte.stringToBytes)
753b9fbe18be allow NUL characters in ML string passed to C library;
wenzelm
parents: 43948
diff changeset
    26
    (CInterface.Cpointer CInterface.Cchar);
753b9fbe18be allow NUL characters in ML string passed to C library;
wenzelm
parents: 43948
diff changeset
    27
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    28
fun digest_external str =
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    29
  let
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    30
    val digest = CInterface.alloc 20 CInterface.Cchar;
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    31
    val _ =
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    32
      CInterface.call3 (CInterface.get_sym (File.platform_path lib_path) "sha1_buffer")
53211
753b9fbe18be allow NUL characters in ML string passed to C library;
wenzelm
parents: 43948
diff changeset
    33
        (STRING_INPUT_BYTES, CInterface.LONG, CInterface.POINTER)
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    34
        CInterface.POINTER (str, size str, CInterface.address digest);
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    35
  in fold (suffix o hex_string digest) (0 upto 19) "" end;
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    36
41954
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    37
fun digest_string str = digest_external str
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    38
  handle CInterface.Foreign msg =>
41954
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    39
    (warning (msg ^ "\nUsing slow ML implementation of SHA1.digest"); SHA1.rep (SHA1.digest str));
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    40
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    41
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    42
(* type digest *)
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    43
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    44
datatype digest = Digest of string;
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    45
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    46
val digest = Digest o digest_string;
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    47
fun rep (Digest s) = s;
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    48
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    49
end;