Run-time CSS style validation

3 files changed, 49 insertions, 1 deletions

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 93635fd1..2e16743c 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4021,3 +4021,46 @@ uw_Basis_int uw_Basis_trunc(uw_context ctx, uw_Basis_float n) {
 uw_Basis_int uw_Basis_round(uw_context ctx, uw_Basis_float n) {
   return round(n);
 }
+
+uw_Basis_string uw_Basis_atom(uw_context ctx, uw_Basis_string s) {
+  char *p;
+
+  for (p = s; *p; ++p) {
+    char c = *p;
+    if (!isalnum(c) && c != '+' && c != '-' && c != '.' && c != '%' && c != '#')
+      uw_error(ctx, FATAL, "Disallowed character in CSS atom");
+  }
+
+  return s;
+}
+
+uw_Basis_string uw_Basis_css_url(uw_context ctx, uw_Basis_string s) {
+  char *p;
+
+  for (p = s; *p; ++p) {
+    char c = *p;
+    if (!isalnum(c) && c != ':' && c != '/' && c != '.' && c != '_' && c != '+'
+        && c != '-' && c != '%' && c != '?' && c != '&' && c != '=' && c != '#')
+      uw_error(ctx, FATAL, "Disallowed character in CSS URL");
+  }
+
+  return s;
+}
+
+uw_Basis_string uw_Basis_property(uw_context ctx, uw_Basis_string s) {
+  char *p;
+
+  if (!*s)
+    uw_error(ctx, FATAL, "Empty CSS property");
+
+  if (!islower(s[0]) && s[0] != '_')
+    uw_error(ctx, FATAL, "Bad initial character in CSS property");
+
+  for (p = s; *p; ++p) {
+    char c = *p;
+    if (!islower(c) && !isdigit(c) && c != '_' && c != '-')
+      uw_error(ctx, FATAL, "Disallowed character in CSS property");
+  }
+
+  return s;
+}
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index af9e9a9c..17d23cc2 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -129,6 +129,7 @@ val checkCssUrl = CharVector.all (fn ch => Char.isAlphaNum ch
                                            orelse ch = #"/"
                                            orelse ch = #"."
                                            orelse ch = #"_"
+                                           orelse ch = #"+"
                                            orelse ch = #"-"
                                            orelse ch = #"%"
                                            orelse ch = #"?"
diff --git a/src/settings.sml b/src/settings.sml
index a9c2315c..246be88b 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -315,7 +315,11 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("preventDefault", "uw_preventDefault"),
                           ("stopPropagation", "uw_stopPropagation"),
 
-                          ("fresh", "fresh")]
+                          ("fresh", "fresh"),
+
+                          ("atom", "atom"),
+                          ("css_url", "css_url"),
+                          ("property", "property")]
 val jsFuncs = ref jsFuncsBase
 fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
 fun jsFunc x = M.find (!jsFuncs, x)