http/http_headers.ml

   1 (* Ocsigen
   2  * http://www.ocsigen.org
   3  * Module http_headers.mli
   4  * Copyright (C) 2007 Jérôme Vouillon
   5  * Laboratoire PPS - CNRS Université Paris Diderot
   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 type name = string
  23 let name s = String.lowercase s
  24 let name_to_string s = s
  25
  26 let accept = name "Accept"
  27 let accept_charset = name "Accept-Charset"
  28 let accept_encoding = name "Accept-Encoding"
  29 let accept_language = name "Accept-Language"
  30 let accept_ranges = name "Accept-Ranges"
  31 let cache_control = name "Cache-Control"
  32 let connection = name "Connection"
  33 let content_encoding = name "Content-Encoding"
  34 let content_range = name "Content-Range"
  35 let content_length = name "Content-Length"
  36 let content_type = name "Content-Type"
  37 let cookie = name "Cookie"
  38 let date = name "Date"
  39 let etag = name "ETag"
  40 let expires = name "Expires"
  41 let host = name "Host"
  42 let if_match = name "If-Match"
  43 let if_modified_since = name "If-Modified-Since"
  44 let if_none_match = name "If-None-Match"
  45 let if_unmodified_since = name "If-Unmodified-Since"
  46 let if_range = name "If-Range"
  47 let last_modified = name "Last-Modified"
  48 let location = name "Location"
  49 let server = name "Server"
  50 let set_cookie = name "Set-Cookie"
  51 let status = name "Status"
  52 let transfer_encoding = name "Transfer-Encoding"
  53 let user_agent = name "User-Agent"
  54 let referer = name "Referer"
  55 let range = name "Range"
  56
  57 module NameHtbl =
  58   Hashtbl.Make
  59     (struct
  60        type t = name
  61        let equal (n : string) n' = n = n'
  62        let hash = Hashtbl.hash
  63      end)
  64
  65 (****)
  66
  67 module Map = Map.Make (String)
  68
  69 type t = string list Map.t
  70
  71 let empty = Map.empty
  72
  73 let find_all n h = List.rev (Map.find n h)
  74
  75 (*XXX We currently return the last header.
  76   Should we fail if there is more than one? *)
  77 let find n h =
  78   match Map.find n h with
  79     v :: _ -> v
  80   | _      -> assert false
  81
  82 let replace n v h = Map.add n [v] h
  83
  84 let replace_opt n v h =
  85  match v with
  86    None   -> Map.remove n h
  87  | Some v -> replace n v h
  88
  89 let add n v h =
  90   let vl = try find_all n h with Not_found -> [] in
  91   Map.add n (v :: vl) h
  92
  93 let iter f h =
  94   Map.iter
  95     (fun n vl ->
  96        match vl with
  97          [v] -> f n v
  98        | _   -> List.iter (fun v -> f n v) (List.rev vl))
  99     h
 100
 101 let fold f h acc =
 102   Map.fold
 103     (fun n vl acc -> f n (List.rev vl) acc)
 104     h acc
 105
 106 let with_defaults h h' = Map.fold Map.add h h'
 107
 108
 109
 110 (****)
 111 let (<<) h (n, v) = replace n v h
 112
 113 let dyn_headers =
 114   empty
 115   << (cache_control, "no-cache")
 116   << (expires, "0")
 117