From: rich Date: Wed, 6 Oct 2004 10:34:29 +0000 (+0000) Subject: The 'create host' code is now in a separate library so TNAAA can call it. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=253dcc86ed026e18643f07559009b1d50ea5b800;p=cocanwiki.git The 'create host' code is now in a separate library so TNAAA can call it. --- diff --git a/MANIFEST b/MANIFEST index e06eace..cb13c83 100644 --- a/MANIFEST +++ b/MANIFEST @@ -54,6 +54,8 @@ scripts/admin/host.ml scripts/change_password.ml scripts/change_password_form.ml scripts/cocanwiki.ml +scripts/cocanwiki_create_host.ml +scripts/cocanwiki_create_host.mli scripts/cocanwiki_date.ml scripts/cocanwiki_diff.ml scripts/cocanwiki_emailnotify.ml diff --git a/scripts/.depend b/scripts/.depend index f4503cf..87ebd07 100644 --- a/scripts/.depend +++ b/scripts/.depend @@ -6,6 +6,8 @@ change_password_form.cmo: cocanwiki.cmo cocanwiki_template.cmi change_password_form.cmx: cocanwiki.cmx cocanwiki_template.cmx cocanwiki.cmo: cocanwiki_ok.cmo cocanwiki_strings.cmo cocanwiki.cmx: cocanwiki_ok.cmx cocanwiki_strings.cmx +cocanwiki_create_host.cmo: cocanwiki_create_host.cmi +cocanwiki_create_host.cmx: cocanwiki_create_host.cmi cocanwiki_diff.cmo: cocanwiki_files.cmo cocanwiki_diff.cmx: cocanwiki_files.cmx cocanwiki_images.cmo: cocanwiki_files.cmo cocanwiki_strings.cmo \ @@ -224,8 +226,10 @@ wikilib.cmo: cocanwiki_strings.cmo wikilib.cmi wikilib.cmx: cocanwiki_strings.cmx wikilib.cmi admin/admin.cmo: cocanwiki.cmo cocanwiki_date.cmo cocanwiki_template.cmi admin/admin.cmx: cocanwiki.cmx cocanwiki_date.cmx cocanwiki_template.cmx -admin/create_host.cmo: cocanwiki.cmo cocanwiki_ok.cmo cocanwiki_strings.cmo -admin/create_host.cmx: cocanwiki.cmx cocanwiki_ok.cmx cocanwiki_strings.cmx +admin/create_host.cmo: cocanwiki.cmo cocanwiki_create_host.cmi \ + cocanwiki_ok.cmo cocanwiki_strings.cmo +admin/create_host.cmx: cocanwiki.cmx cocanwiki_create_host.cmx \ + cocanwiki_ok.cmx cocanwiki_strings.cmx admin/create_host_form.cmo: cocanwiki.cmo cocanwiki_template.cmi admin/create_host_form.cmx: cocanwiki.cmx cocanwiki_template.cmx admin/edit_emails.cmo: cocanwiki.cmo cocanwiki_ok.cmo cocanwiki_strings.cmo diff --git a/scripts/Makefile b/scripts/Makefile index 1008ebf..8022749 100644 --- a/scripts/Makefile +++ b/scripts/Makefile @@ -1,5 +1,5 @@ # Makefile for COCANWIKI. -# $Id: Makefile,v 1.31 2004/09/29 09:44:52 rich Exp $ +# $Id: Makefile,v 1.32 2004/10/06 10:34:29 rich Exp $ include ../Makefile.config @@ -20,7 +20,8 @@ LIB_OBJS := \ cocanwiki_diff.cmo \ cocanwiki_emailnotify.cmo \ wikilib.cmo \ - cocanwiki_links.cmo + cocanwiki_links.cmo \ + cocanwiki_create_host.cmo OBJS := change_password.cmo \ change_password_form.cmo \ diff --git a/scripts/admin/create_host.ml b/scripts/admin/create_host.ml index ff41490..9e1b627 100644 --- a/scripts/admin/create_host.ml +++ b/scripts/admin/create_host.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_host.ml,v 1.6 2004/10/04 14:46:51 rich Exp $ + * $Id: create_host.ml,v 1.7 2004/10/06 10:34:30 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 @@ -29,6 +29,7 @@ open Cgi open Printf open Cocanwiki_strings +open Cocanwiki_create_host let split_re = Pcre.regexp "[\\s,;]+" @@ -62,132 +63,12 @@ let run r = 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 template = + if q#param_true "template" then int_of_string (q#param "template") + else 0 in - 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); - - (* Force new host.is_template field to false. *) - let sth = - dbh#prepare_cached - "update hosts set is_template = false where id = ?" in - sth#execute [`Int hostid]; - - (* 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 id 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]; + let hostid = create_host dbh canonical_hostname hostnames template title + "Administrator" "123456" true in (* Commit to the database. *) dbh#commit (); diff --git a/scripts/cocanwiki_create_host.ml b/scripts/cocanwiki_create_host.ml new file mode 100644 index 0000000..b528efd --- /dev/null +++ b/scripts/cocanwiki_create_host.ml @@ -0,0 +1,150 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: cocanwiki_create_host.ml,v 1.1 2004/10/06 10:34:29 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. + *) + +open Apache +open Registry +open Cgi +open Printf + +let create_host dbh canonical_hostname hostnames template + title username password force_password_change = + 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 template = 0 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. *) + + (*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" && + name <> "is_template" 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 id 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 (?, ?, ?, ?, + true)" in + sth#execute [`Int hostid; `String username; `String password; + `Bool force_password_change]; + + hostid diff --git a/scripts/cocanwiki_create_host.mli b/scripts/cocanwiki_create_host.mli new file mode 100644 index 0000000..5f38702 --- /dev/null +++ b/scripts/cocanwiki_create_host.mli @@ -0,0 +1,23 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: cocanwiki_create_host.mli,v 1.1 2004/10/06 10:34:29 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. + *) + +val create_host : Dbi.connection -> string -> string list -> int -> + string -> string -> string -> bool -> int