Source file eliom_parameter.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
# 1 "src/lib/eliom_parameter.server.ml"
(* Ocsigen
 * http://www.ocsigen.org
 * Copyright (C) 2007 Vincent Balat
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)

open Eliom_lib
include Eliom_parameter_base

type raw_post_data = Eliom_request_info.raw_post_data

open Ocsigen_extensions

(* server-specific constructors *)

let user_type
      ?client_to_and_of
      ~(of_string : string -> 'a)
      ~(to_string : 'a -> string)
      (n : string)
  =
  TUserType
    ( n
    , Eliom_common.To_and_of_shared.create ?client_to_and_of
        {of_string; to_string} )

let all_suffix_user
      ?client_to_and_of
      ~(of_string : string -> 'a)
      ~(to_string : 'a -> string)
      (n : string)
  =
  TESuffixu
    ( n
    , Eliom_common.To_and_of_shared.create ?client_to_and_of
        {of_string; to_string} )

(* types available only on server side (no pcre on browser) *)

let regexp reg dest ~to_string n =
  user_type
    ~of_string:(fun s ->
      match Re.Pcre.exec ~rex:reg ~pos:0 s with
      | g when Re.Group.start g 0 = 0 -> (
        try
          Ocsigen_extensions.replace_user_dir reg
            (Ocsigen_extensions.parse_user_dir dest)
            s
        with Ocsigen_extensions.NoSuchUser ->
          raise (Failure "User does not exist"))
      | _ | (exception Not_found) -> raise (Failure "Regexp not matching"))
    ~to_string n

let all_suffix_regexp reg dest ~(to_string : 'a -> string) (n : string) :
  (string, [`Endsuffix], [`One of string] param_name) params_type
  =
  all_suffix_user
    ~of_string:(fun s ->
      match Re.Pcre.exec ~rex:reg ~pos:0 s with
      | g when Re.Group.start g 0 = 0 -> (
        try
          Ocsigen_extensions.replace_user_dir reg
            (Ocsigen_extensions.parse_user_dir dest)
            s
        with Ocsigen_extensions.NoSuchUser ->
          raise (Failure "User does not exist"))
      | _ | (exception Not_found) -> raise (Failure "Regexp not matching"))
    ~to_string n

(* Non localized parameters *)

let get_non_localized_parameters
      params
      files
      ~getorpost
      ~sp
      {name; get; post; param = paramtype; _}
  =
  (* non localized parameters are parsed only once,
     and cached in request_cache *)
  let key = match getorpost with `Get -> get | `Post -> post in
  try
    (* first, look in cache: *)
    Polytables.get
      ~table:
        (Ocsigen_request.request_cache sp.Eliom_common.sp_request.request_info)
      ~key
  with Not_found ->
    let p =
      try
        Some
          (let params =
             try String.Table.find name params with Not_found -> []
           in
           let files =
             try String.Table.find name files with Not_found -> []
           in
           reconstruct_params_ paramtype params files false None)
      with Eliom_common.Eliom_Wrong_parameter | Not_found -> None
    in
    (* add in cache: *)
    Polytables.set
      ~table:
        (Ocsigen_request.request_cache sp.Eliom_common.sp_request.request_info)
      ~key ~value:p;
    p

let get_non_localized_get_parameters p =
  let sp = Eliom_common.get_sp () in
  get_non_localized_parameters
    sp.Eliom_common.sp_si.Eliom_common.si_nl_get_params
    sp.Eliom_common.sp_si.Eliom_common.si_nl_file_params ~getorpost:`Get ~sp p

let get_non_localized_post_parameters p =
  let sp = Eliom_common.get_sp () in
  get_non_localized_parameters
    sp.Eliom_common.sp_si.Eliom_common.si_nl_post_params
    sp.Eliom_common.sp_si.Eliom_common.si_nl_file_params ~getorpost:`Post ~sp p