# HG changeset patch # User Adam Chlipala # Date 1342898217 14400 # Node ID 69daa6d70299586d88d910a360a7e85106f29d32 # Parent d794149b3713e9b5e6f59889f02b99622451b1fa Top.postFields diff -r d794149b3713 -r 69daa6d70299 doc/manual.tex --- a/doc/manual.tex Sat Jul 21 13:55:35 2012 -0400 +++ b/doc/manual.tex Sat Jul 21 15:16:57 2012 -0400 @@ -2310,7 +2310,7 @@ 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 -r d794149b3713 -r 69daa6d70299 include/urweb/types.h --- a/include/urweb/types.h Sat Jul 21 13:55:35 2012 -0400 +++ b/include/urweb/types.h Sat Jul 21 15:16:57 2012 -0400 @@ -51,6 +51,10 @@ 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 -r d794149b3713 -r 69daa6d70299 include/urweb/urweb.h --- a/include/urweb/urweb.h Sat Jul 21 13:55:35 2012 -0400 +++ b/include/urweb/urweb.h Sat Jul 21 15:16:57 2012 -0400 @@ -363,4 +363,9 @@ 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 -r d794149b3713 -r 69daa6d70299 lib/ur/basis.urs --- a/lib/ur/basis.urs Sat Jul 21 13:55:35 2012 -0400 +++ b/lib/ur/basis.urs Sat Jul 21 15:16:57 2012 -0400 @@ -898,6 +898,12 @@ 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 -r d794149b3713 -r 69daa6d70299 lib/ur/top.ur --- a/lib/ur/top.ur Sat Jul 21 13:55:35 2012 -0400 +++ b/lib/ur/top.ur Sat Jul 21 15:16:57 2012 -0400 @@ -393,3 +393,15 @@ 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 -r d794149b3713 -r 69daa6d70299 lib/ur/top.urs --- a/lib/ur/top.urs Sat Jul 21 13:55:35 2012 -0400 +++ b/lib/ur/top.urs Sat Jul 21 15:16:57 2012 -0400 @@ -281,3 +281,5 @@ -> sql_exp tables agg exps bool val mkRead' : t ::: Type -> (string -> option t) -> string -> read t + +val postFields : postBody -> list (string * string) diff -r d794149b3713 -r 69daa6d70299 src/c/request.c --- a/src/c/request.c Sat Jul 21 13:55:35 2012 -0400 +++ b/src/c/request.c Sat Jul 21 15:16:57 2012 -0400 @@ -294,7 +294,7 @@ 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 -r d794149b3713 -r 69daa6d70299 src/c/urweb.c --- a/src/c/urweb.c Sat Jul 21 13:55:35 2012 -0400 +++ b/src/c/urweb.c Sat Jul 21 15:16:57 2012 -0400 @@ -4086,3 +4086,43 @@ 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 -r d794149b3713 -r 69daa6d70299 src/settings.sml --- a/src/settings.sml Sat Jul 21 13:55:35 2012 -0400 +++ b/src/settings.sml Sat Jul 21 15:16:57 2012 -0400 @@ -218,7 +218,11 @@ "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 -r d794149b3713 -r 69daa6d70299 tests/formFields.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/formFields.ur Sat Jul 21 15:16:57 2012 -0400 @@ -0,0 +1,3 @@ +fun main (pb : postBody) : transaction page = return + {List.mapX (fn (n, v) =>
  • {[n]} = {[v]}
    • ) (postFields pb)} +     diff -r d794149b3713 -r 69daa6d70299 tests/formFields.urp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/formFields.urp Sat Jul 21 15:16:57 2012 -0400 @@ -0,0 +1,4 @@ +rewrite url FormFields/* + +$/list +formFields