More verbose system error reporting

[hcoop/zz_old/portal.git] / init.sml

diff --git a/init.sml b/init.sml
index 4d55c90..22b27f6 100644 (file)
--- a/init.sml
+++ b/init.sml
@@ -203,4 +203,34 @@ fun nodeDebian id =
        [debian] => C.stringFromSql debian
       | row => rowError ("nodeDebian", row)
 
+fun explain e =
+    case e of
+       OS.SysErr (name, sop) =>
+       "System error: " ^ name ^
+       (case sop of
+            NONE => ""
+          | SOME syserr => ": " ^ OS.errorName syserr ^ ": " ^ OS.errorMsg syserr)
+      | _ => "Unknown"
+
+fun tokens () =
+    let
+       val proc = Unix.execute ("/usr/bin/tokens", [])
+       val inf = Unix.textInstreamOf proc
+
+       fun reader acc =
+           case TextIO.inputLine inf of
+               NONE => String.concat (rev acc)
+             | SOME s => reader (s :: acc)
+    in
+       reader []
+       before (TextIO.closeIn inf;
+               ignore (Unix.reap proc))
+    end
+
+fun tokensForked () =
+    case Posix.Process.fork () of
+       NONE => (OS.Process.system "/usr/bin/tokens >/tmp/tokens.child";
+                OS.Process.exit OS.Process.success)
+      | _ => ignore (OS.Process.system "/usr/bin/tokens >/tmp/tokens.parent")
+
 end