From cbce1b6184acae87ba220969ab2c69cf2697ea32 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 21 Jul 2012 15:16:57 -0400 Subject: Top.postFields --- doc/manual.tex | 2 +- include/urweb/types.h | 4 ++++ include/urweb/urweb.h | 5 +++++ lib/ur/basis.urs | 6 ++++++ lib/ur/top.ur | 12 ++++++++++++ lib/ur/top.urs | 2 ++ src/c/request.c | 2 +- src/c/urweb.c | 40 ++++++++++++++++++++++++++++++++++++++++ src/settings.sml | 6 +++++- tests/formFields.ur | 3 +++ tests/formFields.urp | 4 ++++ 11 files changed, 83 insertions(+), 3 deletions(-) create mode 100644 tests/formFields.ur create mode 100644 tests/formFields.urp diff --git a/doc/manual.tex b/doc/manual.tex index 9e73e5ae..c7a6491b 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -2310,7 +2310,7 @@ A web application is built from a series of modules, with one module, the last o Elements of modules beside the main module, including page handlers, will only be included in the final application if they are transitive dependencies of the handlers in the main module. -Normal links are accessible via HTTP \texttt{GET}, which the relevant standard says should never cause side effects. To export a page which may cause side effects, accessible only via HTTP \texttt{POST}, include one argument of the page handler of type $\mt{Basis.postBody}$. When the handler is called, this argument will receive a value that can be deconstructed into a MIME type (with $\mt{Basis.postType}$) and payload (with $\mt{Basis.postData}$). This kind of handler will only work with \texttt{POST} payloads of MIME types besides those associated with HTML forms; for these, use Ur/Web's built-in support, as described below. +Normal links are accessible via HTTP \texttt{GET}, which the relevant standard says should never cause side effects. To export a page which may cause side effects, accessible only via HTTP \texttt{POST}, include one argument of the page handler of type $\mt{Basis.postBody}$. When the handler is called, this argument will receive a value that can be deconstructed into a MIME type (with $\mt{Basis.postType}$) and payload (with $\mt{Basis.postData}$). This kind of handler should not be used with forms that exist solely within Ur/Web apps; for these, use Ur/Web's built-in support, as described below. It may still be useful to use $\mt{Basis.postBody}$ with form requests submitted by code outside an Ur/Web app. For such cases, the function $\mt{Top.postFields} : \mt{postBody} \to \mt{list} \; (\mt{string} \times \mt{string})$ may be useful, breaking a \texttt{POST} body of type \texttt{application/x-www-form-urlencoded} into its name-value pairs. Any normal page handler may also include arguments of type $\mt{option \; Basis.queryString}$, which will be handled specially. Rather than being deserialized from the current URI, such an argument is passed the whole query string that the handler received. The string may be analyzed by calling $\mt{Basis.show}$ on it. A handler of this kind may be passed as an argument to $\mt{Basis.effectfulUrl}$ to generate a URL to a page that may be used as a ``callback'' by an external service, such that the handler is allowed to cause side effects. diff --git a/include/urweb/types.h b/include/urweb/types.h index c401b38f..152f4392 100644 --- a/include/urweb/types.h +++ b/include/urweb/types.h @@ -51,6 +51,10 @@ typedef struct uw_Basis_postBody { typedef uw_Basis_string uw_Basis_queryString; +typedef struct { + uw_Basis_string name, value, remaining; +} uw_Basis_postField; + typedef enum { SUCCESS, FATAL, BOUNDED_RETRY, UNLIMITED_RETRY, RETURN_INDIRECTLY } failure_kind; typedef enum { SERVED, KEEP_OPEN, FAILED } request_result; diff --git a/include/urweb/urweb.h b/include/urweb/urweb.h index 21c8bc88..af0aafdb 100644 --- a/include/urweb/urweb.h +++ b/include/urweb/urweb.h @@ -363,4 +363,9 @@ uw_Basis_string uw_Basis_property(uw_context, uw_Basis_string); void uw_begin_initializing(uw_context); void uw_end_initializing(uw_context); +uw_Basis_string uw_Basis_fieldName(uw_context, uw_Basis_postField); +uw_Basis_string uw_Basis_fieldValue(uw_context, uw_Basis_postField); +uw_Basis_string uw_Basis_remainingFields(uw_context, uw_Basis_postField); +uw_Basis_postField *uw_Basis_firstFormField(uw_context, uw_Basis_string); + #endif diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 8ac94668..cb5d16ea 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -898,6 +898,12 @@ type postBody val postType : postBody -> string val postData : postBody -> string +type postField +val firstFormField : string -> option postField +val fieldName : postField -> string +val fieldValue : postField -> string +val remainingFields : postField -> string + con radio = [Body, Radio] val radio : formTag (option string) radio [Id = id] val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs) radio [] [] [] diff --git a/lib/ur/top.ur b/lib/ur/top.ur index e504204e..5b9d43ab 100644 --- a/lib/ur/top.ur +++ b/lib/ur/top.ur @@ -393,3 +393,15 @@ fun mkRead' [t ::: Type] (f : string -> option t) (name : string) : read t = mkRead (fn s => case f s of None => error Invalid {txt name}: {txt s} | Some v => v) f + +fun postFields pb = + let + fun postFields' s = + case firstFormField s of + None => [] + | Some f => (fieldName f, fieldValue f) :: postFields' (remainingFields f) + in + case postType pb of + "application/x-www-form-urlencoded" => postFields' (postData pb) + | _ => error Tried to get POST fields, but MIME type is not "application/x-www-form-urlencoded" + end diff --git a/lib/ur/top.urs b/lib/ur/top.urs index 489e744d..30f1eaad 100644 --- a/lib/ur/top.urs +++ b/lib/ur/top.urs @@ -281,3 +281,5 @@ val eqNullable' : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> sql_exp tables agg exps bool val mkRead' : t ::: Type -> (string -> option t) -> string -> read t + +val postFields : postBody -> list (string * string) diff --git a/src/c/request.c b/src/c/request.c index a697ba44..b23c251f 100644 --- a/src/c/request.c +++ b/src/c/request.c @@ -294,7 +294,7 @@ request_result uw_request(uw_request_context rc, uw_context ctx, boundary[0] = '-'; boundary[1] = '-'; boundary_len = strlen(boundary); - } else if (clen_s && strcasecmp(clen_s, "application/x-www-form-urlencoded")) { + } else if (clen_s) { uw_Basis_postBody pb = {clen_s, body}; uw_postBody(ctx, pb); } diff --git a/src/c/urweb.c b/src/c/urweb.c index d0b6987c..0ccc418a 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4086,3 +4086,43 @@ uw_Basis_string uw_Basis_property(uw_context ctx, uw_Basis_string s) { return s; } + +uw_Basis_string uw_Basis_fieldName(uw_context ctx, uw_Basis_postField f) { + return f.name; +} + +uw_Basis_string uw_Basis_fieldValue(uw_context ctx, uw_Basis_postField f) { + return f.value; +} + +uw_Basis_string uw_Basis_remainingFields(uw_context ctx, uw_Basis_postField f) { + return f.remaining; +} + +uw_Basis_postField *uw_Basis_firstFormField(uw_context ctx, uw_Basis_string s) { + char *amp, *eq, *unurl, *copy; + uw_Basis_postField *f; + + if (s[0] == 0) + return NULL; + + amp = strchr(s, '&'); + copy = uw_malloc(ctx, amp ? amp - s + 1 : strlen(s) + 1); + if (amp) { + strncpy(copy, s, amp - s); + copy[amp - s] = 0; + } else + strcpy(copy, s); + + eq = strchr(copy, '='); + if (eq) + *eq++ = 0; + + f = uw_malloc(ctx, sizeof(uw_Basis_postField)); + unurl = copy; + f->name = uw_Basis_unurlifyString(ctx, &unurl); + f->value = eq ? (unurl = eq, uw_Basis_unurlifyString(ctx, &unurl)) : ""; + f->remaining = amp ? amp+1 : ""; + + return f; +} diff --git a/src/settings.sml b/src/settings.sml index dcaf392d..9359337d 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -218,7 +218,11 @@ val serverBase = basis ["requestHeader", "nextval", "setval", "channel", - "send"] + "send", + "fieldName", + "fieldValue", + "remainingFields", + "firstFormField"] val server = ref serverBase fun setServerOnly ls = server := S.addList (serverBase, ls) fun isServerOnly x = S.member (!server, x) diff --git a/tests/formFields.ur b/tests/formFields.ur new file mode 100644 index 00000000..2dbf2d53 --- /dev/null +++ b/tests/formFields.ur @@ -0,0 +1,3 @@ +fun main (pb : postBody) : transaction page = return + {List.mapX (fn (n, v) =>
  • {[n]} = {[v]}
    • ) (postFields pb)} +     diff --git a/tests/formFields.urp b/tests/formFields.urp new file mode 100644 index 00000000..82f95f1c --- /dev/null +++ b/tests/formFields.urp @@ -0,0 +1,4 @@ +rewrite url FormFields/* + +$/list +formFields -- cgit v1.2.3