Source file ocsigen_charset_mime.ml

(* Ocsigen
 * http://www.ocsigen.org
 * ocsigen_charset_mime.ml Copyright (C) 2008
 * Boris Yakobowski
 * Laboratoire PPS - CNRS Université Paris Diderot
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)

open Ocsigen_lib

module MapString = Map.Make(String)
type extension = string
type filename = string
type file = string

let section = Lwt_log.Section.make "ocsigen:mimetype"

type 'a assoc_item =
  | Extension of extension * 'a
  | File of filename * 'a
  | Regexp of Pcre.regexp * 'a
  | Map of 'a MapString.t

type 'a assoc = {
  assoc_list: 'a assoc_item list;
  assoc_default: 'a
}

let find_in_assoc file assoc =
  let filename = Filename.basename file in
  let ext =
    try String.lowercase_ascii (Filename.extension_no_directory file)
    with Not_found -> ""
  in
  let rec aux = function
    | [] -> assoc.assoc_default
    | Extension (ext', v) :: q ->
      if ext = ext' then v else aux q
    | File (filename', v) :: q ->
      if filename = filename' then v else aux q
    | Regexp (reg, v) :: q ->
      if Netstring_pcre.string_match reg file 0 <> None then v else aux q
    | Map m :: q ->
      try MapString.find ext m
      with Not_found -> aux q
  in
  aux assoc.assoc_list


let default assoc = assoc.assoc_default

let set_default assoc default = { assoc with assoc_default = default }

let update_ext assoc (ext : extension) v =
  { assoc with assoc_list =
                 Extension (String.lowercase_ascii ext, v) :: assoc.assoc_list}

let update_file assoc (file : filename) v =
  { assoc with assoc_list = File (file, v) :: assoc.assoc_list}

let update_regexp assoc r v =
  { assoc with assoc_list = Regexp (r, v) :: assoc.assoc_list}


let empty default () = {
  assoc_list = [];
  assoc_default = default
}


(* Handling of charset and mime ; specific values and declarations *)

type charset = string
type mime_type = string

type charset_assoc = charset assoc
type mime_assoc = mime_type assoc

let no_charset : charset = ""
let default_mime_type : mime_type = "application/octet-stream"

let empty_charset_assoc ?(default=no_charset) = empty default
let empty_mime_assoc ?(default=default_mime_type) = empty default

(* Generic functions *)

let default_charset = default
let default_mime = default

let update_charset_ext = update_ext
let update_mime_ext = update_ext

let update_charset_file = update_file
let update_mime_file = update_file

let update_charset_regexp = update_regexp
let update_mime_regexp = update_regexp

let set_default_mime = set_default
let set_default_charset = set_default

let find_charset = find_in_assoc
let find_mime = find_in_assoc


(* Specific handling of content-type *)


let parse_mime_types ~filename : mime_type assoc =
  let rec read_and_split mimemap in_ch =
    try
      let line = input_line in_ch in
      let line_upto =
        try
          let upto = String.index line '#' in
          String.sub line 0 upto
        with Not_found -> line
      in
      let strlist =
        Netstring_pcre.split (Netstring_pcre.regexp "\\s+") line_upto
      in
      match  strlist with
      | [] | [_] -> (* No extension on this line *) read_and_split mimemap in_ch
      | mime :: extensions ->
        let mimemap =
          List.fold_left (fun mimemap ext ->
              MapString.add ext mime mimemap) mimemap extensions
        in
        read_and_split mimemap in_ch
    with End_of_file -> mimemap
  in
  { assoc_list =
      [ Map(try
              let in_ch = open_in filename in
              let map =
                (try
                   read_and_split MapString.empty in_ch
                 with e -> close_in in_ch; raise e)
              in
              close_in in_ch;
              map
            with exn ->
                    Lwt_log.ign_error ~section ~exn
               "unable to read the mime.types file";
                   MapString.empty
           )];
    assoc_default = default_mime_type;
  }


let default_mime_assoc () =
  let parsed = ref None in
  match !parsed with
    | None ->
        let filename = !Ocsigen_config_static.mimefile in
        Lwt_log.ign_info_f ~section "Loading mime types in '%s'" filename;
        let map = parse_mime_types ~filename in
        parsed := Some map;
        map
    | Some map -> map