Initial implementation of protocols in Settings

5 files changed, 48 insertions, 4 deletions

diff --git a/src/c/driver.c b/src/c/http.c
index e8345be2..e8345be2 100644
--- a/src/c/driver.c
+++ b/src/c/http.c
diff --git a/src/compiler.sml b/src/compiler.sml
index c7c2f65e..6126a1a2 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -883,14 +883,13 @@ val toSqlify = transform sqlify "sqlify" o toMono_opt2
 
 fun compileC {cname, oname, ename, libs, profile, debug, link = link'} =
     let
+        val proto = Settings.currentProtocol ()
         val urweb_o = clibFile "urweb.o"
-        val request_o = clibFile "request.o"
-        val driver_o = clibFile "driver.o"
 
         val compile = "gcc " ^ Config.gccArgs ^ " -Wstrict-prototypes -Werror -O3 -I " ^ Config.includ
                       ^ " -c " ^ cname ^ " -o " ^ oname
         val link = "gcc -Werror -O3 -lm -lmhash -pthread " ^ libs ^ " " ^ urweb_o ^ " " ^ oname
-                   ^ " " ^ request_o ^ " " ^ driver_o ^ " -o " ^ ename
+                   ^ " " ^ #link proto ^ " -o " ^ ename
 
         val (compile, link) =
             if profile then
diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml
index 834ff1c7..e0b9f855 100644
--- a/src/scriptcheck.sml
+++ b/src/scriptcheck.sml
@@ -73,6 +73,8 @@ val pushWords = ["rv("]
 
 fun classify (ds, ps) =
     let
+        val proto = Settings.currentProtocol ()
+
         fun inString {needle, haystack} =
             let
                 val (_, suffix) = Substring.position needle (Substring.full haystack)
@@ -158,10 +160,18 @@ fun classify (ds, ps) =
 
         val (pull_ids, push_ids) = foldl decl (IS.empty, IS.empty) ds
 
+        val foundBad = ref false
+
         val ps = map (fn (ek, x, n, ts, t, _) =>
                          (ek, x, n, ts, t,
                           if IS.member (push_ids, n) then
-                              ServerAndPullAndPush
+                              (if not (#supportsPush proto) andalso not (!foundBad) then
+                                   (foundBad := true;
+                                    ErrorMsg.error ("This program needs server push, but the current protocol ("
+                                                    ^ #name proto ^ ") doesn't support that."))
+                               else
+                                   ();
+                               ServerAndPullAndPush)
                           else if IS.member (pull_ids, n) then
                               ServerAndPull
                           else
diff --git a/src/settings.sig b/src/settings.sig
index dd812ac4..bccb2ef7 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -85,4 +85,16 @@ signature SETTINGS = sig
     val getMimeRules : unit -> rule list
     val checkMime : string -> bool
 
+    (* Web protocols that generated programs may speak *)
+    type protocol = {
+        name : string,      (* Call it this on the command line *)
+        link : string,      (* Pass these linker arguments *)
+        supportsPush : bool (* Is Ur/Web message-passing supported? *)
+    }
+    val addProtocol : protocol -> unit
+    val getProtocol : string -> protocol option
+
+    val setProtocol : protocol -> unit
+    val currentProtocol : unit -> protocol
+
 end
diff --git a/src/settings.sml b/src/settings.sml
index 9c7b1175..75c879f7 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -248,4 +248,27 @@ val checkMime = check
                     (CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #"."))
                     mime
 
+
+type protocol = {
+     name : string,
+     link : string,
+     supportsPush : bool
+}
+val protocols = ref ([] : protocol list)
+fun addProtocol p = protocols := p :: !protocols
+fun getProtocol s = List.find (fn p => #name p = s) (!protocols)
+
+fun clibFile s = OS.Path.joinDirFile {dir = Config.libC,
+                                      file = s}
+
+val http = {name = "http",
+            link = clibFile "request.o" ^ " " ^ clibFile "http.o",
+            supportsPush = true}
+
+val () = addProtocol http
+
+val curProto = ref http
+fun setProtocol p = curProto := p
+fun currentProtocol () = !curProto
+
 end