src/Pure/General/sha1_polyml.ML
author wenzelm
Tue, 26 Feb 2013 12:50:52 +0100
changeset 51280 12b7b0baaa1e
parent 43948 8f5add916a99
child 53211 753b9fbe18be
permissions -rw-r--r--
less eventful shutdown: merely wait for scheduler to terminate;
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
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    24
fun digest_external str =
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    25
  let
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    26
    val digest = CInterface.alloc 20 CInterface.Cchar;
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    27
    val _ =
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    28
      CInterface.call3 (CInterface.get_sym (File.platform_path lib_path) "sha1_buffer")
35935
32887cbfd62d use LONG rather than INT to represent the C datatype size_t
boehmes
parents: 35713
diff changeset
    29
        (CInterface.STRING, CInterface.LONG, CInterface.POINTER)
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    30
        CInterface.POINTER (str, size str, CInterface.address digest);
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    31
  in fold (suffix o hex_string digest) (0 upto 19) "" end;
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    32
41954
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    33
fun digest_string str = digest_external str
35713
428284ee1465 absolute lib_path relative to ML_HOME -- for improved robustness;
wenzelm
parents: 35628
diff changeset
    34
  handle CInterface.Foreign msg =>
41954
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    35
    (warning (msg ^ "\nUsing slow ML implementation of SHA1.digest"); SHA1.rep (SHA1.digest str));
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    36
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    37
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    38
(* type digest *)
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    39
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    40
datatype digest = Digest of string;
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    41
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    42
val digest = Digest o digest_string;
fb94df4505a0 explicit type SHA1.digest;
wenzelm
parents: 35937
diff changeset
    43
fun rep (Digest s) = s;
35628
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    44
f1456d045151 Digesting strings according to SHA-1.
wenzelm
parents:
diff changeset
    45
end;