tests/eliom_testsuite1.ml

   1 (* Eliom test suite, part 1 *)
   2 (* TODO: extract the tests from the manual or vice versa.
   3    Take the code in the manual, not here! (and remove duplicates here) *)
   4 (* TODO: include some missing parts in the manual *)
   5
   6 open Lwt
   7 open XHTML.M
   8 open Ocsigen_cookies
   9 open Eliom_services
  10 open Eliom_parameters
  11 open Eliom_state
  12 open Eliom_output.Xhtml
  13
  14 let coucou =
  15   register_service
  16     ~path:["coucou"]
  17     ~get_params:unit
  18     (fun () () ->
  19       return
  20         (html
  21            (head (title (pcdata "")) [])
  22            (body [h1 [pcdata "Hallo!"]])))
  23
  24 let coucou1 =
  25   Eliom_output.Xhtml.register_service
  26     ~path:["coucou1"]
  27     ~get_params:Eliom_parameters.unit
  28     (fun () () ->
  29       return
  30         <:xhtml< <html>
  31              <head><title></title></head>
  32              <body><h1>Coucou</h1></body>
  33            </html> >>)
  34
  35 let coucoutext =
  36   Eliom_output.HtmlText.register_service
  37     ~path:["coucoutext"]
  38     ~get_params:Eliom_parameters.unit
  39     (fun () () ->
  40       return
  41         ("<html>n'importe quoi "^
  42          (Eliom_output.HtmlText.a coucou "clic" ())^
  43          "</html>"))
  44 (*wiki*
  45
  46         Page generation may have side-effects:
  47
  48
  49
  50 *wiki*)
  51 let count =
  52   let next =
  53     let c = ref 0 in
  54       (fun () -> c := !c + 1; !c)
  55   in
  56   register_service
  57     ~path:["count"]
  58     ~get_params:unit
  59     (fun () () ->
  60       return
  61         (html
  62          (head (title (pcdata "counter")) [])
  63          (body [p [pcdata (string_of_int (next ()))]])))
  64 (*wiki*
  65 As usual in OCaml, you can forget labels when the application
  66           is total:
  67
  68 *wiki*)
  69 let hello =
  70   register_service
  71     ["dir";"hello"]  (* the url dir/hello *)
  72     unit
  73     (fun () () ->
  74       return
  75         (html
  76          (head (title (pcdata "Hello")) [])
  77          (body [h1 [pcdata "Hello"]])))
  78 (*wiki*
  79
  80 The following example shows how to define the default page for
  81 a directory. (Note that %<span class="code"|["rep";""]>% means
  82 the default page of the directory %<span class="code"|rep/>%)
  83
  84 *wiki*)
  85 let default = register_service ["rep";""] unit
  86   (fun () () ->
  87     return
  88      (html
  89       (head (title (pcdata "")) [])
  90       (body [p [pcdata "default page. rep is redirected to rep/"]])))
  91
  92
  93
  94 let writeparams (i1, (i2, s1)) () =
  95   return
  96    (html
  97     (head (title (pcdata "")) [])
  98     (body [p [pcdata "You sent: ";
  99               strong [pcdata (string_of_int i1)];
 100               pcdata ", ";
 101               strong [pcdata (string_of_int i2)];
 102               pcdata " and ";
 103               strong [pcdata s1]]]))
 104 (*zap* you can register twice the same service, with different parameter names
 105  *zap*)
 106 let coucou_params = register_service
 107     ~path:["coucou"]
 108     ~get_params:(int "i" ** (int "ii" ** string "s"))
 109     writeparams
 110 (*zap* If you register twice exactly the same URL, the server won't start
 111  *zap*)
 112 (*wiki*
 113
 114
 115
 116 *wiki*)
 117 let uasuffix =
 118   register_service
 119     ~path:["uasuffix"]
 120     ~get_params:(suffix (int "year" ** int "month"))
 121     (fun (year, month) () ->
 122       return
 123        (html
 124         (head (title (pcdata "")) [])
 125         (body
 126            [p [pcdata "The suffix of the url is ";
 127                strong [pcdata ((string_of_int year)^"/"
 128                                ^(string_of_int month))];
 129                pcdata ", your user-agent is ";
 130                strong [pcdata (Eliom_request_info.get_user_agent ())];
 131                pcdata ", your IP is ";
 132                strong [pcdata (Eliom_request_info.get_remote_ip ())]]])))
 133 (*wiki*
 134
 135 *wiki*)
 136 let isuffix =
 137   register_service
 138     ~path:["isuffix"]
 139     ~get_params:(suffix_prod (int "suff" ** all_suffix "endsuff") (int "i"))
 140     (fun ((suff, endsuff), i) () ->
 141       return
 142        (html
 143         (head (title (pcdata "")) [])
 144         (body
 145            [p [pcdata "The suffix of the url is ";
 146                strong [pcdata (string_of_int suff)];
 147                pcdata " followed by ";
 148                strong [pcdata (Url.string_of_url_path ~encode:false endsuff)];
 149                pcdata " and i is equal to ";
 150                strong [pcdata (string_of_int i)]]])))
 151 (*wiki*
 152
 153
 154   *wiki*)
 155 let constfix =
 156   register_service
 157     ~path:["constfix"]
 158     ~get_params:(suffix (string "s1" ** (Eliom_parameters.suffix_const "toto" ** string "s2")))
 159     (fun (s1, ((), s2))  () ->
 160       return
 161         (html
 162           (head (title (pcdata "")) [])
 163           (body [h1
 164                    [pcdata "Suffix with constants"];
 165                  p [pcdata ("Parameters are "^s1^" and "^s2)]])))
 166 (*wiki*
 167
 168
 169 *wiki*)
 170 type mysum = A | B
 171 let mysum_of_string = function
 172   | "A" -> A
 173   | "B" -> B
 174   | _ -> raise (Failure "mysum_of_string")
 175 let string_of_mysum = function
 176   | A -> "A"
 177   | B -> "B"
 178
 179 let mytype =
 180   Eliom_output.Xhtml.register_service
 181     ~path:["mytype"]
 182     ~get_params:
 183       (Eliom_parameters.user_type mysum_of_string string_of_mysum "valeur")
 184     (fun x () ->
 185       let v = string_of_mysum x in
 186       return
 187         (html
 188          (head (title (pcdata "")) [])
 189          (body [p [pcdata (v^" is valid. Now try with another value.")]])))
 190 (*wiki*
 191
 192
 193 *wiki*)
 194 let raw_serv = register_service
 195     ~path:["any"]
 196     ~get_params:Eliom_parameters.any
 197   (fun l () ->
 198     let ll =
 199       List.map
 200         (fun (a,s) -> <:xhtml< <strong>($str:a$, $str:s$)</strong> >>) l
 201     in
 202     return
 203      <:xhtml< <html>
 204           <head><title></title></head>
 205           <body>
 206           <p>
 207             You sent:
 208             $list:ll$
 209           </p>
 210           </body>
 211         </html> >>)
 212 (*wiki*
 213
 214 *wiki*)
 215
 216 let catch = register_service
 217     ~path:["catch"]
 218     ~get_params:(int "i")
 219     ~error_handler:(fun l ->
 220       return
 221         (html
 222          (head (title (pcdata "")) [])
 223          (body [p [pcdata ("i is not an integer.")]])))
 224     (fun i () ->
 225       let v = string_of_int i in
 226       return
 227         (html
 228            (head (title (pcdata "")) [])
 229            (body [p [pcdata ("i is an integer: "^v)]])))
 230 (*wiki*
 231
 232
 233 *wiki*)
 234 let links = register_service ["rep";"links"] unit
 235  (fun () () ->
 236    return
 237     (html
 238      (head (title (pcdata "Links")) [])
 239      (body
 240        [p
 241         [Eliom_output.Xhtml.a coucou [pcdata "coucou"] (); br ();
 242          Eliom_output.Xhtml.a hello [pcdata "hello"] (); br ();
 243          Eliom_output.Xhtml.a default
 244            [pcdata "default page of the dir"] (); br ();
 245          Eliom_output.Xhtml.a uasuffix
 246            [pcdata "uasuffix"] (2007,06); br ();
 247          Eliom_output.Xhtml.a coucou_params
 248            [pcdata "coucou_params"] (42,(22,"ciao")); br ();
 249          Eliom_output.Xhtml.a raw_serv
 250            [pcdata "raw_serv"] [("sun","yellow");("sea","blue and pink")]; br ();
 251          Eliom_output.Xhtml.a
 252            (external_service
 253               ~prefix:"http://fr.wikipedia.org"
 254               ~path:["wiki";""]
 255               ~get_params:(suffix (all_suffix "suff"))
 256               ())
 257            [pcdata "OCaml on wikipedia"]
 258            ["OCaml"]; br ();
 259          XHTML.M.a
 260            ~a:[a_href (Uri.uri_of_string "http://en.wikipedia.org/wiki/OCaml")]
 261            [pcdata "OCaml on wikipedia"]
 262        ]])))
 263 (*zap*
 264    Note that to create a link we need to know the current url, because:
 265    the link from toto/titi to toto/tata is "tata" and not "toto/tata"
 266 *zap*)
 267 (*wiki*
 268
 269
 270
 271 *wiki*)
 272 let linkrec = Eliom_services.service ["linkrec"] unit ()
 273
 274 let _ = Eliom_output.Xhtml.register linkrec
 275     (fun () () ->
 276       return
 277        (html
 278         (head (title (pcdata "")) [])
 279         (body [p [a linkrec [pcdata "click"] ()]])))
 280 (*zap* If some url are not registered, the server will not start:
 281 let essai =
 282   new_url
 283    ~path:["essai"]
 284    ~server_params:no_server_param
 285    ~get_params:no_get_param
 286    ()
 287 *zap*)
 288 (*zap* pour les reload : le serveur ne s'éteint pas mais ajoute un message sur les services non enregistrés dans son log *zap*)
 289 (*wiki*
 290
 291
 292 *wiki*)
 293 let create_form =
 294   (fun (number_name, (number2_name, string_name)) ->
 295     [p [pcdata "Write an int: ";
 296         Eliom_output.Xhtml.int_input ~input_type:`Text ~name:number_name ();
 297         pcdata "Write another int: ";
 298         Eliom_output.Xhtml.int_input ~input_type:`Text ~name:number2_name ();
 299         pcdata "Write a string: ";
 300         Eliom_output.Xhtml.string_input ~input_type:`Text ~name:string_name ();
 301         Eliom_output.Xhtml.string_input ~input_type:`Submit ~value:"Click" ()]])
 302
 303 let form = register_service ["form"] unit
 304   (fun () () ->
 305      let f = Eliom_output.Xhtml.get_form coucou_params create_form in
 306      return
 307        (html
 308          (head (title (pcdata "")) [])
 309          (body [f])))
 310 (*wiki*
 311
 312 *wiki*)
 313 let raw_form = register_service
 314     ~path:["anyform"]
 315     ~get_params:unit
 316     (fun () () ->
 317       return
 318         (html
 319            (head (title (pcdata "")) [])
 320            (body
 321               [h1 [pcdata "Any Form"];
 322                Eliom_output.Xhtml.get_form raw_serv
 323                  (fun () ->
 324                    [p [pcdata "Form to raw_serv: ";
 325                        Eliom_output.Xhtml.raw_input ~input_type:`Text ~name:"plop" ();
 326                        Eliom_output.Xhtml.raw_input ~input_type:`Text ~name:"plip" ();
 327                        Eliom_output.Xhtml.raw_input ~input_type:`Text ~name:"plap" ();
 328                        Eliom_output.Xhtml.string_input ~input_type:`Submit ~value:"Click" ()]])
 329                 ])))
 330 (*wiki*
 331
 332
 333
 334 *wiki*)
 335 let no_post_param_service =
 336   register_service
 337     ~path:["post"]
 338     ~get_params:unit
 339     (fun () () ->
 340       return
 341         (html
 342          (head (title (pcdata "")) [])
 343          (body [h1 [pcdata
 344                       "Version of the page without POST parameters"]])))
 345
 346 let my_service_with_post_params =
 347   register_post_service
 348     ~fallback:no_post_param_service
 349     ~post_params:(string "value")
 350     (fun () value ->
 351       return
 352         (html
 353          (head (title (pcdata "")) [])
 354          (body [h1 [pcdata value]])))
 355 (*wiki*
 356
 357
 358
 359
 360 Services may take both GET and POST parameters:
 361
 362
 363 *wiki*)
 364 let get_no_post_param_service =
 365   register_service
 366     ~path:["post2"]
 367     ~get_params:(int "i")
 368     (fun i () ->
 369       return
 370         (html
 371          (head (title (pcdata "")) [])
 372          (body [p [pcdata "No POST parameter, i:";
 373                    em [pcdata (string_of_int i)]]])))
 374
 375 let my_service_with_get_and_post = register_post_service
 376   ~fallback:get_no_post_param_service
 377   ~post_params:(string "value")
 378   (fun i value ->
 379     return
 380       (html
 381          (head (title (pcdata "")) [])
 382          (body [p [pcdata "Value: ";
 383                    em [pcdata value];
 384                    pcdata ", i: ";
 385                    em [pcdata (string_of_int i)]]])))
 386 (*wiki*
 387
 388 POST forms
 389
 390 *wiki*)
 391 let form2 = register_service ["form2"] unit
 392   (fun () () ->
 393      let f =
 394        (Eliom_output.Xhtml.post_form my_service_with_post_params
 395           (fun chaine ->
 396             [p [pcdata "Write a string: ";
 397                 string_input ~input_type:`Text ~name:chaine ()]]) ()) in
 398      return
 399        (html
 400          (head (title (pcdata "form")) [])
 401          (body [f])))
 402
 403 let form3 = register_service ["form3"] unit
 404   (fun () () ->
 405      let f  =
 406        (Eliom_output.Xhtml.post_form my_service_with_get_and_post
 407           (fun chaine ->
 408             <:xhtmllist< <p> Write a string:
 409                     $string_input ~input_type:`Text ~name:chaine ()$ </p> >>)
 410           222) in
 411      return
 412        <:xhtml< <html>
 413             <head><title></title></head>
 414             <body>$f$</body></html> >>)
 415
 416 let form4 = register_service ["form4"] unit
 417   (fun () () ->
 418      let f  =
 419        (Eliom_output.Xhtml.post_form
 420           (external_post_service
 421              ~prefix:"http://www.petizomverts.com"
 422              ~path:["zebulon"]
 423              ~get_params:(int "i")
 424              ~post_params:(string "chaine") ())
 425           (fun chaine ->
 426             <:xhtmllist< <p> Write a string:
 427                      $string_input ~input_type:`Text ~name:chaine ()$ </p> >>)
 428           222) in
 429      return
 430        (html
 431         (head (title (pcdata "form")) [])
 432         (body [f])))
 433 (*wiki*
 434
 435 Lwt
 436
 437
 438 %<code language="ocaml"|let looong =
 439   register_service
 440     ~path:["looong"]
 441     ~get_params:unit
 442     (fun () () ->
 443       Unix.sleep 5;
 444       return
 445         (html
 446           (head (title (pcdata "")) [])
 447           (body [h1 [pcdata "Ok now, you can read the page."]])))
 448 >%
 449
 450
 451
 452 *wiki*)
 453 let looong =
 454   register_service
 455     ~path:["looong"]
 456     ~get_params:unit
 457     (fun () () ->
 458       Lwt_unix.sleep 5.0 >>= fun () ->
 459       return
 460         (html
 461           (head (title (pcdata "")) [])
 462           (body [h1 [pcdata
 463                    "Ok now, you can read the page."]])))
 464 (*wiki*
 465
 466 *wiki*)
 467 let looong2 =
 468   register_service
 469     ~path:["looong2"]
 470     ~get_params:unit
 471     (fun () () ->
 472       Lwt_preemptive.detach Unix.sleep 5 >>= fun () ->
 473       return
 474         (html
 475           (head (title (pcdata "")) [])
 476           (body [h1 [pcdata
 477                    "Ok now, you can read the page."]])))
 478 (*wiki*
 479
 480
 481 *wiki*)
 482 (************************************************************)
 483 (************ Connection of users, version 1 ****************)
 484 (************************************************************)
 485
 486 (*zap* *)
 487 let scope_name = Eliom_common.create_scope_name "session_data"
 488 let session = `Session scope_name
 489 (* *zap*)
 490
 491 (* "my_table" will be the structure used to store
 492    the session data (namely the login name): *)
 493
 494 let my_table = Eliom_state.create_volatile_table (*zap* *) ~scope:session (* *zap*) ()
 495
 496
 497 (* -------------------------------------------------------- *)
 498 (* Create services, but do not register them yet:           *)
 499
 500 let session_data_example =
 501   Eliom_services.service
 502     ~path:["sessdata"]
 503     ~get_params:Eliom_parameters.unit
 504     ()
 505
 506 let session_data_example_with_post_params =
 507   Eliom_services.post_service
 508     ~fallback:session_data_example
 509     ~post_params:(Eliom_parameters.string "login")
 510     ()
 511
 512 let session_data_example_close =
 513   Eliom_services.service
 514     ~path:["close"]
 515     ~get_params:Eliom_parameters.unit
 516     ()
 517
 518
 519
 520 (* -------------------------------------------------------- *)
 521 (* Handler for the "session_data_example" service:          *)
 522
 523 let session_data_example_handler _ _  =
 524   let sessdat = Eliom_state.get_volatile_data ~table:my_table () in
 525   return
 526     (html
 527        (head (title (pcdata "")) [])
 528        (body
 529           [
 530            match sessdat with
 531            | Eliom_state.Data name ->
 532                p [pcdata ("Hello "^name);
 533                   br ();
 534                   Eliom_output.Xhtml.a
 535                     session_data_example_close
 536                     [pcdata "close session"] ()]
 537            | Eliom_state.Data_session_expired
 538            | Eliom_state.No_data ->
 539                Eliom_output.Xhtml.post_form
 540                  session_data_example_with_post_params
 541                  (fun login ->
 542                    [p [pcdata "login: ";
 543                        Eliom_output.Xhtml.string_input
 544                          ~input_type:`Text ~name:login ()]]) ()
 545          ]))
 546
 547 (* -------------------------------------------------------- *)
 548 (* Handler for the "session_data_example_with_post_params"  *)
 549 (* service with POST params:                                *)
 550
 551 let session_data_example_with_post_params_handler _ login =
 552   lwt () = Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () in
 553   Eliom_state.set_volatile_data ~table:my_table login;
 554   return
 555     (html
 556        (head (title (pcdata "")) [])
 557        (body
 558           [p [pcdata ("Welcome " ^ login ^ ". You are now connected.");
 559               br ();
 560               Eliom_output.Xhtml.a session_data_example
 561                 [pcdata "Try again"] ()
 562             ]]))
 563
 564
 565
 566 (* -------------------------------------------------------- *)
 567 (* Handler for the "session_data_example_close" service:    *)
 568
 569 let session_data_example_close_handler () () =
 570   let sessdat = Eliom_state.get_volatile_data ~table:my_table () in
 571   lwt () = Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () in
 572   return
 573     (html
 574        (head (title (pcdata "Disconnect")) [])
 575        (body [
 576         (match sessdat with
 577         | Eliom_state.Data_session_expired -> p [pcdata "Your session has expired."]
 578         | Eliom_state.No_data -> p [pcdata "You were not connected."]
 579         | Eliom_state.Data _ -> p [pcdata "You have been disconnected."]);
 580         p [Eliom_output.Xhtml.a session_data_example [pcdata "Retry"] () ]]))
 581
 582
 583 (* -------------------------------------------------------- *)
 584 (* Registration of main services:                           *)
 585
 586 let () =
 587   Eliom_output.Xhtml.register
 588     session_data_example_close session_data_example_close_handler;
 589   Eliom_output.Xhtml.register
 590     session_data_example session_data_example_handler;
 591   Eliom_output.Xhtml.register
 592     session_data_example_with_post_params
 593     session_data_example_with_post_params_handler
 594
 595
 596
 597
 598
 599
 600 (*zap* *)
 601 let () = set_default_global_service_state_timeout ~cookie_scope:`Session (Some 600.)
 602 let () = set_default_global_persistent_data_state_timeout ~cookie_scope:`Session (Some 3600.)
 603 (* *zap*)
 604 (************************************************************)
 605 (************ Connection of users, version 2 ****************)
 606 (************************************************************)
 607
 608 (*zap* *)
 609 let scope_name = Eliom_common.create_scope_name "session_services"
 610 let session = `Session scope_name
 611 (* *zap*)
 612 (* -------------------------------------------------------- *)
 613 (* Create services, but do not register them yet:           *)
 614
 615 let session_services_example =
 616   Eliom_services.service
 617     ~path:["sessionservices"]
 618     ~get_params:Eliom_parameters.unit
 619     ()
 620
 621 let session_services_example_with_post_params =
 622   Eliom_services.post_service
 623     ~fallback:session_services_example
 624     ~post_params:(Eliom_parameters.string "login")
 625     ()
 626
 627 let session_services_example_close =
 628   Eliom_services.service
 629     ~path:["close2"]
 630     ~get_params:Eliom_parameters.unit
 631     ()
 632
 633
 634 (* ------------------------------------------------------------- *)
 635 (* Handler for the "session_services_example" service:           *)
 636 (* It displays the main page of our site, with a login form.     *)
 637
 638 let session_services_example_handler () () =
 639   let f =
 640     Eliom_output.Xhtml.post_form
 641       session_services_example_with_post_params
 642       (fun login ->
 643         [p [pcdata "login: ";
 644             string_input ~input_type:`Text ~name:login ()]]) ()
 645   in
 646   return
 647     (html
 648        (head (title (pcdata "")) [])
 649        (body [f]))
 650
 651
 652 (* ------------------------------------------------------------- *)
 653 (* Handler for the "session_services_example_close" service:     *)
 654
 655 let session_services_example_close_handler () () =
 656   lwt () = Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () in
 657   return
 658     (html
 659        (head (title (pcdata "Disconnect")) [])
 660        (body [p [pcdata "You have been disconnected. ";
 661                  a session_services_example
 662                    [pcdata "Retry"] ()
 663                ]]))
 664
 665 (*wiki*
 666
 667
 668 When the page is called with login parameters,
 669        it runs the function %<span class="code"|launch_session>%
 670        that replaces some services already defined by new ones:
 671
 672
 673
 674 *wiki*)
 675 (* ------------------------------------------------------------- *)
 676 (* Handler for the "session_services_example_with_post_params"   *)
 677 (* service:                                                      *)
 678
 679 let launch_session () login =
 680
 681   (* New handler for the main page: *)
 682   let new_main_page () () =
 683     return
 684       (html
 685        (head (title (pcdata "")) [])
 686        (body [p [pcdata "Welcome ";
 687                  pcdata login;
 688                  pcdata "!"; br ();
 689                  a coucou [pcdata "coucou"] (); br ();
 690                  a hello [pcdata "hello"] (); br ();
 691                  a links [pcdata "links"] (); br ();
 692                  a session_services_example_close
 693                    [pcdata "close session"] ()]]))
 694   in
 695
 696   (* If a session was opened, we close it first! *)
 697   lwt () = Eliom_state.discard ~scope:session () in
 698
 699   (* Now we register new versions of main services in the
 700      session service table: *)
 701   Eliom_output.Xhtml.register ~scope:session
 702     ~service:session_services_example
 703     (* service is any public service already registered,
 704        here the main page of our site *)
 705     new_main_page;
 706
 707   Eliom_output.Xhtml.register ~scope:session
 708     ~service:coucou
 709     (fun () () ->
 710       return
 711         (html
 712          (head (title (pcdata "")) [])
 713          (body [p [pcdata "Coucou ";
 714                    pcdata login;
 715                    pcdata "!"]])));
 716
 717   Eliom_output.Xhtml.register ~scope:session
 718     ~service:hello
 719     (fun () () ->
 720       return
 721         (html
 722          (head (title (pcdata "")) [])
 723          (body [p [pcdata "Ciao ";
 724                    pcdata login;
 725                    pcdata "!"]])));
 726
 727   new_main_page () ()
 728
 729 (* -------------------------------------------------------- *)
 730 (* Registration of main services:                           *)
 731
 732 let () =
 733   Eliom_output.Xhtml.register
 734     ~service:session_services_example
 735     session_services_example_handler;
 736   Eliom_output.Xhtml.register
 737     ~service:session_services_example_close
 738     session_services_example_close_handler;
 739   Eliom_output.Xhtml.register
 740     ~service:session_services_example_with_post_params
 741     launch_session
 742 (*zap* Registering for session during initialisation is forbidden:
 743 let _ = register ~scope:`Session
 744     ~path:coucou1
 745     %< <html>
 746          <head><title></title></head>
 747          <body><h1>humhum</h1></body>
 748        </html> >%
 749 *zap*)
 750 (*wiki*
 751
 752
 753 *wiki*)
 754 (************************************************************)
 755 (************** Coservices. Basic examples ******************)
 756 (************************************************************)
 757
 758 (* -------------------------------------------------------- *)
 759 (* We create one main service and two coservices:           *)
 760
 761 let coservices_example =
 762   Eliom_services.service
 763     ~path:["coserv"]
 764     ~get_params:Eliom_parameters.unit
 765     ()
 766
 767 let coservices_example_post =
 768   Eliom_services.post_coservice
 769     ~fallback:coservices_example
 770     ~post_params:Eliom_parameters.unit
 771     ()
 772
 773 let coservices_example_get =
 774   Eliom_services.coservice
 775     ~fallback:coservices_example
 776     ~get_params:Eliom_parameters.unit
 777     ()
 778
 779
 780 (* -------------------------------------------------------- *)
 781 (* The three of them display the same page,                 *)
 782 (* but the coservices change the counter.                   *)
 783
 784 let _ =
 785   let c = ref 0 in
 786   let page () () =
 787     let l3 = Eliom_output.Xhtml.post_form coservices_example_post
 788         (fun _ -> [p [Eliom_output.Xhtml.string_input
 789                         ~input_type:`Submit
 790                         ~value:"incr i (post)" ()]]) ()
 791     in
 792     let l4 = Eliom_output.Xhtml.get_form coservices_example_get
 793         (fun _ -> [p [Eliom_output.Xhtml.string_input
 794                         ~input_type:`Submit
 795                         ~value:"incr i (get)" ()]])
 796     in
 797     return
 798       (html
 799        (head (title (pcdata "")) [])
 800        (body [p [pcdata "i is equal to ";
 801                  pcdata (string_of_int !c); br ();
 802                  a coservices_example [pcdata "reload"] (); br ();
 803                  a coservices_example_get [pcdata "incr i"] ()];
 804               l3;
 805               l4]))
 806   in
 807   Eliom_output.Xhtml.register coservices_example page;
 808   let f () () = c := !c + 1; page () () in
 809   Eliom_output.Xhtml.register coservices_example_post f;
 810   Eliom_output.Xhtml.register coservices_example_get f
 811 (*wiki*
 812
 813
 814
 815           %<div class="encadre"|
 816             ====URLs
 817
 818
 819 While designing a Web site, think carefully about the URLs you
 820           want to use. URLs are the entry points of your site. Think that
 821           they may be bookmarked. If you create a link, you want to go to
 822           another URL, and you want a page to be generated. That page may be
 823           the default page for the URL (the one you get when you go back
 824           to a bookmarked page), or another page, that depends on the precise
 825           link or form you used to go to that URL (link to a coservice,
 826           or page depending on post data).
 827           Sometimes, you want that clicking
 828           a link or submitting a form does something without changing the URL.
 829           You can do this using //non-attached coservices// (see below).
 830
 831
 832
 833           >%
 834           %<div class="encadre"|
 835             ====Continuations
 836
 837
 838 Eliom is using the concept of //continuation//.
 839         A continuation represents the future of a program (what to do after).
 840         When a user clicks on a link or a form, he chooses the future of the
 841         computation. When he uses the "back" button of the browser, he chooses
 842         to go back to an old continuation. Continuations for Web programming
 843         have been introduced by
 844         [[http://www-spi.lip6.fr/%7Equeinnec/PDF/www.pdf| Christian Queinnec]],
 845         and are a big step in
 846         the understanding of Web interaction.
 847
 848
 849
 850         Some programming languages (Scheme...) allow to manipulate
 851         continuations using //control operators// (like
 852         %<span class="code"|call/cc>%). The style of programming used by Eliom
 853         is closer to //Continuation Passing Style// (CPS), and has the
 854         advantage that it does not need control operators, and fits
 855         very well Web programming.
 856
 857
 858
 859
 860 Coservices allow to create dynamically
 861 new continuations that depend on previous interactions with users
 862 ([[manual/dev/2#p2calc|See the %<span class="code"|calc>% example below]]).
 863 Such a behaviour is difficult to simulate with traditional Web
 864 programming.
 865
 866
 867
 868           >%
 869
 870 *wiki*)
 871 (*zap* Queinnec example: *zap*)
 872 (************************************************************)
 873 (*************** calc: sum of two integers ******************)
 874 (************************************************************)
 875
 876 (*zap* *)
 877 let calc_example_scope_name = Eliom_common.create_scope_name "calc_example"
 878 let session = `Session calc_example_scope_name
 879 let session_group = `Session_group calc_example_scope_name
 880 (* *zap*)
 881 (* -------------------------------------------------------- *)
 882 (* We create two main services on the same URL,             *)
 883 (* one with a GET integer parameter:                        *)
 884
 885 let calc =
 886   service
 887     ~path:["calc"]
 888     ~get_params:unit
 889     ()
 890
 891 let calc_i =
 892   service
 893     ~path:["calc"]
 894     ~get_params:(int "i")
 895     ()
 896
 897
 898 (* -------------------------------------------------------- *)
 899 (* The handler for the service without parameter.           *)
 900 (* It displays a form where you can write an integer value: *)
 901
 902 let calc_handler () () =
 903   let create_form intname =
 904     [p [pcdata "Write a number: ";
 905         Eliom_output.Xhtml.int_input ~input_type:`Text ~name:intname ();
 906         br ();
 907         Eliom_output.Xhtml.string_input ~input_type:`Submit ~value:"Send" ()]]
 908   in
 909   let f = Eliom_output.Xhtml.get_form calc_i create_form in
 910   return
 911     (html
 912        (head (title (pcdata "")) [])
 913        (body [f]))
 914
 915
 916 (* -------------------------------------------------------- *)
 917 (* The handler for the service with parameter.              *)
 918 (* It creates dynamically and registers a new coservice     *)
 919 (* with one GET integer parameter.                          *)
 920 (* This new coservice depends on the first value (i)        *)
 921 (* entered by the user.                                     *)
 922
 923 let calc_i_handler i () =
 924   let create_form is =
 925     (fun entier ->
 926        [p [pcdata (is^" + ");
 927            int_input ~input_type:`Text ~name:entier ();
 928            br ();
 929            string_input ~input_type:`Submit ~value:"Sum" ()]])
 930   in
 931   let is = string_of_int i in
 932   let calc_result =
 933     register_coservice ~scope:Eliom_common.session
 934       ~fallback:calc
 935       ~get_params:(int "j")
 936       (fun j () ->
 937         let js = string_of_int j in
 938         let ijs = string_of_int (i+j) in
 939         return
 940           (html
 941              (head (title (pcdata "")) [])
 942              (body
 943                 [p [pcdata (is^" + "^js^" = "^ijs)]])))
 944   in
 945   let f = get_form calc_result (create_form is) in
 946   return
 947     (html
 948        (head (title (pcdata "")) [])
 949        (body [f]))
 950
 951
 952 (* -------------------------------------------------------- *)
 953 (* Registration of main services:                           *)
 954
 955 let () =
 956   Eliom_output.Xhtml.register calc   calc_handler;
 957   Eliom_output.Xhtml.register calc_i calc_i_handler
 958 (*wiki*
 959
 960
 961 *wiki*)
 962 (************************************************************)
 963 (************ Connection of users, version 3 ****************)
 964 (************************************************************)
 965
 966 (*zap* *)
 967 let connect_example3_scope_name = Eliom_common.create_scope_name "connect_example3"
 968 let session = `Session connect_example3_scope_name
 969 let session_group = `Session_group connect_example3_scope_name
 970 let my_table = Eliom_state.create_volatile_table (*zap* *) ~scope:session (* *zap*) ()
 971 (* *zap*)
 972 (* -------------------------------------------------------- *)
 973 (* We create one main service and two (POST) actions        *)
 974 (* (for connection and disconnection)                       *)
 975
 976 let connect_example3 =
 977   Eliom_services.service
 978     ~path:["action"]
 979     ~get_params:Eliom_parameters.unit
 980     ()
 981
 982 let connect_action =
 983   Eliom_services.post_coservice'
 984     ~name:"connect3"
 985     ~post_params:(Eliom_parameters.string "login")
 986     ()
 987
 988 (* As the handler is very simple, we register it now: *)
 989 let disconnect_action =
 990   Eliom_output.Action.register_post_coservice'
 991     ~name:"disconnect3"
 992     ~post_params:Eliom_parameters.unit
 993     (fun () () ->
 994       Eliom_state.discard (*zap* *) ~scope:session (* *zap*) ())
 995
 996
 997 (* -------------------------------------------------------- *)
 998 (* login ang logout boxes:                                  *)
 999
1000 let disconnect_box s =
1001   Eliom_output.Xhtml.post_form disconnect_action
1002     (fun _ -> [p [Eliom_output.Xhtml.string_input
1003                     ~input_type:`Submit ~value:s ()]]) ()
1004
1005 let login_box () =
1006   Eliom_output.Xhtml.post_form connect_action
1007     (fun loginname ->
1008       [p
1009          (let l = [pcdata "login: ";
1010                    Eliom_output.Xhtml.string_input
1011                      ~input_type:`Text ~name:loginname ()]
1012          in l)
1013      ])
1014     ()
1015
1016
1017 (* -------------------------------------------------------- *)
1018 (* Handler for the "connect_example3" service (main page):    *)
1019
1020 let connect_example3_handler () () =
1021   let sessdat = Eliom_state.get_volatile_data ~table:my_table () in
1022   return
1023     (html
1024        (head (title (pcdata "")) [])
1025        (body
1026           (match sessdat with
1027           | Eliom_state.Data name ->
1028               [p [pcdata ("Hello "^name); br ()];
1029               disconnect_box "Close session"]
1030           | Eliom_state.Data_session_expired
1031           | Eliom_state.No_data -> [login_box ()]
1032           )))
1033
1034
1035 (* -------------------------------------------------------- *)
1036 (* Handler for connect_action (user logs in):               *)
1037
1038 let connect_action_handler () login =
1039   lwt () = Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () in
1040   Eliom_state.set_volatile_data ~table:my_table login;
1041   return ()
1042
1043
1044 (* -------------------------------------------------------- *)
1045 (* Registration of main services:                           *)
1046
1047 let () =
1048   Eliom_output.Xhtml.register ~service:connect_example3 connect_example3_handler;
1049   Eliom_output.Action.register ~service:connect_action connect_action_handler
1050 (*wiki*
1051
1052
1053 *wiki*)
1054 let divpage =
1055   Eliom_output.Blocks.register_service
1056     ~path:["div"]
1057     ~get_params:unit
1058     (fun () () ->
1059       return
1060         [div [h2 [pcdata "Hallo"];
1061               p [pcdata "Blablablabla"] ]])
1062 (*wiki*
1063
1064
1065 *wiki*)
1066 let redir1 = Eliom_output.Redirection.register_service
1067     ~options:`Temporary
1068     ~path:["redir"]
1069     ~get_params:Eliom_parameters.unit
1070    (fun () () -> Lwt.return coucou)
1071 (*wiki*
1072
1073  *wiki*)
1074 let redir = Eliom_output.Redirection.register_service
1075     ~options:`Temporary
1076     ~path:["redir"]
1077     ~get_params:(int "o")
1078    (fun o () ->
1079       Lwt.return
1080         (Eliom_services.preapply coucou_params (o,(22,"ee"))))
1081 (*wiki*
1082
1083
1084 *wiki*)
1085 let send_any =
1086   Eliom_output.Any.register_service
1087     ~path:["sendany"]
1088     ~get_params:(string "type")
1089    (fun s () ->
1090      if s = "valid"
1091      then
1092        Eliom_output.Xhtml.send
1093          (html
1094             (head (title (pcdata "")) [])
1095             (body [p [pcdata
1096                         "This page has been statically typechecked.
1097                          If you change the parameter in the URL you will get an unchecked text page"]]))
1098      else
1099        Eliom_output.HtmlText.send
1100          "<html><body><p>It is not a valid page. Put type=\"valid\" in the URL to get a typechecked page.</p></body></html>"
1101    )
1102 (*wiki*
1103
1104 Cookies
1105
1106 *wiki*)
1107 let cookiename = "mycookie"
1108
1109 let cookies = service ["cookies"] unit ()
1110
1111 let _ = Eliom_output.Xhtml.register cookies
1112   (fun () () ->
1113     Eliom_state.set_cookie
1114       ~name:cookiename ~value:(string_of_int (Random.int 100)) ();
1115     Lwt.return
1116       (html
1117          (head (title (pcdata "")) [])
1118          (body [p [pcdata (try
1119                              "cookie value: "^
1120                                (CookiesTable.find
1121                                   cookiename (Eliom_request_info.get_cookies ()))
1122                            with _ -> "<cookie not set>");
1123                    br ();
1124                    a cookies [pcdata "send other cookie"] ()]])))
1125 (*wiki*
1126
1127
1128
1129
1130 *wiki*)
1131 let mystore = Ocsipersist.open_store "eliomexamplestore2"
1132
1133 let count2 =
1134   let next =
1135     let cthr = Ocsipersist.make_persistent mystore "countpage" 0 in
1136     let mutex = Lwt_mutex.create () in
1137     (fun () ->
1138       cthr >>= fun c ->
1139       Lwt_mutex.lock mutex >>= fun () ->
1140       Ocsipersist.get c >>= fun oldc ->
1141       let newc = oldc + 1 in
1142       Ocsipersist.set c newc >>= fun () ->
1143       Lwt_mutex.unlock mutex;
1144       Lwt.return newc)
1145   in
1146   register_service
1147     ~path:["count2"]
1148     ~get_params:unit
1149     (fun () () ->
1150       next () >>=
1151       (fun n ->
1152         return
1153          (html
1154           (head (title (pcdata "counter")) [])
1155           (body [p [pcdata (string_of_int n)]]))))
1156
1157 (*wiki*
1158
1159
1160 *wiki*)
1161 (************************************************************)
1162 (************ Connection of users, version 4 ****************)
1163 (**************** (persistent sessions) *********************)
1164 (************************************************************)
1165
1166 (*zap* *)
1167 let persistent_sessions_scope_name = Eliom_common.create_scope_name "persistent_sessions"
1168 let session = `Session persistent_sessions_scope_name
1169 let session_group = `Session_group persistent_sessions_scope_name
1170 let persistent_session_scope = session
1171 (* *zap*)
1172 let my_persistent_table =
1173   create_persistent_table (*zap* *) ~scope:session (* *zap*) "eliom_example_table"
1174
1175 (* -------------------------------------------------------- *)
1176 (* We create one main service and two (POST) actions        *)
1177 (* (for connection and disconnection)                       *)
1178
1179 let persist_session_example =
1180   Eliom_services.service
1181     ~path:["persist"]
1182     ~get_params:unit
1183     ()
1184
1185 let persist_session_connect_action =
1186   Eliom_services.post_coservice'
1187     ~name:"connect4"
1188     ~post_params:(string "login")
1189     ()
1190
1191 (* disconnect_action, login_box and disconnect_box have been
1192    defined in the section about actions *)
1193
1194 (*zap* *)
1195
1196 (* -------------------------------------------------------- *)
1197 (* Actually, no. It's a lie because we don't use the
1198    same session name :-) *)
1199 (* new disconnect action and box:                           *)
1200
1201 let disconnect_action =
1202   Eliom_output.Action.register_post_coservice'
1203     ~name:"disconnect4"
1204     ~post_params:Eliom_parameters.unit
1205     (fun () () ->
1206       Eliom_state.discard ~scope:session ())
1207
1208 let disconnect_box s =
1209   Eliom_output.Xhtml.post_form disconnect_action
1210     (fun _ -> [p [Eliom_output.Xhtml.string_input
1211                     ~input_type:`Submit ~value:s ()]]) ()
1212
1213 let bad_user_key = Polytables.make_key ()
1214 let get_bad_user table =
1215   try Polytables.get ~table ~key:bad_user_key with Not_found -> false
1216
1217 (* -------------------------------------------------------- *)
1218 (* new login box:                                           *)
1219
1220 let login_box session_expired action =
1221   Eliom_output.Xhtml.post_form action
1222     (fun loginname ->
1223       let l =
1224         [pcdata "login: ";
1225          string_input ~input_type:`Text ~name:loginname ()]
1226       in
1227       [p (if get_bad_user (Eliom_request_info.get_request_cache ())
1228       then (pcdata "Wrong user")::(br ())::l
1229       else
1230         if session_expired
1231         then (pcdata "Session expired")::(br ())::l
1232         else l)
1233      ])
1234     ()
1235
1236 (* *zap*)
1237
1238 (* ----------------------------------------------------------- *)
1239 (* Handler for "persist_session_example" service (main page):  *)
1240
1241 let persist_session_example_handler () () =
1242   Eliom_state.get_persistent_data
1243     ~table:my_persistent_table () >>= fun sessdat ->
1244   return
1245     (html
1246        (head (title (pcdata "")) [])
1247        (body
1248           (match sessdat with
1249           | Eliom_state.Data name ->
1250               [p [pcdata ("Hello "^name); br ()];
1251               disconnect_box "Close session"]
1252           | Eliom_state.Data_session_expired ->
1253               [login_box true persist_session_connect_action;
1254                p [em [pcdata "The only user is 'toto'."]]]
1255           | Eliom_state.No_data ->
1256               [login_box false persist_session_connect_action;
1257                p [em [pcdata "The only user is 'toto'."]]]
1258           )))
1259
1260
1261 (* ----------------------------------------------------------- *)
1262 (* Handler for persist_session_connect_action (user logs in):  *)
1263
1264 let persist_session_connect_action_handler () login =
1265   lwt () = Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () in
1266   if login = "toto" (* Check user and password :-) *)
1267   then
1268     Eliom_state.set_persistent_data ~table:my_persistent_table login
1269   else ((*zap* *)Polytables.set (Eliom_request_info.get_request_cache ()) bad_user_key true;(* *zap*)return ())
1270
1271
1272 (* -------------------------------------------------------- *)
1273 (* Registration of main services:                           *)
1274
1275 let () =
1276   Eliom_output.Xhtml.register
1277     ~service:persist_session_example
1278     persist_session_example_handler;
1279   Eliom_output.Action.register
1280     ~service:persist_session_connect_action
1281     persist_session_connect_action_handler
1282 (*wiki*
1283
1284
1285 *wiki*)
1286 (************************************************************)
1287 (************ Connection of users, version 6 ****************)
1288 (************************************************************)
1289 (*zap* *)
1290 let scope_name = Eliom_common.create_scope_name "connect_example6"
1291 let session = `Session scope_name
1292 let session_group = `Session_group scope_name
1293 (* *zap*)
1294 (* -------------------------------------------------------- *)
1295 (* We create one main service and two (POST) actions        *)
1296 (* (for connection and disconnection)                       *)
1297
1298 let connect_example6 =
1299   Eliom_services.service
1300     ~path:["action2"]
1301     ~get_params:unit
1302     ()
1303
1304 let connect_action =
1305   Eliom_services.post_coservice'
1306     ~name:"connect6"
1307     ~post_params:(string "login")
1308     ()
1309
1310 (* new disconnect action and box:                           *)
1311
1312 let disconnect_action =
1313   Eliom_output.Action.register_post_coservice'
1314     ~name:"disconnect6"
1315     ~post_params:Eliom_parameters.unit
1316     (fun () () ->
1317       Eliom_state.discard (*zap* *) ~scope:session (* *zap*) ())
1318
1319 let disconnect_box s =
1320   Eliom_output.Xhtml.post_form disconnect_action
1321     (fun _ -> [p [Eliom_output.Xhtml.string_input
1322                     ~input_type:`Submit ~value:s ()]]) ()
1323
1324
1325 let bad_user_key = Polytables.make_key ()
1326 let get_bad_user table =
1327   try Polytables.get ~table ~key:bad_user_key with Not_found -> false
1328
1329 (* -------------------------------------------------------- *)
1330 (* new login box:                                           *)
1331
1332 let login_box session_expired action =
1333   Eliom_output.Xhtml.post_form action
1334     (fun loginname ->
1335       let l =
1336         [pcdata "login: ";
1337          string_input ~input_type:`Text ~name:loginname ()]
1338       in
1339       [p (if get_bad_user (Eliom_request_info.get_request_cache ())
1340       then (pcdata "Wrong user")::(br ())::l
1341       else
1342         if session_expired
1343         then (pcdata "Session expired")::(br ())::l
1344         else l)
1345      ])
1346     ()
1347
1348 (* -------------------------------------------------------- *)
1349 (* Handler for the "connect_example6" service (main page):   *)
1350
1351 let connect_example6_handler () () =
1352   let status = Eliom_state.volatile_data_state_status (*zap* *) ~scope:session (* *zap*) ()
1353   in
1354   let group =
1355     Eliom_state.get_volatile_data_session_group (*zap* *) ~scope:session (* *zap*) ()
1356   in
1357   return
1358     (html
1359        (head (title (pcdata "")) [])
1360        (body
1361           (match group, status with
1362           | Some name, _ ->
1363               [p [pcdata ("Hello "^name); br ()];
1364               disconnect_box "Close session"]
1365           | None, Eliom_state.Expired_state ->
1366               [login_box true connect_action;
1367                p [em [pcdata "The only user is 'toto'."]]]
1368           | _ ->
1369               [login_box false connect_action;
1370                p [em [pcdata "The only user is 'toto'."]]]
1371           )))
1372
1373 (* -------------------------------------------------------- *)
1374 (* New handler for connect_action (user logs in):           *)
1375
1376 let connect_action_handler () login =
1377   lwt () = Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () in
1378   if login = "toto" (* Check user and password :-) *)
1379   then begin
1380     Eliom_state.set_volatile_data_session_group ~set_max:4
1381     (*zap* *) ~scope:session (* *zap*) login;
1382     return ()
1383   end
1384   else begin
1385     Polytables.set (Eliom_request_info.get_request_cache ()) bad_user_key true;
1386     return ()
1387   end
1388
1389
1390 (* -------------------------------------------------------- *)
1391 (* Registration of main services:                           *)
1392
1393 let () =
1394   Eliom_output.Xhtml.register ~service:connect_example6 connect_example6_handler;
1395   Eliom_output.Action.register ~service:connect_action connect_action_handler
1396
1397 (*wiki*
1398
1399
1400 *wiki*)
1401 let disposable = service ["disposable"] unit ()
1402
1403 let _ = register disposable
1404     (fun () () ->
1405       let disp_coservice =
1406         coservice ~max_use:2 ~fallback:disposable ~get_params:unit ()
1407       in
1408       register ~scope:Eliom_common.session ~service:disp_coservice
1409         (fun () () ->
1410           return
1411             (html
1412               (head (title (pcdata "")) [])
1413               (body [p [pcdata "I am a disposable coservice";
1414                         br ();
1415                         a disp_coservice [pcdata "Try me once again"] ()]]))
1416         );
1417       return
1418         (html
1419           (head (title (pcdata "")) [])
1420           (body [p [(if Eliom_request_info.get_link_too_old ()
1421                     then pcdata "Your link was outdated. I am the fallback. I just created a new disposable coservice. You can use it only twice."
1422                     else
1423                     pcdata "I just created a disposable coservice. You can use it only twice.");
1424                     br ();
1425                     a disp_coservice [pcdata "Try it!"] ()]])))
1426 (*wiki*
1427
1428
1429 *wiki*)
1430 let timeout = service ["timeout"] unit ()
1431
1432 let _ =
1433   let page () () =
1434     let timeoutcoserv =
1435       register_coservice ~scope:session
1436         ~fallback:timeout ~get_params:unit ~timeout:5.
1437         (fun _ _ ->
1438            return
1439              (html
1440                (head (title (pcdata "Coservices with timeouts")) [])
1441                (body [p
1442                  [pcdata "I am a coservice with timeout."; br ();
1443                   pcdata "Try to reload the page!"; br ();
1444                   pcdata "I will disappear after 5 seconds of inactivity." ];
1445                  ])))
1446     in
1447     return
1448       (html
1449         (head (title (pcdata "Coservices with timeouts")) [])
1450         (body [p
1451           [pcdata "I just created a coservice with 5 seconds timeout."; br ();
1452            a timeoutcoserv [pcdata "Try it"] (); ];
1453           ]))
1454   in
1455   register timeout page
1456 (*wiki*
1457
1458
1459 *wiki*)
1460 let publiccoduringsess = service ["publiccoduringsess"] unit ()
1461
1462 let _ =
1463   let page () () =
1464     let timeoutcoserv =
1465       register_coservice
1466         ~fallback:publiccoduringsess ~get_params:unit ~timeout:5.
1467         (fun _ _ ->
1468            return
1469              (html
1470                (head (title (pcdata "Coservices with timeouts")) [])
1471                (body [p
1472                  [pcdata "I am a public coservice with timeout."; br ();
1473                   pcdata "I will disappear after 5 seconds of inactivity." ];
1474                  ])))
1475     in
1476     return
1477       (html
1478         (head (title (pcdata "Public coservices with timeouts")) [])
1479         (body [p
1480           [pcdata "I just created a public coservice with 5 seconds timeout."; br ();
1481            a timeoutcoserv [pcdata "Try it"] (); ];
1482           ]))
1483   in
1484   register publiccoduringsess page
1485 (*wiki*
1486
1487
1488 *wiki*)
1489 let _ = Eliom_output.set_exn_handler
1490    (fun e -> match e with
1491     | Eliom_common.Eliom_404 ->
1492         Eliom_output.Xhtml.send ~code:404
1493           (html
1494              (head (title (pcdata "")) [])
1495              (body [h1 [pcdata "Eliom tutorial"];
1496                     p [pcdata "Page not found"]]))
1497 (*    | Eliom_common.Eliom_Wrong_parameter ->
1498         Eliom_output.Xhtml.send
1499           (html
1500              (head (title (pcdata "")) [])
1501              (body [h1 [pcdata "Eliom tutorial"];
1502                     p [pcdata "Wrong parameters"]])) *)
1503     | e -> fail e)
1504 (*wiki*
1505
1506   *wiki*)
1507 let my_nl_params =
1508   Eliom_parameters.make_non_localized_parameters
1509     ~prefix:"tutoeliom"
1510     ~name:"mynlparams"
1511     (Eliom_parameters.int "a" ** Eliom_parameters.string "s")
1512
1513 let nlparams = register_service
1514     ~path:["nlparams"]
1515     ~get_params:(int "i")
1516     (fun i () ->
1517        Lwt.return
1518          (html
1519             (head (title (pcdata "")) [])
1520             (body [p [pcdata "i = ";
1521                       strong [pcdata (string_of_int i)]];
1522                    (match Eliom_parameters.get_non_localized_get_parameters
1523                       my_nl_params
1524                     with
1525                       | None ->
1526                           p [pcdata "I do not have my non localized parameters"]
1527                       | Some (a, s) ->
1528                           p [pcdata "I have my non localized parameters, ";
1529                              pcdata ("with values a = "^string_of_int a^
1530                                        " and s = "^s^".")]
1531                    )]))
1532
1533     )
1534   (*wiki*
1535
1536
1537     *wiki*)
1538
1539 let tonlparams = register_service
1540     ~path:["nlparams"]
1541     ~get_params:unit
1542     (fun i () ->
1543        Lwt.return
1544          (html
1545             (head (title (pcdata "")) [])
1546             (body
1547                [p [a ~service:nlparams [pcdata "without nl params"] 4];
1548                 p [a ~service:nlparams
1549                      ~nl_params:(Eliom_parameters.add_nl_parameter
1550                                    Eliom_parameters.empty_nl_params_set
1551                                    my_nl_params
1552                                    (22, "oh")
1553                                 )
1554                      [pcdata "with nl params"]
1555                      5];
1556                 get_form
1557                   ~service:nlparams
1558                   ~nl_params:(Eliom_parameters.add_nl_parameter
1559                                 Eliom_parameters.empty_nl_params_set
1560                                 my_nl_params
1561                                 (22, "oh")
1562                              )
1563                   (fun iname ->
1564                      [p [pcdata "form with hidden nl params";
1565                          Eliom_output.Xhtml.int_input
1566                            ~input_type:`Text ~name:iname ();
1567                          Eliom_output.Xhtml.string_input
1568                            ~input_type:`Submit ~value:"Send" ()]]);
1569                 get_form
1570                   ~service:nlparams
1571                   (fun iname ->
1572                      let (aname, sname) =
1573                        Eliom_parameters.get_nl_params_names my_nl_params
1574                      in
1575                      [p [pcdata "form with nl params fiels";
1576                          Eliom_output.Xhtml.int_input
1577                            ~input_type:`Text ~name:iname ();
1578                          Eliom_output.Xhtml.int_input
1579                            ~input_type:`Text ~name:aname ();
1580                          Eliom_output.Xhtml.string_input
1581                            ~input_type:`Text ~name:sname ();
1582                          Eliom_output.Xhtml.string_input
1583                            ~input_type:`Submit ~value:"Send" ()]]);
1584                ]))
1585     )
1586
1587
1588   (*wiki*
1589
1590
1591   *wiki*)
1592 let nlparams_with_nlp =
1593   Eliom_services.add_non_localized_get_parameters my_nl_params nlparams
1594   (*wiki*
1595
1596   *wiki*)
1597 (************************************************************)
1598 (************ Connection of users, version 5 ****************)
1599 (************************************************************)
1600
1601 (*zap* *)
1602 let scope_name = Eliom_common.create_scope_name "connect_example5"
1603 let session = `Session scope_name
1604 let session_group = `Session_group scope_name
1605 (* *zap*)
1606 (* -------------------------------------------------------- *)
1607 (* We create one main service and two (POST) actions        *)
1608 (* (for connection and disconnection)                       *)
1609
1610 let connect_example5 =
1611   Eliom_services.service
1612     ~path:["groups"]
1613     ~get_params:Eliom_parameters.unit
1614     ()
1615
1616 let connect_action =
1617   Eliom_services.post_coservice'
1618     ~name:"connect5"
1619     ~post_params:(Eliom_parameters.string "login")
1620     ()
1621
1622 (* As the handler is very simple, we register it now: *)
1623 let disconnect_action =
1624   Eliom_output.Action.register_post_coservice'
1625     ~name:"disconnect5"
1626     ~post_params:Eliom_parameters.unit
1627     (fun () () ->
1628       Eliom_state.discard (*zap* *) ~scope:session (* *zap*) ())
1629
1630
1631 (* -------------------------------------------------------- *)
1632 (* login ang logout boxes:                                  *)
1633
1634 let disconnect_box s =
1635   Eliom_output.Xhtml.post_form disconnect_action
1636     (fun _ -> [p [Eliom_output.Xhtml.string_input
1637                     ~input_type:`Submit ~value:s ()]]) ()
1638
1639 let login_box () =
1640   Eliom_output.Xhtml.post_form connect_action
1641     (fun loginname ->
1642       [p
1643          (let l = [pcdata "login: ";
1644                    Eliom_output.Xhtml.string_input
1645                      ~input_type:`Text ~name:loginname ()]
1646          in l)
1647      ])
1648     ()
1649
1650
1651 (* -------------------------------------------------------- *)
1652 (* Handler for the "connect_example5" service (main page):    *)
1653
1654 let connect_example5_handler () () =
1655   let sessdat = Eliom_state.get_volatile_data_session_group (*zap* *) ~scope:session (* *zap*) () in
1656   return
1657     (html
1658        (head (title (pcdata "")) [])
1659        (body
1660           (match sessdat with
1661           | Some name ->
1662               [p [pcdata ("Hello "^name); br ()];
1663               disconnect_box "Close session"]
1664           | None -> [login_box ()]
1665           )))
1666
1667
1668 (* -------------------------------------------------------- *)
1669 (* Handler for connect_action (user logs in):               *)
1670
1671 let connect_action_handler () login =
1672   Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () >>= fun () ->
1673   Eliom_state.set_volatile_data_session_group ~set_max:4 (*zap* *) ~scope:session (* *zap*) login;
1674   return ()
1675
1676
1677 (* -------------------------------------------------------- *)
1678 (* Registration of main services:                           *)
1679
1680 let () =
1681   Eliom_output.Xhtml.register ~service:connect_example5 connect_example5_handler;
1682   Eliom_output.Action.register ~service:connect_action connect_action_handler
1683 (*wiki*
1684
1685   *wiki*)
1686 (************************************************************)
1687 (********************* Group tables *************************)
1688 (************************************************************)
1689
1690 (*zap* *)
1691 let scope_name = Eliom_common.create_scope_name "group_tables"
1692 let session = `Session scope_name
1693 let session_group = `Session_group scope_name
1694 (* *zap*)
1695 let my_table =
1696   Eliom_state.create_volatile_table
1697     ~scope:session_group ()
1698 (* -------------------------------------------------------- *)
1699 (* We create one main service and two (POST) actions        *)
1700 (* (for connection and disconnection)                       *)
1701
1702 let group_tables_example =
1703   Eliom_services.service
1704     ~path:["grouptables"]
1705     ~get_params:Eliom_parameters.unit
1706     ()
1707
1708 let connect_action =
1709   Eliom_services.post_coservice'
1710     ~name:"connect7"
1711     ~post_params:(Eliom_parameters.string "login")
1712     ()
1713
1714 let disconnect_action =
1715   Eliom_output.Action.register_post_coservice'
1716     ~name:"disconnectgt"
1717     ~post_params:Eliom_parameters.unit
1718     (fun () () ->
1719       Eliom_state.discard ~scope:session ())
1720
1721 let disconnect_g_action =
1722   Eliom_output.Action.register_post_coservice'
1723     ~name:"disconnectgtg"
1724     ~post_params:Eliom_parameters.unit
1725     (fun () () ->
1726       Eliom_state.discard ~scope:session_group ())
1727
1728
1729 (* -------------------------------------------------------- *)
1730 (* login ang logout boxes:                                  *)
1731
1732 let disconnect_box () =
1733   div [
1734     Eliom_output.Xhtml.post_form disconnect_action
1735       (fun _ -> [p [Eliom_output.Xhtml.string_input
1736                        ~input_type:`Submit ~value:"Close session" ()]]) ();
1737     Eliom_output.Xhtml.post_form disconnect_g_action
1738       (fun _ -> [p [Eliom_output.Xhtml.string_input
1739                        ~input_type:`Submit ~value:"Close group" ()]]) ()
1740   ]
1741
1742 let login_box () =
1743   Eliom_output.Xhtml.post_form connect_action
1744     (fun loginname ->
1745       [p
1746          (let l = [pcdata "login: ";
1747                    Eliom_output.Xhtml.string_input
1748                      ~input_type:`Text ~name:loginname ()]
1749          in l)
1750      ])
1751     ()
1752
1753
1754 (* -------------------------------------------------------- *)
1755 (* Handler for the "group_tables_example" service (main page): *)
1756
1757 let group_tables_example_handler () () =
1758   let sessdat = Eliom_state.get_volatile_data_session_group (*zap* *) ~scope:session (* *zap*) () in
1759   let groupdata = Eliom_state.get_volatile_data
1760     ~table:my_table ()
1761   in
1762   let group_info name =
1763     match groupdata with
1764       | Eliom_state.Data_session_expired
1765       | Eliom_state.No_data ->
1766         let d = string_of_int (Random.int 1000) in
1767         Eliom_state.set_volatile_data ~table:my_table d;
1768         d
1769       | Eliom_state.Data d -> d
1770   in
1771   return
1772     (html
1773        (head (title (pcdata "")) [])
1774        (body
1775           (match sessdat with
1776           | Some name ->
1777               [p [pcdata ("Hello "^name); br ()];
1778                (let d = group_info name in
1779                 p [pcdata "Your group data is: ";
1780                    pcdata d;
1781                    pcdata ". It is common to all the sessions for the same user ";
1782                    pcdata name;
1783                    pcdata ". Try with another browser!"
1784                   ]);
1785                p [pcdata "Check that all sessions with same user name share the value."];
1786                p [pcdata "Check that the value disappears when all sessions from the group are closed."];
1787                p [pcdata "Check that the all sessions are closed when clicking on \"close group\" button."];
1788                disconnect_box ()]
1789           | None -> [login_box ()]
1790           )))
1791
1792
1793 (* -------------------------------------------------------- *)
1794 (* Handler for connect_action (user logs in):               *)
1795
1796 let connect_action_handler () login =
1797   lwt () = Eliom_state.discard (*zap* *) ~scope:session (* *zap*) () in
1798   Eliom_state.set_volatile_data_session_group ~set_max:4 (*zap* *) ~scope:session (* *zap*) login;
1799   return ()
1800
1801
1802 (* -------------------------------------------------------- *)
1803 (* Registration of main services:                           *)
1804
1805 let () =
1806   Eliom_output.Xhtml.register ~service:group_tables_example group_tables_example_handler;
1807   Eliom_output.Action.register ~service:connect_action connect_action_handler
1808
1809
1810
1811
1812
1813
1814 (*zap* *)
1815
1816 (************************************************************)
1817 (**************** Persistent group tables *******************)
1818 (************************************************************)
1819
1820 let scope_name = Eliom_common.create_scope_name "pgroup_tables"
1821 let session = `Session scope_name
1822 let session_group = `Session_group scope_name
1823 let my_table =
1824   Eliom_state.create_persistent_table
1825     ~scope:session_group "pgroup_table"
1826 (* -------------------------------------------------------- *)
1827 (* We create one main service and two (POST) actions        *)
1828 (* (for connection and disconnection)                       *)
1829
1830
1831 let pgroup_tables_example =
1832   Eliom_services.service
1833     ~path:["pgrouptables"]
1834     ~get_params:Eliom_parameters.unit
1835     ()
1836
1837
1838 let connect_action =
1839   Eliom_services.post_coservice'
1840     ~name:"connect8"
1841     ~post_params:(Eliom_parameters.string "login")
1842     ()
1843
1844 let disconnect_action =
1845   Eliom_output.Action.register_post_coservice'
1846     ~name:"pdisconnectgt"
1847     ~post_params:Eliom_parameters.unit
1848     (fun () () -> Eliom_state.discard ~scope:session ())
1849
1850 let disconnect_g_action =
1851   Eliom_output.Action.register_post_coservice'
1852     ~name:"pdisconnectgtg"
1853     ~post_params:Eliom_parameters.unit
1854     (fun () () ->
1855       Eliom_state.discard ~scope:session_group ())
1856
1857
1858
1859 (* -------------------------------------------------------- *)
1860 (* login ang logout boxes:                                  *)
1861
1862 let disconnect_box () =
1863   div [
1864     Eliom_output.Xhtml.post_form disconnect_action
1865       (fun _ -> [p [Eliom_output.Xhtml.string_input
1866                        ~input_type:`Submit ~value:"Close session" ()]]) ();
1867     Eliom_output.Xhtml.post_form disconnect_g_action
1868       (fun _ -> [p [Eliom_output.Xhtml.string_input
1869                        ~input_type:`Submit ~value:"Close group" ()]]) ()
1870   ]
1871
1872 let login_box () =
1873   Eliom_output.Xhtml.post_form connect_action
1874     (fun loginname ->
1875       [p
1876          (let l = [pcdata "login: ";
1877                    Eliom_output.Xhtml.string_input
1878                      ~input_type:`Text ~name:loginname ()]
1879          in l)
1880      ])
1881     ()
1882
1883
1884 (* -------------------------------------------------------- *)
1885 (* Handler for the "group_tables_example" service (main page): *)
1886
1887 let group_tables_example_handler () () =
1888   Eliom_state.get_persistent_data_session_group ~scope:session ()
1889   >>= fun sessdat ->
1890   Eliom_state.get_persistent_data ~table:my_table ()
1891   >>= fun groupdata ->
1892   let group_info name =
1893     match groupdata with
1894       | Eliom_state.Data_session_expired
1895       | Eliom_state.No_data ->
1896         let d = string_of_int (Random.int 1000) in
1897         Eliom_state.set_persistent_data ~table:my_table d
1898         >>= fun r -> Lwt.return d
1899       | Eliom_state.Data d -> Lwt.return d
1900   in
1901   (match sessdat with
1902     | Some name ->
1903       (group_info name >>= fun d ->
1904        Lwt.return
1905          [p [pcdata ("Hello "^name); br ()];
1906           (p [pcdata "Your persistent group data is: ";
1907               pcdata d;
1908               pcdata ". It is common to all the sessions for the same user ";
1909               pcdata name;
1910               pcdata ". Try with another browser!"
1911              ]);
1912           p [pcdata "Check that all sessions with same user name share the value."];
1913           p [pcdata "Check that the value disappears when all sessions from the group are closed."];
1914           p [pcdata "Check that the all sessions are closed when clicking on \"close group\" button."];
1915           p [pcdata "Check that the value is preserved after relaunching the server."];
1916           disconnect_box ()])
1917     | None -> Lwt.return [login_box ()]) >>= fun l ->
1918   Lwt.return
1919     (html
1920        (head (title (pcdata "")) [])
1921        (body l))
1922
1923
1924 (* -------------------------------------------------------- *)
1925 (* Handler for connect_action (user logs in):               *)
1926
1927 let connect_action_handler () login =
1928   lwt () = Eliom_state.discard ~scope:session () in
1929   Eliom_state.set_persistent_data_session_group
1930     ~set_max:(Some 4) ~scope:session login
1931
1932
1933 (* -------------------------------------------------------- *)
1934 (* Registration of main services:                           *)
1935
1936 let () =
1937   Eliom_output.Xhtml.register ~service:pgroup_tables_example group_tables_example_handler;
1938   Eliom_output.Action.register ~service:connect_action connect_action_handler
1939
1940 (* *zap*)
1941 (*wiki*
1942
1943   *wiki*)
1944
1945 let csrf_scope_name = Eliom_common.create_scope_name "csrf"
1946 let csrf_scope = `Session csrf_scope_name
1947
1948 let csrfsafe_example =
1949   Eliom_services.service
1950     ~path:["csrf"]
1951     ~get_params:Eliom_parameters.unit
1952     ()
1953
1954 let csrfsafe_example_post =
1955   Eliom_services.post_coservice
1956     ~csrf_safe:true
1957     ~csrf_scope
1958     ~csrf_secure:true
1959     ~timeout:10.
1960     ~max_use:1
1961     ~https:true
1962     ~fallback:csrfsafe_example
1963     ~post_params:Eliom_parameters.unit
1964     ()
1965
1966 let _ =
1967   let page () () =
1968     let l3 = Eliom_output.Xhtml.post_form csrfsafe_example_post
1969         (fun _ -> [p [Eliom_output.Xhtml.string_input
1970                         ~input_type:`Submit
1971                         ~value:"Click" ()]]) ()
1972     in
1973     return
1974       (html
1975        (head (title (pcdata "CSRF safe service example")) [])
1976        (body [p [pcdata "A new coservice will be created each time this form is displayed"];
1977               l3]))
1978   in
1979   Eliom_output.Xhtml.register csrfsafe_example page;
1980   Eliom_output.Xhtml.register csrfsafe_example_post
1981     (fun () () ->
1982        Lwt.return
1983          (html
1984             (head (title (pcdata "CSRF safe service")) [])
1985             (body [p [pcdata "This is a CSRF safe service"]])))
1986
1987 (*wiki*
1988
1989
1990
1991 %<code language="ocaml"|
1992 let r = Netstring_pcre.regexp "\\\\[(.*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@)\\\\]"
1993
1994 let regexp =
1995   Eliom_output.Xhtml.register_service
1996     ~path:["regexp"]
1997     ~get_params:(regexp r "$1" "myparam")
1998     (fun g () ->
1999       return
2000         (html
2001            (head (title (pcdata "")) [])
2002            (body [p [pcdata g]])))
2003
2004 >%
2005
2006 *wiki*)
2007 (*zap* *)
2008 let myregexp = Netstring_pcre.regexp "\\[(.*)\\]"
2009
2010 let regexpserv =
2011   Eliom_output.Xhtml.register_service
2012     ~path:["regexp"]
2013     ~get_params:(regexp myregexp "$1" (fun s -> s) "myparam")
2014     (fun g () ->
2015       return
2016         (html
2017            (head (title (pcdata "")) [])
2018            (body [p [pcdata g]])))
2019 (* *zap*)
2020 (*wiki*
2021
2022 *wiki*)
2023 (* Form with bool checkbox: *)
2024 let bool_params = register_service
2025     ~path:["bool"]
2026     ~get_params:(bool "case")
2027   (fun case () ->
2028     return
2029     <:xhtml< <html>
2030          <head><title></title></head>
2031          <body>
2032          <p>
2033            $pcdata (if case then "checked" else "not checked")$
2034          </p>
2035          </body>
2036        </html> >>)
2037
2038 let create_form_bool casename =
2039     <:xhtmllist< <p>check? $bool_checkbox ~name:casename ()$ <br/>
2040       $string_input ~input_type:`Submit ~value:"Click" ()$</p> >>
2041
2042 let form_bool = register_service ["formbool"] unit
2043   (fun () () ->
2044      let f = get_form bool_params create_form_bool in
2045      return
2046      <:xhtml< <html>
2047           <head><title></title></head>
2048           <body> $f$ </body>
2049         </html> >>)
2050
2051
2052 (*wiki*
2053
2054
2055 *wiki*)
2056
2057 let set = register_service
2058     ~path:["set"]
2059     ~get_params:(set string "s")
2060   (fun l () ->
2061     let ll =
2062       List.map
2063         (fun s -> <:xhtml< <strong>$str:s$ </strong> >>) l
2064     in
2065     return
2066     <:xhtml< <html>
2067          <head><title></title></head>
2068          <body>
2069          <p>
2070            You sent:
2071            $list:ll$
2072          </p>
2073          </body>
2074        </html> >>)
2075 (*wiki*
2076
2077
2078 *wiki*)
2079
2080 (* form to set *)
2081 let setform = register_service
2082     ~path:["setform"]
2083     ~get_params:unit
2084     (fun () () ->
2085       return
2086         (html
2087            (head (title (pcdata "")) [])
2088            (body [h1 [pcdata "Set Form"];
2089                   get_form set
2090                     (fun n ->
2091                       [p [pcdata "Form to set: ";
2092                           string_checkbox ~name:n ~value:"box1" ();
2093                           string_checkbox
2094                             ~name:n ~value:"box2" ~checked:true ();
2095                           string_checkbox ~name:n ~value:"box3" ();
2096                           string_checkbox ~name:n ~value:"box4" ();
2097                           string_input ~input_type:`Submit ~value:"Click" ()]])
2098                 ])))
2099 (*wiki*
2100
2101
2102 *wiki*)
2103 let select_example_result = register_service
2104     ~path:["select"]
2105     ~get_params:(string "s")
2106     (fun g () ->
2107       return
2108         (html
2109            (head (title (pcdata "")) [])
2110            (body [p [pcdata "You selected: ";
2111                      strong [pcdata g]]])))
2112
2113 let create_select_form =
2114   (fun select_name ->
2115     [p [pcdata "Select something: ";
2116         Eliom_output.Xhtml.string_select ~name:select_name
2117           (Eliom_output.Xhtml.Option ([] (* attributes *),
2118                                         "Bob" (* value *),
2119                                         None (* Content, if different from value *),
2120                                         false (* not selected *))) (* first line *)
2121           [Eliom_output.Xhtml.Option ([], "Marc", None, false);
2122           (Eliom_output.Xhtml.Optgroup
2123           ([],
2124            "Girls",
2125            ([], "Karin", None, false),
2126            [([a_disabled `Disabled], "Juliette", None, false);
2127             ([], "Alice", None, true);
2128             ([], "Germaine", Some (pcdata "Bob's mother"), false)]))]
2129           ;
2130         Eliom_output.Xhtml.string_input ~input_type:`Submit ~value:"Send" ()]])
2131
2132 let select_example = register_service ["select"] unit
2133   (fun () () ->
2134      let f =
2135        Eliom_output.Xhtml.get_form
2136          select_example_result create_select_form
2137      in
2138      return
2139        (html
2140          (head (title (pcdata "")) [])
2141          (body [f])))
2142 (*wiki*
2143
2144
2145 *wiki*)
2146 let coord = register_service
2147     ~path:["coord"]
2148     ~get_params:(coordinates "coord")
2149   (fun c () ->
2150     return
2151   <:xhtml< <html>
2152        <head><title></title></head>
2153        <body>
2154        <p>
2155          You clicked on coordinates:
2156          ($str:(string_of_int c.abscissa)$, $str:(string_of_int c.ordinate)$)
2157        </p>
2158        </body>
2159      </html> >>)
2160
2161 (* form to image *)
2162 let imageform = register_service
2163     ~path:["imageform"]
2164     ~get_params:unit
2165     (fun () () ->
2166       return
2167         (html
2168            (head (title (pcdata "")) [])
2169            (body [h1 [pcdata "Image Form"];
2170                   get_form coord
2171                     (fun n ->
2172                       [p [image_input
2173                             ~src:(make_uri ~service:(static_dir ()) ["ocsigen5.png"])
2174                             ~name:n
2175                             ()]])
2176                 ])))
2177 (*wiki*
2178
2179
2180 *wiki*)
2181 let coord2 = register_service
2182     ~path:["coord2"]
2183     ~get_params:(int_coordinates "coord")
2184   (fun (i, c) () ->
2185     return
2186   <:xhtml< <html>
2187        <head><title></title></head>
2188        <body>
2189        <p>
2190          You clicked on coordinates:
2191          ($str:(string_of_int c.abscissa)$, $str:(string_of_int c.ordinate)$)
2192        </p>
2193        </body>
2194      </html> >>)
2195
2196 (* form to image *)
2197 let imageform2 = register_service
2198     ~path:["imageform2"]
2199     ~get_params:unit
2200     (fun () () ->
2201       return
2202         (html
2203            (head (title (pcdata "")) [])
2204            (body [h1 [pcdata "Image Form"];
2205                   get_form coord2
2206                     (fun n ->
2207                       [p [int_image_input
2208                             ~src:(make_uri ~service:(static_dir ()) ["ocsigen5.png"])
2209                             ~name:n
2210                             ~value:3
2211                             ()]])
2212                 ])))
2213
2214 (*wiki*
2215
2216
2217 *wiki*)
2218
2219 (* lists *)
2220 let coucou_list = register_service
2221     ~path:["coucou"]
2222     ~get_params:(list "a" (string "str"))
2223   (fun l () ->
2224     let ll =
2225       List.map (fun s -> <:xhtml< <strong>$str:s$</strong> >>) l in
2226       return
2227         <:xhtml< <html>
2228              <head><title></title></head>
2229              <body>
2230              <p>
2231                You sent:
2232                $list:ll$
2233              </p>
2234              </body>
2235            </html> >>)
2236 (*wiki*
2237
2238
2239 *wiki*)
2240 (*zap* Note:
2241    Actually almost all services will be overwritten by new versions,
2242    but not those with user_type parameters for example
2243    (because the type description contains functions)
2244  *zap*)
2245
2246 (* Form with list: *)
2247 let create_listform f =
2248   (* Here, f.it is an iterator like List.map,
2249      but it must be applied to a function taking 3 arguments
2250      (unlike 1 in map), the first one being the name of the parameter,
2251      and the second one the element of list.
2252      The last parameter of f.it is the code that must be appended at the
2253      end of the list created
2254    *)
2255   f.it (fun stringname v init ->
2256     <:xhtmllist< <p>Write the value for $str:v$:
2257       $string_input ~input_type:`Text ~name:stringname ()$ </p> >>@init)
2258     ["one";"two";"three";"four"]
2259     <:xhtmllist< <p>$string_input ~input_type:`Submit ~value:"Click" ()$</p> >>
2260
2261 let listform = register_service ["listform"] unit
2262   (fun () () ->
2263      let f = get_form coucou_list create_listform in
2264      return
2265       <:xhtml< <html>
2266            <head><title></title></head>
2267            <body> $f$ </body>
2268          </html> >>)
2269
2270 (*wiki*
2271
2272
2273 *wiki*)
2274 (* Form for service with suffix: *)
2275 let create_suffixform ((suff, endsuff),i) =
2276     <:xhtmllist< <p>Write the suffix (integer):
2277       $int_input ~input_type:`Text ~name:suff ()$ <br/>
2278       Write a string: $user_type_input
2279       (Url.string_of_url_path ~encode:false)
2280          ~input_type:`Text ~name:endsuff ()
2281          $ <br/>
2282       Write an int: $int_input ~input_type:`Text ~name:i ()$ <br/>
2283       $string_input ~input_type:`Submit ~value:"Click" ()$</p> >>
2284
2285 let suffixform = register_service ["suffixform"] unit
2286   (fun () () ->
2287      let f = get_form isuffix create_suffixform in
2288      return
2289       <:xhtml< <html>
2290            <head><title></title></head>
2291            <body> $f$ </body>
2292          </html> >>)
2293
2294 (*wiki*
2295
2296
2297 *wiki*)
2298 let upload = service
2299     ~path:["upload"]
2300     ~get_params:unit
2301     ()
2302
2303 let upload2 = register_post_service
2304    ~fallback:upload
2305    ~post_params:(file "file")
2306     (fun () file ->
2307       let to_display =
2308         let newname = "/tmp/thefile" in
2309         (try
2310           Unix.unlink newname;
2311         with _ -> ());
2312         Ocsigen_messages.console2 (Eliom_request_info.get_tmp_filename file);
2313         Unix.link (Eliom_request_info.get_tmp_filename file) newname;
2314         let fd_in = open_in newname in
2315         try
2316           let line = input_line fd_in in close_in fd_in; line (*end*)
2317         with End_of_file -> close_in fd_in; "vide"
2318       in
2319       return
2320         (html
2321            (head (title (pcdata "Upload")) [])
2322            (body [h1 [pcdata to_display]])))
2323
2324
2325 let uploadform = register upload
2326     (fun () () ->
2327       let f =
2328         (post_form upload2
2329            (fun file ->
2330              [p [file_input ~name:file ();
2331                  br ();
2332                  string_input ~input_type:`Submit ~value:"Send" ()
2333                ]]) ()) in
2334       return
2335         (html
2336            (head (title (pcdata "form")) [])
2337            (body [f])))
2338
2339
2340 (*wiki*
2341
2342
2343 *wiki*)
2344 (* Hierarchical menu *)
2345 open Eliom_tools_common
2346 open Eliom_tools
2347
2348 let hier1 = service ~path:["hier1"] ~get_params:unit ()
2349 let hier2 = service ~path:["hier2"] ~get_params:unit ()
2350 let hier3 = service ~path:["hier3"] ~get_params:unit ()
2351 let hier4 = service ~path:["hier4"] ~get_params:unit ()
2352 let hier5 = service ~path:["hier5"] ~get_params:unit ()
2353 let hier6 = service ~path:["hier6"] ~get_params:unit ()
2354 let hier7 = service ~path:["hier7"] ~get_params:unit ()
2355 let hier8 = service ~path:["hier8"] ~get_params:unit ()
2356 let hier9 = service ~path:["hier9"] ~get_params:unit ()
2357 let hier10 = service ~path:["hier10"] ~get_params:unit ()
2358
2359 let mymenu =
2360   (
2361    (Main_page hier1),
2362
2363    [([pcdata "page 1"], Site_tree (Main_page hier1, []));
2364
2365     ([pcdata "page 2"], Site_tree (Main_page hier2, []));
2366
2367     ([pcdata "submenu 4"],
2368      Site_tree
2369        (Default_page hier4,
2370          [([pcdata "submenu 3"],
2371           Site_tree
2372              (Not_clickable,
2373               [([pcdata "page 3"], Site_tree (Main_page hier3, []));
2374                ([pcdata "page 4"], Site_tree (Main_page hier4, []));
2375                ([pcdata "page 5"], Site_tree (Main_page hier5, []))]
2376              )
2377           );
2378
2379           ([pcdata "page 6"], Site_tree (Main_page hier6, []))]
2380        )
2381     );
2382
2383     ([pcdata "page 7"],
2384      Site_tree (Main_page hier7, []));
2385
2386     ([pcdata "disabled"], Disabled);
2387
2388     ([pcdata "submenu 8"],
2389      Site_tree
2390        (Main_page hier8,
2391         [([pcdata "page 9"], Site_tree (Main_page hier9, []));
2392          ([pcdata "page 10"], Site_tree (Main_page hier10, []))]
2393        )
2394     )
2395   ]
2396   )
2397
2398 let f i s () () =
2399   return
2400     (html
2401        (head (title (pcdata ""))
2402           ((style ~contenttype:"text/css"
2403              [cdata_style
2404  "a {color: red;}\n
2405   li.eliomtools_current > a {color: blue;}\n
2406   .breadthmenu li {\n
2407     display: inline;\n
2408     padding: 0px 1em;\n
2409     margin: 0px;\n
2410     border-right: solid 1px black;}\n
2411   .breadthmenu li.eliomtools_last {border: none;}\n
2412                 "])::
2413                 Xhtml.structure_links mymenu ~service:s ())
2414              )
2415        (body [h1 [pcdata ("Page "^string_of_int i)];
2416               h2 [pcdata "Depth first, whole tree:"];
2417               div
2418                 (Xhtml.hierarchical_menu_depth_first
2419                    ~whole_tree:true mymenu ~service:s ());
2420               h2 [pcdata "Depth first, only current submenu:"];
2421               div (Xhtml.hierarchical_menu_depth_first mymenu ~service:s ());
2422               h2 [pcdata "Breadth first:"];
2423               div
2424                 (Xhtml.hierarchical_menu_breadth_first
2425                    ~classe:["breadthmenu"] mymenu ~service:s ())]))
2426
2427
2428 let _ =
2429   register hier1 (f 1 hier1);
2430   register hier2 (f 2 hier2);
2431   register hier3 (f 3 hier3);
2432   register hier4 (f 4 hier4);
2433   register hier5 (f 5 hier5);
2434   register hier6 (f 6 hier6);
2435   register hier7 (f 7 hier7);
2436   register hier8 (f 8 hier8);
2437   register hier9 (f 9 hier9);
2438   register hier10 (f 10 hier10)
2439