2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: edit_hostnames.ml,v 1.1 2004/09/07 10:14:10 rich Exp $
17 let split_re = Pcre.regexp "[\\s,;]+"
19 let run r (q : cgi) (dbh : Dbi.connection) hostid_hostname _ =
20 let hostid = int_of_string (q#param "hostid") in
22 if q#param_true "cancel" then (
23 let _, hostname = hostid_hostname in
24 q#redirect ("http://" ^ hostname ^ "/_bin/admin/host.cmo?hostid=" ^
25 string_of_int hostid);
29 let canonical_hostname = q#param "canonical_hostname" in
30 let hostnames = try q#param "hostnames" with Not_found -> "" in
32 (* In theory we could verify characters in hostnames, and call
33 * error / raise CgiExit if the format is incorrect. However
34 * it's probably best to assume the sysadmin knows what they're up to
35 * here. If this script is allowed to be accessed by untrusted users,
36 * then this has security implications.
38 let check_hostname h =
39 let h = trim h in (* Trim whitespace. *)
40 let h = String.lowercase h in (* Lowercase. *)
44 let canonical_hostname = check_hostname canonical_hostname in
45 let hostnames = Pcre.split ~rex:split_re hostnames in
46 let hostnames = List.map check_hostname hostnames in
47 let hostnames = List.filter ((<>) "") hostnames in
49 (* Update the database. *)
50 let sth = dbh#prepare_cached
51 "set constraints \"hosts_hostname_cn\" deferred" in
53 let sth = dbh#prepare_cached "update hosts set canonical_hostname = ?
55 sth#execute [`String canonical_hostname; `Int hostid];
56 let sth = dbh#prepare_cached "delete from hostnames where hostid = ?" in
57 sth#execute [`Int hostid];
58 let sth = dbh#prepare_cached "insert into hostnames (hostid, name)
60 sth#execute [`Int hostid; `String canonical_hostname];
61 List.iter (fun name ->
62 sth#execute [`Int hostid; `String name]) hostnames;
64 (* Commit to the database. *)
67 (* Print confirmation page. *)
69 { StdPages.label = "OK";
70 StdPages.link = "/_bin/admin/host.cmo";
71 StdPages.method_ = None;
72 StdPages.params = [ "hostid", string_of_int hostid ] }
75 ok ~title:"Saved" ~buttons
76 q "Hostnames updated."