summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c/urweb.c2
-rw-r--r--src/cgi.sml15
-rw-r--r--src/cjr_print.sml2
-rw-r--r--src/compiler.sig3
-rw-r--r--src/compiler.sml18
-rw-r--r--src/demo.sml3
-rw-r--r--src/fastcgi.sml15
-rw-r--r--src/http.sml16
-rw-r--r--src/main.mlton.sml3
-rw-r--r--src/settings.sig6
-rw-r--r--src/settings.sml10
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 17:28:33 +0000