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

« back to all changes in this revision

Viewing changes to http/ocsigen_charset_mime.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:
 
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