Source file ocsigen_parseconfig.ml

(* Ocsigen
 * http://www.ocsigen.org
 * Module ocsigen_parseconfig.ml
 * Copyright (C) 2005-2008 Vincent Balat, Nataliya Guts, Stéphane Glondu
 *
 * 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.
*)

(******************************************************************)
(** Config file parsing *)

open Xml
open Ocsigen_config

module Netstring_pcre = Ocsigen_lib.Netstring_pcre

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

let blah_of_string f tag s =
  try
    f (Ocsigen_lib.String.remove_spaces s 0 ((String.length s) -1))
  with Failure _ -> raise (Ocsigen_config.Config_file_error
                             ("While parsing <"^tag^"> - "^s^
                              " is not a valid value."))

let int_of_string = blah_of_string int_of_string
let float_of_string = blah_of_string float_of_string

let default_default_hostname =
  let hostname = Unix.gethostname () in
  try
    (*VVV Is it ok? Is it reliable? *)
    (List.hd
       (Unix.getaddrinfo hostname "www"
          [Unix.AI_CANONNAME;
           Unix.AI_SOCKTYPE Unix.SOCK_STREAM])).Unix.ai_canonname
  with Failure _ ->
    Lwt_log.ign_warning_f ~section
      "Cannot determine default host name. Will use \"%s\" \
       to create absolute links or redirections dynamically \
       if you do not set <host defaulthostname=\"...\" ...> \
       in config file." hostname;
    (*VVV Is it the right behaviour? *)
    hostname

let parse_size =
  let kilo = Int64.of_int 1000 in
  let mega = Int64.of_int 1000000 in
  let giga = Int64.mul kilo mega in
  let tera = Int64.mul mega mega in
  let kibi = Int64.of_int 1024 in
  let mebi = Int64.of_int 1048576 in
  let gibi = Int64.mul kibi mebi in
  let tebi = Int64.mul mebi mebi in
  fun s ->
    let l = String.length s in
    let s = Ocsigen_lib.String.remove_spaces s 0 (l-1) in
    let v l =
      try
        Int64.of_string (String.sub s 0 l)
      with Failure _ -> failwith "Ocsigen_parseconfig.parse_size"
    in
    let o l =
      let l1 = l-1 in
      if l1>0
      then
        let c1 = s.[l1] in
        if (c1 = 'o') || (c1 = 'B')
        then v l1
        else v l
      else v l
    in
    if (s = "") || (s = "infinity")
    then None
    else Some
        (let l = String.length s in
         let l1 = l-1 in
         if l1>0
         then
           let c1 = String.sub s l1 1 in
           if (c1 = "T")
           then Int64.mul tebi (v l1)
           else
           if (c1 = "G")
           then Int64.mul gibi (v l1)
           else
           if (c1 = "M")
           then Int64.mul mebi (v l1)
           else
           if (c1 = "k")
           then Int64.mul kibi (v l1)
           else
             let l2 = l-2 in
             if l2>0
             then
               let c2 = String.sub s l2 2 in
               if (c2 = "To") || (c2 = "TB")
               then Int64.mul tera (v l2)
               else
               if (c2 = "Go") || (c2 = "GB")
               then Int64.mul giga (v l2)
               else
               if (c2 = "Mo") || (c2 = "MB")
               then Int64.mul mega (v l2)
               else
               if (c2 = "ko") || (c2 = "kB")
               then Int64.mul kilo (v l2)
               else
                 let l3 = l-3 in
                 if l3>0
                 then
                   let c3 = String.sub s l3 3 in
                   if (c3 = "Tio") || (c3 = "TiB")
                   then Int64.mul tebi (v l3)
                   else
                   if (c3 = "Gio") || (c3 = "GiB")
                   then Int64.mul gibi (v l3)
                   else
                   if (c3 = "Mio") || (c3 = "MiB")
                   then Int64.mul mebi (v l3)
                   else
                   if (c3 = "kio") || (c3 = "kiB")
                   then Int64.mul kibi (v l3)
                   else o l
                 else o l
             else o l
         else o l)

let parse_size_tag tag s =
  try
    parse_size s
  with Failure _ ->
    raise
      (Ocsigen_config.Config_file_error
         ("While parsing <"^tag^"> - "^s^" is not a valid size."))

let rec parse_string = function
  | [] -> ""
  | PCData s :: l -> s ^ parse_string l
  | _ -> failwith "ocsigen_parseconfig.parse_string"

let parse_string_tag tag s =
  try
    parse_string s
  with Failure _ ->
    raise
      (Ocsigen_config.Config_file_error
         ("While parsing <"^tag^"> - String expected."))

let parser_config =
  let rec parse_servers n = function
    | [] -> (match n with
        | [] -> raise (Config_file_error ("<server> tag expected"))
        | _ -> n)
    | (Element ("server", [], nouveau))::ll ->
        (match ll with
        | [] -> ()
        | _ ->
          Lwt_log.ign_warning ~section
            "At most one <server> tag possible in config file. \
             Ignoring trailing data.");
        parse_servers (n@[nouveau]) [] (* ll *)
        (* Multiple server not supported any more *)
        (* nouveau at the end *)
    | _ -> raise (Config_file_error ("syntax error inside <ocsigen>"))
  in function
    | Element ("ocsigen", [], l) ->
      parse_servers [] l
    | _ -> raise (Config_file_error "<ocsigen> tag expected")

let parse_ext file =
  parser_config (Xml.parse_file file)

let preloadfile config () = Ocsigen_extensions.set_config config
let postloadfile () = Ocsigen_extensions.set_config []

(* Checking hostnames.  We make only make looze efforts.
   See RFC 921 and 952 for further details *)
let correct_hostname =
  let regexp = Netstring_pcre.regexp "^[a-zA-Z0-9]+((\\.|-)[a-zA-Z0-9]+)*$" in
  fun h -> Netstring_pcre.string_match regexp h 0 <> None

(* Splits the [host] field, first according to spaces
   (which encode disjunction),
   and then according to wildcards '*' ; we then transform the hosts-with-regexp
   into a regepx that matches a potential host.
   The whole result is cached because user config files (for userconf)
   are read at each request. *)
let parse_host_field =
  let h = Hashtbl.create 17 in
  (fun (hostfilter : string option) ->
     try Hashtbl.find h hostfilter
     with Not_found ->
       let r = match hostfilter with
         | None -> ["*", Netstring_pcre.regexp ".*$", None] (* default = "*:*" *)
         | Some s ->
           let parse_one_host ss =
             let host, port =
               try
                 let dppos = String.index ss ':'
                 and len = String.length ss in
                 let host = String.sub ss 0 dppos
                 and port =
                   match String.sub ss (dppos+1) ((len - dppos) - 1) with
                   | "*" -> None
                   | p -> Some (int_of_string "host" p)
                 in host, port
               with
               | Not_found -> ss, None
               | Failure _ ->
                 raise (Config_file_error "bad port number")
             in
             let split_host = function
               | Str.Delim _ -> ".*"
               | Str.Text t -> Pcre.quote t
             in
             (host,
              Netstring_pcre.regexp
                (String.concat ""
                   ((List.map split_host
                       (Str.full_split
                          (Str.regexp "[*]+") host))@["$"])),
              port)
           in
           List.map parse_one_host
             (Str.split (Str.regexp "[ \t]+") s)
       in
       Hashtbl.add h hostfilter r;
       (r : Ocsigen_extensions.virtual_hosts)
  )

(* Extract a default hostname from the "host" field if no default is
   provided *)
let get_defaulthostname ~defaulthostname ~host =
  match defaulthostname with
  | Some d -> d
  | None ->
    (* We look for a hostname without wildcard (second case).
       Something more clever could be envisioned *)
    let rec aux = function
      | [] ->
        default_default_hostname
      | (t, _, (Some 80 | None)) :: _
        when (not (String.contains t '*')) ->
        t
      | _ :: q -> aux q
    in
    let host = aux host in
    Lwt_log.ign_warning_f ~section
      "While parsing config file, tag <host>: No defaulthostname, \
       assuming it is \"%s\"" host;
    if correct_hostname host then
      host
    else
      raise (Ocsigen_config.Config_file_error
               ("Incorrect hostname " ^ host))

let later_pass_host_attr
    (name, charset,
     defaulthostname, defaulthttpport, defaulthttpsport,
     ishttps) =
  function
  | "hostfilter", s ->
    (match name with
     | None ->
       Some s, charset,
       defaulthostname,
       defaulthttpport,
       defaulthttpsport,
       ishttps
     | _ ->
       raise (Ocsigen_config.Config_file_error
                ("Duplicate attribute name in <host>")))
  | "charset", s ->
    (match charset with
     | None ->
       name, Some s,
       defaulthostname,
       defaulthttpport,
       defaulthttpsport,
       ishttps
     | _ ->
       raise (Ocsigen_config.Config_file_error
                ("Duplicate attribute charset in <host>")))
  | "defaulthostname", s ->
    (match defaulthostname with
     | None ->
       if correct_hostname s then
         name, charset,
         Some s,
         defaulthttpport,
         defaulthttpsport,
         ishttps
       else
         raise (Ocsigen_config.Config_file_error
                  ("Incorrect hostname " ^ s))
     | _ ->
       raise (Ocsigen_config.Config_file_error
                "Duplicate attribute defaulthostname in <host>"))
  | "defaulthttpport", s ->
    (match defaulthttpport with
     | None ->
       name, charset,
       defaulthostname,
       Some s,
       defaulthttpsport,
       ishttps
     | _ ->
       raise (Ocsigen_config.Config_file_error
                ("Duplicate attribute defaulthttpport in <host>")))
  | "defaulthttpsport", s ->
    (match defaulthttpsport with
     | None ->
       name, charset,
       defaulthostname,
       defaulthttpport,
       Some s,
       ishttps
     | _ ->
       raise (Ocsigen_config.Config_file_error
                ("Duplicate attribute defaulthttpsport in <host>")))
  | "defaultprotocol", s ->
    (match ishttps with
     | None ->
       name, charset,
       defaulthostname,
       defaulthttpport,
       defaulthttpsport,
       Some s
     | _ ->
       raise (Ocsigen_config.Config_file_error
                ("Duplicate attribute defaultprotocol in <host>")))
  | attr, _ ->
    raise (Ocsigen_config.Config_file_error
             ("Wrong attribute for <host>: " ^ attr))

let later_pass_host attrs l =
  let host, charset, defaulthostname, defaulthttpport,
      defaulthttpsport, defaultprotocol =
    List.fold_left
      later_pass_host_attr
      (None, None, None, None, None, None)
      (List.rev attrs)
  in
  let host = parse_host_field host in
  let charset =
    match charset, Ocsigen_config.get_default_charset () with
    | Some charset, _
    | None, Some charset -> charset
    | None, None -> "utf-8"
  and defaulthttpport =
    match defaulthttpport with
    | None -> Ocsigen_config.get_default_port ()
    | Some p -> int_of_string "host" p
  and defaulthostname = get_defaulthostname ~defaulthostname ~host
  and defaulthttpsport =
    match defaulthttpsport with
    | None -> Ocsigen_config.get_default_sslport ()
    | Some p -> int_of_string "host" p
  and serve_everything = {
    Ocsigen_extensions.do_not_serve_regexps = [];
    do_not_serve_files = [];
    do_not_serve_extensions = [];
  } in
  let conf = {
    Ocsigen_extensions.default_hostname = defaulthostname;
    default_httpport = defaulthttpport;
    default_httpsport = defaulthttpsport;
    default_protocol_is_https = defaultprotocol = Some "https";
    mime_assoc = Ocsigen_charset_mime.default_mime_assoc ();
    charset_assoc =
      Ocsigen_charset_mime.empty_charset_assoc
        ~default:charset ();
    default_directory_index = ["index.html"];
    list_directory_content = false;
    follow_symlinks = `Owner_match;
    do_not_serve_404 = serve_everything;
    do_not_serve_403 = serve_everything;
    uploaddir = Ocsigen_config.get_uploaddir ();
    maxuploadfilesize = Ocsigen_config.get_maxuploadfilesize ();
  } in
  let parse_config =
    Ocsigen_extensions.make_parse_config []
      (Ocsigen_extensions.parse_config_item None host conf)
  in
  (* default site for host *)
  host, conf, parse_config l

let later_pass_extension tag attrs l =
  (* We do not reload extensions *)
  match attrs with
  | [] ->
    raise
      (Config_file_error
         ("missing module, name or findlib-package attribute in " ^ tag))
  | ["name", s] ->
    Ocsigen_loader.init_module
      (preloadfile l) postloadfile false s
  | ["module", s] ->
    Ocsigen_loader.loadfiles
      (preloadfile l) postloadfile false
      [s];
  | ["findlib-package", s] ->
    Ocsigen_loader.loadfiles
      (preloadfile l) postloadfile false
      (Ocsigen_loader.findfiles s)
  | _ ->
    raise (Config_file_error ("Wrong attribute for " ^ tag))

let rec later_pass_extconf dir =
  let f acc s =
    if Filename.check_suffix s "conf" then
      match
        let filename = dir^"/"^s in
        try
          Lwt_log.ign_info_f ~section
            "Parsing configuration file %s" filename;
          parse_ext filename
        with e ->
          Lwt_log.ign_error_f ~section ~exn:e
            "Error while loading configuration file %s (ignored)"
            filename;
          []
      with
      | [] -> acc
      | s :: _ -> acc @ later_pass s
    else
      acc
  in
  try
    let files = Sys.readdir dir in
    Array.sort compare files;
    Array.fold_left f [] files
  with
  | Sys_error _ as e ->
    Lwt_log.ign_error ~section ~exn:e
      "Error while loading configuration file (ignored)";
    []

(* Config file is parsed twice. This is the second parsing (site
   loading). *)
and later_pass = function
  | [] -> []
  | Element ("port", _atts, _p) :: ll ->
    later_pass ll
  | Element ("charset" as st, _atts, p) :: ll ->
    set_default_charset (Some (parse_string_tag st p));
    later_pass ll
  | Element ("logdir", [], _p) :: ll ->
    later_pass ll
  | Element ("syslog", [], _p) :: ll ->
    later_pass ll
  | Element ("ssl", [], _p) :: ll ->
    later_pass ll
  | Element ("user", [], _p) :: ll ->
    later_pass ll
  | Element ("group", [], _p) :: ll ->
    later_pass ll
  | Element ("uploaddir" as st, [], p) :: ll ->
    set_uploaddir (Some (parse_string_tag st p));
    later_pass ll
  | Element ("datadir" as st, [], p) :: ll ->
    set_datadir (parse_string_tag st p);
    later_pass ll
  | Element ("minthreads", [], _p) :: ll ->
    later_pass ll
  | Element ("maxthreads", [], _p) :: ll ->
    later_pass ll
  | Element ("maxdetachedcomputationsqueued" as st, [], p) :: ll ->
    set_max_number_of_threads_queued
      (int_of_string st (parse_string_tag st p));
    later_pass ll
  | Element ("maxconnected" as st, [], p) :: ll ->
    set_max_number_of_connections (int_of_string st (parse_string_tag st p));
    later_pass ll
  | Element ("mimefile" as st, [], p) :: ll ->
    Ocsigen_config.set_mimefile (parse_string_tag st p);
    later_pass ll
  | Element ("maxretries" as st, [], p) :: ll ->
    set_maxretries (int_of_string st (parse_string_tag st p));
    later_pass ll
  | Element ("timeout" as st, [], p) :: ll
  | Element ("clienttimeout" as st, [], p) :: ll ->
    set_client_timeout (int_of_string st (parse_string_tag st p));
    later_pass ll
  | Element ("servertimeout" as st, [], p) :: ll ->
    set_server_timeout (int_of_string st (parse_string_tag st p));
    later_pass ll
  | Element ("netbuffersize" as st, [], p) :: ll ->
    Ocsigen_stream.set_net_buffer_size
      (int_of_string st (parse_string_tag st p));
    later_pass ll
  | Element ("filebuffersize" as st, [], p) :: ll ->
    set_filebuffersize (int_of_string st (parse_string_tag st p));
    later_pass ll
  | Element ("maxrequestbodysize" as st, [], p) :: ll ->
    set_maxrequestbodysize (parse_size_tag st (parse_string_tag st p));
    later_pass ll
  | Element ("maxuploadfilesize" as st, [], p) :: ll ->
    set_maxuploadfilesize (parse_size_tag st (parse_string_tag st p));
    later_pass ll
  | Element ("commandpipe" as st, [], p) :: ll ->
    set_command_pipe (parse_string_tag st p);
    later_pass ll
  | Element ("shutdowntimeout" as st, [], p) :: ll ->
    set_shutdown_timeout
      (match parse_string_tag st p with
       | "notimeout" ->
         None
       | p ->
         Some (float_of_string st p));
    later_pass ll
  | Element ("debugmode", [], []) :: ll ->
    set_debugmode true;
    later_pass ll
  | Element ("usedefaulthostname", [], []) :: ll ->
    set_usedefaulthostname true;
    later_pass ll
  | Element ("disablepartialrequests", [], []) :: ll ->
    set_disablepartialrequests true;
    later_pass ll
  | Element ("respectpipeline", [], []) :: ll ->
    set_respect_pipeline ();
    later_pass ll
  | Element ("findlib", ["path",p], []) :: ll ->
    Ocsigen_loader.add_ocamlpath p;
    later_pass ll
  | Element ("require", atts, l) :: ll
  | Element ("extension", atts, l) :: ll ->
    later_pass_extension "<extension>" atts l;
    later_pass ll
  | Element ("library", atts, l) :: ll ->
    later_pass_extension "<library>" atts l;
    later_pass ll
  | Element ("host", atts, l) :: ll ->
    (* The evaluation order is important here *)
    let h = later_pass_host atts l in h :: later_pass ll
  | Element ("extconf", [("dir", dir)], []) :: ll ->
    (* The evaluation order is important here *)
    let h = later_pass_extconf dir in h @ later_pass ll
  | Element (tag, _, _) :: _ ->
    raise (Config_file_error
             ("tag <"^tag^"> unexpected inside <server>"))
  | _ ->
    raise (Config_file_error "Syntax error")

let later_pass l = Ocsigen_extensions.set_hosts (later_pass l)

(* Parsing <port> tags *)
let parse_port =
  let all_ipv6 = Netstring_pcre.regexp "^\\[::\\]:([0-9]+)$" in
  let all_ipv4 = Netstring_pcre.regexp "^\\*:([0-9]+)$" in
  let single_ipv6 = Netstring_pcre.regexp "^\\[([0-9A-Fa-f.:]+)\\]:([0-9]+)$" in
  let single_ipv4 = Netstring_pcre.regexp "^([0-9.]+):([0-9]+)$" in
  fun s ->
    let do_match r = Netstring_pcre.string_match r s 0 in
    let get x i = Netstring_pcre.matched_group x i s in
    match do_match all_ipv6 with
    | Some r ->
      `IPv6 (Unix.inet6_addr_any),
      int_of_string "port" (get r 1)
    | None -> match do_match all_ipv4 with
      | Some r ->
        `IPv4 (Unix.inet_addr_any),
        int_of_string "port" (get r 1)
      | None -> match do_match single_ipv6 with
        | Some r ->
          `IPv6 (Unix.inet_addr_of_string (get r 1)),
          int_of_string "port" (get r 2)
        | None -> match do_match single_ipv4 with
          | Some r ->
            `IPv4 (Unix.inet_addr_of_string (get r 1)),
            int_of_string "port" (get r 2)
          | None ->
            `All,
            int_of_string "port" s

let parse_facility = function
  | "auth" -> `Auth
  | "authpriv" -> `Authpriv
  | "console" -> `Console
  | "cron" -> `Cron
  | "daemon" -> `Daemon
  | "ftp" -> `FTP
  | "kernel" -> `Kernel
  | "lpr" -> `LPR
  | "local0" -> `Local0
  | "local1" -> `Local1
  | "local2" -> `Local2
  | "local3" -> `Local3
  | "local4" -> `Local4
  | "local5" -> `Local5
  | "local6" -> `Local6
  | "local7" -> `Local7
  | "mail" -> `Mail
  | "ntp" -> `NTP
  | "news" -> `News
  | "security" -> `Security
  | "syslog" -> `Syslog
  | "uucp" -> `UUCP
  | "user" -> `User
  | t -> raise (Config_file_error ("Unknown " ^ t ^ " facility in <syslog>"))

(* First parsing of config file *)

let config_error_for_some s = function
  | None -> ()
  | _ -> raise (Config_file_error s)

let make_ssl_info ~certificate ~privatekey ~ciphers ~dhfile ~curve = {
  Ocsigen_config.
  ssl_certificate = certificate;
  ssl_privatekey  = privatekey;
  ssl_ciphers     = ciphers;
  ssl_dhfile      = dhfile;
  ssl_curve       = curve
}

let rec parse_ssl l ~certificate ~privatekey ~ciphers ~dhfile ~curve =
  match l with
  | [] ->
    Some (make_ssl_info ~certificate ~privatekey ~ciphers ~dhfile ~curve)
  | Element ("certificate" as st, [], p) :: l ->
    config_error_for_some "Two certificates inside <ssl>" certificate;
    let certificate = Some (parse_string_tag st p) in
    parse_ssl ~certificate ~privatekey ~ciphers ~dhfile ~curve l
  | Element ("privatekey" as st, [], p) ::l ->
    config_error_for_some "Two private keys inside <ssl>" privatekey;
    let privatekey = Some (parse_string_tag st p) in
    parse_ssl ~certificate ~privatekey ~ciphers ~dhfile ~curve l
  | Element ("ciphers" as st, [], p) :: l ->
    config_error_for_some "Two cipher strings inside <ssl>" ciphers;
    let ciphers = Some (parse_string_tag st p) in
    parse_ssl ~certificate ~privatekey ~ciphers ~dhfile ~curve l
  | Element ("dhfile" as st, [], p) :: l ->
    config_error_for_some "Two DH files inside <ssl>" dhfile;
    let dhfile = Some (parse_string_tag st p) in
    parse_ssl ~certificate ~privatekey ~ciphers ~dhfile ~curve l
  | Element ("curve" as st, [], p) :: l ->
    config_error_for_some "Two (EC) curves inside <ssl>" curve;
    let curve = Some (parse_string_tag st p) in
    parse_ssl ~certificate ~privatekey ~ciphers ~dhfile ~curve l
  | Element (tag, _, _) :: _l ->
    raise (Config_file_error ("<"^tag^"> tag unexpected inside <ssl>"))
  | _ ->
    raise (Config_file_error ("Unexpected content inside <ssl>"))

let first_pass c =
  let rec aux user group ssl ports sslports = function
      [] -> ((user, group), (ssl, ports, sslports))
    | Element ("logdir" as st, [], p) :: ll ->
      set_logdir (parse_string_tag st p);
      aux user group ssl ports sslports ll
    | Element ("syslog" as st, [], p) :: ll ->
      let str = String.lowercase_ascii (parse_string_tag st p) in
      set_syslog_facility (Some (parse_facility str));
      aux user group ssl ports sslports ll
    | Element ("port" as st, atts, p) :: ll ->
      (match atts with
         []
       | [("protocol", "HTTP")] ->
         let po =
           try
             parse_port (parse_string_tag st p)
           with Failure _ ->
             raise (Config_file_error "Wrong value for <port> tag")
         in
         aux user group ssl (po::ports) sslports ll
       | [("protocol", "HTTPS")] ->
         let po = try
             parse_port (parse_string_tag st p)
           with Failure _ ->
             raise (Config_file_error "Wrong value for <port> tag")
         in
         aux user group ssl ports (po::sslports) ll
       | _ -> raise (Config_file_error "Wrong attribute for <port>"))
    | Element ("minthreads" as st, [], p) :: ll ->
      set_minthreads (int_of_string st (parse_string_tag st p));
      aux user group ssl ports sslports ll
    | Element ("maxthreads" as st, [], p) :: ll ->
      set_maxthreads (int_of_string st (parse_string_tag st p));
      aux user group ssl ports sslports ll
    | Element ("ssl", [], p) :: ll ->
      (match ssl with
         None ->
         let ssl =
           let certificate = None
           and privatekey = None
           and ciphers = None
           and dhfile = None
           and curve = None in
           parse_ssl ~certificate ~privatekey ~ciphers ~dhfile ~curve p
         in
         aux user group ssl ports sslports ll
       | _ ->
         raise
           (Config_file_error
              "Only one ssl certificate for each server supported for now"))
    | Element ("user" as st, [], p) :: ll ->
      (match user with
         None ->
         aux (Some (parse_string_tag st p)) group ssl ports sslports ll
       | _ -> raise (Config_file_error
                       "Only one <user> tag for each server allowed"))
    | Element ("group" as st, [], p) :: ll ->
      (match group with
         None ->
         aux user (Some (parse_string_tag st p)) ssl ports sslports ll
       | _ -> raise (Config_file_error
                       "Only one <group> tag for each server allowed"))
    | Element ("commandpipe" as st, [], p) :: ll ->
      set_command_pipe (parse_string_tag st p);
      aux user group ssl ports sslports ll
    | Element _ :: ll ->
      aux user group ssl ports sslports ll
    | _ ->
      raise (Config_file_error "Syntax error")
  in
  let (user, group), (si, ports, ssl_ports) =
    aux None None None [] [] c
  in
  let user = match user with
      None -> None (* Some (get_default_user ()) *)
    | Some s -> if s = "" then None else Some s
  in
  let group = match group with
      None -> None (* Some (get_default_group ()) *)
    | Some s -> if s = "" then None else Some s
  in
  Ocsigen_config.set_user user;
  Ocsigen_config.set_group group;
  Ocsigen_config.set_ssl_info si;
  Ocsigen_config.set_ports ports;
  Ocsigen_config.set_ssl_ports ssl_ports;
  ()

let parse_config ?file () =
  let file =
    match file with
    | None -> Ocsigen_config.get_config_file ()
    | Some f -> f
  in
  parser_config (Xml.parse_file file)