From a91daf909f14d7bf3bd94cbec672497e1f23d400 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 11 Feb 2010 09:10:01 -0500 Subject: sigfile directive --- src/c/urweb.c | 2 ++ src/cgi.sml | 15 ++++++++++++++- src/cjr_print.sml | 2 ++ src/compiler.sig | 3 ++- src/compiler.sml | 18 +++++++++++++++--- src/demo.sml | 3 ++- src/fastcgi.sml | 15 ++++++++++++++- src/http.sml | 16 +++++++++++++++- src/main.mlton.sml | 3 +++ src/settings.sig | 6 +++++- src/settings.sml | 10 ++++++++-- 11 files changed, 82 insertions(+), 11 deletions(-) (limited to 'src') 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 -- cgit v1.2.3