http/ocsigen_charset_mime.ml

   1 module MapString = Map.Make(String)
   2 type extension = string
   3 type filename = string
   4 type file = string
   5
   6
   7 type 'a assoc_item =
   8   | Extension of extension * 'a
   9   | File of filename * 'a
  10   | Regexp of Netstring_pcre.regexp * 'a
  11   | Map of 'a MapString.t
  12
  13 type 'a assoc = {
  14   assoc_list: 'a assoc_item list;
  15   assoc_default: 'a
  16 }
  17
  18 let find_in_assoc file assoc =
  19   let filename = Filename.basename file in
  20   let ext =
  21     try String.lowercase (Ocsigen_lib.extension_no_directory file)
  22     with Not_found -> ""
  23   in
  24   let rec aux = function
  25     | [] -> assoc.assoc_default
  26     | Extension (ext', v) :: q ->
  27         if ext = ext' then v else aux q
  28     | File (filename', v) :: q ->
  29         if filename = filename' then v else aux q
  30     | Regexp (reg, v) :: q ->
  31         if Netstring_pcre.string_match reg file 0 <> None then v else aux q
  32     | Map m :: q ->
  33         try MapString.find ext m
  34         with Not_found -> aux q
  35   in
  36   aux assoc.assoc_list
  37
  38
  39 let default assoc = assoc.assoc_default
  40
  41 let set_default assoc default = { assoc with assoc_default = default }
  42
  43 let update_ext assoc (ext : extension) v =
  44   { assoc with assoc_list =
  45       Extension (String.lowercase ext, v) :: assoc.assoc_list}
  46
  47 let update_file assoc (file : filename) v =
  48   { assoc with assoc_list = File (file, v) :: assoc.assoc_list}
  49
  50 let update_regexp assoc r v =
  51   { assoc with assoc_list = Regexp (r, v) :: assoc.assoc_list}
  52
  53
  54 let empty default () = {
  55   assoc_list = [];
  56   assoc_default = default
  57 }
  58
  59
  60 (* Handling of charset and mime ; specific values and declarations *)
  61
  62 type charset = string
  63 type mime_type = string
  64
  65 type charset_assoc = charset assoc
  66 type mime_assoc = mime_type assoc
  67
  68 let no_charset : charset = ""
  69 let default_mime_type : mime_type = "application/octet-stream"
  70
  71 let empty_charset_assoc ?(default=no_charset) = empty default
  72 let empty_mime_assoc ?(default=default_mime_type) = empty default
  73
  74 (* Generic functions *)
  75
  76 let default_charset = default
  77 let default_mime = default
  78
  79 let update_charset_ext = update_ext
  80 let update_mime_ext = update_ext
  81
  82 let update_charset_file = update_file
  83 let update_mime_file = update_file
  84
  85 let update_charset_regexp = update_regexp
  86 let update_mime_regexp = update_regexp
  87
  88 let set_default_mime = set_default
  89 let set_default_charset = set_default
  90
  91 let find_charset = find_in_assoc
  92 let find_mime = find_in_assoc
  93
  94
  95 (* Specific handling of content-type *)
  96
  97
  98 let parse_mime_types ~filename : mime_type assoc =
  99   let rec read_and_split mimemap in_ch =
 100     try
 101       let line = input_line in_ch in
 102       let line_upto =
 103         try
 104           let upto = String.index line '#' in
 105           String.sub line 0 upto
 106         with Not_found -> line
 107       in
 108       let strlist =
 109         Netstring_pcre.split (Netstring_pcre.regexp "\\s+") line_upto
 110       in
 111       match  strlist with
 112       | [] | [_] -> (* No extension on this line *) read_and_split mimemap in_ch
 113       | mime :: extensions ->
 114           let mimemap =
 115             List.fold_left (fun mimemap ext ->
 116                               MapString.add ext mime mimemap) mimemap extensions
 117           in
 118           read_and_split mimemap in_ch
 119     with End_of_file -> mimemap
 120   in
 121   { assoc_list =
 122       [ Map(try
 123               let in_ch = open_in filename in
 124               let map =
 125                 (try
 126                    read_and_split MapString.empty in_ch
 127                  with e -> close_in in_ch; raise e)
 128               in
 129               close_in in_ch;
 130               map
 131             with Sys_error _ -> MapString.empty
 132            )];
 133     assoc_default = default_mime_type;
 134   }
 135
 136
 137 let default_mime_assoc () =
 138   let parsed = ref None in
 139   match !parsed with
 140     | None ->
 141         let file = Ocsigen_config.get_mimefile () in
 142         Ocsigen_messages.debug
 143           (fun () -> Printf.sprintf "Loading mime types in '%s'" file);
 144         let map = parse_mime_types file in
 145         parsed := Some map;
 146         map
 147     | Some map -> map