1
module MapString = Map.Make(String)
2
type extension = string
8
| Extension of extension * 'a
9
| File of filename * 'a
10
| Regexp of Netstring_pcre.regexp * 'a
11
| Map of 'a MapString.t
14
assoc_list: 'a assoc_item list;
18
let find_in_assoc file assoc =
19
let filename = Filename.basename file in
21
try String.lowercase (Ocsigen_lib.extension_no_directory file)
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
33
try MapString.find ext m
34
with Not_found -> aux q
39
let default assoc = assoc.assoc_default
41
let set_default assoc default = { assoc with assoc_default = default }
43
let update_ext assoc (ext : extension) v =
44
{ assoc with assoc_list =
45
Extension (String.lowercase ext, v) :: assoc.assoc_list}
47
let update_file assoc (file : filename) v =
48
{ assoc with assoc_list = File (file, v) :: assoc.assoc_list}
50
let update_regexp assoc r v =
51
{ assoc with assoc_list = Regexp (r, v) :: assoc.assoc_list}
54
let empty default () = {
56
assoc_default = default
60
(* Handling of charset and mime ; specific values and declarations *)
63
type mime_type = string
65
type charset_assoc = charset assoc
66
type mime_assoc = mime_type assoc
68
let no_charset : charset = ""
69
let default_mime_type : mime_type = "application/octet-stream"
71
let empty_charset_assoc ?(default=no_charset) = empty default
72
let empty_mime_assoc ?(default=default_mime_type) = empty default
74
(* Generic functions *)
76
let default_charset = default
77
let default_mime = default
79
let update_charset_ext = update_ext
80
let update_mime_ext = update_ext
82
let update_charset_file = update_file
83
let update_mime_file = update_file
85
let update_charset_regexp = update_regexp
86
let update_mime_regexp = update_regexp
88
let set_default_mime = set_default
89
let set_default_charset = set_default
91
let find_charset = find_in_assoc
92
let find_mime = find_in_assoc
95
(* Specific handling of content-type *)
98
let parse_mime_types ~filename : mime_type assoc =
99
let rec read_and_split mimemap in_ch =
101
let line = input_line in_ch in
104
let upto = String.index line '#' in
105
String.sub line 0 upto
106
with Not_found -> line
109
Netstring_pcre.split (Netstring_pcre.regexp "\\s+") line_upto
112
| [] | [_] -> (* No extension on this line *) read_and_split mimemap in_ch
113
| mime :: extensions ->
115
List.fold_left (fun mimemap ext ->
116
MapString.add ext mime mimemap) mimemap extensions
118
read_and_split mimemap in_ch
119
with End_of_file -> mimemap
123
let in_ch = open_in filename in
126
read_and_split MapString.empty in_ch
127
with e -> close_in in_ch; raise e)
131
with Sys_error _ -> MapString.empty
133
assoc_default = default_mime_type;
137
let default_mime_assoc () =
138
let parsed = ref None in
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