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.5 2006/12/11 15:34:36 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 -shost 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 TESTING
 111
 112 Use -dryrun as a parameter to test the copy.  This does everything
 113 and then rolls back the database at the end.
 114
 115 STAGING SERVER
 116
 117 It is possible to use this script to implement a staging server.
 118
 119 The basic setup is that you have two hosts (called for example
 120 'staging.example.com' and 'www.example.com' where the latter
 121 is the live site).  Create the staging host first (or use
 122 copy_host to duplicate it from the live host if you already
 123 have one).  Do all editing on the staging server.
 124
 125 When you are satisfied with the state of the staging server
 126 and are ready to go live, use the following command:
 127
 128   copy_host -shost staging.example.com -dhost www.example.com,example.com \
 129     -overwrite -disableedit -enableviewanon
 130
 131 The key options to take note of are:
 132
 133   -overwrite   If the dhost already exists, it can be overwritten.
 134           (In fact what happens is that the existing destination
 135           host is renamed to a unique name like 'deleted-<timestamp>')
 136
 137   -disableedit  This disables the editing capability of all users on
 138           the destination host.  This stops users from accidentally
 139           editing the live site.
 140
 141   -enableviewanon  This enables anonymous viewing on the destination
 142           host (assuming that the staging server is configured to
 143           only allow logged in users to view, which is usually the
 144           right thing to do).
 145
 146 OPTIONS
 147 "
 148
 149 let shost = ref ""
 150 let dhost = ref ""
 151 let sdbhost = ref ""
 152 let ddbhost = ref ""
 153 let sdbport = ref 0
 154 let ddbport = ref 0
 155 let sdbuser = ref ""
 156 let ddbuser = ref ""
 157 let sdbpassword = ref ""
 158 let ddbpassword = ref ""
 159 let sdbdatabase = ref "cocanwiki"
 160 let ddbdatabase = ref "cocanwiki"
 161 let dryrun = ref false
 162 let overwrite = ref false
 163 let disableedit = ref false
 164 let enableviewanon = ref false
 165
 166 let argspec = [
 167   "-shost", Arg.Set_string shost,
 168     "Source hostname (required).";
 169   "-dhost", Arg.Set_string dhost,
 170     "Destination hostname(s) (optional).";
 171   "-sdbhost", Arg.Set_string sdbhost,
 172     "Source database hostname (optional).";
 173   "-ddbhost", Arg.Set_string ddbhost,
 174     "Destination database hostname (optional).";
 175   "-sdbport", Arg.Set_int sdbport,
 176     "Source database port (optional).";
 177   "-ddbport", Arg.Set_int ddbport,
 178     "Destination database port (optional).";
 179   "-sdbuser", Arg.Set_string sdbuser,
 180     "Source database user (optional).";
 181   "-ddbuser", Arg.Set_string ddbuser,
 182     "Destination database user (optional).";
 183   "-sdbpassword", Arg.Set_string sdbpassword,
 184     "Source database password (optional).";
 185   "-ddbpassword", Arg.Set_string ddbpassword,
 186     "Destination database password (optional).";
 187   "-sdbdatabase", Arg.Set_string sdbdatabase,
 188     "Source database name (default: cocanwiki).";
 189   "-ddbdatabase", Arg.Set_string ddbdatabase,
 190     "Destination database name (default: cocanwiki).";
 191   "-dryrun", Arg.Set dryrun,
 192     "Rollback database changes at the end.";
 193   "-overwrite", Arg.Set overwrite,
 194     "Allow the destination host to be overwritten.";
 195   "-disableedit", Arg.Set disableedit,
 196     "Disable users.can_edit on the destination host.";
 197   "-enableviewanon", Arg.Set enableviewanon,
 198     "Enable hosts.view_anon  on the destination host.";
 199 ]
 200
 201 let error _ = raise (Arg.Bad "Use --help for help.")
 202
 203 let () = Arg.parse argspec error usage
 204
 205 let shost =
 206   match !shost with
 207   | "" -> failwith "-shost is required.  Use --help for help."
 208   | s -> s
 209 let dhost =
 210   match !dhost with
 211   | "" -> []
 212   | s -> String.nsplit s ","
 213 let sdbhost = match !sdbhost with "" -> None | s -> Some s
 214 let ddbhost = match !ddbhost with "" -> None | s -> Some s
 215 let sdbport = match !sdbport with 0 -> None | p -> Some p
 216 let ddbport = match !ddbport with 0 -> None | p -> Some p
 217 let sdbuser = match !sdbuser with "" -> None | s -> Some s
 218 let ddbuser = match !ddbuser with "" -> None | s -> Some s
 219 let sdbpassword = match !sdbpassword with "" -> None | s -> Some s
 220 let ddbpassword = match !ddbpassword with "" -> None | s -> Some s
 221 let sdbdatabase = match !sdbdatabase with "" -> None | s -> Some s
 222 let ddbdatabase = match !ddbdatabase with "" -> None | s -> Some s
 223 let dryrun = !dryrun
 224 let overwrite = !overwrite
 225 let disableedit = !disableedit
 226 let enableviewanon = !enableviewanon
 227
 228 (* Get column names from a table. *)
 229 let columns dbh table_name =
 230   let query = "select * from " ^ table_name ^ " order by 1" in
 231   let name = "columns" in
 232   PGOCaml.prepare dbh ~query ~name ();
 233   let columns =
 234     match PGOCaml.describe_statement dbh ~name () with
 235     | _, Some results ->
 236         List.map (fun { PGOCaml.name = name } -> name) results
 237     | _, None -> assert false in
 238   PGOCaml.close_statement dbh ~name ();
 239   columns
 240
 241 (* 'select * on table where ...' using the low level interface. *)
 242 let select_all dbh table_name where_clause =
 243   let query = "select * from " ^ table_name ^
 244     (match where_clause with
 245      | "" -> ""
 246      | where_clause -> " where " ^ where_clause) ^
 247     " order by 1" in
 248   let name = "selectall" in
 249   PGOCaml.prepare dbh ~query ~name ();
 250   let columns =
 251     match PGOCaml.describe_statement dbh ~name () with
 252     | _, Some results ->
 253         List.map (fun { PGOCaml.name = name } -> name) results
 254     | _, None -> assert false in
 255   let rows = PGOCaml.execute dbh ~name ~params:[] () in
 256   PGOCaml.close_statement dbh ~name ();
 257   columns, rows
 258
 259 (* Functions to remove or update the value in a column. *)
 260 let rec remove_column columns rows col_name =
 261   List.filter (
 262     fun col_name' -> col_name <> col_name'
 263   ) columns,
 264   List.map (
 265     fun row ->
 266       List.filter_map (
 267         fun (col_name', value) ->
 268           if col_name <> col_name' then Some value else None
 269       ) (List.combine columns row)
 270   ) rows
 271
 272 and update_column columns rows col_name new_value =
 273   columns,
 274   List.map (
 275     fun row ->
 276       List.map (
 277         fun (col_name', old_value) ->
 278           if col_name <> col_name' then old_value else new_value
 279       ) (List.combine columns row)
 280   ) rows
 281
 282 and update_apply_column columns rows col_name f =
 283   columns,
 284   List.map (
 285     fun row ->
 286       List.map (
 287         fun (col_name', old_value) ->
 288           if col_name <> col_name' then old_value else f old_value
 289       ) (List.combine columns row)
 290   ) rows
 291
 292 (* Insert rows into the database table. *)
 293 let insert dbh table_name columns rows =
 294   let query = "insert into " ^ table_name ^ " (" ^
 295     String.concat ", " columns
 296     ^ ") values (" ^
 297     String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns)
 298     ^ ")" in
 299   let name = "insertinto" in
 300   PGOCaml.prepare dbh ~query ~name ();
 301   List.iter (fun params -> ignore (PGOCaml.execute dbh ~name ~params ())) rows;
 302   PGOCaml.close_statement dbh ~name ()
 303
 304 (* Insert rows into the database table, returning serial numbers. *)
 305 let insert_serial dbh table_name columns rows serial_col =
 306   let query = "insert into " ^ table_name ^ " (" ^
 307     String.concat ", " columns
 308     ^ ") values (" ^
 309     String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns)
 310     ^ ")" in
 311   let name = "insertserial" in
 312   PGOCaml.prepare dbh ~query ~name ();
 313   let seq = table_name ^ "_" ^ serial_col ^ "_seq" in
 314   let serials =
 315     List.map (
 316       fun params ->
 317         ignore (PGOCaml.execute dbh ~name ~params ());
 318         PGOCaml.serial4 dbh seq
 319     ) rows in
 320   PGOCaml.close_statement dbh ~name ();
 321   serials
 322
 323 let int32_of_value value =
 324   let value = Option.get value in
 325   Int32.of_string value
 326
 327 let value_of_int32 i =
 328   let i = Int32.to_string i in
 329   Some i
 330
 331 let value_of_bool b =
 332   let b = string_of_bool b in
 333   Some b
 334
 335 let () =
 336   print_endline "Connecting to databases ...";
 337   print_endline "  Source ...";
 338   let sdbh =
 339     let host = sdbhost in
 340     let port = sdbport in
 341     let user = sdbuser in
 342     let password = sdbpassword in
 343     let database = sdbdatabase in
 344     PGOCaml.connect ?host ?port ?user ?password ?database () in
 345   print_endline "  Destination ...";
 346   let ddbh =
 347     let host = ddbhost in
 348     let port = ddbport in
 349     let user = ddbuser in
 350     let password = ddbpassword in
 351     let database = ddbdatabase in
 352     PGOCaml.connect ?host ?port ?user ?password ?database () in
 353   print_endline "Locate source host ...";
 354   let shostid = List.hd (
 355     PGSQL(sdbh) "select hostid from hostnames where name = $shost"
 356   ) in
 357   let scanonical_hostname = List.hd (
 358     PGSQL(sdbh) "select canonical_hostname from hosts where id = $shostid"
 359   ) in
 360   let shostnames =
 361     PGSQL(sdbh)
 362       "select name from hostnames where hostid = $shostid order by 1" in
 363   printf "  shostid = %ld\n" shostid;
 364   printf "  scanonical_hostname = %s\n" scanonical_hostname;
 365   printf "  shostnames = [ %s ]\n" (String.concat "; " shostnames);
 366
 367   print_endline "Begin transaction on destination database ...";
 368   PGOCaml.begin_work ddbh;
 369   PGSQL(ddbh) "set constraints hosts_hostname_cn, pages_redirect_cn deferred";
 370
 371   (* Also start a transaction on the source database.  We are not
 372    * intending to make any changes, but this transaction ensures that we
 373    * can't because the disconnect at the end of the program will roll any
 374    * we make back.
 375    *)
 376   PGOCaml.begin_work sdbh;
 377
 378   (* Tables hosts and hostnames are the most complex to copy because
 379    * we may want to update the hostname.
 380    *)
 381   let dcanonical_hostname, dhostnames =
 382     match dhost with
 383     | [] -> scanonical_hostname, shostnames
 384     | x :: xs -> x, (x :: xs) in
 385
 386   (* Does the destination host already exist? *)
 387   let dhost_exists, old_dhostid =
 388     let rows =
 389       PGSQL(ddbh)
 390         "select hostid from hostnames where name = $dcanonical_hostname" in
 391     match rows with
 392     | [dhostid] -> true, dhostid
 393     | _ -> false, (-1_l) in
 394   if dhost_exists then (
 395     if overwrite then (
 396       (* Rename the destination host. *)
 397       let name = sprintf "deleted-%.0f" (Unix.time ()) in
 398
 399       printf "Renaming old host %s to %s\n%!" dcanonical_hostname name;
 400
 401       PGSQL(ddbh)
 402         "update hosts set canonical_hostname = $name where id = $old_dhostid";
 403       PGSQL(ddbh)
 404         "delete from hostnames where hostid = $old_dhostid";
 405       PGSQL(ddbh)
 406         "insert into hostnames (hostid, name) values ($old_dhostid, $name)";
 407     ) else
 408       failwith "Destination host exists.  Did you mean to use -overwrite?"
 409   );
 410
 411   print_endline "Create new host ...";
 412
 413   let columns, rows =
 414     select_all sdbh "hosts" (sprintf "id = %ld" shostid) in
 415   let nr_columns = List.length columns in
 416   assert (nr_columns >= 19);
 417   assert (List.length rows = 1);
 418   let columns, rows = remove_column columns rows "id" in
 419   assert (List.length columns = nr_columns - 1);
 420   assert (List.length rows = 1);
 421   let columns, rows =
 422     update_column columns rows "canonical_hostname"
 423       (Some dcanonical_hostname) in
 424   assert (List.length columns = nr_columns - 1);
 425   assert (List.length rows = 1);
 426   let columns, rows =
 427     if enableviewanon then
 428       update_column columns rows "view_anon" (value_of_bool true)
 429     else
 430       columns, rows in
 431   let serials = insert_serial ddbh "hosts" columns rows "id" in
 432   assert (List.length serials = 1);
 433   let dhostid = List.hd serials in
 434   printf "  dhostid = %ld\n" dhostid;
 435
 436   print_endline "Create table hostnames ...";
 437   List.iter (
 438     fun hostname ->
 439       printf "  adding hostname %s\n" hostname;
 440       PGSQL(ddbh)
 441         "insert into hostnames (hostid, name) values ($dhostid, $hostname)"
 442   ) dhostnames;
 443
 444   (* Now start copying the tables.
 445    * Not entirely trivial because where a table references another,
 446    * we will need to update the IDs to match the corrected serial
 447    * numbers.
 448    *)
 449   print_endline "Copying table users ...";
 450   let columns, rows =
 451     select_all sdbh "users" (sprintf "hostid = %ld" shostid) in
 452   assert (List.hd columns = "id");
 453   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 454   let columns, rows =
 455     remove_column columns rows "id" in
 456   let columns, rows =
 457     update_column columns rows "hostid" (value_of_int32 dhostid) in
 458   let columns, rows =
 459     if disableedit then
 460       update_column columns rows "can_edit" (value_of_bool false)
 461     else
 462       columns, rows in
 463   let new_ids =
 464     insert_serial ddbh "users" columns rows "id" in
 465
 466   let userid_map = List.combine old_ids new_ids in
 467
 468   print_endline "Copying tables contacts, contact_emails ...";
 469   let columns, rows =
 470     select_all sdbh "contacts" (sprintf "hostid = %ld" shostid) in
 471   assert (List.hd columns = "id");
 472   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 473   let columns, rows =
 474     remove_column columns rows "id" in
 475   let columns, rows =
 476     update_column columns rows "hostid" (value_of_int32 dhostid) in
 477   let new_ids =
 478     insert_serial ddbh "contacts" columns rows "id" in
 479
 480   let map = List.combine old_ids new_ids in
 481
 482   if old_ids <> [] then (
 483     let columns, rows =
 484       select_all sdbh "contact_emails"
 485         ("contactid in (" ^
 486            String.concat ", " (List.map Int32.to_string old_ids) ^
 487            ")") in
 488     let columns, rows =
 489       update_apply_column columns rows "contactid"
 490         (fun old_id ->
 491            let old_id = int32_of_value old_id in
 492            value_of_int32 (List.assoc old_id map)) in
 493     insert ddbh "contact_emails" columns rows
 494   );
 495
 496   print_endline "Copying tables pages, contents ...";
 497   let columns, rows =
 498     select_all sdbh "pages" (sprintf "hostid = %ld" shostid) in
 499   assert (List.hd columns = "id");
 500   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 501   let columns, rows =
 502     remove_column columns rows "id" in
 503   let columns, rows =
 504     remove_column columns rows "title_description_fti" in
 505   let columns, rows =
 506     update_column columns rows "hostid" (value_of_int32 dhostid) in
 507   let columns, rows =
 508     update_apply_column columns rows "logged_user"
 509       (function
 510        | None -> None
 511        | (Some _) as old_id ->
 512            let old_id = int32_of_value old_id in
 513            value_of_int32 (List.assoc old_id userid_map)) in
 514   let new_ids =
 515     insert_serial ddbh "pages" columns rows "id" in
 516
 517   let map = List.combine old_ids new_ids in
 518
 519   if old_ids <> [] then (
 520     let columns, rows =
 521       select_all sdbh "contents"
 522         ("pageid in (" ^
 523            String.concat ", " (List.map Int32.to_string old_ids) ^
 524            ")") in
 525     let columns, rows = remove_column columns rows "id" in
 526     let columns, rows = remove_column columns rows "content_fti" in
 527     let columns, rows =
 528       update_apply_column columns rows "pageid"
 529         (fun old_id ->
 530            let old_id = int32_of_value old_id in
 531            value_of_int32 (List.assoc old_id map)) in
 532     insert ddbh "contents" columns rows
 533   );
 534
 535   print_endline "Copying tables messages, msg_references ...";
 536   let columns, rows =
 537     select_all sdbh "messages" (sprintf "hostid = %ld" shostid) in
 538   assert (List.hd columns = "id");
 539   let old_ids = List.map int32_of_value (List.map List.hd rows) in
 540   let columns, rows =
 541     remove_column columns rows "id" in
 542   let columns, rows =
 543     update_column columns rows "hostid" (value_of_int32 dhostid) in
 544   let new_ids =
 545     insert_serial ddbh "messages" columns rows "id" in
 546
 547   let map = List.combine old_ids new_ids in
 548
 549   if old_ids <> [] then (
 550     let columns, rows =
 551       select_all sdbh "msg_references"
 552         ("message_id in (" ^
 553            String.concat ", " (List.map Int32.to_string old_ids) ^
 554            ")") in
 555     let columns, rows =
 556       update_apply_column columns rows "message_id"
 557         (fun old_id ->
 558            let old_id = int32_of_value old_id in
 559            value_of_int32 (List.assoc old_id map)) in
 560     insert ddbh "msg_references" columns rows
 561   );
 562
 563   print_endline "Copying table files ...";
 564   let columns, rows =
 565     select_all sdbh "files" (sprintf "hostid = %ld" shostid) in
 566   let columns, rows =
 567     remove_column columns rows "id" in
 568   let columns, rows =
 569     update_column columns rows "hostid" (value_of_int32 dhostid) in
 570   insert ddbh "files" columns rows;
 571
 572   print_endline "Copying table images ...";
 573   let columns, rows =
 574     select_all sdbh "images" (sprintf "hostid = %ld" shostid) in
 575   let columns, rows =
 576     remove_column columns rows "id" in
 577   let columns, rows =
 578     update_column columns rows "hostid" (value_of_int32 dhostid) in
 579   insert ddbh "images" columns rows;
 580
 581   print_endline "Copying table sitemenu ...";
 582   let columns, rows =
 583     select_all sdbh "sitemenu" (sprintf "hostid = %ld" shostid) in
 584   let columns, rows =
 585     update_column columns rows "hostid" (value_of_int32 dhostid) in
 586   insert ddbh "sitemenu" columns rows;
 587
 588   print_endline "Copying table links ...";
 589   let columns, rows =
 590     select_all sdbh "links" (sprintf "hostid = %ld" shostid) in
 591   let columns, rows =
 592     update_column columns rows "hostid" (value_of_int32 dhostid) in
 593   insert ddbh "links" columns rows;
 594
 595   print_endline "Copying table macros ...";
 596   let columns, rows =
 597     select_all sdbh "macros" (sprintf "hostid = %ld" shostid) in
 598   let columns, rows =
 599     update_column columns rows "hostid" (value_of_int32 dhostid) in
 600   insert ddbh "macros" columns rows;
 601
 602   print_endline "Copying table page_emails ...";
 603   let columns, rows =
 604     select_all sdbh "page_emails" (sprintf "hostid = %ld" shostid) in
 605   let columns, rows =
 606     update_column columns rows "hostid" (value_of_int32 dhostid) in
 607   insert ddbh "page_emails" columns rows;
 608
 609   print_endline "Copying table mailing_lists ...";
 610   let columns, rows =
 611     select_all sdbh "mailing_lists" (sprintf "hostid = %ld" shostid) in
 612   let columns, rows =
 613     update_column columns rows "hostid" (value_of_int32 dhostid) in
 614   insert ddbh "mailing_lists" columns rows;
 615
 616   (* pending_email_changes and usercookies are only copied if the URL
 617    * will not change, because if the URL does change then there is
 618    * no point copying them because all cookies/email URLs will be
 619    * out of date.
 620    *)
 621   if scanonical_hostname = dcanonical_hostname && userid_map <> [] then (
 622     let where_clause =
 623       "userid in (" ^
 624         String.concat ", "
 625         (List.map Int32.to_string (List.map fst userid_map)) ^
 626         ")" in
 627
 628     print_endline "Copying table usercookies ...";
 629     let columns, rows = select_all sdbh "usercookies" where_clause in
 630     let columns, rows =
 631       update_apply_column columns rows "userid"
 632         (function
 633          | None -> None
 634          | (Some _) as old_id ->
 635              let old_id = int32_of_value old_id in
 636              value_of_int32 (List.assoc old_id userid_map)) in
 637     insert ddbh "usercookies" columns rows;
 638
 639     print_endline "Copying table pending_email_changes ...";
 640     let columns, rows = select_all sdbh "pending_email_changes" where_clause in
 641     let columns, rows =
 642       update_apply_column columns rows "userid"
 643         (function
 644          | None -> None
 645          | (Some _) as old_id ->
 646              let old_id = int32_of_value old_id in
 647              value_of_int32 (List.assoc old_id userid_map)) in
 648     insert ddbh "pending_email_changes" columns rows;
 649   );
 650
 651   (* Note: Tables which are NOT copied:
 652    *
 653    * pg_ts_cfg      -- Internal tables used by tsearch2
 654    * pg_ts_cfgmap   --   """"
 655    * pg_ts_dict     --   """"
 656    * pg_ts_parser   --   """"
 657    * powered_by     -- Fixed table.
 658    * recently_visited -- Not worth copying.
 659    * server_settings -- Global configuration table.
 660    * templates      -- Fixed table.
 661    * themes         -- Fixed table.
 662    *)
 663
 664   (* Commit or rollback. *)
 665   if dryrun then (
 666     print_endline "Rolling back database because -dryrun flag was given.";
 667     PGOCaml.rollback ddbh
 668   ) else (
 669     print_endline "Committing changes ...";
 670     PGOCaml.commit ddbh;
 671     print_endline "Done."
 672   )