package DkZero_RuntimeC

  1. Overview
  2. Docs
package DkZero_RuntimeC
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file UnifiedScriptC.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
type t = {
  fp : MlFront_Core.FilePath.t;
  rel_fp : MlFront_Core.FilePath.t;
  scriptdir : MlFront_Core.FilePath.t option;
  contents : string;
  contents_sha256 : string;
  uid : string;
}

let load ~absbasepath unifiedscript_fp =
  let exception Local of string in
  try
    (* find if file or directory unified script *)
    let scriptdir_fp, unifiedscript_fp =
      let unifiedscript_s = MlFront_Core.FilePath.to_string unifiedscript_fp in
      if Sys.file_exists unifiedscript_s then
        if Sys.is_directory unifiedscript_s then
          let run_u_fp =
            MlFront_Core.FilePath.append_exn unifiedscript_fp "run.u"
          in
          let run_t_fp =
            MlFront_Core.FilePath.append_exn unifiedscript_fp "run.t"
          in
          (* [unifiedscript_fp] is the directory.
             [run_u_fp] or [run_t_fp] is the file. *)
          if Sys.file_exists (MlFront_Core.FilePath.to_string run_u_fp) then
            (Some unifiedscript_fp, run_u_fp)
          else if Sys.file_exists (MlFront_Core.FilePath.to_string run_t_fp)
          then (Some unifiedscript_fp, run_t_fp)
          else
            let msg =
              Printf.sprintf
                "Unified script directory `%s` does not contain the file \
                 `run.u` or `run.t`."
                unifiedscript_s
            in
            raise (Local msg)
        else (None, unifiedscript_fp)
      else
        let msg =
          Printf.sprintf "Unified script file `%s` does not exist"
            unifiedscript_s
        in
        raise (Local msg)
    in
    let unifiedscript_s = MlFront_Core.FilePath.to_string unifiedscript_fp in

    (* relative file path *)
    let unifiedscript_rel_fp =
      match
        MlFront_Core.FilePath.relative ~base:absbasepath ~from:absbasepath
          ~to_:unifiedscript_fp ()
      with
      | Ok v -> v
      | Error _ -> unifiedscript_fp
    in

    (* read file contents *)
    let contents =
      In_channel.with_open_bin unifiedscript_s In_channel.input_all
    in

    (* checksum the script *)
    let cramrun_sha256, _vsl_source_sz =
      match
        MlFront_Thunk_IoDisk.ThunkIoDisk.checksum_local_file ~algo:`SHA256
          ~return:Fun.id
          (MlFront_Core.FilePath.to_string unifiedscript_fp)
      with
      | `Checksum cksum -> cksum
      | `Error msg -> raise (Local ("Error computing checksum: " ^ msg))
    in

    (* short, somewhat unique id *)
    let cramrun_uid =
      let unifiedscript_absfp =
        MlFront_Core.FilePath.normalize
          (MlFront_Core.FilePath.concat absbasepath unifiedscript_fp)
      in
      let components =
        [ cramrun_sha256; MlFront_Core.FilePath.to_string unifiedscript_absfp ]
      in
      let hex =
        Digestif.SHA256.digestv_string components |> Digestif.SHA256.to_hex
      in
      Stringext.take
        (MlFront_Thunk.ThunkStrings.hex_to_base32_exn ~no_pad:() ~lowercase:()
           hex)
        4
    in

    Ok
      {
        fp = unifiedscript_fp;
        rel_fp = unifiedscript_rel_fp;
        scriptdir = scriptdir_fp;
        contents;
        contents_sha256 = cramrun_sha256;
        uid = cramrun_uid;
      }
  with Local msg -> Error msg

let contents { contents; _ } = contents
let contents_sha256 { contents_sha256; _ } = contents_sha256
let scriptdir { scriptdir; _ } = scriptdir
let uid { uid; _ } = uid
let fp { fp; _ } = fp
let rel_fp { rel_fp; _ } = rel_fp