2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: create_host.ml,v 1.2 2004/09/07 14:58:34 rich Exp $
6 * NB. Because there might not be any hosts existing when this Wiki
7 * is created, this is not a normal Cocanwiki.register_script script.
8 * Instead, we're using the standard mod_caml Registry.
16 open Cocanwiki_strings
18 let split_re = Pcre.regexp "[\\s,;]+"
22 let dbh = Cocanwiki._get_dbh r in
24 let canonical_hostname = q#param "canonical_hostname" in
25 let hostnames = try q#param "hostnames" with Not_found -> "" in
26 let title = q#param "title" in
28 (* Check the title is reasonable. *)
29 let title = trim title in
31 Cocanwiki_ok.error ~back_button:true ~title:"Bad title"
32 q "You must give a title for this Wiki.";
34 (* In theory we could verify characters in hostnames. However
35 * it's probably best to assume the sysadmin knows what they're up to
36 * here. If this script is allowed to be accessed by untrusted
37 * users, then this has security implications.
39 let check_hostname h =
40 let h = trim h in (* Trim whitespace. *)
41 let h = String.lowercase h in (* Lowercase. *)
45 let canonical_hostname = check_hostname canonical_hostname in
46 let hostnames = Pcre.split ~rex:split_re hostnames in
47 let hostnames = List.map check_hostname hostnames in
48 let hostnames = List.filter ((<>) "") hostnames in
50 (* Update the database. *)
51 let sth = dbh#prepare_cached
52 "set constraints \"hosts_hostname_cn\" deferred" in
54 let sth = dbh#prepare_cached "insert into hosts (canonical_hostname)
56 sth#execute [`String canonical_hostname];
58 let hostid = sth#serial "hosts_id_seq" in
60 let sth = dbh#prepare_cached "insert into hostnames (hostid, name)
62 sth#execute [`Int hostid; `String canonical_hostname];
63 List.iter (fun name ->
64 sth#execute [`Int hostid; `String name]) hostnames;
66 let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
67 description) values (?, 'index', ?, ?)" in
68 sth#execute [`Int hostid; `String title; `String title];
70 (* Commit to the database. *)
73 (* Print confirmation page. *)
75 { StdPages.label = "OK";
76 StdPages.link = "/_bin/admin/host.cmo";
77 StdPages.method_ = None;
78 StdPages.params = [ "hostid", string_of_int hostid ] }
81 Cocanwiki_ok.ok ~title:"Wiki created" ~buttons
82 q "A new Wiki was created."