summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@csail.mit.edu>2016-09-19 14:48:51 -0400
committerGravatar GitHub <noreply@github.com>2016-09-19 14:48:51 -0400
commita2af672326e0cf943ba3622ed77be18ac703d3c7 (patch)
treea271152c69adc3c891deda1cfcc5a533ed00279a
parentc49ad46cc190e63f2395fcef03deff4386845877 (diff)
parent40f5ea3c4242f8f92d511596778f980671972d7f (diff)
Merge pull request #48 from jmitchell/bin-repro
Reproducible project builds with HTTP caching support
-rw-r--r--src/cjr_print.sml63
-rw-r--r--src/compiler.sml8
-rw-r--r--src/demo.sml4
-rw-r--r--src/elab_err.sml2
-rw-r--r--src/fileio.sig9
-rw-r--r--src/fileio.sml34
-rw-r--r--src/globals.sig7
-rw-r--r--src/globals.sml7
-rw-r--r--src/jscomp.sml2
-rw-r--r--src/main.mlton.sml5
-rw-r--r--src/settings.sig1
-rw-r--r--src/settings.sml9
-rw-r--r--src/sha1.sig31
-rw-r--r--src/sha1.sml264
-rw-r--r--src/sources9
-rw-r--r--src/tutorial.sml4
16 files changed, 413 insertions, 46 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b2c85a54..688b3e4d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -55,6 +55,8 @@ structure CM = BinaryMapFn(struct
val debug = ref false
+val app_js = ref ""
+
val dummyTyp = (TDatatype (Enum, 0, ref []), ErrorMsg.dummySpan)
val ident = String.translate (fn #"'" => "PRIME"
@@ -2509,9 +2511,15 @@ fun p_decl env (dAll as (d, loc) : decl) =
| DDatabase _ => box []
| DPreparedStatements _ => box []
- | DJavaScript s => box [string "static char jslib[] = \"",
- string (Prim.toCString s),
- string "\";"]
+ | DJavaScript s =>
+ let
+ val () = app_js := OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
+ file = "app." ^ SHA1.bintohex (SHA1.hash s) ^ ".js"}
+ in
+ box [string "static char jslib[] = \"",
+ string (Prim.toCString s),
+ string "\";"]
+ end
| DCookie s => box [string "/*",
space,
string "cookie",
@@ -2948,15 +2956,11 @@ fun p_file env (ds, ps) =
newline]
end
- val timestamp = LargeInt.toString (Time.toMilliseconds (Time.now ()))
- val app_js = OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
- file = "app." ^ timestamp ^ ".js"}
-
- val allScripts =
+ fun allScripts () =
foldl (fn (x, scripts) =>
scripts
^ "<script type=\\\"text/javascript\\\" src=\\\"" ^ x ^ "\\\"></script>\\n")
- "" (Settings.getScripts () @ [app_js])
+ "" (Settings.getScripts () @ [!app_js])
fun p_page (ek, s, n, ts, ran, side, dbmode, tellSig) =
let
@@ -3098,7 +3102,7 @@ fun p_file env (ds, ps) =
val scripts =
case side of
ServerOnly => ""
- | _ => allScripts
+ | _ => allScripts ()
in
string scripts
end,
@@ -3306,8 +3310,7 @@ fun p_file env (ds, ps) =
val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds
- val now = Time.now ()
- val nowD = Date.fromTimeUniv now
+ val lastMod = Date.fromTimeUniv (FileIO.mostRecentModTime ())
val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT"
fun hexifyByte (b : Word8.word) : string =
@@ -3496,26 +3499,26 @@ fun p_file env (ds, ps) =
string "static void uw_handle(uw_context ctx, char *request) {",
newline,
- string "if (!strcmp(request, \"",
- string app_js,
- string "\")) {",
+ string "uw_Basis_string ims = uw_Basis_requestHeader(ctx, \"If-modified-since\");",
newline,
- box [string "uw_Basis_string ims = uw_Basis_requestHeader(ctx, \"If-modified-since\");",
- newline,
- string ("if (ims && !strcmp(ims, \"" ^ Date.fmt rfcFmt nowD ^ "\")) {"),
- newline,
- box [string "uw_clear_headers(ctx);",
- newline,
- string "uw_write_header(ctx, uw_supports_direct_status ? \"HTTP/1.1 304 Not Modified\\r\\n\" : \"Status: 304 Not Modified\\r\\n\");",
- newline,
- string "return;",
- newline],
- string "}",
+ string ("if (ims && !strcmp(ims, \"" ^ Date.fmt rfcFmt lastMod ^ "\")) {"),
+ newline,
+ box [string "uw_clear_headers(ctx);",
newline,
+ string "uw_write_header(ctx, uw_supports_direct_status ? \"HTTP/1.1 304 Not Modified\\r\\n\" : \"Status: 304 Not Modified\\r\\n\");",
newline,
- string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
+ string "return;",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (!strcmp(request, \"",
+ string (!app_js),
+ string "\")) {",
+ newline,
+ box [string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
newline,
- string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"),
+ string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt lastMod ^ "\\r\\n\");"),
newline,
string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
newline,
@@ -3538,7 +3541,7 @@ fun p_file env (ds, ps) =
string (String.toCString ct),
string "\\r\\n\");",
newline]),
- string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt (Date.fromTimeUniv (#LastModified r)) ^ "\\r\\n\");"),
+ string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt lastMod ^ "\\r\\n\");"),
newline,
string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"),
newline,
@@ -3634,7 +3637,7 @@ fun p_file env (ds, ps) =
newline,
if !hasJs then
box [string "uw_set_script_header(ctx, \"",
- string allScripts,
+ string (allScripts ()),
string "\");",
newline]
else
diff --git a/src/compiler.sml b/src/compiler.sml
index dccda06d..87d175ed 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -212,7 +212,7 @@ val parseUrs =
val fname = OS.FileSys.tmpName ()
val outf = TextIO.openOut fname
val () = TextIO.output (outf, "sig\n")
- val inf = TextIO.openIn filename
+ val inf = FileIO.txtOpenIn filename
fun loop () =
case TextIO.inputLine inf of
NONE => ()
@@ -225,7 +225,7 @@ val parseUrs =
val () = (ErrorMsg.resetErrors ();
ErrorMsg.resetPositioning filename;
Lex.UserDeclarations.initialize ())
- val file = TextIO.openIn fname
+ val file = FileIO.txtOpenIn fname
fun get _ = TextIO.input file
fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
@@ -251,7 +251,7 @@ val parseUr = {
val () = (ErrorMsg.resetErrors ();
ErrorMsg.resetPositioning filename;
Lex.UserDeclarations.initialize ())
- val file = TextIO.openIn filename
+ val file = FileIO.txtOpenIn filename
fun get _ = TextIO.input file
fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
@@ -478,7 +478,7 @@ fun parseUrp' accLibs fname =
val thisPath = OS.Path.dir filename
val dir = OS.Path.dir filename
- fun opener () = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
+ fun opener () = FileIO.txtOpenIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
val inf = opener ()
diff --git a/src/demo.sml b/src/demo.sml
index 0d9f0f4f..47d22395 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -33,7 +33,7 @@ fun make' {prefix, dirname, guided} =
let
val prose = OS.Path.joinDirFile {dir = dirname,
file = "prose"}
- val inf = TextIO.openIn prose
+ val inf = FileIO.txtOpenIn prose
val outDir = OS.Path.concat (dirname, "out")
@@ -351,7 +351,7 @@ fun make' {prefix, dirname, guided} =
SOME "urp" =>
doit (fn (src, html) =>
let
- val inf = TextIO.openIn src
+ val inf = FileIO.txtOpenIn src
val out = TextIO.openOut html
fun loop () =
diff --git a/src/elab_err.sml b/src/elab_err.sml
index 33daa118..385caca3 100644
--- a/src/elab_err.sml
+++ b/src/elab_err.sml
@@ -275,7 +275,7 @@ fun p_decl env d =
fun readFromFile () =
let
- val inf = TextIO.openIn fname
+ val inf = FileIO.txtOpenIn fname
fun loop acc =
case TextIO.inputLine inf of
diff --git a/src/fileio.sig b/src/fileio.sig
new file mode 100644
index 00000000..37b3b529
--- /dev/null
+++ b/src/fileio.sig
@@ -0,0 +1,9 @@
+signature FILE_IO = sig
+
+ (* When was a source file last modified (excluding files produced after [getResetTime])? *)
+ val mostRecentModTime : unit -> Time.time
+
+ val txtOpenIn : string -> TextIO.instream
+ val binOpenIn : string -> BinIO.instream
+
+end
diff --git a/src/fileio.sml b/src/fileio.sml
new file mode 100644
index 00000000..72e72f6d
--- /dev/null
+++ b/src/fileio.sml
@@ -0,0 +1,34 @@
+structure FileIO :> FILE_IO = struct
+
+val mostRecentModTimeRef = ref (Time.zeroTime)
+
+fun checkFileModTime fname =
+ let val mtime = OS.FileSys.modTime fname in
+ if Time.compare (mtime, !mostRecentModTimeRef) = GREATER andalso
+ Time.compare (mtime, Globals.getResetTime ()) = LESS
+ then mostRecentModTimeRef := mtime
+ else ()
+ end
+
+fun mostRecentModTime () =
+ if Time.compare (!mostRecentModTimeRef, Time.zeroTime) = EQUAL
+ then Globals.getResetTime ()
+ else !mostRecentModTimeRef
+
+fun txtOpenIn fname =
+ let
+ val inf = TextIO.openIn fname
+ val () = checkFileModTime fname
+ in
+ inf
+ end
+
+fun binOpenIn fname =
+ let
+ val inf = BinIO.openIn fname
+ val () = checkFileModTime fname
+ in
+ inf
+ end
+
+end
diff --git a/src/globals.sig b/src/globals.sig
new file mode 100644
index 00000000..0cff65b5
--- /dev/null
+++ b/src/globals.sig
@@ -0,0 +1,7 @@
+signature GLOBALS = sig
+
+ (* When was the Ur/Web compiler started or reset? *)
+ val setResetTime : unit -> unit
+ val getResetTime : unit -> Time.time
+
+end
diff --git a/src/globals.sml b/src/globals.sml
new file mode 100644
index 00000000..fafc0438
--- /dev/null
+++ b/src/globals.sml
@@ -0,0 +1,7 @@
+structure Globals :> GLOBALS = struct
+
+val resetTime = ref (Time.zeroTime)
+fun setResetTime () = resetTime := Time.now ()
+fun getResetTime () = !resetTime
+
+end
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 65a0fa3a..dedcb554 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -1334,7 +1334,7 @@ fun process (file : file) =
maxName = U.File.maxName file + 1}
(#1 file)
- val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"})
+ val inf = FileIO.txtOpenIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"})
fun lines acc =
case TextIO.inputLine inf of
NONE => String.concat (rev acc)
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 6d368106..fb1a1723 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -254,7 +254,8 @@ fun send (sock, s) =
send (sock, String.extract (s, n, NONE))
end
-val () = case CommandLine.arguments () of
+val () = (Globals.setResetTime ();
+ case CommandLine.arguments () of
["daemon", "start"] =>
(case Posix.Process.fork () of
SOME _ => ()
@@ -376,4 +377,4 @@ val () = case CommandLine.arguments () of
else
(OS.FileSys.remove socket;
raise OS.SysErr ("", NONE))
- end handle OS.SysErr _ => OS.Process.exit (oneRun args)
+ end handle OS.SysErr _ => OS.Process.exit (oneRun args))
diff --git a/src/settings.sig b/src/settings.sig
index dd135bda..05ab5e23 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -302,4 +302,5 @@ signature SETTINGS = sig
val addJsFile : string (* filename *) -> unit
val listJsFiles : unit -> {Filename : string, Content : string} list
+
end
diff --git a/src/settings.sml b/src/settings.sml
index b72789df..f4d399dc 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -844,7 +844,7 @@ fun noMime () =
fun readMimeTypes () =
let
- val inf = TextIO.openIn "/etc/mime.types"
+ val inf = FileIO.txtOpenIn "/etc/mime.types"
fun loop m =
case TextIO.inputLine inf of
@@ -914,7 +914,7 @@ fun addFile {Uri, LoadFromFilename} =
ErrorMsg.error ("Two different files requested for URI " ^ Uri ^ " ( " ^ path' ^ " vs. " ^ path ^ ")")
| NONE =>
let
- val inf = BinIO.openIn path
+ val inf = FileIO.binOpenIn path
in
files := SM.insert (!files,
Uri,
@@ -937,7 +937,7 @@ val jsFiles = ref (SM.empty : {Filename : string, Content : string} SM.map)
fun addJsFile LoadFromFilename =
let
val path = OS.Path.concat (!filePath, LoadFromFilename)
- val inf = TextIO.openIn path
+ val inf = FileIO.txtOpenIn path
in
jsFiles := SM.insert (!jsFiles,
path,
@@ -952,7 +952,8 @@ fun addJsFile LoadFromFilename =
fun listJsFiles () = SM.listItems (!jsFiles)
fun reset () =
- (urlPrefixFull := "/";
+ (Globals.setResetTime ();
+ urlPrefixFull := "/";
urlPrefix := "/";
urlPrePrefix := "";
timeout := 0;
diff --git a/src/sha1.sig b/src/sha1.sig
new file mode 100644
index 00000000..7fda97f5
--- /dev/null
+++ b/src/sha1.sig
@@ -0,0 +1,31 @@
+
+(* Implementation the SHA-1 hash function.
+ Written by Tom 7 in 2004; code in the public domain. *)
+
+signature SHA1 =
+sig
+
+ (* Perform the SHA-1 hash function on a message.
+ Returns the 160 bit (20 byte) hash.
+
+ recall that string = CharVector.vector.
+ The input string may contain non-ascii data;
+ the output certainly will. *)
+
+ val hash : string -> string
+
+ (* pass in a stream as stateful function that returns
+ SOME s for some non-empty prefix of the remainder of
+ the stream, or NONE when the stream has ended. *)
+ val hash_stream : (unit -> string option) -> string
+
+ (* XXX move to hashutil *)
+ (* convert a binary string to one built of hex digits *)
+ val bintohex : string -> string
+
+ (* Parse a hexadecimal SHA-1 string. Uppercase and lowercase
+ are permitted. If the string is not the right length or
+ contains invalid characters, returns NONE. *)
+ val parse_hex : string -> string option
+
+end
diff --git a/src/sha1.sml b/src/sha1.sml
new file mode 100644
index 00000000..d962c4e0
--- /dev/null
+++ b/src/sha1.sml
@@ -0,0 +1,264 @@
+
+(* RFC-3174 (SHA-1) hashing function.
+ By Tom 7, 2004: Code placed in the public domain.
+*)
+
+structure SHA1 :> SHA1 =
+struct
+ exception Unimplemented
+
+ val xorb = Word32.xorb
+ val andb = Word32.andb
+ val orb = Word32.orb
+ val << = Word32.<<
+ val >> = Word32.>>
+ val notb = Word32.notb
+ val ++ = Word32.+
+
+ type w32 = word
+ infix xorb andb orb << >> ++
+
+ (* workaround for andb bug in MLton 20010706 *)
+ fun mkbyte w = Word32.mod (w, 0w256)
+
+ fun ROL(X, N : Word.word) = (X << N) orb (X >> (0w32-N))
+
+ fun wc hi lo = (hi << 0w16) orb lo
+
+ fun w2b w = map chr
+ [Word32.toInt (mkbyte (w >> 0w24)),
+ Word32.toInt (mkbyte (w >> 0w16)),
+ Word32.toInt (mkbyte (w >> 0w8)),
+ Word32.toInt (mkbyte w)]
+
+ (* the length (arg in bytes, output in bits)
+ as a 64-bit quantity, big-endian *)
+ fun lenbits l =
+ implode (List.tabulate (4, fn _ => chr 0)) ^
+ implode (w2b (Word32.fromInt (l * 8)))
+
+
+ (* executes f for each index lo..hi-1 inclusive *)
+ fun for lo hi f =
+ if lo >= hi then ()
+ else (ignore (f lo); for (lo + 1) hi f)
+
+ fun ford lo hi b f =
+ if lo >= hi then b
+ else
+ let
+ val b = f (lo, b)
+ in
+ (ford (lo + 1) hi b f)
+ end
+
+ fun doblock (aa, bb, cc, dd, ee) msg =
+ let
+ val K0 = wc 0wx5A82 0wx7999
+ val K1 = wc 0wx6ED9 0wxEBA1
+ val K2 = wc 0wx8F1B 0wxBCDC
+ val K3 = wc 0wxCA62 0wxC1D6
+
+ fun mb n = Word32.fromInt (ord (CharVector.sub(msg, n)))
+
+ val W = Array.array(80, 0w0)
+ fun Ws x = Array.sub(W, x)
+
+ val _ =
+ for 0 16
+ (fn t =>
+ let in
+ Array.update(W, t,
+ (mb (t * 4 ) << 0w24) orb
+ (mb (t * 4 + 1) << 0w16) orb
+ (mb (t * 4 + 2) << 0w8) orb
+ (mb (t * 4 + 3)))
+ end)
+
+ val _ =
+ for 16 80
+ (fn t =>
+ let
+ val n =
+ Ws (t-3) xorb
+ Ws (t-8) xorb
+ Ws (t-14) xorb
+ Ws (t-16)
+ val zz = ROL(n, 0w1)
+ in
+ Array.update(W, t, zz)
+ end)
+
+
+ val (A, B, C, D, E) = (aa, bb, cc, dd, ee)
+
+
+ fun round lo hi f k ctxt =
+ ford lo hi ctxt
+ (fn (t, ctxt as (A, B, C, D, E)) =>
+ let
+ val temp = ROL(A, 0w5) ++ (f ctxt) ++ E ++ Ws t ++ k
+ val E = D;
+ val D = C;
+ val C = ROL(B, 0w30)
+ val B = A
+ val A = temp
+ in
+ (A, B, C, D, E)
+ end)
+
+ val (A, B, C, D, E) =
+ round 0 20 (fn (A, B, C, D, E) =>
+ ((B andb C) orb ((notb B) andb D)))
+ K0 (A, B, C, D, E)
+
+ val (A, B, C, D, E) =
+ round 20 40 (fn (A, B, C, D, E) =>
+ (B xorb C xorb D))
+ K1 (A, B, C, D, E)
+
+ val (A, B, C, D, E) =
+ round 40 60 (fn (A, B, C, D, E) =>
+ ((B andb C) orb (B andb D) orb (C andb D)))
+ K2 (A, B, C, D, E)
+
+ val (A, B, C, D, E) =
+ round 60 80 (fn (A, B, C, D, E) =>
+ (B xorb C xorb D))
+ K3 (A, B, C, D, E)
+
+ in
+ (aa ++ A, bb ++ B, cc ++ C, dd ++ D, ee ++ E)
+ end
+
+ datatype 'a stream =
+ Cons of ('a * (unit -> 'a stream))
+ | Nil
+
+ (* turn a stream of oddly chunked strings into
+ one with 512-bit blocks *)
+ fun chunk_512 s =
+ let
+
+ (* the padding required to make a message of length l (bytes)
+ a proper SHA-1 input. Returns either one or two Cons cells.
+ tail is the end of the input (63 bytes or less)
+ l is the total length of the input, *including* the length of the
+ tail end *)
+ fun padding tail l =
+ let val v = l mod 64 in
+ if v < 56 then
+ let val p = 56 - v
+ val padding = implode (List.tabulate (p - 1, fn _ => chr 0))
+ in Cons (tail ^ str (chr 0x80) ^ padding ^ lenbits l,
+ fn _ => Nil)
+ end
+ else if v < 64 then
+ let val p = 64 - v
+ val padding1 = implode (List.tabulate (p - 1, fn _ => chr 0))
+ val padding2 = implode (List.tabulate (56, fn _ => chr 0))
+ in Cons (tail ^ str (chr 0x80) ^ padding1,
+ fn _ => Cons (padding2 ^ lenbits l, fn _ => Nil))
+ end
+ else raise Unimplemented (* Impossible? *)
+ end
+
+ (* n is the bytes we've already output.
+ cur is a string (of 64 bytes or less) that will
+ be our next chunk.
+ rest,sofar is a string and index indicating the
+ next bit of data. *)
+ (* PERF Could be more efficient by using an
+ accumulating array instead of a string for cur *)
+ fun ch n cur sofar startat () =
+ (* if we already have 64 bytes, return it *)
+ if size cur = 64
+ then
+ let in
+ Cons(cur, ch (n + 64) "" sofar startat)
+ end
+ else
+ (* do we have any in 'sofar'? *)
+ if startat < size sofar
+ then let
+ val get = Int.min(size sofar - startat,
+ 64 - size cur)
+ in
+ (* be eager, since we need to return something now *)
+ ch n (cur ^ String.substring(sofar, startat, get))
+ sofar (startat + get) ()
+ end
+ else
+ (* sofar has been exhausted,
+ so get some from input stream *)
+ (case s () of
+ (* eager, again *)
+ SOME ss => ch n cur ss 0 ()
+ | NONE =>
+ (* no more data. *)
+ padding cur (n + size cur))
+ in
+ ch 0 "" "" 0
+ end
+
+ fun hash_stream orig_stream =
+ let
+
+ val stream512 = chunk_512 orig_stream
+
+ (* gets hash context, length of string so far (bytes),
+ and tail of stream *)
+ fun hash_rest stream ctxt =
+ (case stream() of
+ Cons (s, stream) =>
+ let val ctxt = doblock ctxt s
+ in hash_rest stream ctxt
+ end
+ | Nil => ctxt)
+
+ val init =
+ (wc 0wx6745 0wx2301,
+ wc 0wxefcd 0wxab89,
+ wc 0wx98ba 0wxdcfe,
+ wc 0wx1032 0wx5476,
+ wc 0wxc3d2 0wxe1f0)
+
+ val (a, b, c, d, e) = hash_rest stream512 init
+ in
+ implode (w2b a @ w2b b @ w2b c @ w2b d @ w2b e)
+ end
+
+ fun hash m =
+ hash_stream
+ (let val r = ref true
+ in (fn () =>
+ if !r
+ then (r := false; SOME m)
+ else NONE)
+ end)
+
+ val digits = "0123456789ABCDEF"
+ fun bintohex s =
+ String.translate (fn c =>
+ implode [CharVector.sub (digits, ord c div 16),
+ CharVector.sub (digits, ord c mod 16)]) s
+
+ (* ASCII trick: (ch | 4400) % 55 *)
+ fun hexvalue ch =
+ SysWord.toInt (SysWord.orb(SysWord.fromInt(ord ch), SysWord.fromInt 4400)) mod 55
+
+ fun parse_hex s =
+ if size s <> 40
+ orelse not (CharVector.all (fn c => (ord c >= ord #"0" andalso
+ ord c <= ord #"9") orelse
+ (ord c >= ord #"a" andalso
+ ord c <= ord #"f") orelse
+ (ord c >= ord #"A" andalso
+ ord c <= ord #"F")) s)
+ then NONE
+ else SOME (CharVector.tabulate(20,
+ (fn i =>
+ chr(hexvalue (String.sub(s, i * 2)) * 16 +
+ hexvalue (String.sub(s, i * 2 + 1))))))
+
+end
diff --git a/src/sources b/src/sources
index 1a09e7e8..52b1bdd7 100644
--- a/src/sources
+++ b/src/sources
@@ -1,6 +1,9 @@
$(SRC)/config.sig
config.sml
+$(SRC)/globals.sig
+$(SRC)/globals.sml
+
$(SRC)/search.sig
$(SRC)/search.sml
@@ -16,6 +19,9 @@ $(SRC)/errormsg.sml
$(SRC)/print.sig
$(SRC)/print.sml
+$(SRC)/fileio.sig
+$(SRC)/fileio.sml
+
$(SRC)/settings.sig
$(SRC)/settings.sml
@@ -227,6 +233,9 @@ $(SRC)/sigcheck.sml
$(SRC)/mono_inline.sml
+$(SRC)/sha1.sig
+$(SRC)/sha1.sml
+
$(SRC)/cjr.sml
$(SRC)/postgres.sig
diff --git a/src/tutorial.sml b/src/tutorial.sml
index dd2d3f7d..0c2f908f 100644
--- a/src/tutorial.sml
+++ b/src/tutorial.sml
@@ -38,7 +38,7 @@ fun readAll inf =
before TextIO.closeIn inf
end
-val readAllFile = readAll o TextIO.openIn
+val readAllFile = readAll o FileIO.txtOpenIn
fun fixupFile (fname, title) =
let
@@ -154,7 +154,7 @@ fun fixupFile (fname, title) =
fun doUr fname =
let
- val inf = TextIO.openIn fname
+ val inf = FileIO.txtOpenIn fname
val title = case TextIO.inputLine inf of
NONE => raise Fail ("No title comment at start of " ^ fname)