diff --git a/.ocamlformat b/.ocamlformat index 64d0472..f7747f8 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.19.0 +version=0.26.2 break-cases = fit break-collection-expressions = fit-or-vertical break-fun-decl = wrap diff --git a/ocsipersist-dbm-config.opam b/ocsipersist-dbm-config.opam new file mode 100644 index 0000000..769cf91 --- /dev/null +++ b/ocsipersist-dbm-config.opam @@ -0,0 +1,20 @@ +opam-version: "2.0" +name: "ocsipersist-dbm-config" +version: "2.0.0" +authors: "The Ocsigen team " +maintainer: "Jan Rochel " +license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" +synopsis: "Ocsigen Server configuration file extension for ocsipersist-dbm" +description: "Load this package from Ocsigen Server's configuration file if you want to use the DBM storage backend." + +homepage: "https://github.com/ocsigen/ocsipersist" +bug-reports: "https://github.com/ocsigen/ocsipersist/issues" +dev-repo: "git+https://github.com/ocsigen/ocsipersist.git" +build: [ "dune" "build" "-p" name "-j" jobs ] + +depends: [ + "dune" {>= "2.9"} + "xml-light" + "ocsigenserver" {>= "3.0.0"} + "ocsipersist-dbm" {>= "2.0.0" & < "2.1.0"} +] diff --git a/ocsipersist-dbm.opam b/ocsipersist-dbm.opam index 347d61a..4ad8ea4 100644 --- a/ocsipersist-dbm.opam +++ b/ocsipersist-dbm.opam @@ -1,11 +1,11 @@ opam-version: "2.0" name: "ocsipersist-dbm" -version: "1.1.0" +version: "2.0.0" authors: "The Ocsigen team " maintainer: "Jan Rochel " license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -synopsis: "Persistent key/value storage (for Ocsigen) using DBM" -description: "This library provides a DBM backend for the unified key/value storage frontend as defined in the ocsipersist package. Ocsipersist is used pervasively in Eliom/Ocsigen to handle sessions and references. It can be used as an extension for ocsigenserver or as a library." +synopsis: "Persistent key/value storage for OCaml using DBM" +description: "This library provides a DBM backend for the unified key/value storage frontend as defined in the ocsipersist package." homepage: "https://github.com/ocsigen/ocsipersist" bug-reports: "https://github.com/ocsigen/ocsipersist/issues" @@ -16,8 +16,6 @@ depends: [ "dune" {>= "2.9"} "lwt" {>= "4.2.0"} "lwt_log" - "xml-light" - "ocsigenserver" {>= "3.0.0"} - "ocsipersist-lib" {>= "1.1.0" & < "1.2.0"} + "ocsipersist" {>= "2.0.0" & < "2.1.0"} "dbm" ] diff --git a/ocsipersist-lib.opam b/ocsipersist-lib.opam index 5ae0b7c..d648722 100644 --- a/ocsipersist-lib.opam +++ b/ocsipersist-lib.opam @@ -1,10 +1,10 @@ opam-version: "2.0" name: "ocsipersist-lib" -version: "1.1.0" +version: "2.0.0" authors: "The Ocsigen team " maintainer: "Jan Rochel " license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -synopsis: "Persistent key/value storage (for Ocsigen) - support library" +synopsis: "Persistent key/value storage for OCaml - support library" description: "This library defines signatures and auxiliary tools for defining backends for the Ocsipersist frontent. Ocsipersist is used pervasively in Eliom/Ocsigen to handle sessions and references. It can be used as an extension for ocsigenserver or as a library. Implementations of the following backends currently exist: DBM, PostgreSQL, SQLite." homepage: "https://github.com/ocsigen/ocsipersist" diff --git a/ocsipersist-pgsql-config.opam b/ocsipersist-pgsql-config.opam new file mode 100644 index 0000000..f92da82 --- /dev/null +++ b/ocsipersist-pgsql-config.opam @@ -0,0 +1,20 @@ +opam-version: "2.0" +name: "ocsipersist-pgsql-config" +version: "2.0.0" +authors: "The Ocsigen team " +maintainer: "Jan Rochel " +license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" +synopsis: "Ocsigen Server configuration file extension for ocsipersist-pgsql" +description: "Load this package from Ocsigen Server's configuration file if you want to use the PostgreSQL storage backend." + +homepage: "https://github.com/ocsigen/ocsipersist" +bug-reports: "https://github.com/ocsigen/ocsipersist/issues" +dev-repo: "git+https://github.com/ocsigen/ocsipersist.git" +build: [ "dune" "build" "-p" name "-j" jobs ] + +depends: [ + "dune" {>= "2.9"} + "xml-light" + "ocsigenserver" {>= "3.0.0"} + "ocsipersist-pgsql" {>= "2.0.0" & < "2.1.0"} +] diff --git a/ocsipersist-pgsql.opam b/ocsipersist-pgsql.opam index 98ef526..d228a59 100644 --- a/ocsipersist-pgsql.opam +++ b/ocsipersist-pgsql.opam @@ -1,11 +1,11 @@ opam-version: "2.0" name: "ocsipersist-pgsql" -version: "1.1.0" +version: "2.0.0" authors: "The Ocsigen team " maintainer: "Jan Rochel " license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -synopsis: "Persistent key/value storage (for Ocsigen) using PostgreSQL" -description: "This library provides a PostgreSQL backend for the unified key/value storage frontend as defined in the ocsipersist package. Ocsipersist is used pervasively in Eliom/Ocsigen to handle sessions and references. It can be used as an extension for ocsigenserver or as a library." +synopsis: "Persistent key/value storage for OCaml using PostgreSQL" +description: "This library provides a PostgreSQL backend for the unified key/value storage frontend as defined in the ocsipersist package." homepage: "https://github.com/ocsigen/ocsipersist" bug-reports: "https://github.com/ocsigen/ocsipersist/issues" @@ -16,8 +16,6 @@ depends: [ "dune" {>= "2.9"} "lwt" {>= "4.2.0"} "lwt_log" - "xml-light" - "ocsigenserver" {>= "3.0.0"} - "ocsipersist-lib" {>= "1.1.0" & < "1.2.0"} + "ocsipersist" {>= "2.0.0" & < "2.1.0"} "pgocaml" ] diff --git a/ocsipersist-sqlite-config.opam b/ocsipersist-sqlite-config.opam new file mode 100644 index 0000000..8b39783 --- /dev/null +++ b/ocsipersist-sqlite-config.opam @@ -0,0 +1,20 @@ +opam-version: "2.0" +name: "ocsipersist-sqlite-config" +version: "2.0.0" +authors: "The Ocsigen team " +maintainer: "Jan Rochel " +license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" +synopsis: "Ocsigen Server configuration file extension for ocsipersist-sqlite" +description: "Load this package from Ocsigen Server's configuration file if you want to use the SQLite storage backend." + +homepage: "https://github.com/ocsigen/ocsipersist" +bug-reports: "https://github.com/ocsigen/ocsipersist/issues" +dev-repo: "git+https://github.com/ocsigen/ocsipersist.git" +build: [ "dune" "build" "-p" name "-j" jobs ] + +depends: [ + "dune" {>= "2.9"} + "xml-light" + "ocsigenserver" {>= "3.0.0"} + "ocsipersist-sqlite" {>= "2.0.0" & < "2.1.0"} +] diff --git a/ocsipersist-sqlite.opam b/ocsipersist-sqlite.opam index c9f4f18..467ce31 100644 --- a/ocsipersist-sqlite.opam +++ b/ocsipersist-sqlite.opam @@ -1,11 +1,11 @@ opam-version: "2.0" name: "ocsipersist-sqlite" -version: "1.1.0" +version: "2.0.0" authors: "The Ocsigen team " maintainer: "Jan Rochel " license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -synopsis: "Persistent key/value storage (for Ocsigen) using SQLite" -description: "This library provides a SQLite backend for the unified key/value storage frontend as defined in the ocsipersist package. Ocsipersist is used pervasively in Eliom/Ocsigen to handle sessions and references. It can be used as an extension for ocsigenserver or as a library." +synopsis: "Persistent key/value storage for OCaml using SQLite" +description: "This library provides a SQLite backend for the unified key/value storage frontend as defined in the ocsipersist package." homepage: "https://github.com/ocsigen/ocsipersist" bug-reports: "https://github.com/ocsigen/ocsipersist/issues" @@ -16,8 +16,6 @@ depends: [ "dune" {>= "2.9"} "lwt" {>= "4.2.0"} "lwt_log" - "xml-light" - "ocsigenserver" {>= "3.0.0"} - "ocsipersist-lib" {>= "1.1.0" & < "1.2.0"} + "ocsipersist" {>= "2.0.0" & < "2.1.0"} "sqlite3" ] diff --git a/ocsipersist.opam b/ocsipersist.opam index cd404c9..adb213f 100644 --- a/ocsipersist.opam +++ b/ocsipersist.opam @@ -1,11 +1,11 @@ opam-version: "2.0" name: "ocsipersist" -version: "1.1.0" +version: "2.0.0" authors: "The Ocsigen team " maintainer: "Jan Rochel " license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -synopsis: "Persistent key/value storage (for Ocsigen) using multiple backends" -description: "This is an virtual library defining a unified frontend for a number of key/value storage implementations. Ocsipersist is used pervasively in Eliom/Ocsigen to handle sessions and references. It can be used as an extension for ocsigenserver or as a library. Implementations of the following backends currently exist: DBM, PostgreSQL, SQLite." +synopsis: "Persistent key-value storage for OCaml using multiple backends" +description: "This is an virtual library defining a unified frontend for a number of key-value storage implementations. Implementations of the following backends currently exist: DBM, PostgreSQL, SQLite." homepage: "https://github.com/ocsigen/ocsipersist" bug-reports: "https://github.com/ocsigen/ocsipersist/issues" @@ -15,18 +15,10 @@ build: [ "dune" "build" "-p" name "-j" jobs ] depends: [ "dune" {>= "2.9"} "lwt" {>= "4.2.0"} - "ocsigenserver" {>= "3.0.0"} - "ocsipersist-lib" {>= "1.1.0" & < "1.2.0"} + "ocsipersist-lib" {>= "2.0.0" & < "3.0.0"} ] - -depopts: [ - "ocsipersist-dbm" - "ocsipersist-pgsql" - "ocsipersist-sqlite" -] - conflicts: [ - "ocsipersist-dbm" {< "1.1.0" | >= "1.2.0"} - "ocsipersist-pgsql" {< "1.1.0" | >= "1.2.0"} - "ocsipersist-sqlite" {< "1.1.0" | >= "1.2.0"} + "ocsipersist-dbm" {< "2.0.0" | >= "2.1.0"} + "ocsipersist-pgsql" {< "2.0.0" | >= "2.1.0"} + "ocsipersist-sqlite" {< "2.0.0" | >= "2.1.0"} ] diff --git a/src/dbm/dune b/src/dbm/dune index 9c95dee..4129756 100644 --- a/src/dbm/dune +++ b/src/dbm/dune @@ -7,17 +7,41 @@ (library (name ocsipersist_dbm) - (public_name ocsipersist.dbm) + (public_name ocsipersist-dbm) (implements ocsipersist) - (modules ocsipersist) + (modules + :standard + \ + ocsipersist_config + ocsidbm + ocsidbmtypes + ocsipersist_settings) (libraries dbm lwt_log - xml-light ocsipersist_dbmtypes - ocsigenserver - ocsipersist_lib) - (optional)) + ocsipersist_lib + ocsipersist_dbm_settings)) + +; Configuration functions (part of ocsipersist-dbm package): + +(library + (name ocsipersist_dbm_settings) + (public_name ocsipersist-dbm.settings) + (wrapped false) + (modules ocsipersist_settings) + (libraries lwt lwt.unix)) + +; Configuration through Ocsigen Server config file: + +(library + (name ocsipersist_dbm_config) + (public_name ocsipersist-dbm-config) + (modules ocsipersist_config) + (wrapped false) + (libraries xml-light ocsipersist_dbm ocsigenserver)) + +; DBM server: (executable (public_name ocsidbm) diff --git a/src/dbm/index.mld b/src/dbm/index.mld index e0f3dc3..9aab666 100644 --- a/src/dbm/index.mld +++ b/src/dbm/index.mld @@ -1,14 +1,19 @@ {0 ocsipersist-dbm} -For the API documentation see OPAM package [ocsipersist]. - -Here we document the configuration options of the ocsigenserver extension. -All sub-tags of the [extension] tag are optional. - -{[ - - - - - -]} +DBM backend for Ocsipersist. +For the API documentation see OPAM package {{:../ocsipersist/Ocsipersist/index.html}ocsipersist}. +This page describes how to configure the DBM backend. +The DBM backend uses a server process [ocsidbm]. + +{1 Using as a library} + +If you are not using Ocsigen Server's configuration file, +add library [ocsipersist-dbm.settings] in your Dune file, and +use module {!Ocsipersist_settings} +to configure the storage file. + +{1 Using with Ocsigen Server: ocsipersist-dbm-config} + +If you want to configure Ocsipersist-dbm from Ocsigen Server's +configuration file, use package +{{:../ocsipersist-dbm-config/Ocsipersist_config/index.html}ocsipersist-dbm-config}. diff --git a/src/dbm/ocsidbm.ml b/src/dbm/ocsidbm.ml index 1f8bf03..ab90276 100644 --- a/src/dbm/ocsidbm.ml +++ b/src/dbm/ocsidbm.ml @@ -47,10 +47,10 @@ let errlog s = (** Internal functions: storage in files using DBM *) module Tableoftables = Map.Make (struct - type t = string + type t = string - let compare = compare -end) + let compare = compare + end) let tableoftables = ref Tableoftables.empty @@ -138,8 +138,8 @@ let db_length t = let rec aux f n = Lwt.catch (fun () -> - ignore (f table); - Lwt.pause () >>= fun () -> aux Dbm.nextkey (n + 1)) + ignore (f table); + Lwt.pause () >>= fun () -> aux Dbm.nextkey (n + 1)) (function Not_found -> Lwt.return n | e -> Lwt.fail e) in aux Dbm.firstkey 0 @@ -189,34 +189,32 @@ let execute outch = function | Get (t, k) -> handle_errors (fun () -> - try send outch (Value (db_get t k)) - with Not_found -> send outch Dbm_not_found) + try send outch (Value (db_get t k)) + with Not_found -> send outch Dbm_not_found) | Remove (t, k) -> handle_errors (fun () -> db_remove t k; send outch Ok) | Replace (t, k, v) -> handle_errors (fun () -> db_replace t k v; send outch Ok) | Replace_if_exists (t, k, v) -> handle_errors (fun () -> - try - ignore (db_get t k); - db_replace t k v; - send outch Ok - with Not_found -> send outch Dbm_not_found) + try + ignore (db_get t k); + db_replace t k v; + send outch Ok + with Not_found -> send outch Dbm_not_found) | Firstkey t -> handle_errors (fun () -> - try send outch (Key (db_firstkey t)) - with Not_found -> send outch End) + try send outch (Key (db_firstkey t)) with Not_found -> send outch End) | Nextkey t -> handle_errors (fun () -> - try send outch (Key (db_nextkey t)) with Not_found -> send outch End) + try send outch (Key (db_nextkey t)) with Not_found -> send outch End) | Length t -> handle_errors (fun () -> - Lwt.catch - (fun () -> - db_length t >>= fun i -> - send outch (Value (Marshal.to_string i []))) - (function - | Not_found -> send outch Dbm_not_found - | e -> send outch (Error e))) + Lwt.catch + (fun () -> + db_length t >>= fun i -> + send outch (Value (Marshal.to_string i []))) + (function + | Not_found -> send outch Dbm_not_found | e -> send outch (Error e))) let nb_clients = ref 0 @@ -246,13 +244,13 @@ let _ = (let socket = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in Lwt.catch (fun () -> - Lwt_unix.bind socket (Unix.ADDR_UNIX (directory ^ "/" ^ socketname))) + Lwt_unix.bind socket (Unix.ADDR_UNIX (directory ^ "/" ^ socketname))) (fun _exn -> - errlog - ("Please make sure that the directory " ^ directory - ^ " exists, writable for ocsidbm, and no other ocsidbm process is running on the same directory. If not, remove the file " - ^ directory ^ "/" ^ socketname); - the_end 1) + errlog + ("Please make sure that the directory " ^ directory + ^ " exists, writable for ocsidbm, and no other ocsidbm process is running on the same directory. If not, remove the file " + ^ directory ^ "/" ^ socketname); + the_end 1) >>= fun () -> Lwt_unix.listen socket 20; (* Done in ocsipersist.ml @@ -316,5 +314,4 @@ let _ = ) >>= f in ignore (f ()) - *) diff --git a/src/dbm/ocsipersist.ml b/src/dbm/ocsipersist.ml index 13e821a..c03ecb7 100644 --- a/src/dbm/ocsipersist.ml +++ b/src/dbm/ocsipersist.ml @@ -11,13 +11,7 @@ exception Ocsipersist_error let socketname = "socket" -module Config = struct - let directory, ocsidbm = - ref (Ocsigen_config.get_datadir () ^ "/ocsipersist"), ref "ocsidbm" - - let inch = ref (Lwt.fail (Failure "Ocsipersist not initialised")) - let outch = ref (Lwt.fail (Failure "Ocsipersist not initialised")) -end +module Config = Ocsipersist_settings module Aux = struct external sys_exit : int -> 'a = "caml_sys_exit" @@ -27,59 +21,58 @@ module Db = struct let try_connect sname = Lwt.catch (fun () -> - let socket = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in - Lwt_unix.connect socket (Unix.ADDR_UNIX sname) >>= fun () -> - Lwt.return socket) + let socket = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in + Lwt_unix.connect socket (Unix.ADDR_UNIX sname) >>= fun () -> + Lwt.return socket) (fun _ -> - Lwt_log.ign_warning_f ~section - "Launching a new Ocsidbm process: %s on directory %s." !Config.ocsidbm - !Config.directory; - let param = [|!Config.ocsidbm; !Config.directory|] in - let child () = - let log = - Unix.openfile - (Ocsigen_messages.error_log_path ()) - [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND] - 0o640 - in - Unix.dup2 log Unix.stderr; - Unix.close log; - let devnull = Unix.openfile "/dev/null" [Unix.O_WRONLY] 0 in - Unix.dup2 devnull Unix.stdout; - Unix.close devnull; - Unix.close Unix.stdin; - Unix.execvp !Config.ocsidbm param - in - let pid = Lwt_unix.fork () in - if pid = 0 - then - if (* double fork *) - Lwt_unix.fork () = 0 - then child () - else Aux.sys_exit 0 - else - Lwt_unix.waitpid [] pid >>= fun _ -> - Lwt_unix.sleep 1.1 >>= fun () -> - let socket = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in - Lwt_unix.connect socket (Unix.ADDR_UNIX sname) >>= fun () -> - Lwt.return socket) + Lwt_log.ign_warning_f ~section + "Launching a new Ocsidbm process: %s on directory %s." + !Config.ocsidbm !Config.directory; + let param = [|!Config.ocsidbm; !Config.directory|] in + let child () = + let log = + Unix.openfile !Config.error_log_path + [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND] + 0o640 + in + Unix.dup2 log Unix.stderr; + Unix.close log; + let devnull = Unix.openfile "/dev/null" [Unix.O_WRONLY] 0 in + Unix.dup2 devnull Unix.stdout; + Unix.close devnull; + Unix.close Unix.stdin; + Unix.execvp !Config.ocsidbm param + in + let pid = Lwt_unix.fork () in + if pid = 0 + then + if (* double fork *) + Lwt_unix.fork () = 0 + then child () + else Aux.sys_exit 0 + else + Lwt_unix.waitpid [] pid >>= fun _ -> + Lwt_unix.sleep 1.1 >>= fun () -> + let socket = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in + Lwt_unix.connect socket (Unix.ADDR_UNIX sname) >>= fun () -> + Lwt.return socket) let rec get_indescr i = Lwt.catch (fun () -> try_connect (!Config.directory ^ "/" ^ socketname)) (fun e -> - if i = 0 - then ( - Lwt_log.ign_error_f ~section - "Cannot connect to Ocsidbm. Will continue without persistent session support. Error message is: %s .Have a look at the logs to see if there is an error message from the Ocsidbm process." - (match e with - | Unix.Unix_error (a, b, c) -> - Printf.sprintf "%a in %s(%s)" - (fun () -> Unix.error_message) - a b c - | _ -> Printexc.to_string e); - Lwt.fail e) - else Lwt_unix.sleep 2.1 >>= fun () -> get_indescr (i - 1)) + if i = 0 + then ( + Lwt_log.ign_error_f ~section + "Cannot connect to Ocsidbm. Will continue without persistent session support. Error message is: %s .Have a look at the logs to see if there is an error message from the Ocsidbm process." + (match e with + | Unix.Unix_error (a, b, c) -> + Printf.sprintf "%a in %s(%s)" + (fun () -> Unix.error_message) + a b c + | _ -> Printexc.to_string e); + Lwt.fail e) + else Lwt_unix.sleep 2.1 >>= fun () -> get_indescr (i - 1)) let send = let previous = ref (Lwt.return Ok) in @@ -151,10 +144,10 @@ module Store = struct Lwt.catch (fun () -> Db.get pvname >>= fun _ -> Lwt.return ()) (function - | Not_found -> - default () >>= fun def -> - Db.replace pvname (Marshal.to_string def []) - | e -> Lwt.fail e) + | Not_found -> + default () >>= fun def -> + Db.replace pvname (Marshal.to_string def []) + | e -> Lwt.fail e) >>= fun () -> Lwt.return pvname let make_persistent_lazy ~store ~name ~default = @@ -186,11 +179,12 @@ module Functorial = struct val decode : string -> t end - module Table (T : sig - val name : string - end) - (Key : COLUMN) - (Value : COLUMN) : + module Table + (T : sig + val name : string + end) + (Key : COLUMN) + (Value : COLUMN) : Ocsipersist_lib.Sigs.TABLE with type key = Key.t and type value = Value.t = struct type key = Key.t @@ -250,12 +244,12 @@ module Functorial = struct Db.length name module Variable = Ocsipersist_lib.Variable (struct - type k = key - type v = value + type k = key + type v = value - let find = find - let add = add - end) + let find = find + let add = add + end) end module Column = struct @@ -276,8 +270,8 @@ module Functorial = struct end module Marshal (C : sig - type t - end) : COLUMN with type t = C.t = struct + type t + end) : COLUMN with type t = C.t = struct type t = C.t let column_type = "_" @@ -288,6 +282,7 @@ module Functorial = struct end module Polymorphic = Ocsipersist_lib.Polymorphic (Functorial) +module Ref = Ocsipersist_lib.Ref (Store) type 'value table = 'value Polymorphic.table @@ -327,52 +322,23 @@ type 'value table = 'value Polymorphic.table aux first firstl >>= (fun () -> Unix.close socket; return ())) (fun e -> Unix.close socket; Lwt.fail e)))) - *) -module Registration = struct - (** getting the directory from config file *) - let rec parse_global_config ((store, ocsidbm, delayloading) as d) = function - | [] -> d - | Xml.Element ("delayloading", [("val", ("true" | "1"))], []) :: ll -> - parse_global_config (store, ocsidbm, true) ll - | Xml.Element ("delayloading", [("val", ("false" | "0"))], []) :: ll -> - parse_global_config (store, ocsidbm, false) ll - | Xml.Element ("store", [("dir", s)], []) :: ll -> - if store = None - then parse_global_config (Some s, ocsidbm, delayloading) ll - else Ocsigen_extensions.badconfig "Ocsipersist: Duplicate tag" - | Xml.Element ("ocsidbm", [("name", s)], []) :: ll -> - if ocsidbm = None - then parse_global_config (store, Some s, delayloading) ll - else Ocsigen_extensions.badconfig "Ocsipersist: Duplicate tag" - | Xml.Element (s, _, _) :: _ll -> - Ocsigen_extensions.badconfig "Bad tag %s" s - | _ -> - Ocsigen_extensions.badconfig - "Unexpected content inside Ocsipersist config" - - let init_fun config = - let store, ocsidbmconf, delay_loading = - parse_global_config (None, None, false) config - in - (match store with None -> () | Some d -> Config.directory := d); - (match ocsidbmconf with None -> () | Some d -> Config.ocsidbm := d); - if delay_loading - then - Lwt_log.ign_warning ~section - "Asynchronuous initialization (may fail later)" - else Lwt_log.ign_warning ~section "Initializing ..."; - let indescr = Db.get_indescr 2 in - if delay_loading - then ( - Config.inch := Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.input) indescr; - Config.outch := Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.output) indescr) - else - let r = Lwt_main.run indescr in - Config.inch := Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.input r); - Config.outch := Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.output r); - Lwt_log.ign_warning ~section "...Initialization complete" - - let _ = Ocsigen_extensions.register ~name:"ocsipersist" ~init_fun () -end +let init () = + if !Ocsipersist_settings.delay_loading + then + Lwt_log.ign_warning ~section "Asynchronuous initialization (may fail later)" + else Lwt_log.ign_warning ~section "Initializing ..."; + let indescr = Db.get_indescr 2 in + if !Ocsipersist_settings.delay_loading + then ( + Ocsipersist_settings.inch := + Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.input) indescr; + Ocsipersist_settings.outch := + Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.output) indescr) + else + let r = Lwt_main.run indescr in + Ocsipersist_settings.inch := Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.input r); + Ocsipersist_settings.outch := + Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.output r); + Lwt_log.ign_warning ~section "...Initialization complete" diff --git a/src/dbm/ocsipersist_config.ml b/src/dbm/ocsipersist_config.ml new file mode 100644 index 0000000..e59df9b --- /dev/null +++ b/src/dbm/ocsipersist_config.ml @@ -0,0 +1,37 @@ +(** getting the directory from config file *) +let rec parse_global_config ((store, ocsidbm, delayloading) as d) = function + | [] -> d + | Xml.Element ("delayloading", [("val", ("true" | "1"))], []) :: ll -> + parse_global_config (store, ocsidbm, true) ll + | Xml.Element ("delayloading", [("val", ("false" | "0"))], []) :: ll -> + parse_global_config (store, ocsidbm, false) ll + | Xml.Element ("store", [("dir", s)], []) :: ll -> + if store = None + then parse_global_config (Some s, ocsidbm, delayloading) ll + else Ocsigen_extensions.badconfig "Ocsipersist: Duplicate tag" + | Xml.Element ("ocsidbm", [("name", s)], []) :: ll -> + if ocsidbm = None + then parse_global_config (store, Some s, delayloading) ll + else Ocsigen_extensions.badconfig "Ocsipersist: Duplicate tag" + | Xml.Element (s, _, _) :: _ll -> Ocsigen_extensions.badconfig "Bad tag %s" s + | _ -> + Ocsigen_extensions.badconfig + "Unexpected content inside Ocsipersist config" + +let init_fun config = + let store, ocsidbmconf, delay_loading = + parse_global_config (None, None, false) config + in + Ocsipersist_settings.delay_loading := delay_loading; + Ocsipersist_settings.error_log_path := Ocsigen_messages.error_log_path (); + (match store with + | None -> + Ocsipersist_settings.directory := + Ocsigen_config.get_datadir () ^ "/ocsipersist" + | Some d -> Ocsipersist_settings.directory := d); + (match ocsidbmconf with + | None -> () + | Some d -> Ocsipersist_settings.ocsidbm := d); + Ocsipersist.init () + +let _ = Ocsigen_extensions.register ~name:"ocsipersist" ~init_fun () diff --git a/src/dbm/ocsipersist_config.mli b/src/dbm/ocsipersist_config.mli new file mode 100644 index 0000000..14355b8 --- /dev/null +++ b/src/dbm/ocsipersist_config.mli @@ -0,0 +1,16 @@ +(** + +If you are using the DBM backend of Ocsipersist +with Ocsigen Server with a configuration file, +install package [ocsipersist-dbm-config] and +use the following configuration tags. +All sub-tags of the [extension] tag are optional. + +{@xml[ + + + + + +]} +*) diff --git a/src/dbm/ocsipersist_settings.ml b/src/dbm/ocsipersist_settings.ml new file mode 100644 index 0000000..2f40448 --- /dev/null +++ b/src/dbm/ocsipersist_settings.ml @@ -0,0 +1,9 @@ +let directory, ocsidbm = ref "ocsipersist-store", ref "ocsidbm" +let inch = ref (Lwt.fail (Failure "Ocsipersist not initialised")) +let outch = ref (Lwt.fail (Failure "Ocsipersist not initialised")) +let delay_loading = ref false +let error_log_path = ref "ocsipersist-errors" +let set_error_log_path s = error_log_path := s +let set_store s = directory := s +let set_ocsidbm s = ocsidbm := s +let set_delay_loading b = delay_loading := b diff --git a/src/dbm/ocsipersist_settings.mli b/src/dbm/ocsipersist_settings.mli new file mode 100644 index 0000000..e12140b --- /dev/null +++ b/src/dbm/ocsipersist_settings.mli @@ -0,0 +1,13 @@ +val set_store : string -> unit +val set_delay_loading : bool -> unit +val set_ocsidbm : string -> unit +val set_error_log_path : string -> unit + +(**/**) + +val directory : string ref +val ocsidbm : string ref +val delay_loading : bool ref +val error_log_path : string ref +val inch : Lwt_io.input_channel Lwt.t ref +val outch : Lwt_io.output_channel Lwt.t ref diff --git a/src/dune b/src/dune index 21c6c99..15f1ce0 100644 --- a/src/dune +++ b/src/dune @@ -4,13 +4,14 @@ (modules ocsipersist_lib) (wrapped false) (libraries lwt) - (preprocess (pps lwt_ppx))) + (preprocess + (pps lwt_ppx))) (library + (name ocsipersist) (public_name ocsipersist) (virtual_modules ocsipersist) (modules ocsipersist) - (wrapped false) (libraries ocsipersist_lib lwt)) (env diff --git a/src/ocsipersist.mli b/src/ocsipersist.mli index d6effaf..3bd6cac 100644 --- a/src/ocsipersist.mli +++ b/src/ocsipersist.mli @@ -1,6 +1,38 @@ -(** Library (and extension for ocsigenserver) for storing and retrieving - key/value data in a persistent manner. This module defines a unified - frontend for a number of different backends. *) +(** Persistent key-value store interface for OCaml. + This is an virtual library defining a unified frontend for a number of + key-value storage implementations. Implementations of the following backends + currently exist: SQLite, DBM, PostgreSQL. + You can choose the backend you prefer by installing packages + [ocsipersist-sqlite], [ocsipersist-dbm] or [ocsipersist-pgsql]. + + Library [Ocsipersist_settings], provided by each of the backends, + contain the configuration options for your stores. + + Packages [ocsipersist-sqlite-config], [ocsipersist-dbm-config] and + [ocsipersist-pgsql-config] add the possibility to configure the + corresponding backends from Ocsigen Server's configuration file. + + Ocsipersist is used by Eliom for persistent session storages and references. + + Ocsipersist defines several interfaces: + - [Ref] is the simpler the use: it provides persistent references + - [Store] is a lower level interface for persistent values + - [Polymorphic] is a polymorphic table, using Mahshal + - [Functorial] is a typed interface for your own data type + +Example of use from the toplevel: + +{[ +# #require "lwt_ppx";; +(* #thread;; if you are using OCaml < 5.0.0 *) +# #require "ocsipersist-sqlite";; +# Ocsipersist.init ();; +# let r = Ocsipersist.Ref.ref ~persistent:"r" 444;; +val r : int Ocsipersist.Ref.t = +# Lwt_main.run (let%lwt v = Ocsipersist.Ref.get r in print_int v; Lwt.return_unit);; +444- : unit = () +]} +*) module Functorial : Ocsipersist_lib.Sigs.FUNCTORIAL (** Functorial frontent. Allows for custom (de)serialisation functions, which @@ -18,6 +50,12 @@ module Polymorphic : Ocsipersist_lib.Sigs.POLYMORPHIC type 'value table = 'value Polymorphic.table (** Table representation as generated by the function {!Polymorphic.open_table} *) +module Ref : Ocsipersist_lib.Sigs.REF +(** Simple interface for persistent references. + Relies on {!Stdlib.Marshal} for (de)serialisation, which entails + the same limitations as for the {!Polymorphic} frontend. If this is an + issue you can rely on {!Functorial} frontend instead (see {!TABLE.Variable}). *) + module Store : Ocsipersist_lib.Sigs.STORE (** The variable store allows for the persistent storage of individual variables. Relies on {!Stdlib.Marshal} for (de)serialisation, which entails @@ -26,3 +64,5 @@ module Store : Ocsipersist_lib.Sigs.STORE type store = Store.store type 'a variable = 'a Store.t + +val init : unit -> unit diff --git a/src/ocsipersist_lib.ml b/src/ocsipersist_lib.ml index 2e9705d..88c14f8 100644 --- a/src/ocsipersist_lib.ml +++ b/src/ocsipersist_lib.ml @@ -13,8 +13,8 @@ module Sigs = struct val modify_opt : key -> (value option -> value option) -> unit Lwt.t val length : unit -> int Lwt.t - val iter - : ?count:int64 + val iter : + ?count:int64 -> ?gt:key -> ?geq:key -> ?lt:key @@ -22,8 +22,8 @@ module Sigs = struct -> (key -> value -> unit Lwt.t) -> unit Lwt.t - val fold - : ?count:int64 + val fold : + ?count:int64 -> ?gt:key -> ?geq:key -> ?lt:key @@ -32,8 +32,8 @@ module Sigs = struct -> 'a -> 'a Lwt.t - val iter_block - : ?count:int64 + val iter_block : + ?count:int64 -> ?gt:key -> ?geq:key -> ?lt:key @@ -41,8 +41,8 @@ module Sigs = struct -> (key -> value -> unit) -> unit Lwt.t - val iter_batch - : ?count:int64 + val iter_batch : + ?count:int64 -> ?gt:key -> ?geq:key -> ?lt:key @@ -72,19 +72,20 @@ module Sigs = struct val decode : internal -> t end - module Table (T : sig - val name : string - end) - (Key : COLUMN) - (Value : COLUMN) : TABLE with type key = Key.t and type value = Value.t + module Table + (T : sig + val name : string + end) + (Key : COLUMN) + (Value : COLUMN) : TABLE with type key = Key.t and type value = Value.t module Column : sig module String : COLUMN with type t = string module Float : COLUMN with type t = float module Marshal (C : sig - type t - end) : COLUMN with type t = C.t + type t + end) : COLUMN with type t = C.t end end @@ -128,8 +129,8 @@ module Sigs = struct is very old (at least 9 223 372 036 854 775 807 insertions). *) - val fold_step - : (string -> 'a -> 'b -> 'b Lwt.t) + val fold_step : + (string -> 'a -> 'b -> 'b Lwt.t) -> 'a table -> 'b -> 'b Lwt.t @@ -150,6 +151,29 @@ module Sigs = struct *) end + module type REF = sig + (** Persistent references for OCaml *) + + type 'a t + (** The type of (persistent or not) references *) + + val ref : ?persistent:string -> 'a -> 'a t + (** [ref ?persistent default] creates a reference. + If optional parameter [?persistent] is absent, ++ the reference will not be persistent (implemented using OCaml references). ++ Otherwise, the value of [persistent] will be used as key for the + + value in the persistent reference table. + If the reference already exists, the current value is kept. ++ Be careful to change this name every time you change the type of the ++ value. *) + + val get : 'a t -> 'a Lwt.t + (** Get the value of a reference *) + + val set : 'a t -> 'a -> unit Lwt.t + (** Set the value of a reference *) + end + module type STORE = sig type 'a t (** Type of persistent data *) @@ -167,8 +191,8 @@ module Sigs = struct from database, or create it with the default value [default] if it does not exist. *) - val make_persistent_lazy - : store:store + val make_persistent_lazy : + store:store -> name:string -> default:(unit -> 'a) -> 'a t Lwt.t @@ -176,8 +200,8 @@ module Sigs = struct if needed *) - val make_persistent_lazy_lwt - : store:store + val make_persistent_lazy_lwt : + store:store -> name:string -> default:(unit -> 'a Lwt.t) -> 'a t Lwt.t @@ -210,8 +234,8 @@ module Polymorphic (Functorial : FUNCTORIAL) : POLYMORPHIC = struct end) (Column.String) (Column.Marshal (struct - type t = a - end)) + type t = a + end)) in Lwt.return (module T : POLYMORPHIC with type value = a) @@ -238,12 +262,12 @@ module Polymorphic (Functorial : FUNCTORIAL) : POLYMORPHIC = struct end module Variable (T : sig - type k - type v + type k + type v - val find : k -> v Lwt.t - val add : k -> v -> unit Lwt.t -end) = + val find : k -> v Lwt.t + val add : k -> v -> unit Lwt.t + end) = struct type t = {name : T.k; default : unit -> T.v Lwt.t} @@ -262,3 +286,32 @@ struct let set {name} = T.add name end + +module Ref (Store : STORE) = struct + let store = lazy (Store.open_store "__ocsipersist_ref_store__") + + type 'a t = Ref of 'a ref | Per of 'a Store.t Lwt.t + + let ref ?persistent v = + match persistent with + | None -> Ref (ref v) + | Some name -> + Per + (let%lwt store = Lazy.force store in + Store.make_persistent ~store ~name ~default:v) + + let get = function + | Ref r -> Lwt.return !r + | Per r -> + let%lwt r = r in + Store.get r + + let set r v = + match r with + | Ref r -> + r := v; + Lwt.return_unit + | Per r -> + let%lwt r = r in + Store.set r v +end diff --git a/src/pgsql/dune b/src/pgsql/dune index d5f4dc0..a795067 100644 --- a/src/pgsql/dune +++ b/src/pgsql/dune @@ -1,9 +1,26 @@ (library (name ocsipersist_pgsql) - (public_name ocsipersist.pgsql) + (public_name ocsipersist-pgsql) (implements ocsipersist) - (libraries pgocaml lwt_log xml-light ocsigenserver ocsipersist_lib) - (optional)) + (modules :standard \ ocsipersist_config ocsipersist_settings) + (libraries pgocaml lwt_log ocsipersist_lib ocsipersist_pgsql_settings)) + +; Configuration functions (part of ocsipersist-pgsql package): + +(library + (name ocsipersist_pgsql_settings) + (public_name ocsipersist-pgsql.settings) + (wrapped false) + (modules ocsipersist_settings)) + +; Configuration through Ocsigen Server config file (separate package): + +(library + (name ocsipersist_pgsql_config) + (public_name ocsipersist-pgsql-config) + (modules ocsipersist_config) + (wrapped false) + (libraries xml-light ocsigenserver ocsipersist_pgsql)) (documentation (package ocsipersist-pgsql) diff --git a/src/pgsql/index.mld b/src/pgsql/index.mld index b00635e..f5b2860 100644 --- a/src/pgsql/index.mld +++ b/src/pgsql/index.mld @@ -1,31 +1,18 @@ {0 ocsipersist-pgsql} -For the API documentation see OPAM package [ocsipersist]. +PostgreSQL backend for Ocsipersist. +For the API documentation see OPAM package {{:../ocsipersist/Ocsipersist/index.html}ocsipersist}. +This page describes how to configure the PostgreSQL backend. -Here we document the configuration options of the ocsigenserver extension. -All attributes of the [database] tag are optional. +{1 Using as a library} -One can either define a host to connect to: -{[ - - - -]} +If you are not using Ocsigen Server's configuration file, +add library [ocsipersist-pgsql.settings] in your Dune file, and +use module {!Ocsipersist_settings} +to configure the storage file. -Or a UNIX domain socket: -{[ - - - -]} +{1 Using with Ocsigen Server: ocsipersist-pgsql-config} + +If you want to configure Ocsipersist-pgsql from Ocsigen Server's +configuration file, use package +{{:../ocsipersist-pgsql-config/Ocsipersist_config/index.html}ocsipersist-pgsql-config}. diff --git a/src/pgsql/ocsipersist.ml b/src/pgsql/ocsipersist.ml index 5424a4c..cc4f178 100644 --- a/src/pgsql/ocsipersist.ml +++ b/src/pgsql/ocsipersist.ml @@ -27,15 +27,7 @@ open Printf exception Ocsipersist_error -module Config = struct - let host = ref None - let port = ref None - let user = ref None - let password = ref None - let database = ref "ocsipersist" - let unix_domain_socket_dir = ref None - let size_conn_pool = ref 16 -end +module Config = Ocsipersist_settings let connect () = PGOCaml.connect ?host:!Config.host ?port:!Config.port ?user:!Config.user @@ -55,20 +47,20 @@ let conn_pool : (string, unit) Hashtbl.t PGOCaml.t Lwt_pool.t ref = (* This connection pool will be overwritten by init_fun! *) ref (Lwt_pool.create !Config.size_conn_pool ~validate:PGOCaml.alive ~dispose - connect) + (fun () -> Lwt.fail (Failure "Ocsipersist db not initialised"))) let use_pool f = Lwt_pool.use !conn_pool @@ fun db -> Lwt.catch (fun () -> f db) (function - | PGOCaml.Error msg as e -> - Lwt_log.ign_error_f ~section "postgresql protocol error: %s" msg; - PGOCaml.close db >>= fun () -> Lwt.fail e - | Lwt.Canceled as e -> - Lwt_log.ign_error ~section "thread canceled"; - PGOCaml.close db >>= fun () -> Lwt.fail e - | e -> Lwt.fail e) + | PGOCaml.Error msg as e -> + Lwt_log.ign_error_f ~section "postgresql protocol error: %s" msg; + PGOCaml.close db >>= fun () -> Lwt.fail e + | Lwt.Canceled as e -> + Lwt_log.ign_error ~section "thread canceled"; + PGOCaml.close db >>= fun () -> Lwt.fail e + | e -> Lwt.fail e) (* escapes characters that are not in the range of 0x20..0x7e; this is to meet PostgreSQL's format requirements for text fields @@ -140,10 +132,10 @@ let prepare db query = (* Have we prepared this statement already? If not, do so. *) let is_prepared = Hashtbl.mem hashtbl name in (if is_prepared - then Lwt.return () - else - PGOCaml.prepare db ~name ~query () - >> Lwt.return @@ Hashtbl.add hashtbl name ()) + then Lwt.return () + else + PGOCaml.prepare db ~name ~query () + >> Lwt.return @@ Hashtbl.add hashtbl name ()) >>= fun () -> Lwt.return name let exec db query params = @@ -164,11 +156,12 @@ module Functorial = struct val decode : internal -> t end - module Table (T : sig - val name : string - end) - (Key : COLUMN) - (Value : COLUMN) : TABLE with type key = Key.t and type value = Value.t = + module Table + (T : sig + val name : string + end) + (Key : COLUMN) + (Value : COLUMN) : TABLE with type key = Key.t and type value = Value.t = struct type key = Key.t type value = Value.t @@ -327,12 +320,12 @@ module Functorial = struct failwith "Ocsipersist.iter_block: not implemented" module Variable = Ocsipersist_lib.Variable (struct - type k = key - type v = value + type k = key + type v = value - let find = find - let add = add - end) + let find = find + let add = add + end) end module Column = struct @@ -353,8 +346,8 @@ module Functorial = struct end module Marshal (C : sig - type t - end) : COLUMN with type t = C.t = struct + type t + end) : COLUMN with type t = C.t = struct type t = C.t let column_type = "bytea" @@ -421,48 +414,11 @@ module Store = struct exec db query [Key p.name; Value v] >> Lwt.return () end +module Ref = Ocsipersist_lib.Ref (Store) + type store = Store.store type 'a variable = 'a Store.t -module Registration = struct - let parse_global_config = function - | [] -> () - | [Xml.Element ("database", attrs, [])] -> - let parse_attr = function - | "host", h -> Config.host := Some h - | "port", p -> ( - try Config.port := Some (int_of_string p) - with Failure _ -> - raise - @@ Ocsigen_extensions.Error_in_config_file - "port is not an integer") - | "user", u -> Config.user := Some u - | "password", pw -> Config.password := Some pw - | "database", db -> Config.database := db - | "unix_domain_socket_dir", udsd -> - Config.unix_domain_socket_dir := Some udsd - | "size_conn_pool", scp -> ( - try Config.size_conn_pool := int_of_string scp - with Failure _ -> - raise - @@ Ocsigen_extensions.Error_in_config_file - "size_conn_pool is not an integer") - | _ -> - raise - @@ Ocsigen_extensions.Error_in_config_file - "Unexpected attribute for in Ocsipersist config" - in - ignore @@ List.map parse_attr attrs; - () - | _ -> - raise - @@ Ocsigen_extensions.Error_in_config_file - "Unexpected content inside Ocsipersist config" - - let init_fun config = - parse_global_config config; - conn_pool := - Lwt_pool.create !Config.size_conn_pool ~validate:PGOCaml.alive connect - - let _ = Ocsigen_extensions.register ~name:"ocsipersist" ~init_fun () -end +let init () = + conn_pool := + Lwt_pool.create !Config.size_conn_pool ~validate:PGOCaml.alive connect diff --git a/src/pgsql/ocsipersist_config.ml b/src/pgsql/ocsipersist_config.ml new file mode 100644 index 0000000..7563e6a --- /dev/null +++ b/src/pgsql/ocsipersist_config.ml @@ -0,0 +1,38 @@ +let section = Lwt_log.Section.make "ocsigen:ocsipersist:pgsql:config" +let _ = Lwt_log.ign_info ~section "Init for Ocsigen Server config file" + +let parse_global_config = function + | [] -> () + | [Xml.Element ("database", attrs, [])] -> + let parse_attr = function + | "host", h -> Ocsipersist_settings.host := Some h + | "port", p -> ( + try Ocsipersist_settings.port := Some (int_of_string p) + with Failure _ -> + raise + @@ Ocsigen_extensions.Error_in_config_file "port is not an integer") + | "user", u -> Ocsipersist_settings.user := Some u + | "password", pw -> Ocsipersist_settings.password := Some pw + | "database", db -> Ocsipersist_settings.database := db + | "unix_domain_socket_dir", udsd -> + Ocsipersist_settings.unix_domain_socket_dir := Some udsd + | "size_conn_pool", scp -> ( + try Ocsipersist_settings.size_conn_pool := int_of_string scp + with Failure _ -> + raise + @@ Ocsigen_extensions.Error_in_config_file + "size_conn_pool is not an integer") + | _ -> + raise + @@ Ocsigen_extensions.Error_in_config_file + "Unexpected attribute for in Ocsipersist config" + in + ignore @@ List.map parse_attr attrs; + () + | _ -> + raise + @@ Ocsigen_extensions.Error_in_config_file + "Unexpected content inside Ocsipersist config" + +let init_fun config = parse_global_config config; Ocsipersist.init () +let _ = Ocsigen_extensions.register ~name:"ocsipersist" ~init_fun () diff --git a/src/pgsql/ocsipersist_config.mli b/src/pgsql/ocsipersist_config.mli new file mode 100644 index 0000000..78db0a4 --- /dev/null +++ b/src/pgsql/ocsipersist_config.mli @@ -0,0 +1,33 @@ +(** +If you are using the PostgreSQL backend of Ocsipersist +with Ocsigen Server with a configuration file, +install package [ocsipersist-pgsql-config] and +use the following configuration tags. +All attributes of the [database] tag are optional. + +One can either define a host to connect to: +{@xml[ + + + +]} + +Or a UNIX domain socket: +{@xml[ + + + +]} + +*) diff --git a/src/pgsql/ocsipersist_settings.ml b/src/pgsql/ocsipersist_settings.ml new file mode 100644 index 0000000..3d7eaad --- /dev/null +++ b/src/pgsql/ocsipersist_settings.ml @@ -0,0 +1,14 @@ +let host = ref None +let port = ref None +let user = ref None +let password = ref None +let database = ref "ocsipersist" +let unix_domain_socket_dir = ref None +let size_conn_pool = ref 16 +let set_host (s : string) = host := Some s +let set_port (s : int) = port := Some s +let set_user (s : string) = user := Some s +let set_password (s : string) = password := Some s +let set_database (s : string) = database := s +let set_unix_domain_socket_dir (s : string) = unix_domain_socket_dir := Some s +let set_connexion_pool_size (s : int) = size_conn_pool := s diff --git a/src/pgsql/ocsipersist_settings.mli b/src/pgsql/ocsipersist_settings.mli new file mode 100644 index 0000000..f312432 --- /dev/null +++ b/src/pgsql/ocsipersist_settings.mli @@ -0,0 +1,17 @@ +val set_host : string -> unit +val set_port : int -> unit +val set_user : string -> unit +val set_password : string -> unit +val set_database : string -> unit +val set_unix_domain_socket_dir : string -> unit +val set_connexion_pool_size : int -> unit + +(**/**) + +val host : string option ref +val port : int option ref +val user : string option ref +val password : string option ref +val database : string ref +val unix_domain_socket_dir : string option ref +val size_conn_pool : int ref diff --git a/src/sqlite/dune b/src/sqlite/dune index 6a143cd..4ef220a 100644 --- a/src/sqlite/dune +++ b/src/sqlite/dune @@ -1,9 +1,26 @@ (library (name ocsipersist_sqlite) - (public_name ocsipersist.sqlite) + (public_name ocsipersist-sqlite) (implements ocsipersist) - (libraries sqlite3 lwt_log xml-light ocsigenserver ocsipersist_lib) - (optional)) + (modules ocsipersist) + (libraries sqlite3 lwt_log ocsipersist_lib ocsipersist_sqlite_settings)) + +; Configuration functions (part of ocsipersist-sqlite package): + +(library + (name ocsipersist_sqlite_settings) + (public_name ocsipersist-sqlite.settings) + (wrapped false) + (modules ocsipersist_settings)) + +; Configuration through Ocsigen Server config file (separate package): + +(library + (name ocsipersist_sqlite_config) + (public_name ocsipersist-sqlite-config) + (modules ocsipersist_config) + (wrapped false) + (libraries xml-light ocsigenserver ocsipersist_sqlite)) (documentation (package ocsipersist-sqlite) diff --git a/src/sqlite/index.mld b/src/sqlite/index.mld index e50ee07..afc3590 100644 --- a/src/sqlite/index.mld +++ b/src/sqlite/index.mld @@ -1,12 +1,18 @@ {0 ocsipersist-sqlite} -For the API documentation see OPAM package [ocsipersist]. +SQLite backend for Ocsipersist. +For the API documentation see OPAM package {{:../ocsipersist/Ocsipersist/index.html}ocsipersist}. +This page describes how to configure the SQLite backend. -Here we document the configuration options of the ocsigenserver extension. -All sub-tags of the [extension] tag are optional. +{1 Using as a library} -{[ - - - -]} +If you are not using Ocsigen Server's configuration file, +add library [ocsipersist-sqlite.settings] in your Dune file, and +use module {!Ocsipersist_settings} to configure the storage file. + + +{1 Using with Ocsigen Server: ocsipersist-sqlite-config} + +If you want to configure Ocsipersist-sqlite from Ocsigen Server's +configuration file, use package +{{:../ocsipersist-sqlite-config/Ocsipersist_config/index.html}ocsipersist-sqlite-config}. diff --git a/src/sqlite/ocsipersist.ml b/src/sqlite/ocsipersist.ml index b723888..5d1040a 100644 --- a/src/sqlite/ocsipersist.ml +++ b/src/sqlite/ocsipersist.ml @@ -9,7 +9,7 @@ open Printf module Aux = struct (* This reference is overwritten when the init function (at the end of the file) is run, which occurs when the extension is loaded *) - let db_file = ref (Ocsigen_config.get_datadir () ^ "/ocsidb") + let db_file = Ocsipersist_settings.db_file let yield () = Thread.yield () let rec bind_safely stmt = function @@ -41,7 +41,7 @@ module Aux = struct in Lwt_preemptive.detach aux () - (* Référence indispensable pour les codes de retours et leur signification : + (* Référence indispensable pour les codes de retours et leur signification : * http://sqlite.org/capi3ref.html * Langage compris par SQLite : http://www.sqlite.org/lang.html *) @@ -123,10 +123,10 @@ module Store = struct Lwt.catch (fun () -> Aux.db_get pvname >>= fun _ -> Lwt.return ()) (function - | Not_found -> - default () >>= fun def -> - Aux.db_replace pvname (Marshal.to_string def []) - | e -> Lwt.fail e) + | Not_found -> + default () >>= fun def -> + Aux.db_replace pvname (Marshal.to_string def []) + | e -> Lwt.fail e) >>= fun () -> Lwt.return pvname let make_persistent_lazy ~store ~name ~default = @@ -158,11 +158,12 @@ module Functorial = struct val decode : internal -> t end - module Table (T : sig - val name : string - end) - (Key : COLUMN) - (Value : COLUMN) : + module Table + (T : sig + val name : string + end) + (Key : COLUMN) + (Value : COLUMN) : Ocsipersist_lib.Sigs.TABLE with type key = Key.t and type value = Value.t = struct type key = Key.t @@ -395,12 +396,12 @@ module Functorial = struct let length () = with_table @@ db_length name module Variable = Ocsipersist_lib.Variable (struct - type k = key - type v = value + type k = key + type v = value - let find = find - let add = add - end) + let find = find + let add = add + end) end module Column = struct @@ -421,8 +422,8 @@ module Functorial = struct end module Marshal (C : sig - type t - end) : COLUMN with type t = C.t = struct + type t + end) : COLUMN with type t = C.t = struct type t = C.t let column_type = "blob" @@ -436,31 +437,10 @@ module Functorial = struct end module Polymorphic = Ocsipersist_lib.Polymorphic (Functorial) +module Ref = Ocsipersist_lib.Ref (Store) type 'value table = 'value Polymorphic.table -module Registration = struct - let parse_global_config = function - | [] -> None - | [Xml.Element ("database", [("file", s)], [])] -> Some s - | _ -> - raise - (Ocsigen_extensions.Error_in_config_file - "Unexpected content inside Ocsipersist config") - - let init config = - Aux.db_file := Ocsigen_config.get_datadir () ^ "/ocsidb"; - (match parse_global_config config with - | None -> () - | Some d -> Aux.db_file := d); - (* We check that we can access the database *) - try Lwt_main.run (Aux.exec_safely (fun _ -> ())) - with e -> - Ocsigen_messages.errlog - (Printf.sprintf - "Error opening database file '%s' when registering Ocsipersist. Check that the directory exists, and that Ocsigen has enough rights" - !Aux.db_file); - raise e - - let _ = Ocsigen_extensions.register ~name:"ocsipersist" ~init_fun:init () -end +let init () = + (* We check that we can access the database *) + Lwt_main.run (Aux.exec_safely (fun _ -> ())) diff --git a/src/sqlite/ocsipersist_config.ml b/src/sqlite/ocsipersist_config.ml new file mode 100644 index 0000000..a3f70a4 --- /dev/null +++ b/src/sqlite/ocsipersist_config.ml @@ -0,0 +1,22 @@ +let parse_global_config = function + | [] -> None + | [Xml.Element ("database", [("file", s)], [])] -> Some s + | _ -> + raise + (Ocsigen_extensions.Error_in_config_file + "Unexpected content inside Ocsipersist config") + +let init config = + Ocsipersist_settings.db_file := Ocsigen_config.get_datadir () ^ "/ocsidb"; + (match parse_global_config config with + | None -> () + | Some d -> Ocsipersist_settings.db_file := d); + try Ocsipersist.init () + with e -> + Ocsigen_messages.errlog + (Printf.sprintf + "Error opening database file '%s' when registering Ocsipersist. Check that the directory exists, and that Ocsigen has enough rights" + !Ocsipersist_settings.db_file); + raise e + +let _ = Ocsigen_extensions.register ~name:"ocsipersist" ~init_fun:init () diff --git a/src/sqlite/ocsipersist_config.mli b/src/sqlite/ocsipersist_config.mli new file mode 100644 index 0000000..2b509fa --- /dev/null +++ b/src/sqlite/ocsipersist_config.mli @@ -0,0 +1,12 @@ +(** +If you are using the SQLite backend of Ocsipersist with Ocsigen Server +with a configuration file, install package [ocsipersist-sqlite-config] and +use the following configuration tags. +All sub-tags of the [extension] tag are optional. + +{@xml[ + + + +]} +*) diff --git a/src/sqlite/ocsipersist_settings.ml b/src/sqlite/ocsipersist_settings.ml new file mode 100644 index 0000000..d6ad7ef --- /dev/null +++ b/src/sqlite/ocsipersist_settings.ml @@ -0,0 +1,2 @@ +let db_file = ref "ocsidb" +let set_db_file s = db_file := s diff --git a/src/sqlite/ocsipersist_settings.mli b/src/sqlite/ocsipersist_settings.mli new file mode 100644 index 0000000..b20cc7e --- /dev/null +++ b/src/sqlite/ocsipersist_settings.mli @@ -0,0 +1,5 @@ +val set_db_file : string -> unit + +(**/**) + +val db_file : string ref