1 (* Copy a whole host (site). This can also copy between databases and
4 * Use 'copy_host --help' for usage.
6 * $Id: copy_host.ml,v 1.1 2006/09/09 15:08:08 rich Exp $
14 "copy_host can be used to copy/duplicate a whole host (site).
15 It can also copy hosts between databases and database server.
17 Please read the instructions below carefully before attempting
22 Duplicate a host on the same (local) database server:
24 copy_host -shost mysite.example.com -dhost mycopy.example.com
26 Copy a host from the local database server to another. The copy
27 will have the same canonical and alternate hostnames:
29 copy_host -short mysite.example.com -ddbhost anotherdb.example.com
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.
38 'canonical hostname': The standard hostname for a host. See the
39 hosts.canonical_hostname column.
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.
46 'source ***', 'destination ***': When copying hosts, you copy
47 from the source whatever to the destination whatever.
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.
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
58 SELECTING THE SOURCE AND DESTINATION HOSTS
60 In general, any parameter beginning with '-s***' refers to the
61 source and with '-d***' to the destination.
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
69 '-dhost hostname[,...]' is an optional parameter which specifies
70 the destination hostnames (canonical and alternates).
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.
77 If given with a single hostname, then that hostname is used
78 as the canonical hostname for the copy.
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:
84 -dhost www.example.com,example.com
86 SELECTING THE SOURCE AND DESTINATION DATABASE(S)
88 '-sdb***' and '-ddb***' parameters can be used to select
89 different source and destination database instances. The
90 parameters in question are:
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.
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).
103 The database name defaults to 'cocanwiki'.
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.
121 let sdbpassword = ref ""
122 let ddbpassword = ref ""
123 let sdbdatabase = ref "cocanwiki"
124 let ddbdatabase = ref "cocanwiki"
125 let dryrun = ref false
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.";
156 let error _ = raise (Arg.Bad "Use --help for help.")
158 let () = Arg.parse argspec error usage
162 | "" -> failwith "-shost is required. Use --help for help."
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
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 ();
186 match PGOCaml.describe_statement dbh ~name () with
188 List.map (fun { PGOCaml.name = name } -> name) results
189 | _, None -> assert false in
190 PGOCaml.close_statement dbh ~name ();
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
198 | where_clause -> " where " ^ where_clause) in
199 let name = "selectall" in
200 PGOCaml.prepare dbh ~query ~name ();
202 match PGOCaml.describe_statement dbh ~name () with
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 ();
210 (* Functions to remove or update the value in a column. *)
211 let rec remove_column columns rows col_name =
213 fun col_name' -> col_name <> col_name'
218 fun (col_name', value) ->
219 if col_name <> col_name' then Some value else None
220 ) (List.combine columns row)
223 and update_column columns rows col_name new_value =
228 fun (col_name', old_value) ->
229 if col_name <> col_name' then old_value else new_value
230 ) (List.combine columns row)
233 and update_apply_column columns rows col_name f =
238 fun (col_name', old_value) ->
239 if col_name <> col_name' then old_value else f old_value
240 ) (List.combine columns row)
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
248 String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns)
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 ()
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
260 String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns)
262 let name = "insertserial" in
263 PGOCaml.prepare dbh ~query ~name ();
264 let seq = table_name ^ "_" ^ serial_col ^ "_seq" in
268 ignore (PGOCaml.execute dbh ~name ~params ());
269 PGOCaml.serial4 dbh seq
271 PGOCaml.close_statement dbh ~name ();
274 let int32_of_value value =
275 let value = Option.get value in
276 Int32.of_string value
278 let value_of_int32 i =
279 let i = Int32.to_string i in
283 print_endline "Connecting to databases ...";
284 print_endline " Source ...";
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 ...";
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"
304 let scanonical_hostname = List.hd (
305 PGSQL(sdbh) "select canonical_hostname from hosts where id = $shostid"
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);
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";
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
323 PGOCaml.begin_work sdbh;
325 (* Tables hosts and hostnames are the most complex to copy because
326 * we may want to update the hostname.
328 let dcanonical_hostname, dhostnames =
330 | [] -> scanonical_hostname, shostnames
331 | x :: xs -> x, xs in
333 print_endline "Create new host ...";
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);
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;
353 print_endline "Create table hostnames ...";
356 printf " adding hostname %s\n" hostname;
358 "insert into hostnames (hostid, name) values ($dhostid, $hostname)"
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
366 print_endline "Copying table users ...";
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
372 remove_column columns rows "id" in
374 update_column columns rows "hostid" (value_of_int32 dhostid) in
376 insert_serial ddbh "users" columns rows "id" in
378 let userid_map = List.combine old_ids new_ids in
380 print_endline "Copying tables contacts, contact_emails ...";
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
386 remove_column columns rows "id" in
388 update_column columns rows "hostid" (value_of_int32 dhostid) in
390 insert_serial ddbh "contacts" columns rows "id" in
392 let map = List.combine old_ids new_ids in
394 if old_ids <> [] then (
396 select_all sdbh "contact_emails"
398 String.concat ", " (List.map Int32.to_string old_ids) ^
401 update_apply_column columns rows "contactid"
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
408 print_endline "Copying tables pages, contents ...";
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
414 remove_column columns rows "id" in
416 remove_column columns rows "title_description_fti" in
418 update_column columns rows "hostid" (value_of_int32 dhostid) in
420 update_apply_column columns rows "logged_user"
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
427 insert_serial ddbh "pages" columns rows "id" in
429 let map = List.combine old_ids new_ids in
431 if old_ids <> [] then (
433 select_all sdbh "contents"
435 String.concat ", " (List.map Int32.to_string old_ids) ^
437 let columns, rows = remove_column columns rows "id" in
438 let columns, rows = remove_column columns rows "content_fti" in
440 update_apply_column columns rows "pageid"
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
447 print_endline "Copying tables messages, msg_references ...";
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
453 remove_column columns rows "id" in
455 update_column columns rows "hostid" (value_of_int32 dhostid) in
457 insert_serial ddbh "messages" columns rows "id" in
459 let map = List.combine old_ids new_ids in
461 if old_ids <> [] then (
463 select_all sdbh "msg_references"
465 String.concat ", " (List.map Int32.to_string old_ids) ^
468 update_apply_column columns rows "message_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
475 print_endline "Copying table files ...";
477 select_all sdbh "files" (sprintf "hostid = %ld" shostid) in
479 remove_column columns rows "id" in
481 update_column columns rows "hostid" (value_of_int32 dhostid) in
482 insert ddbh "files" columns rows;
484 print_endline "Copying table images ...";
486 select_all sdbh "images" (sprintf "hostid = %ld" shostid) in
488 remove_column columns rows "id" in
490 update_column columns rows "hostid" (value_of_int32 dhostid) in
491 insert ddbh "images" columns rows;
493 print_endline "Copying table sitemenu ...";
495 select_all sdbh "sitemenu" (sprintf "hostid = %ld" shostid) in
497 update_column columns rows "hostid" (value_of_int32 dhostid) in
498 insert ddbh "sitemenu" columns rows;
500 print_endline "Copying table links ...";
502 select_all sdbh "links" (sprintf "hostid = %ld" shostid) in
504 update_column columns rows "hostid" (value_of_int32 dhostid) in
505 insert ddbh "links" columns rows;
507 print_endline "Copying table macros ...";
509 select_all sdbh "macros" (sprintf "hostid = %ld" shostid) in
511 update_column columns rows "hostid" (value_of_int32 dhostid) in
512 insert ddbh "macros" columns rows;
514 print_endline "Copying table page_emails ...";
516 select_all sdbh "page_emails" (sprintf "hostid = %ld" shostid) in
518 update_column columns rows "hostid" (value_of_int32 dhostid) in
519 insert ddbh "page_emails" columns rows;
521 print_endline "Copying table mailing_lists ...";
523 select_all sdbh "mailing_lists" (sprintf "hostid = %ld" shostid) in
525 update_column columns rows "hostid" (value_of_int32 dhostid) in
526 insert ddbh "mailing_lists" columns rows;
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
533 if scanonical_hostname = dcanonical_hostname && userid_map <> [] then (
537 (List.map Int32.to_string (List.map fst userid_map)) ^
540 print_endline "Copying table usercookies ...";
541 let columns, rows = select_all sdbh "usercookies" where_clause in
543 update_apply_column columns rows "userid"
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;
551 print_endline "Copying table pending_email_changes ...";
552 let columns, rows = select_all sdbh "pending_email_changes" where_clause in
554 update_apply_column columns rows "userid"
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;
563 (* Note: Tables which are NOT copied:
565 * pg_ts_cfg -- Internal tables used by tsearch2
566 * pg_ts_cfgmap -- """"
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.
576 (* Commit or rollback. *)
578 print_endline "Rolling back database because -dryrun flag was given.";
579 PGOCaml.rollback ddbh
581 print_endline "Committing changes ...";
583 print_endline "Done."