extensions/rewritemod.ml

   1 (* Ocsigen
   2  * http://www.ocsigen.org
   3  * Module rewritemod.ml
   4  * Copyright (C) 2008 Vincent Balat
   5  * CNRS - Université Paris Diderot Paris 7
   6  *
   7  * This program is free software; you can redistribute it and/or modify
   8  * it under the terms of the GNU Lesser General Public License as published by
   9  * the Free Software Foundation, with linking exception;
  10  * either version 2.1 of the License, or (at your option) any later version.
  11  *
  12  * This program is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU Lesser General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU Lesser General Public License
  18  * along with this program; if not, write to the Free Software
  19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  20  *)
  21 (*****************************************************************************)
  22 (*****************************************************************************)
  23 (* Ocsigen extension for rewriteing URLs                                     *)
  24 (* in the configuration file                                                 *)
  25 (*****************************************************************************)
  26 (*****************************************************************************)
  27
  28 (* IMPORTANT WARNING
  29    It is really basic for now:
  30     - rewrites only subpaths (and do not change get parameters)
  31     - changes only ri_sub_path and ri_sub_path_tring
  32    not ri_full_path and ri_full_path_string and ri_url_string and ri_url
  33    This is probably NOT what we want ...
  34 *)
  35
  36
  37
  38 (* To compile it:
  39 ocamlfind ocamlc  -thread -package netstring,ocsigen -c extensiontemplate.ml
  40
  41 Then load it dynamically from Ocsigen's config file:
  42    <extension module=".../rewritemod.cmo"/>
  43
  44 *)
  45
  46 open Lwt
  47 open Ocsigen_extensions
  48 open Simplexmlparser
  49
  50
  51 exception Not_concerned
  52
  53
  54 (*****************************************************************************)
  55 (* The table of rewrites for each virtual server                             *)
  56 type assockind =
  57   | Regexp of Netstring_pcre.regexp * string * bool
  58
  59
  60
  61 (*****************************************************************************)
  62 (* Finding rewrites *)
  63
  64 let find_rewrite (Regexp (regexp, dest, fullrewrite)) suburl =
  65   (match Netstring_pcre.string_match regexp suburl 0 with
  66      | None -> raise Not_concerned
  67      | Some _ -> (* Matching regexp found! *)
  68          Netstring_pcre.global_replace regexp dest suburl), fullrewrite
  69
  70
  71
  72
  73
  74
  75 (*****************************************************************************)
  76 (** The function that will generate the pages from the request. *)
  77 let gen regexp = function
  78 | Ocsigen_extensions.Req_found _ ->
  79     Lwt.return Ocsigen_extensions.Ext_do_nothing
  80 | Ocsigen_extensions.Req_not_found (err, ri) ->
  81   catch
  82     (* Is it a rewrite? *)
  83     (fun () ->
  84       Ocsigen_messages.debug2 "--Rewritemod: Is it a rewrite?";
  85       let redir, fullrewrite =
  86         let ri = ri.request_info in
  87         find_rewrite regexp
  88           (match ri.ri_get_params_string with
  89              | None -> ri.ri_sub_path_string
  90              | Some g -> ri.ri_sub_path_string ^ "?" ^ g)
  91       in
  92       Ocsigen_messages.debug (fun () ->
  93         "--Rewritemod: YES! rewrite to: "^redir);
  94       return
  95         (Ext_retry_with
  96            ({ ri with request_info =
  97                 Ocsigen_extensions.ri_of_url
  98                   ~full_rewrite:fullrewrite
  99                   redir ri.request_info },
 100             Ocsigen_http_frame.Cookies.empty)
 101         )
 102     )
 103     (function
 104       | Not_concerned -> return (Ext_next err)
 105       | e -> fail e)
 106
 107
 108
 109
 110 (*****************************************************************************)
 111
 112 let parse_config = function
 113   | Element ("rewrite", atts, []) ->
 114       let regexp = match atts with
 115       | [] ->
 116           raise (Error_in_config_file
 117                    "regexp attribute expected for <rewrite>")
 118       | [("regexp", s); ("url", t)]
 119       | [("regexp", s); ("dest", t)] ->
 120           Regexp ((Netstring_pcre.regexp ("^"^s^"$")), t, false)
 121       | [("regexp", s); ("url", t); ("fullrewrite", "fullrewrite")]
 122       | [("regexp", s); ("dest", t); ("fullrewrite", "fullrewrite")] ->
 123           Regexp ((Netstring_pcre.regexp ("^"^s^"$")), t, true)
 124       | _ -> raise (Error_in_config_file "Wrong attribute for <rewrite>")
 125       in
 126       gen regexp
 127   | Element (t, _, _) ->
 128       raise (Bad_config_tag_for_extension t)
 129   | _ -> raise (Error_in_config_file "(rewritemod extension) Bad data")
 130
 131
 132
 133
 134 (*****************************************************************************)
 135 (** Registration of the extension *)
 136 let () = register_extension
 137   ~name:"rewritemod"
 138   ~fun_site:(fun _ _ _ _ -> parse_config)
 139   ~user_fun_site:(fun _ _ _ _ _ -> parse_config)
 140   ()