scripts/lib/cocanwiki_server_settings.ml

   1 (* COCANWIKI - a wiki written in Objective CAML.
   2  * Written by Richard W.M. Jones <rich@merjis.com>.
   3  * Copyright (C) 2004 Merjis Ltd.
   4  * $Id: cocanwiki_server_settings.ml,v 1.1 2004/10/21 11:42:05 rich Exp $
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; see the file COPYING.  If not, write to
  18  * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19  * Boston, MA 02111-1307, USA.
  20  *)
  21
  22 open Apache
  23 open Registry
  24 open Cgi
  25 open Printf
  26
  27 (* Server-wide settings.
  28  *
  29  * These are stored in a single row in the database in the table
  30  * 'server_settings'.  You must restart the server if you change
  31  * this row.
  32  *
  33  * It's not possible to read these at server start-up time because the
  34  * Apache server is still running as 'root' and will not normally be
  35  * allowed to access the database.  We thus read them at the earliest
  36  * opportunity, in a request context, and cache the results.
  37  *)
  38 let server_settings_version, server_settings_stats_page,
  39     server_settings_crash_email =
  40   let default = 1, None, None in
  41   let settings = ref None in
  42   let get_settings (dbh : Dbi.connection) =
  43     let sth = dbh#prepare "select version, stats_page, crash_email
  44                              from server_settings" in
  45     sth#execute [];
  46     let s =
  47       try
  48         (match sth#fetch1 () with
  49            | [ `Int version; (`String _ | `Null) as stats_page;
  50                (`String _ | `Null) as crash_email ] ->
  51                let stats_page =
  52                  match stats_page with `String s -> Some s | `Null -> None in
  53                let crash_email =
  54                  match crash_email with `String s -> Some s | `Null -> None in
  55                version, stats_page, crash_email
  56            | _ -> assert false)
  57       with
  58           Not_found -> default in
  59     sth#finish ();
  60     settings := Some s;
  61     s
  62   in
  63
  64   let server_settings_version dbh =
  65     let (version, _, _) =
  66       match !settings with
  67           None -> get_settings dbh
  68         | Some settings -> settings in
  69     version
  70   in
  71
  72   let server_settings_stats_page dbh =
  73     let (_, stats_page, _) =
  74       match !settings with
  75           None -> get_settings dbh
  76         | Some settings -> settings in
  77     stats_page
  78   in
  79
  80   let server_settings_crash_email dbh =
  81     let (_, _, crash_email) =
  82       match !settings with
  83           None -> get_settings dbh
  84         | Some settings -> settings in
  85     crash_email
  86   in
  87
  88   server_settings_version, server_settings_stats_page,
  89   server_settings_crash_email