summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/urweb/urweb.h4
-rw-r--r--lib/js/urweb.js40
-rw-r--r--src/c/urweb.c43
-rw-r--r--src/mono_opt.sml1
-rw-r--r--src/settings.sml6
-rw-r--r--tests/styleRt.ur38
-rw-r--r--tests/styleRt.urp4
-rw-r--r--tests/styleRt.urs1
8 files changed, 136 insertions, 1 deletions
diff --git a/include/urweb/urweb.h b/include/urweb/urweb.h
index c506985d..7320eb12 100644
--- a/include/urweb/urweb.h
+++ b/include/urweb/urweb.h
@@ -356,4 +356,8 @@ uw_Basis_int uw_Basis_ceil(uw_context, uw_Basis_float);
uw_Basis_int uw_Basis_trunc(uw_context, uw_Basis_float);
uw_Basis_int uw_Basis_round(uw_context, uw_Basis_float);
+uw_Basis_string uw_Basis_atom(uw_context, uw_Basis_string);
+uw_Basis_string uw_Basis_css_url(uw_context, uw_Basis_string);
+uw_Basis_string uw_Basis_property(uw_context, uw_Basis_string);
+
#endif
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 4f6a5f22..85d10d4a 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1748,6 +1748,46 @@ function bless(s) {
}
+// CSS validation
+
+function atom(s) {
+ for (var i = 0; i < s.length; ++i) {
+ var c = s[i];
+ if (!isAlnum(c) && c != '+' && c != '-' && c != '.' && c != '%' && c != '#')
+ er("Disallowed character in CSS atom");
+ }
+
+ return s;
+}
+
+function css_url(s) {
+ for (var i = 0; i < s.length; ++i) {
+ var c = s[i];
+ if (!isAlnum(c) && c != ':' && c != '/' && c != '.' && c != '_' && c != '+'
+ && c != '-' && c != '%' && c != '?' && c != '&' && c != '=' && c != '#')
+ er("Disallowed character in CSS URL");
+ }
+
+ return s;
+}
+
+function property(s) {
+ if (s.length <= 0)
+ er("Empty CSS property");
+
+ if (!isLower(s[0]) && s[0] != '_')
+ er("Bad initial character in CSS property");
+
+ for (var i = 0; i < s.length; ++i) {
+ var c = s[i];
+ if (!isLower(c) && !isDigit(c) && c != '_' && c != '-')
+ er("Disallowed character in CSS property");
+ }
+
+ return s;
+}
+
+
// ID generation
var nextId = 0;
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)
diff --git a/tests/styleRt.ur b/tests/styleRt.ur
new file mode 100644
index 00000000..583649a1
--- /dev/null
+++ b/tests/styleRt.ur
@@ -0,0 +1,38 @@
+fun handler r =
+ return <xml><body>
+ <span style={oneProperty
+ (oneProperty noStyle (value (property r.Prop) (atom r.Valu)))
+ (value (property "background") (css_url (bless r.Url)))}>
+ Teeeest
+ </span>
+ </body></xml>
+
+fun main () =
+ prop <- source "";
+ valu <- source "";
+ url <- source "";
+ xm <- source <xml/>;
+ return <xml><body>
+ Property: <ctextbox source={prop}/><br/>
+ Value: <ctextbox source={valu}/><br/>
+ URL: <ctextbox source={url}/><br/>
+ <button value="Go!" onclick={prop <- get prop;
+ valu <- get valu;
+ url <- get url;
+ set xm <xml><span style={oneProperty
+ (oneProperty noStyle (value (property prop) (atom valu)))
+ (value (property "background") (css_url (bless url)))}>
+ Teeeest
+ </span></xml>}/>
+ <hr/>
+ <dyn signal={signal xm}/>
+ <hr/>
+ <h2>Or the old fashioned way...</h2>
+
+ <form>
+ Property: <textbox{#Prop}/><br/>
+ Value: <textbox{#Valu}/><br/>
+ URL: <textbox{#Url}/><br/>
+ <submit action={handler}/>
+ </form>
+ </body></xml>
diff --git a/tests/styleRt.urp b/tests/styleRt.urp
new file mode 100644
index 00000000..42e5f024
--- /dev/null
+++ b/tests/styleRt.urp
@@ -0,0 +1,4 @@
+rewrite all StyleRt/*
+allow url http://www.google.com/*
+
+styleRt
diff --git a/tests/styleRt.urs b/tests/styleRt.urs
new file mode 100644
index 00000000..901d6bf2
--- /dev/null
+++ b/tests/styleRt.urs
@@ -0,0 +1 @@
+val main : {} -> transaction page
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 12:07:48 +0000