X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=tools%2Fcopy_host.ml;fp=tools%2Fcopy_host.ml;h=fd98c8c2038c200396c4ce8bac42be480431a4c8;hb=b4571f671f34d60584aedde45503e2ec4930d57f;hp=e8c27cd316aeec572c0b048b9a83e927ef1175b7;hpb=546de7d9d904dd6130523df520d0b77c28c6bfe4;p=cocanwiki.git

diff --git a/tools/copy_host.ml b/tools/copy_host.ml
index e8c27cd..fd98c8c 100644
--- a/tools/copy_host.ml
+++ b/tools/copy_host.ml
@@ -3,7 +3,7 @@
  *
  * Use 'copy_host --help' for usage.
  *
- * $Id: copy_host.ml,v 1.3 2006/09/11 10:01:07 rich Exp $
+ * $Id: copy_host.ml,v 1.4 2006/12/11 15:28:50 rich Exp $
  *)
 
 open Printf
@@ -26,7 +26,7 @@ BASIC USAGE
   Copy a host from the local database server to another.  The copy
   will have the same canonical and alternate hostnames:
 
-    copy_host -short mysite.example.com -ddbhost anotherdb.example.com
+    copy_host -shost mysite.example.com -ddbhost anotherdb.example.com
 
 TERMINOLOGY
 
@@ -107,6 +107,42 @@ In this case it is probably better not to specify the '-sdb***'
 or '-ddb***' parameters, but instead use environment variables,
 or run this program on the database server itself.
 
+TESTING
+
+Use -dryrun as a parameter to test the copy.  This does everything
+and then rolls back the database at the end.
+
+STAGING SERVER
+
+It is possible to use this script to implement a staging server.
+
+The basic setup is that you have two hosts (called for example
+'staging.example.com' and 'www.example.com' where the latter
+is the live site).  Create the staging host first (or use
+copy_host to duplicate it from the live host if you already
+have one).  Do all editing on the staging server.
+
+When you are satisfied with the state of the staging server
+and are ready to go live, use the following command:
+
+  copy_host -shost staging.example.com -dhost www.example.com,example.com \
+    -overwrite -disableedit -enableviewanon
+
+The key options to take note of are:
+
+  -overwrite   If the dhost already exists, it can be overwritten.
+          (In fact what happens is that the existing destination
+          host is renamed to a unique name like 'deleted-<timestamp>')
+
+  -disableedit  This disables the editing capability of all users on
+          the destination host.  This stops users from accidentally
+          editing the live site.
+
+  -enableviewanon  This enables anonymous viewing on the destination
+          host (assuming that the staging server is configured to
+          only allow logged in users to view, which is usually the
+          right thing to do).
+
 OPTIONS
 "
 
@@ -123,6 +159,9 @@ let ddbpassword = ref ""
 let sdbdatabase = ref "cocanwiki"
 let ddbdatabase = ref "cocanwiki"
 let dryrun = ref false
+let overwrite = ref false
+let disableedit = ref false
+let enableviewanon = ref false
 
 let argspec = [
   "-shost", Arg.Set_string shost,
@@ -151,6 +190,12 @@ let argspec = [
     "Destination database name (default: cocanwiki).";
   "-dryrun", Arg.Set dryrun,
     "Rollback database changes at the end.";
+  "-overwrite", Arg.Set overwrite,
+    "Allow the destination host to be overwritten.";
+  "-disableedit", Arg.Set disableedit,
+    "Disable users.can_edit on the destination host.";
+  "-enableviewanon", Arg.Set enableviewanon,
+    "Enable hosts.view_anon  on the destination host.";
 ]
 
 let error _ = raise (Arg.Bad "Use --help for help.")
@@ -176,6 +221,9 @@ let ddbpassword = match !ddbpassword with "" -> None | s -> Some s
 let sdbdatabase = match !sdbdatabase with "" -> None | s -> Some s
 let ddbdatabase = match !ddbdatabase with "" -> None | s -> Some s
 let dryrun = !dryrun
+let overwrite = !overwrite
+let disableedit = !disableedit
+let enableviewanon = !enableviewanon
 
 (* Get column names from a table. *)
 let columns dbh table_name =
@@ -280,6 +328,10 @@ let value_of_int32 i =
   let i = Int32.to_string i in
   Some i
 
+let value_of_bool b =
+  let b = string_of_bool b in
+  Some b
+
 let () =
   print_endline "Connecting to databases ...";
   print_endline "  Source ...";
@@ -331,6 +383,31 @@ let () =
     | [] -> scanonical_hostname, shostnames
     | x :: xs -> x, (x :: xs) in
 
+  (* Does the destination host already exist? *)
+  let dhost_exists, old_dhostid =
+    let rows =
+      PGSQL(ddbh)
+	"select hostid from hostnames where name = $dcanonical_hostname" in
+    match rows with
+    | [dhostid] -> true, dhostid
+    | _ -> false, (-1_l) in
+  if dhost_exists then (
+    if overwrite then (
+      (* Rename the destination host. *)
+      let name = sprintf "deleted-%g" (Unix.time ()) in
+
+      printf "Renaming old host %s to %s\n%!" dcanonical_hostname name;
+
+      PGSQL(ddbh)
+	"update hosts set canonical_hostname = $name where id = $old_dhostid";
+      PGSQL(ddbh)
+	"delete from hostnames where hostid = $old_dhostid";
+      PGSQL(ddbh)
+	"insert into hostnames (hostid, name) values ($old_dhostid, $name)";
+    ) else
+      failwith "Destination host exists.  Did you mean to use -overwrite?"
+  );
+
   print_endline "Create new host ...";
 
   let columns, rows =
@@ -346,6 +423,11 @@ let () =
       (Some dcanonical_hostname) in
   assert (List.length columns = nr_columns - 1);
   assert (List.length rows = 1);
+  let columns, rows =
+    if enableviewanon then
+      update_column columns rows "view_anon" (value_of_bool true)
+    else
+      columns, rows in
   let serials = insert_serial ddbh "hosts" columns rows "id" in
   assert (List.length serials = 1);
   let dhostid = List.hd serials in
@@ -373,6 +455,11 @@ let () =
     remove_column columns rows "id" in
   let columns, rows =
     update_column columns rows "hostid" (value_of_int32 dhostid) in
+  let columns, rows =
+    if disableedit then
+      update_column columns rows "can_edit" (value_of_bool false)
+    else
+      columns, rows in
   let new_ids =
     insert_serial ddbh "users" columns rows "id" in