38
38
open Simplexmlparser
41
exception Not_concerned
44
42
(*****************************************************************************)
45
43
(* The table of redirections for each virtual server *)
47
| Regexp of Netstring_pcre.regexp * string * bool (* temporary *)
52
(*****************************************************************************)
53
let rec parse_global_config = function
55
| _ -> raise (Error_in_config_file
56
("Unexpected content inside redirectmod config"))
58
let _ = parse_global_config (Ocsigen_extensions.get_config ())
64
(*****************************************************************************)
65
(* Finding redirections *)
67
let find_redirection (Regexp (regexp, dest, temp)) path =
68
match Netstring_pcre.string_match regexp path 0 with
69
| None -> raise Not_concerned
70
| Some _ -> (* Matching regexp found! *)
71
(Netstring_pcre.global_replace regexp dest path, temp)
79
(*****************************************************************************)
80
(** Function to be called at the beginning of the initialisation phase
81
of the server (actually each time the config file is reloaded) *)
85
(** Function to be called at the end of the initialisation phase *)
45
| Regexp of Netstring_pcre.regexp * string
46
* Ocsigen_lib.yesnomaybe (* full url *)
47
* bool (* temporary *)
91
51
(*****************************************************************************)
92
52
(** The function that will generate the pages from the request. *)
93
let gen dir charset = function
94
| Ocsigen_extensions.Req_found (_, r) -> Lwt.return (Ocsigen_extensions.Ext_found r)
95
| Ocsigen_extensions.Req_not_found (err, ri) ->
97
(* Is it a redirection? *)
99
Ocsigen_messages.debug2 "--Redirectmod: Is it a redirection?";
102
(match ri.ri_get_params_string with
103
| None -> ri.ri_sub_path_string
104
| Some g -> ri.ri_sub_path_string ^ "?" ^ g)
106
Ocsigen_messages.debug (fun () ->
107
"--Redirectmod: YES! "^
108
(if temp then "Temporary " else "Permanent ")^
109
"redirection to: "^redir);
110
let empty_result = Ocsigen_http_frame.empty_result () in
116
Ocsigen_http_frame.res_location = Some redir;
117
Ocsigen_http_frame.res_code= if temp then 302 else 301}))
120
| Not_concerned -> return (Ext_next err)
53
let gen dir = function
54
| Ocsigen_extensions.Req_found _ ->
55
Lwt.return Ocsigen_extensions.Ext_do_nothing
56
| Ocsigen_extensions.Req_not_found (err, ri) ->
58
(* Is it a redirection? *)
60
Ocsigen_messages.debug2 "--Redirectmod: Is it a redirection?";
61
let Regexp (regexp, dest, full, temp) = dir in
64
Ocsigen_extensions.find_redirection
68
ri.request_info.ri_ssl
69
ri.request_info.ri_host
70
ri.request_info.ri_server_port
71
ri.request_info.ri_get_params_string
72
ri.request_info.ri_sub_path_string
73
ri.request_info.ri_full_path_string
76
| Ocsigen_lib.Yes -> fi true
77
| Ocsigen_lib.No -> fi false
78
| Ocsigen_lib.Maybe ->
80
with Ocsigen_extensions.Not_concerned -> fi true
82
Ocsigen_messages.debug
84
"--Redirectmod: YES! "^
85
(if temp then "Temporary " else "Permanent ")^
86
"redirection to: "^redir);
87
let empty_result = Ocsigen_http_frame.empty_result () in
93
Ocsigen_http_frame.res_location = Some redir;
94
Ocsigen_http_frame.res_code=
95
if temp then 302 else 301}))
98
| Ocsigen_extensions.Not_concerned -> return (Ext_next err)
126
104
(*****************************************************************************)
127
(** Configuration for each site.
128
These tags are inside <site ...>...</site> in the config file.
132
<redirect regexp="" dest="" />
137
let parse_config path charset _ parse_site = function
106
let parse_config = function
138
107
| Element ("redirect", atts, []) ->
139
let dir = match atts with
141
raise (Error_in_config_file
142
"regexp attribute expected for <redirect>")
143
| [("regexp", s);("dest",t)] ->
144
Regexp ((Netstring_pcre.regexp ("^"^s^"$")), t, false)
145
| [("temporary", "temporary");("regexp", s);("dest",t)] ->
146
Regexp ((Netstring_pcre.regexp ("^"^s^"$")), t, true)
147
| _ -> raise (Error_in_config_file "Wrong attribute for <redirect>")
108
let rec parse_attrs ((r, f, d, temp) as res) = function
110
| ("regexp", regexp)::l when r = None -> (* deprecated *)
112
(Some (Netstring_pcre.regexp ("^"^regexp^"$")), Ocsigen_lib.Maybe,
115
| ("fullurl", regexp)::l when r = None ->
117
(Some (Netstring_pcre.regexp ("^"^regexp^"$")), Ocsigen_lib.Yes,
120
| ("suburl", regexp)::l when r = None ->
122
(Some (Netstring_pcre.regexp ("^"^regexp^"$")), Ocsigen_lib.No,
125
| ("dest", dest)::l when d = None ->
127
(r, f, Some dest, temp)
129
| ("temporary", "temporary")::l ->
133
| _ -> raise (Error_in_config_file "Wrong attribute for <redirect>")
136
match parse_attrs (None, Ocsigen_lib.Yes, None, true) atts with
138
raise (Error_in_config_file
139
"Missing attribute regexp for <redirect>")
141
raise (Error_in_config_file
142
"Missing attribute dest for <redirect>>")
143
| (Some r, full, Some d, temp) ->
144
Regexp (r, d, full, temp)
147
| Element ("redirect" as s, _, _) -> badconfig "Bad syntax for tag %s" s
150
149
| Element (t, _, _) ->
151
150
raise (Bad_config_tag_for_extension t)
152
151
| _ -> raise (Error_in_config_file "(redirectmod extension) Bad data")
added
removed
extensions/redirectmod.ml
