changeset 1787:69daa6d70299

Top.postFields
author Adam Chlipala <adam@chlipala.net>
date Sat, 21 Jul 2012 15:16:57 -0400
parents d794149b3713
children f57983ba2a36
files doc/manual.tex include/urweb/types.h include/urweb/urweb.h lib/ur/basis.urs lib/ur/top.ur lib/ur/top.urs src/c/request.c src/c/urweb.c src/settings.sml tests/formFields.ur tests/formFields.urp
diffstat 11 files changed, 83 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- 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.
 
--- 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;
--- 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
--- 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 [] [] []
--- 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 <xml>Invalid {txt name}: {txt s}</xml>
                       | 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 <xml>Tried to get POST fields, but MIME type is not "application/x-www-form-urlencoded"</xml>
+    end
--- 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)
--- 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);
     }
--- 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;
+}
--- 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)
--- /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 <xml><body>
+  {List.mapX (fn (n, v) => <xml><li>{[n]} = {[v]}</li></xml>) (postFields pb)}
+</body></xml>
--- /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