sigfile directive

11 files changed, 82 insertions, 11 deletions

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 7d0a95b2..7821a999 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -330,6 +330,7 @@ static void client_send(client *c, buf *msg) {
 
 // Global entry points
 
+extern void uw_global_custom();
 extern void uw_init_crypto();
 
 void uw_global_init() {
@@ -337,6 +338,7 @@ void uw_global_init() {
 
   clients = malloc(0);
 
+  uw_global_custom();
   uw_init_crypto();
 }
 
diff --git a/src/cgi.sml b/src/cgi.sml
index f4426a70..9099d429 100644
--- a/src/cgi.sml
+++ b/src/cgi.sml
@@ -28,11 +28,24 @@
 structure Cgi :> CGI = struct
 
 open Settings
+open Print.PD Print
 
 val () = addProtocol {name = "cgi",
                       compile = "",
                       linkStatic = Config.lib ^ "/../liburweb_cgi.a",
                       linkDynamic = "-lurweb_cgi",
-                      persistent = false}
+                      persistent = false,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "}",
+                                           newline]}
 
 end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 360ecb5c..fae01db1 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2805,6 +2805,8 @@ fun p_file env (ds, ps) =
              newline,
              newline,
 
+             #code (Settings.currentProtocol ()) (),
+
              if hasDb then
                  #init (Settings.currentDbms ()) {dbstring = !dbstring,
                                                   prepared = !prepped,
diff --git a/src/compiler.sig b/src/compiler.sig
index fd1eccf8..78e82ba8 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -51,7 +51,8 @@ signature COMPILER = sig
          filterUrl : Settings.rule list,
          filterMime : Settings.rule list,
          protocol : string option,
-         dbms : string option
+         dbms : string option,
+         sigFile : string option
     }
     val compile : string -> bool
     val compiler : string -> unit
diff --git a/src/compiler.sml b/src/compiler.sml
index ba80e37e..99c730f1 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -55,7 +55,8 @@ type job = {
      filterUrl : Settings.rule list,
      filterMime : Settings.rule list,
      protocol : string option,
-     dbms : string option
+     dbms : string option,
+     sigFile : string option
 }
 
 type ('src, 'dst) phase = {
@@ -379,6 +380,7 @@ fun parseUrp' accLibs fname =
                 val libs = ref []
                 val protocol = ref NONE
                 val dbms = ref NONE
+                val sigFile = ref (Settings.getSigFile ())
 
                 fun finish sources =
                     let
@@ -405,7 +407,8 @@ fun parseUrp' accLibs fname =
                             filterMime = rev (!mime),
                             sources = sources,
                             protocol = !protocol,
-                            dbms = !dbms
+                            dbms = !dbms,
+                            sigFile = !sigFile
                         }
 
                         fun mergeO f (old, new) =
@@ -446,7 +449,8 @@ fun parseUrp' accLibs fname =
                                       @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
                                                     (#sources old),
                             protocol = mergeO #2 (#protocol old, #protocol new),
-                            dbms = mergeO #2 (#dbms old, #dbms new)
+                            dbms = mergeO #2 (#dbms old, #dbms new),
+                            sigFile = mergeO #2 (#sigFile old, #sigFile new)
                         }
                     in
                         if accLibs then
@@ -523,6 +527,14 @@ fun parseUrp' accLibs fname =
                                 (case !database of
                                      NONE => database := SOME arg
                                    | SOME _ => ())
+                              | "dbms" =>
+                                (case !dbms of
+                                     NONE => dbms := SOME arg
+                                   | SOME _ => ())
+                              | "sigfile" =>
+                                (case !sigFile of
+                                     NONE => sigFile := SOME arg
+                                   | SOME _ => ())
                               | "exe" =>
                                 (case !exe of
                                      NONE => exe := SOME (relify arg)
diff --git a/src/demo.sml b/src/demo.sml
index bb79a749..6280400b 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -112,7 +112,8 @@ fun make' {prefix, dirname, guided} =
             filterUrl = #filterUrl combined @ #filterUrl urp,
             filterMime = #filterMime combined @ #filterMime urp,
             protocol = mergeWith #2 (#protocol combined, #protocol urp),
-            dbms = mergeWith #2 (#dbms combined, #dbms urp)
+            dbms = mergeWith #2 (#dbms combined, #dbms urp),
+            sigFile = mergeWith #2 (#sigFile combined, #sigFile urp)
         }
 
         val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
diff --git a/src/fastcgi.sml b/src/fastcgi.sml
index c2e81d92..31feaee9 100644
--- a/src/fastcgi.sml
+++ b/src/fastcgi.sml
@@ -28,11 +28,24 @@
 structure Fastcgi :> FASTCGI = struct
 
 open Settings
+open Print.PD Print
 
 val () = addProtocol {name = "fastcgi",
                       compile = "",
                       linkStatic = Config.lib ^ "/../liburweb_fastcgi.a",
                       linkDynamic = "-lurweb_fastcgi",
-                      persistent = true}
+                      persistent = true,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "}",
+                                           newline]}
 
 end
diff --git a/src/http.sml b/src/http.sml
index 4054eb1e..a760e195 100644
--- a/src/http.sml
+++ b/src/http.sml
@@ -28,12 +28,26 @@
 structure Http :> HTTP = struct
 
 open Settings
+open Print.PD Print
 
 val () = addProtocol {name = "http",
                       compile = "",
                       linkStatic = Config.lib ^ "/../liburweb_http.a",
                       linkDynamic = "-lurweb_http",
-                      persistent = true}
+                      persistent = true,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "}",
+                                           newline]}
+
 val () = setProtocol "http"
 
 end
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 9cf5064a..fc1ba7e5 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -72,6 +72,9 @@ fun doArgs args =
       | "-root" :: name :: root :: rest =>
         (Compiler.addModuleRoot (root, name);
          doArgs rest)
+      | "-sigfile" :: name :: rest =>
+        (Settings.setSigFile (SOME name);
+         doArgs rest)
       | arg :: rest =>
         (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
              raise Fail ("Unknown flag " ^ arg)
diff --git a/src/settings.sig b/src/settings.sig
index f3a4379e..348c47d4 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -96,7 +96,8 @@ signature SETTINGS = sig
         compile : string,    (* Pass these `gcc -c' arguments *)
         linkStatic : string, (* Pass these static linker arguments *)
         linkDynamic : string,(* Pass these dynamic linker arguments *)
-        persistent : bool    (* Multiple requests per process? *)
+        persistent : bool,   (* Multiple requests per process? *)
+        code : unit -> Print.PD.pp_desc (* Extra code to include in C files *)
     }
     val addProtocol : protocol -> unit
     val setProtocol : string -> unit
@@ -190,4 +191,7 @@ signature SETTINGS = sig
     val setDeadlines : bool -> unit
     val getDeadlines : unit -> bool
 
+    val setSigFile : string option -> unit
+    val getSigFile : unit -> string option
+
 end
diff --git a/src/settings.sml b/src/settings.sml
index 0bbe3961..f600d2ac 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -275,7 +275,8 @@ type protocol = {
      compile : string,
      linkStatic : string,
      linkDynamic : string,
-     persistent : bool
+     persistent : bool,
+     code : unit -> Print.PD.pp_desc
 }
 val protocols = ref ([] : protocol list)
 fun addProtocol p = protocols := p :: !protocols
@@ -288,7 +289,8 @@ val curProto = ref {name = "",
                     compile = "",
                     linkStatic = "",
                     linkDynamic = "",
-                    persistent = false}
+                    persistent = false,
+                    code = fn () => Print.box []}
 fun setProtocol name =
     case getProtocol name of
         NONE => raise Fail ("Unknown protocol " ^ name)
@@ -441,4 +443,8 @@ val deadlines = ref false
 fun setDeadlines b = deadlines := b
 fun getDeadlines () = !deadlines
 
+val sigFile = ref (NONE : string option)
+fun setSigFile v = sigFile := v
+fun getSigFile () = !sigFile
+
 end