(* COCANWIKI - a wiki written in Objective CAML.
 * Written by Richard W.M. Jones <rich@merjis.com>.
 * Copyright (C) 2004 Merjis Ltd.
 * $Id: create_host.ml,v 1.4 2004/09/25 11:45:59 rich Exp $
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 * Boston, MA 02111-1307, USA.
 *
 * NB. Because there might not be any hosts existing when this Wiki
 * is created, this is not a normal Cocanwiki.register_script script.
 * Instead, we're using the standard mod_caml Registry.
 *)

open Apache
open Registry
open Cgi
open Printf

open Cocanwiki_strings

let split_re = Pcre.regexp "[\\s,;]+"

let run r =
  let q = new cgi r in
  let dbh = Cocanwiki._get_dbh r in

  let canonical_hostname = q#param "canonical_hostname" in
  let hostnames = try q#param "hostnames" with Not_found -> "" in
  let title = q#param "title" in

  (* Check the title is reasonable. *)
  let title = trim title in
  if title = "" then (
    Cocanwiki_ok.error ~back_button:true ~title:"Bad title"
      q "You must give a title for this Wiki.";
  ) else (
    (* In theory we could verify characters in hostnames.  However
     * it's probably best to assume the sysadmin knows what they're up to
     * here.  If this script is allowed to be accessed by untrusted
     * users, then this has security implications.
     *)
    let check_hostname h =
      let h = trim h in			(* Trim whitespace. *)
      let h = String.lowercase h in	(* Lowercase. *)
      h
    in

    let canonical_hostname = check_hostname canonical_hostname in
    let hostnames = Pcre.split ~rex:split_re hostnames in
    let hostnames = List.map check_hostname hostnames in
    let hostnames = List.filter ((<>) "") hostnames in

    let sth =
      dbh#prepare_cached "set constraints hosts_hostname_cn deferred" in
    sth#execute [];
    let sth = dbh#prepare_cached "insert into hosts (canonical_hostname)
                                    values (?)" in
    sth#execute [`String canonical_hostname];

    let hostid = sth#serial "hosts_id_seq" in

    let sth = dbh#prepare_cached "insert into hostnames (hostid, name)
                                    values (?, ?)" in
    sth#execute [`Int hostid; `String canonical_hostname];
    List.iter (fun name ->
		 sth#execute [`Int hostid; `String name]) hostnames;

    (* Are we creating a blank site or copying a template? *)
    if not (q#param_true "template") then (
      (* Blank site. *)

      let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
                                    description) values (?, 'index', ?, ?)" in
      sth#execute [`Int hostid; `String title; `String title];

    ) else (
      (* Copy from template. *)
      let template = int_of_string (q#param "template") in

      (*dbh#set_debug true;*)

      let sth = dbh#prepare_cached "select * from hosts where id = ?" in
      sth#execute [`Int template];

      let names = sth#names in
      let row = sth#fetch1 () in
      sth#finish ();

      List.iter
	(fun (name, field) ->
	   if name <> "id" && name <> "canonical_hostname" then (
	     let sql = "update hosts set " ^ name ^ " = ? where id = ?" in
	     let sth = dbh#prepare_cached sql in
	     sth#execute [field; `Int hostid]
	   )
	) (List.combine names row);

      (* Copy pages. *)
      let sth =
	dbh#prepare_cached
	  "insert into pages (hostid, url, title, description, redirect, css)
           select ?, url, title, description, redirect, css
             from pages
            where hostid = ? and url is not null" in
      sth#execute [`Int hostid; `Int template];

      (* Copy page contents. *)
      let sth =
	dbh#prepare_cached
	  "insert into contents (pageid, ordering, sectionname, content,
                                 divname)
           select (select id from pages where hostid = ? and url = p.url),
                  c.ordering, c.sectionname, c.content, c.divname
             from contents c, pages p
            where c.pageid = p.id and p.hostid = ? and p.url is not null" in
      sth#execute [`Int hostid; `Int template];

      (* Copy files and images. *)
      let sth =
	dbh#prepare_cached
	  "insert into files (hostid, name, content, title, mime_type)
           select ?, name, content, title, mime_type
             from files
            where hostid = ? and name is not null" in
      sth#execute [`Int hostid; `Int template];

      let sth =
	dbh#prepare_cached
	  "insert into images (hostid, name, image, width, height, alt, title,
                               longdesc, class, mime_type, thumbnail,
                               tn_width, tn_height, tn_mime_type)
           select ?, name, image, width, height, alt, title, longdesc, class,
                  mime_type, thumbnail, tn_width, tn_height, tn_mime_type
             from images
            where hostid = ? and name is not null" in
      sth#execute [`Int hostid; `Int template];

      (* Copy sitemenu. *)
      let sth =
	dbh#prepare_cached
	  "insert into sitemenu (hostid, url, label, ordering)
           select ?, url, label, ordering from sitemenu where hostid = ?" in
      sth#execute [`Int hostid; `Int template];

      (* Copy contacts. *)
      let sth =
	dbh#prepare_cached
	  "insert into contacts (hostid, name, subject)
           select ?, name, subject from contacts where hostid = ?" in
      sth#execute [`Int hostid; `Int template];

      let sth =
	dbh#prepare_cached
	  "insert into contact_emails (contactid, email)
           select (select contactid from contacts
                    where hostid = ? and name = c.name), ce.email
             from contact_emails ce, contacts c
            where ce.contactid = c.id and c.hostid = ?" in
      sth#execute [`Int hostid; `Int template];

      (* Set the title of the index page. *)
      let sth = dbh#prepare_cached "update pages set title = ?
                                     where hostid = ? and url = 'index'" in
      sth#execute [`String title; `Int hostid]
    );

    (* Create the administrator user. *)
    let sth = dbh#prepare_cached "insert into users (hostid, name, password,
                                  force_password_change, can_manage_users)
                                  values (?, 'Administrator', '123456', true,
                                  true)" in
    sth#execute [`Int hostid];

    (* Commit to the database. *)
    dbh#commit ();

    (* Print confirmation page. *)
    let buttons = [
      { StdPages.label = "OK";
	StdPages.link = "/_bin/admin/host.cmo";
	StdPages.method_ = None;
	StdPages.params = [ "hostid", string_of_int hostid ] }
    ] in

    Cocanwiki_ok.ok ~title:"Wiki created" ~buttons
      q "A new Wiki was created."
  )

let () =
  register_script run