tools/copy_host.ml

   1 (* Copy a whole host (site).  This can also copy between databases and
   2  * servers.
   3  *
   4  * Use 'copy_host --help' for usage.
   5  *
   6  * $Id: copy_host.ml,v 1.1 2006/09/09 15:08:08 rich Exp $
   7  *)
   8
   9 open Printf
  10 open ExtList
  11 open ExtString
  12
  13 let usage =
  14   "copy_host can be used to copy/duplicate a whole host (site).
  15 It can also copy hosts between databases and database server.
  16
  17   Please read the instructions below carefully before attempting
  18   to use this program!
  19
  20 BASIC USAGE
  21
  22   Duplicate a host on the same (local) database server:
  23
  24     copy_host -shost mysite.example.com -dhost mycopy.example.com
  25
  26   Copy a host from the local database server to another.  The copy
  27   will have the same canonical and alternate hostnames:
  28
  29     copy_host -short mysite.example.com -ddbhost anotherdb.example.com
  30
  31 TERMINOLOGY
  32
  33 'host': The term used by COCANWIKI to mean a site.  Each host has
  34   a single row in the 'hosts' table in the database, and a single
  35   unique hostid.  A single COCANWIKI database instance can handle
  36   an unlimited number of hosts.
  37
  38 'canonical hostname': The standard hostname for a host.  See the
  39   hosts.canonical_hostname column.
  40
  41 'hostname': Any of the hostnames permitted for a host.  Most sites
  42   will only have one, the canonical_hostname, but some will have
  43   several names, eg. 'example.com' and 'www.example.com'.  See
  44   the 'hostnames' table.
  45
  46 'source ***', 'destination ***': When copying hosts, you copy
  47   from the source whatever to the destination whatever.
  48
  49 'database hostname': The name of the server running the PostgreSQL
  50   database.  When copying a host between databases, you have a
  51   source database hostname and a destination database hostname.
  52
  53 'database name': The name of the PostgreSQL database (not the
  54   name of the server, but the name of the database).  Usually
  55   'cocanwiki'.  Use the command 'psql -l' to list database
  56   names.
  57
  58 SELECTING THE SOURCE AND DESTINATION HOSTS
  59
  60 In general, any parameter beginning with '-s***' refers to the
  61 source and with '-d***' to the destination.
  62
  63 The '-shost hostname' parameter is required, and it selects the
  64 particular host which you want to copy/duplicate.  You may give
  65 either the canonical hostname or one of the alternate hostnames,
  66 since either uniquely identifies the source host you want to
  67 copy.
  68
  69 '-dhost hostname[,...]' is an optional parameter which specifies
  70 the destination hostnames (canonical and alternates).
  71
  72   If not given, then the same hostname(s) are used as the source.
  73   This only makes sense when copying a host between database
  74   instances, since a single database instance cannot contain
  75   multiple hosts with the same hostnames.
  76
  77   If given with a single hostname, then that hostname is used
  78   as the canonical hostname for the copy.
  79
  80   If given with multiple (comma-separated) hostnames, then
  81   the first one is the canonical hostname and the subsequent
  82   ones are the alternate hostnames, eg:
  83
  84     -dhost www.example.com,example.com
  85
  86 SELECTING THE SOURCE AND DESTINATION DATABASE(S)
  87
  88 '-sdb***' and '-ddb***' parameters can be used to select
  89 different source and destination database instances.  The
  90 parameters in question are:
  91
  92   -sdbhost     -ddbhost      Database hostname.
  93   -sdbport     -ddbport      Database port number.
  94   -sdbuser     -ddbuser      Database username.
  95   -sdbpassword -ddbpassword  Database password.
  96   -sdbdatabase -ddbdatabase  Database name.
  97
  98 All except the last two, database name, default to nothing
  99 which means that the usual PostgreSQL method for find the value
 100 is used (ie. first use environment variables like $PGHOST, then
 101 use an internal default, usually the local database and user).
 102
 103 The database name defaults to 'cocanwiki'.
 104
 105 It is possible to duplicate a host on the same database instance.
 106 In this case it is probably better not to specify the '-sdb***'
 107 or '-ddb***' parameters, but instead use environment variables,
 108 or run this program on the database server itself.
 109
 110 OPTIONS
 111 "
 112
 113 let shost = ref ""
 114 let dhost = ref ""
 115 let sdbhost = ref ""
 116 let ddbhost = ref ""
 117 let sdbport = ref 0
 118 let ddbport = ref 0
 119 let sdbuser = ref ""
 120 let ddbuser = ref ""
 121 let sdbpassword = ref ""
 122 let ddbpassword = ref ""
 123 let sdbdatabase = ref "cocanwiki"
 124 let ddbdatabase = ref "cocanwiki"
 125 let dryrun = ref false
 126
 127 let argspec = [
 128   "-shost", Arg.Set_string shost,
 129     "Source hostname (required).";
 130   "-dhost", Arg.Set_string dhost,
 131     "Destination hostname(s) (optional).";
 132   "-sdbhost", Arg.Set_string sdbhost,
 133     "Source database hostname (optional).";
 134   "-ddbhost", Arg.Set_string ddbhost,
 135     "Destination database hostname (optional).";
 136   "-sdbport", Arg.Set_int sdbport,
 137     "Source database port (optional).";
 138   "-ddbport", Arg.Set_int ddbport,
 139     "Destination database port (optional).";
 140   "-sdbuser", Arg.Set_string sdbuser,
 141     "Source database user (optional).";
 142   "-ddbuser", Arg.Set_string ddbuser,
 143     "Destination database user (optional).";
 144   "-sdbpassword", Arg.Set_string sdbpassword,
 145     "Source database password (optional).";
 146   "-ddbpassword", Arg.Set_string ddbpassword,
 147     "Destination database password (optional).";
 148   "-sdbdatabase", Arg.Set_string sdbdatabase,
 149     "Source database name (default: cocanwiki).";
 150   "-ddbdatabase", Arg.Set_string ddbdatabase,
 151     "Destination database name (default: cocanwiki).";
 152   "-dryrun", Arg.Set dryrun,
 153     "Rollback database changes at the end.";
 154 ]
 155
 156 let error _ = raise (Arg.Bad "Use --help for help.")
 157
 158 let () = Arg.parse argspec error usage
 159
 160 let shost =
 161   match !shost with
 162   | "" -> failwith "-shost is required.  Use --help for help."
 163   | s -> s
 164 let dhost =
 165   match !dhost with
 166   | "" -> []
 167   | s -> String.nsplit s ","
 168 let sdbhost = match !sdbhost with "" -> None | s -> Some s
 169 let ddbhost = match !ddbhost with "" -> None | s -> Some s
 170 let sdbport = match !sdbport with 0 -> None | p -> Some p
 171 let ddbport = match !ddbport with 0 -> None | p -> Some p
 172 let sdbuser = match !sdbuser with "" -> None | s -> Some s
 173 let ddbuser = match !ddbuser with "" -> None | s -> Some s
 174 let sdbpassword = match !sdbpassword with "" -> None | s -> Some s
 175 let ddbpassword = match !ddbpassword with "" -> None | s -> Some s
 176 let sdbdatabase = match !sdbdatabase with "" -> None | s -> Some s
 177 let ddbdatabase = match !ddbdatabase with "" -> None | s -> Some s
 178 let dryrun = !dryrun
 179
 180 (* Get column names from a table. *)
 181 let columns dbh table_name =
 182   let query = "select * from " ^ table_name in
 183   let name = "columns" in
 184   PGOCaml.prepare dbh ~query ~name ();
 185   let columns =
 186     match PGOCaml.describe_statement dbh ~name () with
 187     | _, Some results ->
 188         List.map (fun { PGOCaml.name = name } -> name) results
 189     | _, None -> assert false in
 190   PGOCaml.close_statement dbh ~name ();
 191   columns
 192
 193 (* 'select * on table where ...' using the low level interface. *)
 194 let select_all dbh table_name where_clause =
 195   let query = "select * from " ^ table_name ^
 196     (match where_clause with
 197      | "" -> ""
 198      | where_clause -> " where " ^ where_clause) in
 199   let name = "selectall" in
 200   PGOCaml.prepare dbh ~query ~name ();
 201   let columns =
 202     match PGOCaml.describe_statement dbh ~name () with
 203     | _, Some results ->
 204         List.map (fun { PGOCaml.name = name } -> name) results
 205     | _, None -> assert false in
 206   let rows = PGOCaml.execute dbh ~name ~params:[] () in
 207   PGOCaml.close_statement dbh ~name ();
 208   columns, rows
 209
 210 (* Functions to remove or update the value in a column. *)
 211 let rec remove_column columns rows col_name =
 212   List.filter (
 213     fun col_name' -> col_name <> col_name'
 214   ) columns,
 215   List.map (
 216     fun row ->
 217       List.filter_map (
 218         fun (col_name', value) ->
 219           if col_name <> col_name' then Some value else None
 220       ) (List.combine columns row)
 221   ) rows
 222
 223 and update_column columns rows col_name new_value =
 224   columns,
 225   List.map (
 226     fun row ->
 227       List.map (
 228         fun (col_name', old_value) ->
 229           if col_name <> col_name' then old_value else new_value
 230       ) (List.combine columns row)
 231   ) rows
 232
 233 and update_apply_column columns rows col_name f =
 234   columns,
 235   List.map (
 236     fun row ->
 237       List.map (
 238         fun (col_name', old_value) ->
 239           if col_name <> col_name' then old_value else f old_value
 240       ) (List.combine columns row)
 241   ) rows
 242
 243 (* Insert rows into the database table. *)
 244 let insert dbh table_name columns rows =
 245   let query = "insert into " ^ table_name ^ " (" ^
 246     String.concat ", " columns
 247     ^ ") values (" ^
 248     String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns)
 249     ^ ")" in
 250   let name = "insertinto" in
 251   PGOCaml.prepare dbh ~query ~name ();
 252   List.iter (fun params -> ignore (PGOCaml.execute dbh ~name ~params ())) rows;
 253   PGOCaml.close_statement dbh ~name ()
 254
 255 (* Insert rows into the database table, returning serial numbers. *)
 256 let insert_serial dbh table_name columns rows serial_col =
 257   let query = "insert into " ^ table_name ^ " (" ^
 258     String.concat ", " columns
 259     ^ ") values (" ^
 260     String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns)
 261     ^ ")" in
 262   let name = "insertserial" in
 263   PGOCaml.prepare dbh ~query ~name ();
 264   let seq = table_name ^ "_" ^ serial_col ^ "_seq" in
 265   let serials =
 266     List.map (
 267       fun params ->
 268         ignore (PGOCaml.execute dbh ~name ~params ());
 269         PGOCaml.serial4 dbh seq
 270     ) rows in
 271   PGOCaml.close_statement dbh ~name ();
 272   serials
 273
 274 let int32_of_value value =
 275   let value = Option.get value in
 276   Int32.of_string value
 277
 278 let value_of_int32 i =
 279   let i = Int32.to_string i in
 280   Some i
 281
 282 let () =
 283   print_endline "Connecting to databases ...";
 284   print_endline "  Source ...";
 285   let sdbh =
 286     let host = sdbhost in
 287     let port = sdbport in
 288     let user = sdbuser in
 289     let password = sdbpassword in
 290     let database = sdbdatabase in
 291     PGOCaml.connect ?host ?port ?user ?password ?database () in
 292   print_endline "  Destination ...";
 293   let ddbh =
 294     let host = ddbhost in
 295     let port = ddbport in
 296     let user = ddbuser in
 297     let password = ddbpassword in
 298     let database = ddbdatabase in
 299     PGOCaml.connect ?host ?port ?user ?password ?database () in
 300   print_endline "Locate source host ...";
 301   let shostid = List.hd (
 302     PGSQL(sdbh) "select hostid from hostnames where name = $shost"
 303   ) in
 304   let scanonical_hostname = List.hd (
 305     PGSQL(sdbh) "select canonical_hostname from hosts where id = $shostid"
 306   ) in
 307   let shostnames =
 308     PGSQL(sdbh)
 309       "select name from hostnames where hostid = $shostid order by 1" in
 310   printf "  shostid = %ld\n" shostid;
 311   printf "  scanonical_hostname = %s\n" scanonical_hostname;
 312   printf "  shostnames = [ %s ]\n" (String.concat "; " shostnames);
 313
 314   print_endline "Begin transaction on destination database ...";
 315   PGOCaml.begin_work ddbh;
 316   PGSQL(ddbh) "set constraints hosts_hostname_cn, pages_redirect_cn deferred";
 317
 318   (* Also start a transaction on the source database.  We are not
 319    * intending to make any changes, but this transaction ensures that we
 320    * can't because the disconnect at the end of the program will roll any
 321    * we make back.
 322    *)
 323   PGOCaml.begin_work sdbh;
 324
 325   (* Tables hosts and hostnames are the most complex to copy because
 326    * we may want to update the hostname.
 327    *)
 328   let dcanonical_hostname, dhostnames =
 329     match dhost with
 330     | [] -> scanonical_hostname, shostnames
 331     | x :: xs -> x, xs in
 332
 333   print_endline "Create new host ...";
 334
 335   let columns, rows =
 336     select_all sdbh "hosts" (sprintf "id = %ld" shostid) in
 337   let nr_columns = List.length columns in
 338   assert (nr_columns >= 19);
 339   assert (List.length rows = 1);
 340   let columns, rows = remove_column columns rows "id" in
 341   assert (List.length columns = nr_columns - 1);
 342   assert (List.length rows = 1);
 343   let columns, rows =
 344     update_column columns rows "canonical_hostname"
 345       (Some dcanonical_hostname) in
 346   assert (List.length columns = nr_columns - 1);
 347   assert (List.length rows = 1);
 348   let serials = insert_serial ddbh "hosts" columns rows "id" in
 349   assert (List.length serials = 1);
 350   let dhostid = List.hd serials in
 351   printf "  dhostid = %ld\n" dhostid;
 352
 353   print_endline "Create table hostnames ...";
 354   List.iter (
 355     fun hostname ->
 356       printf "  adding hostname %s\n" hostname;
 357       PGSQL(ddbh)
 358         "insert into hostnames (hostid, name) values ($dhostid, $hostname)"
 359   ) dhostnames;
 360
 361   (* Now start copying the tables.
 362    * Not entirely trivial because where a table references another,
 363    * we will need to update the IDs to match the corrected serial
 364    * numbers.
 365    *)
 366   print_endline "Copying table users ...";
 367   let columns, rows =
 368     select_all sdbh "users" (sprintf "hostid = %ld" shostid) in
 369   assert (List.hd columns = "id");
 370   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 371   let columns, rows =
 372     remove_column columns rows "id" in
 373   let columns, rows =
 374     update_column columns rows "hostid" (value_of_int32 dhostid) in
 375   let new_ids =
 376     insert_serial ddbh "users" columns rows "id" in
 377
 378   let userid_map = List.combine old_ids new_ids in
 379
 380   print_endline "Copying tables contacts, contact_emails ...";
 381   let columns, rows =
 382     select_all sdbh "contacts" (sprintf "hostid = %ld" shostid) in
 383   assert (List.hd columns = "id");
 384   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 385   let columns, rows =
 386     remove_column columns rows "id" in
 387   let columns, rows =
 388     update_column columns rows "hostid" (value_of_int32 dhostid) in
 389   let new_ids =
 390     insert_serial ddbh "contacts" columns rows "id" in
 391
 392   let map = List.combine old_ids new_ids in
 393
 394   if old_ids <> [] then (
 395     let columns, rows =
 396       select_all sdbh "contact_emails"
 397         ("contactid in (" ^
 398            String.concat ", " (List.map Int32.to_string old_ids) ^
 399            ")") in
 400     let columns, rows =
 401       update_apply_column columns rows "contactid"
 402         (fun old_id ->
 403            let old_id = int32_of_value old_id in
 404            value_of_int32 (List.assoc old_id map)) in
 405     insert ddbh "contact_emails" columns rows
 406   );
 407
 408   print_endline "Copying tables pages, contents ...";
 409   let columns, rows =
 410     select_all sdbh "pages" (sprintf "hostid = %ld" shostid) in
 411   assert (List.hd columns = "id");
 412   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 413   let columns, rows =
 414     remove_column columns rows "id" in
 415   let columns, rows =
 416     remove_column columns rows "title_description_fti" in
 417   let columns, rows =
 418     update_column columns rows "hostid" (value_of_int32 dhostid) in
 419   let columns, rows =
 420     update_apply_column columns rows "logged_user"
 421       (function
 422        | None -> None
 423        | (Some _) as old_id ->
 424            let old_id = int32_of_value old_id in
 425            value_of_int32 (List.assoc old_id userid_map)) in
 426   let new_ids =
 427     insert_serial ddbh "pages" columns rows "id" in
 428
 429   let map = List.combine old_ids new_ids in
 430
 431   if old_ids <> [] then (
 432     let columns, rows =
 433       select_all sdbh "contents"
 434         ("pageid in (" ^
 435            String.concat ", " (List.map Int32.to_string old_ids) ^
 436            ")") in
 437     let columns, rows = remove_column columns rows "id" in
 438     let columns, rows = remove_column columns rows "content_fti" in
 439     let columns, rows =
 440       update_apply_column columns rows "pageid"
 441         (fun old_id ->
 442            let old_id = int32_of_value old_id in
 443            value_of_int32 (List.assoc old_id map)) in
 444     insert ddbh "contents" columns rows
 445   );
 446
 447   print_endline "Copying tables messages, msg_references ...";
 448   let columns, rows =
 449     select_all sdbh "messages" (sprintf "hostid = %ld" shostid) in
 450   assert (List.hd columns = "id");
 451   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 452   let columns, rows =
 453     remove_column columns rows "id" in
 454   let columns, rows =
 455     update_column columns rows "hostid" (value_of_int32 dhostid) in
 456   let new_ids =
 457     insert_serial ddbh "messages" columns rows "id" in
 458
 459   let map = List.combine old_ids new_ids in
 460
 461   if old_ids <> [] then (
 462     let columns, rows =
 463       select_all sdbh "msg_references"
 464         ("message_id in (" ^
 465            String.concat ", " (List.map Int32.to_string old_ids) ^
 466            ")") in
 467     let columns, rows =
 468       update_apply_column columns rows "message_id"
 469         (fun old_id ->
 470            let old_id = int32_of_value old_id in
 471            value_of_int32 (List.assoc old_id map)) in
 472     insert ddbh "msg_references" columns rows
 473   );
 474
 475   print_endline "Copying table files ...";
 476   let columns, rows =
 477     select_all sdbh "files" (sprintf "hostid = %ld" shostid) in
 478   let columns, rows =
 479     remove_column columns rows "id" in
 480   let columns, rows =
 481     update_column columns rows "hostid" (value_of_int32 dhostid) in
 482   insert ddbh "files" columns rows;
 483
 484   print_endline "Copying table images ...";
 485   let columns, rows =
 486     select_all sdbh "images" (sprintf "hostid = %ld" shostid) in
 487   let columns, rows =
 488     remove_column columns rows "id" in
 489   let columns, rows =
 490     update_column columns rows "hostid" (value_of_int32 dhostid) in
 491   insert ddbh "images" columns rows;
 492
 493   print_endline "Copying table sitemenu ...";
 494   let columns, rows =
 495     select_all sdbh "sitemenu" (sprintf "hostid = %ld" shostid) in
 496   let columns, rows =
 497     update_column columns rows "hostid" (value_of_int32 dhostid) in
 498   insert ddbh "sitemenu" columns rows;
 499
 500   print_endline "Copying table links ...";
 501   let columns, rows =
 502     select_all sdbh "links" (sprintf "hostid = %ld" shostid) in
 503   let columns, rows =
 504     update_column columns rows "hostid" (value_of_int32 dhostid) in
 505   insert ddbh "links" columns rows;
 506
 507   print_endline "Copying table macros ...";
 508   let columns, rows =
 509     select_all sdbh "macros" (sprintf "hostid = %ld" shostid) in
 510   let columns, rows =
 511     update_column columns rows "hostid" (value_of_int32 dhostid) in
 512   insert ddbh "macros" columns rows;
 513
 514   print_endline "Copying table page_emails ...";
 515   let columns, rows =
 516     select_all sdbh "page_emails" (sprintf "hostid = %ld" shostid) in
 517   let columns, rows =
 518     update_column columns rows "hostid" (value_of_int32 dhostid) in
 519   insert ddbh "page_emails" columns rows;
 520
 521   print_endline "Copying table mailing_lists ...";
 522   let columns, rows =
 523     select_all sdbh "mailing_lists" (sprintf "hostid = %ld" shostid) in
 524   let columns, rows =
 525     update_column columns rows "hostid" (value_of_int32 dhostid) in
 526   insert ddbh "mailing_lists" columns rows;
 527
 528   (* pending_email_changes and usercookies are only copied if the URL
 529    * will not change, because if the URL does change then there is
 530    * no point copying them because all cookies/email URLs will be
 531    * out of date.
 532    *)
 533   if scanonical_hostname = dcanonical_hostname && userid_map <> [] then (
 534     let where_clause =
 535       "userid in (" ^
 536         String.concat ", "
 537         (List.map Int32.to_string (List.map fst userid_map)) ^
 538         ")" in
 539
 540     print_endline "Copying table usercookies ...";
 541     let columns, rows = select_all sdbh "usercookies" where_clause in
 542     let columns, rows =
 543       update_apply_column columns rows "userid"
 544         (function
 545          | None -> None
 546          | (Some _) as old_id ->
 547              let old_id = int32_of_value old_id in
 548              value_of_int32 (List.assoc old_id userid_map)) in
 549     insert ddbh "usercookies" columns rows;
 550
 551     print_endline "Copying table pending_email_changes ...";
 552     let columns, rows = select_all sdbh "pending_email_changes" where_clause in
 553     let columns, rows =
 554       update_apply_column columns rows "userid"
 555         (function
 556          | None -> None
 557          | (Some _) as old_id ->
 558              let old_id = int32_of_value old_id in
 559              value_of_int32 (List.assoc old_id userid_map)) in
 560     insert ddbh "pending_email_changes" columns rows;
 561   );
 562
 563   (* Note: Tables which are NOT copied:
 564    *
 565    * pg_ts_cfg      -- Internal tables used by tsearch2
 566    * pg_ts_cfgmap   --   """"
 567    * pg_ts_dict     --   """"
 568    * pg_ts_parser   --   """"
 569    * powered_by     -- Fixed table.
 570    * recently_visited -- Not worth copying.
 571    * server_settings -- Global configuration table.
 572    * templates      -- Fixed table.
 573    * themes         -- Fixed table.
 574    *)
 575
 576   (* Commit or rollback. *)
 577   if dryrun then (
 578     print_endline "Rolling back database because -dryrun flag was given.";
 579     PGOCaml.rollback ddbh
 580   ) else (
 581     print_endline "Committing changes ...";
 582     PGOCaml.commit ddbh;
 583     print_endline "Done."
 584   )