~ubuntu-branches/ubuntu/oneiric/ocsigen/oneiric

« back to all changes in this revision

Viewing changes to eliom/eliom_services.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stephane Glondu
  • Date: 2009-07-02 10:02:08 UTC
  • mfrom: (1.1.9 upstream) (4.1.3 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090702100208-n158b1sqwzn0asil
Tags: 1.2.0-2
Fix build on non-native architectures

Show diffs side-by-side

added added

removed removed

Lines of Context:
94
94
     subpath: url_path; (* name of the service without parameters *)
95
95
     fullpath: url_path; (* full path of the service = site_dir@subpath *)
96
96
     att_kind: 'a; (* < attached_service_kind *)
97
 
     get_state: Eliom_common.internal_state option;
98
 
     post_state: Eliom_common.internal_state option;
 
97
     get_name: Eliom_common.att_key;
 
98
     post_name: Eliom_common.att_key;
99
99
   }
100
100
 
101
101
type +'a na_s =
151
151
let get_prefix_ s = s.prefix
152
152
let get_sub_path_ s = s.subpath
153
153
let get_full_path_ s = s.fullpath
154
 
let get_get_state_ s = s.get_state
155
 
let get_post_state_ s = s.post_state
 
154
let get_get_name_ s = s.get_name
 
155
let get_post_name_ s = s.post_name
156
156
let get_na_name_ s = s.na_name
157
157
let get_na_kind_ s = s.na_kind
158
158
let get_max_use_ s = s.max_use
169
169
    (Printf.sprintf "%x" (Random.int 0xFFFF))^(Printf.sprintf "%Lx" !c)
170
170
 
171
171
 
 
172
(*****************************************************************************)
 
173
(*****************************************************************************)
 
174
(* Registration of static module initialization functions                    *)
 
175
(*****************************************************************************)
 
176
(*****************************************************************************)
 
177
 
 
178
let register_eliom_module name f =
 
179
  Ocsigen_loader.set_module_init_function name f
172
180
 
173
181
(*****************************************************************************)
174
182
(*****************************************************************************)
188
196
       {prefix = "";
189
197
        subpath = [""];
190
198
        fullpath = (Eliom_sessions.get_site_dir sp) @ [""];
191
 
        get_state = None;
192
 
        post_state = None;
 
199
        get_name = Eliom_common.Att_no;
 
200
        post_name = Eliom_common.Att_no;
193
201
        att_kind = `Internal (`Service, `Get);
194
202
      };
195
203
     https = https;
213
221
       {prefix = "";
214
222
        subpath = [""];
215
223
        fullpath = (Eliom_sessions.get_site_dir sp) @ [""];
216
 
        get_state = None;
217
 
        post_state = None;
 
224
        get_name = Eliom_common.Att_no;
 
225
        post_name = Eliom_common.Att_no;
218
226
        att_kind = `Internal (`Service, `Get);
219
227
      };
220
228
     https = https;
252
260
      subpath = path;
253
261
      fullpath = site_dir @ path;
254
262
      att_kind = kind;
255
 
      get_state = None;
256
 
      post_state = None;
 
263
      get_name = Eliom_common.Att_no;
 
264
      post_name = Eliom_common.Att_no;
257
265
    };
258
266
   https = https;
259
267
 }
340
348
let new_naservice_num () = new_state ()
341
349
 
342
350
let new_coservice
 
351
    ?name
343
352
    ?max_use
344
353
    ?timeout
345
354
    ?(https = false)
356
365
   get_params_type = add_pref_params Eliom_common.co_param_prefix get_params;
357
366
   kind = `Attached
358
367
     {k with
359
 
      get_state = Some (new_state ());
360
 
      att_kind = `Internal (`Coservice, `Get);
361
 
    };
 
368
      get_name = 
 
369
         (match name with
 
370
           | None -> Eliom_common.Att_anon (new_state ())
 
371
           | Some name -> Eliom_common.Att_named name);
 
372
        att_kind = `Internal (`Coservice, `Get);
 
373
     };
362
374
   https = https || fallback.https
363
375
 }
364
376
(* Warning: here no GET parameters for the fallback.
365
 
   Apply services with apply_service
366
 
   if you want fallbacks with GET parameters *)
367
 
 
368
 
 
369
 
let new_coservice' ?max_use ?timeout ?(https = false) ~get_params () =
370
 
  let n = Eliom_common.Na_get' (new_naservice_num ()) in
 
377
   Preapply services if you want fallbacks with GET parameters *)
 
378
 
 
379
 
 
380
let new_coservice' ?name ?max_use ?timeout ?(https = false) ~get_params () =
371
381
  (* (match Eliom_common.global_register_allowed () with
372
382
  | Some _ -> Eliom_common.add_unregistered_na n;
373
383
  | _ -> () (* Do we accept unregistered non-attached coservices? *)); *)
374
 
  {
375
 
   max_use= max_use;
376
 
   timeout= timeout;
377
 
   pre_applied_parameters = [];
378
 
   get_params_type = add_pref_params Eliom_common.na_co_param_prefix get_params;
379
 
   post_params_type = unit;
380
 
   kind = `Nonattached
381
 
     {na_name = n;
382
 
      na_kind = `Get;
383
 
    };
384
 
   https = https;
385
 
 }
 
384
  (* (* Do we accept unregistered non-attached named coservices? *)
 
385
     match sp with
 
386
     | None ->
 
387
     ...
 
388
  *)
 
389
        {
 
390
(*VVV allow timeout and max_use for named coservices? *)
 
391
          max_use= max_use;
 
392
          timeout= timeout;
 
393
          pre_applied_parameters = [];
 
394
          get_params_type = 
 
395
            add_pref_params Eliom_common.na_co_param_prefix get_params;
 
396
          post_params_type = unit;
 
397
          kind = `Nonattached
 
398
            {na_name = 
 
399
                match name with
 
400
                  | None ->
 
401
                      Eliom_common.Na_get' (new_naservice_num ())
 
402
                  | Some name -> Eliom_common.Na_get_ name;
 
403
            ;
 
404
             na_kind = `Get;
 
405
            };
 
406
          https = https;
 
407
        }
386
408
 
387
 
let new_service' ?sp ?(https = false) ~name ~get_params () =
388
 
  match sp with
389
 
  | None ->
390
 
      (match Eliom_common.global_register_allowed () with
391
 
      | Some get_current_sitedata ->
392
 
          let sitedata = get_current_sitedata () in
393
 
          let r =
394
 
            {
395
 
(*VVV allow timeout and max_use? *)
396
 
             max_use= None;
397
 
             timeout= None;
398
 
             pre_applied_parameters = [];
399
 
             get_params_type =
400
 
             add_pref_params Eliom_common.na_co_param_prefix get_params;
401
 
             post_params_type = unit;
402
 
             kind = `Nonattached
403
 
               {na_name = Eliom_common.Na_get_ name;
404
 
                na_kind = `Get;
405
 
              };
406
 
             https = https;
407
 
           }
408
 
          in
409
 
          Eliom_common.add_unregistered_na sitedata
410
 
            (Eliom_common.Na_get_ name);
411
 
          r
412
 
      | None ->
413
 
          raise (Eliom_common.Eliom_function_forbidden_outside_site_loading
414
 
                   "new_service'"))
415
 
  | Some sp ->
416
 
      {
417
 
(*VVV allow timeout and max_use? *)
418
 
       max_use= None;
419
 
       timeout= None;
420
 
       pre_applied_parameters = [];
421
 
       get_params_type =
422
 
       add_pref_params Eliom_common.na_co_param_prefix get_params;
423
 
       post_params_type = unit;
424
 
       kind = `Nonattached
425
 
         {na_name = Eliom_common.Na_get_ name;
426
 
          na_kind = `Get;
427
 
        };
428
 
       https = https;
429
 
     }
430
409
 
431
410
(****************************************************************************)
432
411
(** Register a service with post parameters in the server *)
446
425
      subpath = k1.subpath;
447
426
      fullpath = k1.fullpath;
448
427
      att_kind = `Internal (k, `Post);
449
 
      get_state = k1.get_state;
450
 
      post_state = None;
 
428
      get_name = k1.get_name;
 
429
      post_name = Eliom_common.Att_no;
451
430
    };
452
431
   https = https;
453
432
 }
482
461
 
483
462
 
484
463
let new_post_coservice 
485
 
    ?max_use ?timeout ?(https = false) ~fallback ~post_params () =
 
464
    ?name ?max_use ?timeout ?(https = false) ~fallback ~post_params () =
486
465
  let `Attached k1 = fallback.kind in
487
466
  (* (match Eliom_common.global_register_allowed () with
488
467
  | Some _ -> Eliom_common.add_unregistered k1.path;
494
473
   kind = `Attached
495
474
     {k1 with
496
475
      att_kind = `Internal (`Coservice, `Post);
497
 
      post_state = Some (new_state ());
 
476
      post_name = 
 
477
         (match name with
 
478
            | None -> Eliom_common.Att_anon (new_state ())
 
479
            | Some name -> Eliom_common.Att_named name);
498
480
    };
499
481
   https = https;
500
482
 }
507
489
 
508
490
(*VVV Warning: keep_get_na_params is experimental *)
509
491
let new_post_coservice'
 
492
    ?name
510
493
    ?max_use ?timeout ?(keep_get_na_params = true) ?(https = false)
511
494
    ~post_params () =
512
495
  (* match Eliom_common.global_register_allowed () with
513
496
  | Some _ -> Eliom_common.add_unregistered None
514
497
  | _ -> () *)
515
498
  {
516
 
   max_use= max_use;
517
 
   timeout= timeout;
518
 
   pre_applied_parameters = [];
519
 
   get_params_type = unit;
520
 
   post_params_type = post_params;
521
 
   kind = `Nonattached
522
 
     {na_name = Eliom_common.Na_post' (new_naservice_num ());
523
 
      na_kind = `Post keep_get_na_params;
524
 
    };
525
 
   https = https;
526
 
 }
 
499
(*VVV allow timeout and max_use for named coservices? *)
 
500
    max_use= max_use;
 
501
    timeout= timeout;
 
502
    pre_applied_parameters = [];
 
503
    get_params_type = unit;
 
504
    post_params_type = post_params;
 
505
    kind = `Nonattached
 
506
      {na_name = 
 
507
          (match name with
 
508
            | None ->
 
509
                Eliom_common.Na_post' (new_naservice_num ())
 
510
            | Some name -> Eliom_common.Na_post_ name);
 
511
       na_kind = `Post keep_get_na_params;
 
512
      };
 
513
    https = https;
 
514
  }
527
515
 
528
 
let new_post_service'
529
 
   ?(keep_get_na_params = true) ?(https = false) ~name ~post_params () =
530
 
  (* match Eliom_common.global_register_allowed () with
531
 
  | Some _ -> Eliom_common.add_unregistered None
532
 
  | _ -> () *)
533
 
  {
534
 
(*VVV allow timeout and max_use? *)
535
 
   max_use= None;
536
 
   timeout= None;
537
 
   pre_applied_parameters = [];
538
 
   get_params_type = unit;
539
 
   post_params_type = post_params;
540
 
   kind = `Nonattached
541
 
     {na_name = Eliom_common.Na_post_ name;
542
 
      na_kind = `Post keep_get_na_params;
543
 
    };
544
 
   https = https;
545
 
 }
546
516
 
547
517
(*
548
518
let new_get_post_coservice'
577
547
*)
578
548
 
579
549
 
 
550
let rec append_suffix l m = match l with
 
551
  | [] -> m
 
552
  | [eliom_suffix_internal_name] -> m
 
553
  | a::ll -> a::(append_suffix ll m)
 
554
 
580
555
let preapply ~service getparams =
581
556
  let suff, params = construct_params_list service.get_params_type getparams in
582
557
  {service with
585
560
   kind = match service.kind with
586
561
   | `Attached k -> `Attached {k with
587
562
                               subpath = (match suff with
588
 
                               | Some suff -> k.subpath@suff
 
563
                               | Some suff -> append_suffix k.subpath suff
589
564
                               | _ -> k.subpath);
590
565
                               fullpath = (match suff with
591
 
                               | Some suff -> k.fullpath@suff
 
566
                               | Some suff -> append_suffix k.fullpath suff
592
567
                               | _ -> k.fullpath);
593
568
                             }
594
569
   | k -> k
595
570
 }
596
571
 
597
572
 
598
 
let void_action =
 
573
let void_coservice' =
599
574
  {
600
575
    max_use= None;
601
576
    timeout= None;
603
578
    get_params_type = unit;
604
579
    post_params_type = unit;
605
580
    kind = `Nonattached
606
 
      {na_name = Eliom_common.Na_get_ "";
 
581
      {na_name = Eliom_common.Na_void_dontkeep;
607
582
       na_kind = `Get;
608
583
      };
609
584
    https = false;
610
585
  }
611
586
 
612
 
let https_void_action =
 
587
let https_void_coservice' =
613
588
  {
614
589
    max_use= None;
615
590
    timeout= None;
617
592
    get_params_type = unit;
618
593
    post_params_type = unit;
619
594
    kind = `Nonattached
620
 
      {na_name = Eliom_common.Na_get_ "";
 
595
      {na_name = Eliom_common.Na_void_dontkeep;
621
596
       na_kind = `Get;
622
597
      };
623
598
    https = true;
624
599
  }
625
600
 
 
601
let void_hidden_coservice' = {void_coservice' with 
 
602
                         kind = `Nonattached
 
603
    {na_name = Eliom_common.Na_void_keep;
 
604
     na_kind = `Get;
 
605
    };
 
606
                      }
 
607
 
 
608
let https_void_hidden_coservice' = {void_coservice' with 
 
609
                         kind = `Nonattached
 
610
    {na_name = Eliom_common.Na_void_keep;
 
611
     na_kind = `Get;
 
612
    };
 
613
                      }
 
614
 
626
615
 
627
616
(*****************************************************************************)
628
617
let set_exn_handler ?sp h =