src/client/private/eliommod_cookies.ml

   1 (* Ocsigen
   2  * http://www.ocsigen.org
   3  * Copyright (C) 2010 Vincent Balat
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU Lesser General Public License as published by
   7  * the Free Software Foundation, with linking exception;
   8  * either version 2.1 of the License, or (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  18  *)
  19
  20 open Eliom_pervasives
  21 open Ocsigen_cookies
  22
  23 include Eliom_cookies_base
  24
  25 let cookie_table = ref Cookies.empty
  26
  27 let now () =
  28   let date = jsnew Js.date_now () in
  29   Js.to_float (date##getTime ())
  30
  31 let update_cookie_table cookieset =
  32   let now = now () in
  33   Cookies.iter
  34     (fun path table ->
  35       CookiesTable.iter
  36         (fun name -> function
  37           | OSet (Some exp, _, _) when exp <= now ->
  38             cookie_table := remove_cookie path name !cookie_table
  39           | OUnset ->
  40             cookie_table := remove_cookie path name !cookie_table
  41           | OSet (exp, value, secure) ->
  42             cookie_table :=
  43               add_cookie
  44               path name (exp, value, secure)
  45               !cookie_table)
  46         table
  47     )
  48     cookieset
  49
  50 let get_cookies_to_send https path =
  51   let now = now () in
  52   Cookies.fold
  53     (fun cpath t cookies_to_send ->
  54       if List.is_prefix_skip_end_slash
  55           (Url.remove_slash_at_beginning cpath)
  56           (Url.remove_slash_at_beginning path)
  57       then CookiesTable.fold
  58         (fun name (exp, value, secure) cookies_to_send ->
  59           match exp with
  60             | Some exp when exp <= now ->
  61               cookie_table :=
  62                 remove_cookie cpath name !cookie_table;
  63               cookies_to_send
  64             | _ ->
  65               if (not secure) || https
  66               then (name,value)::cookies_to_send
  67               else cookies_to_send
  68         )
  69         t
  70         cookies_to_send
  71       else cookies_to_send
  72     )
  73     !cookie_table
  74     []