← Back to branch summary

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

« back to all changes in this revision

Viewing changes to extensions/userconf.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:
extensions/userconf.ml
29
29
open Ocsigen_lib
30
30
open Ocsigen_extensions
31
31
 
 
32
exception NoConfFile
32
33
 
33
34
(*****************************************************************************)
34
35
 
35
 
exception Failed_404
36
 
 
37
 
let gen hostpattern sitepath charset (regexp, conf, url, prefix) req_state =
38
 
  match req_state with
39
 
  | Ocsigen_extensions.Req_found (_, r) -> Lwt.return (Ocsigen_extensions.Ext_found r)
40
 
(*VVV not possible to set a filter for now *)
41
 
  | Ocsigen_extensions.Req_not_found (previous_extension_err, ri) ->
42
 
      let path = ri.ri_sub_path_string in
 
36
let err_500 =
 
37
  Ocsigen_extensions.Ext_stop_site (Ocsigen_http_frame.Cookies.empty, 500)
 
38
 
 
39
 
 
40
(* Catch invalid userconf files and report an error *)
 
41
let handle_parsing_error req = function
 
42
  | Ocsigen_extensions.Error_in_config_file s ->
 
43
      Ocsigen_messages.errlog (Printf.sprintf
 
44
          "Syntax error in userconf configuration file for url %s: %s"
 
45
        req.request_info.ri_url_string s);
 
46
      Lwt.return err_500
 
47
 
 
48
  | Ocsigen_extensions.Error_in_user_config_file s ->
 
49
      Ocsigen_messages.errlog  (Printf.sprintf
 
50
          "Unauthorized option in user configuration for url %s: %s"
 
51
          req.request_info.ri_url_string s);
 
52
      Lwt.return err_500
 
53
 
 
54
  | e -> Lwt.fail e
 
55
 
 
56
 
 
57
(* Answer returned by userconf when the url matches *)
 
58
let subresult new_req user_parse_site conf previous_err req req_state =
 
59
  Ext_sub_result
 
60
    (fun awake cookies_to_set rs ->
 
61
       (* XXX why is rs above never used ?? *)
 
62
       Lwt.catch
 
63
         (fun () ->
 
64
            user_parse_site conf awake cookies_to_set
 
65
              (Ocsigen_extensions.Req_not_found (previous_err, new_req))
 
66
            >>= fun (answer, cookies) ->
 
67
            (* If the request is not satisfied by userconf, the changes
 
68
               in configuration (in request_config) are preserved for the
 
69
               remainder of the enclosing <site> (in the Ext_continue
 
70
               and Ext_found_continue cases below) *)
 
71
            let rec aux ((answer, cts) as r) = match answer with
 
72
              | Ext_sub_result sr ->
 
73
                  (* XXX Are these the good cookies ?? *)
 
74
                  sr awake cookies_to_set req_state
 
75
                  >>= aux
 
76
              | Ext_continue_with (newreq, cookies, err) ->
 
77
                  Lwt.return
 
78
                    ((Ext_continue_with
 
79
                        ({req with request_config = newreq.request_config },
 
80
                         cookies, err)), cts)
 
81
              | Ext_found_continue_with r ->
 
82
                  (* We keep config information outside userconf! *)
 
83
                  Lwt.return
 
84
                    (Ext_found_continue_with
 
85
                       (fun () ->
 
86
                          r () >>= fun (r, newreq) -> Lwt.return
 
87
                          (r,
 
88
                           { req with request_config = newreq.request_config })
 
89
                       ), cts)
 
90
              | _ -> Lwt.return r
 
91
            in aux (answer, cookies)
 
92
         )
 
93
         (fun e ->
 
94
            handle_parsing_error req e >>=
 
95
            fun answer ->
 
96
            Lwt.return (answer, Ocsigen_http_frame.Cookies.empty))
 
97
    )
 
98
 
 
99
 
 
100
let conf_to_xml conf =
 
101
  try Simplexmlparser.xmlparser_file conf
 
102
  with
 
103
    | Sys_error _ -> raise NoConfFile
 
104
    | Simplexmlparser.Xml_parser_error s ->
 
105
        raise (Ocsigen_extensions.Error_in_config_file s)
 
106
 
 
107
 
 
108
let gen hostpattern sitepath (regexp, conf, url, prefix, localpath) = function
 
109
  | Req_found _ ->
 
110
      (* We do not allow setting filters through userconf files right now *)
 
111
      Lwt.return Ext_do_nothing
 
112
 
 
113
  | Req_not_found (previous_err, req) as req_state->
 
114
      let path = req.request_info.ri_sub_path_string in
43
115
      match Netstring_pcre.string_match regexp path 0 with
44
 
      | None -> Lwt.return (Ext_next previous_extension_err)
45
 
      | Some _ -> (* Matching regexp found! *)
 
116
      | None -> Lwt.return (Ext_next previous_err)
 
117
      | Some _ ->
46
118
          try
47
119
            Ocsigen_messages.debug2 "--Userconf: Using user configuration";
48
 
            let conf =
49
 
              try
50
 
                Ocsigen_extensions.replace_user_dir regexp conf path
51
 
              with Not_found -> raise Failed_404
52
 
            in
53
 
            let url = Netstring_pcre.global_replace regexp url path in
54
 
            let prefix = Netstring_pcre.global_replace regexp prefix path in
55
 
            ignore (Unix.stat conf);
56
 
            let user_parse_host = Ocsigen_extensions.parse_user_site_item hostpattern in
57
 
            let user_parse_site =
58
 
              Ocsigen_extensions.make_parse_site
59
 
                (sitepath@[prefix]) charset user_parse_host
60
 
            in
61
 
            let xmllist = Simplexmlparser.xmlparser_file conf in
 
120
            let conf = Ocsigen_extensions.replace_user_dir regexp conf path in
 
121
            let url = Netstring_pcre.global_replace regexp url path
 
122
            and prefix = Netstring_pcre.global_replace regexp prefix path
 
123
            and userconf_options = {
 
124
              Ocsigen_extensions.localfiles_root =
 
125
                Ocsigen_extensions.replace_user_dir regexp localpath path }
 
126
            and conf = conf_to_xml conf
 
127
            in
 
128
            let user_parse_host = Ocsigen_extensions.parse_user_site_item
 
129
              userconf_options hostpattern in
 
130
            (* Inside userconf, we create a new virtual site starting
 
131
               after [prefix], and use a request modified accordingly*)
 
132
            let user_parse_site = Ocsigen_extensions.make_parse_config
 
133
              (sitepath@[prefix]) user_parse_host
 
134
            and path =
 
135
              Ocsigen_lib.remove_slash_at_beginning
 
136
                (Ocsigen_lib.remove_dotdot (Neturl.split_path url))
 
137
            in
 
138
            let new_req =
 
139
              { req with request_info =
 
140
                  { req.request_info with
 
141
                      ri_sub_path = path; ri_sub_path_string = url}}
 
142
            in
62
143
            Lwt.return
63
 
              (Ext_sub_result
64
 
                 (fun awake cookies_to_set rs ->
65
 
                   let path =
66
 
                     Ocsigen_lib.remove_slash_at_end
67
 
                       (Ocsigen_lib.remove_slash_at_beginning
68
 
                          (Ocsigen_lib.remove_dotdot (Neturl.split_path url)))
69
 
                   in
70
 
                   user_parse_site
71
 
                     xmllist
72
 
                     awake
73
 
                     cookies_to_set
74
 
                     (Ocsigen_extensions.Req_not_found
75
 
                        (previous_extension_err,
76
 
                         {ri with
77
 
                          ri_sub_path = path;
78
 
                          ri_sub_path_string = url}))
79
 
(*VVV We do not want to continue to search if the page has not been found *)
80
 
(*VVV Filters won't be applied. Is it the right behaviour? *)
81
 
(*VVV v v v *)
82
 
                   >>=
83
 
                   let rec aux ((answer, cts) as r) =
84
 
                     match answer with
85
 
                     | Ext_found _
86
 
                     | Ext_stop_all _
87
 
                     | Ext_retry_with _ -> Lwt.return r
88
 
                     | Ext_next err ->
89
 
                         Lwt.return
90
 
                           (Ext_stop_all (Ocsigen_http_frame.Cookies.empty, err),
91
 
                            cts)
92
 
                     | Ext_continue_with (_, cts2, err)
93
 
                     | Ext_stop_site (cts2, err)
94
 
                     | Ext_stop_host (cts2, err) ->
95
 
                         Lwt.return (Ext_stop_all (cts2, err), cts)
96
 
                     | Ext_sub_result sr ->
97
 
                         sr awake cookies_to_set req_state
98
 
                         >>= aux
99
 
                   in aux
100
 
 (*VVV ^ ^ ^ *)
101
 
                 )
102
 
              )
 
144
             (subresult new_req user_parse_site conf previous_err req req_state)
 
145
 
103
146
          with
 
147
          | Ocsigen_extensions.NoSuchUser
 
148
          | NoConfFile
104
149
          | Unix.Unix_error (Unix.EACCES,_,_)
105
150
          | Unix.Unix_error (Unix.ENOENT, _, _) ->
106
 
              Lwt.return (Ocsigen_extensions.Ext_next previous_extension_err)
107
 
          | Failed_404 ->
108
 
              Lwt.return (Ocsigen_extensions.Ext_next 404)
 
151
              Lwt.return (Ocsigen_extensions.Ext_next previous_err)
 
152
          | e -> handle_parsing_error req e
109
153
 
110
154
 
111
155
 
113
157
(** Parsing of config file *)
114
158
open Simplexmlparser
115
159
 
116
 
let parse_config hostpattern path charset =
117
 
  fun _ _ ->
118
 
    let rec parse_attrs_local ((regexp, conf, url, prefix) as res) = function
119
 
      | [] -> res
120
 
      | ("regexp", s)::l when regexp = None ->
121
 
          (try
122
 
            parse_attrs_local
123
 
              (Some (Netstring_pcre.regexp ("^"^s^"$")), conf, url, prefix)
124
 
              l
125
 
          with Failure _ ->
126
 
            raise (Error_in_config_file "Bad regexp in <userconf regexp=\"...\" />"))
127
 
      | ("conf", s)::l when conf = None ->
128
 
          parse_attrs_local
129
 
            (regexp, Some (Ocsigen_extensions.parse_user_dir s), url, prefix)
130
 
            l
131
 
      | ("url", s)::l when url = None ->
132
 
          parse_attrs_local
133
 
            (regexp, conf, Some s, prefix)
134
 
            l
135
 
      | ("prefix", s)::l when prefix = None ->
136
 
          parse_attrs_local
137
 
            (regexp, conf, url, Some s)
138
 
            l
139
 
      | _ -> raise (Error_in_config_file "Wrong attribute for <userconf>")
140
 
    in
141
 
    function
142
 
      | Element ("userconf", atts, []) ->
143
 
          let info =
144
 
            match parse_attrs_local (None, None, None, None) atts  with
145
 
            | (Some r, Some t, Some u, Some p) -> (r, t, u, p)
146
 
            | _ -> raise (Error_in_config_file
147
 
                            "Missing attributes for <userconf>")
148
 
          in
149
 
          gen hostpattern path charset info
150
 
      | Element (t, _, _) -> raise (Bad_config_tag_for_extension t)
151
 
      | _ -> raise (Error_in_config_file "(userconf extension) Bad data")
152
 
 
153
 
 
154
 
(*****************************************************************************)
155
 
(** Function to be called at the beginning of the initialisation phase *)
156
 
let start_init () =
157
 
  ()
158
 
 
159
 
(** Function to be called at the end of the initialisation phase *)
160
 
let end_init () =
161
 
  ()
162
 
 
 
160
let parse_config hostpattern path = fun _ _ ->
 
161
  let rec parse_attrs_local l ((regexp, conf, url, prefix, path) as r) =
 
162
    match l with
 
163
    | [] -> r
 
164
    | ("regexp", s)::l when regexp = None ->
 
165
        (try parse_attrs_local l
 
166
           (Some (Netstring_pcre.regexp ("^"^s^"$")), conf, url, prefix, path)
 
167
         with Failure _ ->
 
168
           badconfig "Bad regexp '%s' in <userconf regexp=\"...\" />" s)
 
169
    | ("conf", s)::l when conf = None ->
 
170
        parse_attrs_local l
 
171
         (regexp, Some (Ocsigen_extensions.parse_user_dir s), url, prefix, path)
 
172
    | ("url", s)::l when url = None ->
 
173
        parse_attrs_local l (regexp, conf, Some s, prefix, path)
 
174
    | ("prefix", s)::l when prefix = None ->
 
175
        parse_attrs_local l (regexp, conf, url, Some s, path)
 
176
    | ("localpath", s) :: l when path = None ->
 
177
        parse_attrs_local l
 
178
         (regexp, conf, url, prefix, Some (Ocsigen_extensions.parse_user_dir s))
 
179
    | (a, _) :: _ ->
 
180
        badconfig "Wrong or duplicate attribute %s for <userconf>" a
 
181
  in
 
182
  function
 
183
    | Element ("userconf", atts, []) ->
 
184
        let info =
 
185
          match parse_attrs_local atts (None, None, None, None, None)  with
 
186
            | (Some r, Some t, Some u, Some p, Some p') -> (r, t, u, p, p')
 
187
            | _ -> badconfig "Missing attributes for <userconf>"
 
188
        in
 
189
        gen hostpattern path info
 
190
    | Element ("userconf", _, _ :: _) ->
 
191
        badconfig "Incorrect (useless) data inside <userconf>"
 
192
    | Element (t, _, _) -> raise (Bad_config_tag_for_extension t)
 
193
    | _ -> badconfig "Bad data in conf file"
163
194
 
164
195
 
165
196
(*****************************************************************************)
166
197
(** extension registration *)
167
 
let _ = register_extension
168
 
    parse_config
169
 
    Ocsigen_extensions.void_extension
170
 
  (*fun hostpattern ->
171
 
    parse_config (Ocsigen_extensions.parse_user_site_item hostpattern)*)
172
 
  start_init
173
 
  end_init
174
 
  raise
175
 
 
 
198
let () = register_extension
 
199
  ~name:"userconf"
 
200
  ~fun_site:parse_config
 
201
  ()