Mercurial > urweb

comparison src/monoize.sml @ 734:f2a2be93331c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Cookie signing working for forms
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Apr 2009 19:12:12 -0400
parents 1b1047992ecf
children 5ccb67665d05
comparison
equal deleted inserted replaced
733:15ddd64a5113 734:f2a2be93331c
2397 | _ => normal (tag, NONE, NONE) 2397 | _ => normal (tag, NONE, NONE)
2398 end 2398 end
2399 2399
2400 | L.EApp ((L.ECApp ( 2400 | L.EApp ((L.ECApp (
2401 (L.ECApp ((L.EFfi ("Basis", "form"), _), _), _), 2401 (L.ECApp ((L.EFfi ("Basis", "form"), _), _), _),
2402 _), _), 2402 (L.CRecord (_, fields), _)), _),
2403 xml) => 2403 xml) =>
2404 let 2404 let
2405 fun findSubmit (e, _) = 2405 fun findSubmit (e, _) =
2406 case e of 2406 case e of
2407 L.EApp ( 2407 L.EApp (
2466 (L'.EStrcat (action, 2466 (L'.EStrcat (action,
2467 (L'.EPrim (Prim.String "\""), loc)), loc)), loc), 2467 (L'.EPrim (Prim.String "\""), loc)), loc)), loc),
2468 fm) 2468 fm)
2469 end 2469 end
2470 2470
2471 fun inFields s = List.exists (fn ((L.CName s', _), _) => s' = s
2472 | _ => true) fields
2473
2474 fun getSigName () =
2475 let
2476 fun getSigName' n =
2477 let
2478 val s = "Sig" ^ Int.toString n
2479 in
2480 if inFields s then
2481 getSigName' (n + 1)
2482 else
2483 s
2484 end
2485 in
2486 if inFields "Sig" then
2487 getSigName' 0
2488 else
2489 "Sig"
2490 end
2491
2492 val sigName = getSigName ()
2493 val sigSet = (L'.EFfiApp ("Basis", "sigString", [(L'.ERecord [], loc)]), loc)
2494 val sigSet = (L'.EStrcat ((L'.EPrim (Prim.String ("<input type=\"hidden\" name=\""
2495 ^ sigName
2496 ^ "\" value=\"")), loc),
2497 sigSet), loc)
2498 val sigSet = (L'.EStrcat (sigSet,
2499 (L'.EPrim (Prim.String "\">"), loc)), loc)
2500
2471 val (xml, fm) = monoExp (env, st, fm) xml 2501 val (xml, fm) = monoExp (env, st, fm) xml
2502 val xml = (L'.EStrcat (sigSet, xml), loc)
2472 in 2503 in
2473 ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc), 2504 ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc),
2474 (L'.EStrcat (action, 2505 (L'.EStrcat (action,
2475 (L'.EPrim (Prim.String ">"), loc)), loc)), loc), 2506 (L'.EPrim (Prim.String ">"), loc)), loc)), loc),
2476 (L'.EStrcat (xml, 2507 (L'.EStrcat (xml,