[10669] | 1 | #------------------------------------------------------------------------------- |
---|
| 2 | # (C) British Crown Copyright 2006-17 Met Office. |
---|
| 3 | # |
---|
| 4 | # This file is part of FCM, tools for managing and building source code. |
---|
| 5 | # |
---|
| 6 | # FCM is free software: you can redistribute it and/or modify |
---|
| 7 | # it under the terms of the GNU General Public License as published by |
---|
| 8 | # the Free Software Foundation, either version 3 of the License, or |
---|
| 9 | # (at your option) any later version. |
---|
| 10 | # |
---|
| 11 | # FCM is distributed in the hope that it will be useful, |
---|
| 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
| 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
| 14 | # GNU General Public License for more details. |
---|
| 15 | # |
---|
| 16 | # You should have received a copy of the GNU General Public License |
---|
| 17 | # along with FCM. If not, see <http://www.gnu.org/licenses/>. |
---|
| 18 | #------------------------------------------------------------------------------- |
---|
| 19 | |
---|
| 20 | use strict; |
---|
| 21 | use warnings; |
---|
| 22 | |
---|
| 23 | package FCM::Admin::System; |
---|
| 24 | |
---|
| 25 | use Config::IniFiles; |
---|
| 26 | use DBI; # See also: DBD::SQLite |
---|
| 27 | use Exporter qw{import}; |
---|
| 28 | use FCM::Admin::Config; |
---|
| 29 | use FCM::Admin::Project; |
---|
| 30 | use FCM::Admin::Runner; |
---|
| 31 | use FCM::Admin::User; |
---|
| 32 | use FCM::Admin::Util qw{ |
---|
| 33 | read_file |
---|
| 34 | run_copy |
---|
| 35 | run_create_archive |
---|
| 36 | run_extract_archive |
---|
| 37 | run_mkpath |
---|
| 38 | run_rename |
---|
| 39 | run_rmtree |
---|
| 40 | run_rsync |
---|
| 41 | run_symlink |
---|
| 42 | write_file |
---|
| 43 | }; |
---|
| 44 | use Fcntl qw{:mode}; # for S_IRGRP, S_IWGRP, S_IROTH, etc |
---|
| 45 | use File::Basename qw{basename dirname}; |
---|
| 46 | use File::Compare qw{compare}; |
---|
| 47 | use File::Find qw{find}; |
---|
| 48 | use File::Spec::Functions qw{catfile rel2abs}; |
---|
| 49 | use File::Temp qw{tempdir tempfile}; |
---|
| 50 | use IO::Compress::Gzip qw{gzip}; |
---|
| 51 | use IO::Dir; |
---|
| 52 | use IO::Pipe; |
---|
| 53 | use IO::Zlib; |
---|
| 54 | use List::Util qw{first}; |
---|
| 55 | use POSIX qw{strftime}; |
---|
| 56 | use Text::ParseWords qw{shellwords}; |
---|
| 57 | |
---|
| 58 | our @EXPORT_OK = qw{ |
---|
| 59 | add_svn_repository |
---|
| 60 | add_trac_environment |
---|
| 61 | backup_svn_repository |
---|
| 62 | backup_trac_environment |
---|
| 63 | backup_trac_files |
---|
| 64 | distribute_wc |
---|
| 65 | filter_projects |
---|
| 66 | get_projects_from_svn_backup |
---|
| 67 | get_projects_from_svn_live |
---|
| 68 | get_projects_from_trac_backup |
---|
| 69 | get_projects_from_trac_live |
---|
| 70 | get_users |
---|
| 71 | housekeep_svn_hook_logs |
---|
| 72 | install_svn_hook |
---|
| 73 | manage_users_in_svn_passwd |
---|
| 74 | manage_users_in_trac_passwd |
---|
| 75 | manage_users_in_trac_db_of |
---|
| 76 | recover_svn_repository |
---|
| 77 | recover_trac_environment |
---|
| 78 | recover_trac_files |
---|
| 79 | vacuum_trac_env_db |
---|
| 80 | verify_users |
---|
| 81 | }; |
---|
| 82 | |
---|
| 83 | our $NO_OVERWRITE = 1; |
---|
| 84 | our $BUFFER_SIZE = 4096; |
---|
| 85 | our @SVN_REPOS_ROOT_HOOK_ITEMS = qw{commit.conf svnperms.conf}; |
---|
| 86 | our %USER_INFO_TOOL_OF = ( |
---|
| 87 | 'ldap' => 'FCM::Admin::Users::LDAP', |
---|
| 88 | 'passwd' => 'FCM::Admin::Users::Passwd', |
---|
| 89 | ); |
---|
| 90 | our $USER_INFO_TOOL; |
---|
| 91 | |
---|
| 92 | our $UTIL = $FCM::Admin::Config::UTIL; |
---|
| 93 | my $CONFIG = FCM::Admin::Config->instance(); |
---|
| 94 | my $RUNNER = FCM::Admin::Runner->instance(); |
---|
| 95 | |
---|
| 96 | # ------------------------------------------------------------------------------ |
---|
| 97 | # Adds a new Subversion repository. |
---|
| 98 | sub add_svn_repository { |
---|
| 99 | my ($project_name) = @_; |
---|
| 100 | my $project = FCM::Admin::Project->new({name => $project_name}); |
---|
| 101 | if (-e $project->get_svn_live_path()) { |
---|
| 102 | die(sprintf( |
---|
| 103 | "%s: Subversion repository already exists at %s.\n", |
---|
| 104 | $project_name, |
---|
| 105 | $project->get_svn_live_path(), |
---|
| 106 | )); |
---|
| 107 | } |
---|
| 108 | my $repos_path = $project->get_svn_live_path(); |
---|
| 109 | $RUNNER->run( |
---|
| 110 | "creating Subversion repository at $repos_path", |
---|
| 111 | sub {!system(qw{svnadmin create}, $repos_path)}, |
---|
| 112 | ); |
---|
| 113 | my $group = $CONFIG->get_svn_group(); |
---|
| 114 | if ($group) { |
---|
| 115 | _chgrp_and_chmod($project->get_svn_live_path(), $group); |
---|
| 116 | } |
---|
| 117 | install_svn_hook($project); |
---|
| 118 | housekeep_svn_hook_logs($project); |
---|
| 119 | } |
---|
| 120 | |
---|
| 121 | # ------------------------------------------------------------------------------ |
---|
| 122 | # Adds a new Trac environment. |
---|
| 123 | sub add_trac_environment { |
---|
| 124 | my ($project_name) = @_; |
---|
| 125 | my $project = FCM::Admin::Project->new({name => $project_name}); |
---|
| 126 | if (-e $project->get_trac_live_path()) { |
---|
| 127 | die(sprintf( |
---|
| 128 | "%s: Trac environment already exists at %s.\n", |
---|
| 129 | $project_name, |
---|
| 130 | $project->get_trac_live_path(), |
---|
| 131 | )); |
---|
| 132 | } |
---|
| 133 | my @repository_arguments = (q{}, q{}); |
---|
| 134 | if (-d $project->get_svn_live_path()) { |
---|
| 135 | @repository_arguments = (q{svn}, $project->get_svn_live_path()); |
---|
| 136 | } |
---|
| 137 | my $RUN = sub{$RUNNER->run(@_)}; |
---|
| 138 | my $TRAC_ADMIN = sub { |
---|
| 139 | my ($log, @args) = @_; |
---|
| 140 | my @command = (q{trac-admin}, $project->get_trac_live_path(), @args); |
---|
| 141 | $RUN->($log, sub {!system(@command)}); |
---|
| 142 | }; |
---|
| 143 | my $TRAC_ADMIN_CONT = sub { |
---|
| 144 | my ($log, @args) = @_; |
---|
| 145 | my @command = (q{trac-admin}, $project->get_trac_live_path(), @args); |
---|
| 146 | $RUNNER->run_continue($log, sub {!system(@command)}); |
---|
| 147 | }; |
---|
| 148 | $TRAC_ADMIN->( |
---|
| 149 | "initialising Trac environment", |
---|
| 150 | q{initenv}, |
---|
| 151 | $project_name, |
---|
| 152 | q{sqlite:db/trac.db}, |
---|
| 153 | @repository_arguments, |
---|
| 154 | q{--inherit=../../trac.ini}, |
---|
| 155 | ); |
---|
| 156 | my $group = $CONFIG->get_trac_group(); |
---|
| 157 | if ($group) { |
---|
| 158 | _chgrp_and_chmod($project->get_trac_live_path(), $group); |
---|
| 159 | } |
---|
| 160 | # Note: For some reason, the commands to remove example components, |
---|
| 161 | # versions, milestones, priorities fail using the "pip install trac" version |
---|
| 162 | # on Travis CI. It is safe to allow the logic to continue after a failure |
---|
| 163 | # here as they are really unimportant and can easily be configured later. |
---|
| 164 | for my $item (qw{component1 component2}) { |
---|
| 165 | $TRAC_ADMIN_CONT->( |
---|
| 166 | "removing example component $item", q{component remove}, $item, |
---|
| 167 | ); |
---|
| 168 | } |
---|
| 169 | for my $item (qw{1.0 2.0}) { |
---|
| 170 | $TRAC_ADMIN_CONT->( |
---|
| 171 | "removing example version $item", q{version remove}, $item, |
---|
| 172 | ); |
---|
| 173 | } |
---|
| 174 | for my $item (qw{milestone1 milestone2 milestone3 milestone4}) { |
---|
| 175 | $TRAC_ADMIN_CONT->( |
---|
| 176 | "removing example milestone $item", q{milestone remove}, $item, |
---|
| 177 | ); |
---|
| 178 | } |
---|
| 179 | for my $item ( |
---|
| 180 | ['major' => 'normal' ], |
---|
| 181 | ['critical' => 'major' ], |
---|
| 182 | ['blocker' => 'critical'], |
---|
| 183 | ) { |
---|
| 184 | my ($old, $new) = @{$item}; |
---|
| 185 | $TRAC_ADMIN_CONT->( |
---|
| 186 | "changing priority $old to $new", qw{priority change}, $old, $new, |
---|
| 187 | ); |
---|
| 188 | } |
---|
| 189 | $TRAC_ADMIN->( |
---|
| 190 | "adding admin permission", qw{permission add admin TRAC_ADMIN}, |
---|
| 191 | ); |
---|
| 192 | $TRAC_ADMIN->( |
---|
| 193 | "adding admin permission", qw{permission add owner TRAC_ADMIN}, |
---|
| 194 | ); |
---|
| 195 | my @admin_users = shellwords($CONFIG->get_trac_admin_users()); |
---|
| 196 | for my $item (@admin_users) { |
---|
| 197 | $TRAC_ADMIN->( |
---|
| 198 | "adding admin user $item", qw{permission add}, $item, q{admin}, |
---|
| 199 | ); |
---|
| 200 | } |
---|
| 201 | $TRAC_ADMIN->( |
---|
| 202 | "adding TICKET_EDIT_CC permission to authenticated", |
---|
| 203 | qw{permission add}, 'authenticated', qw{TICKET_EDIT_CC}, |
---|
| 204 | ); |
---|
| 205 | $TRAC_ADMIN->( |
---|
| 206 | "adding TICKET_EDIT_DESCRIPTION permission to authenticated", |
---|
| 207 | qw{permission add}, 'authenticated', qw{TICKET_EDIT_DESCRIPTION}, |
---|
| 208 | ); |
---|
| 209 | $RUN->( |
---|
| 210 | "adding names and emails of users", |
---|
| 211 | sub {manage_users_in_trac_db_of($project, get_users())}, |
---|
| 212 | ); |
---|
| 213 | $RUN->( |
---|
| 214 | "updating configuration file", |
---|
| 215 | sub { |
---|
| 216 | my $trac_ini_path = $project->get_trac_live_ini_path(); |
---|
| 217 | my $trac_ini = Config::IniFiles->new(q{-file} => $trac_ini_path); |
---|
| 218 | if (!$trac_ini) { |
---|
| 219 | die("$trac_ini_path: cannot open.\n"); |
---|
| 220 | } |
---|
| 221 | for ( |
---|
| 222 | #section #key #value |
---|
| 223 | ['inherit', 'file' , '../../trac.ini,../../intertrac.ini'], |
---|
| 224 | ['project', 'descr' , $project->get_name() ], |
---|
| 225 | ['trac' , 'base_url', $project->get_trac_live_url() ], |
---|
| 226 | ) { |
---|
| 227 | my ($section, $key, $value) = @{$_}; |
---|
| 228 | if (!$trac_ini->SectionExists($section)) { |
---|
| 229 | $trac_ini->AddSection($section); |
---|
| 230 | } |
---|
| 231 | if (!$trac_ini->newval($section, $key, $value)) { |
---|
| 232 | die("$trac_ini_path: $section:$key: cannot set value.\n"); |
---|
| 233 | } |
---|
| 234 | } |
---|
| 235 | return $trac_ini->RewriteConfig(); |
---|
| 236 | }, |
---|
| 237 | ); |
---|
| 238 | $RUN->( |
---|
| 239 | "updating InterTrac", |
---|
| 240 | sub { |
---|
| 241 | my $ini_path = catfile( |
---|
| 242 | $CONFIG->get_trac_live_dir(), |
---|
| 243 | 'intertrac.ini', |
---|
| 244 | ); |
---|
| 245 | if (!-e $ini_path) { |
---|
| 246 | open(my $handle, '>', $ini_path) || die("$ini_path: $!\n"); |
---|
| 247 | close($handle) || die("$ini_path: $!\n"); |
---|
| 248 | } |
---|
| 249 | my $trac_ini = Config::IniFiles->new( |
---|
| 250 | q{-allowempty} => 1, |
---|
| 251 | q{-file} => $ini_path, |
---|
| 252 | ); |
---|
| 253 | if (!defined($trac_ini)) { |
---|
| 254 | die("$ini_path: cannot open.\n"); |
---|
| 255 | } |
---|
| 256 | if (!$trac_ini->SectionExists(q{intertrac})) { |
---|
| 257 | $trac_ini->AddSection(q{intertrac}); |
---|
| 258 | } |
---|
| 259 | my $name = $project->get_name(); |
---|
| 260 | for ( |
---|
| 261 | [q{title} , $name ], |
---|
| 262 | [q{url} , $project->get_trac_live_url()], |
---|
| 263 | [q{compat}, 'false' ], |
---|
| 264 | ) { |
---|
| 265 | my ($key, $value) = @{$_}; |
---|
| 266 | my $option = lc($name) . q{.} . $key; |
---|
| 267 | if (!$trac_ini->newval(q{intertrac}, $option, $value)) { |
---|
| 268 | die("$ini_path: intertrac:$option: cannot set value.\n"); |
---|
| 269 | } |
---|
| 270 | } |
---|
| 271 | return $trac_ini->RewriteConfig(); |
---|
| 272 | }, |
---|
| 273 | ); |
---|
| 274 | return 1; |
---|
| 275 | } |
---|
| 276 | |
---|
| 277 | # ------------------------------------------------------------------------------ |
---|
| 278 | # Backup the SVN repository of a project. |
---|
| 279 | sub backup_svn_repository { |
---|
| 280 | my ($option_hash_ref, $project) = @_; |
---|
| 281 | my $RUN = sub {FCM::Admin::Runner->instance()->run(@_)}; |
---|
| 282 | if (!exists($option_hash_ref->{'no-pack'})) { |
---|
| 283 | $RUN->( |
---|
| 284 | sprintf("packing %s", $project->get_svn_live_path()), |
---|
| 285 | sub {!system(qw{svnadmin pack}, $project->get_svn_live_path())}, |
---|
| 286 | ); |
---|
| 287 | } |
---|
| 288 | my $base_name = $project->get_svn_base_name(); |
---|
| 289 | run_mkpath($CONFIG->get_svn_backup_dir()); |
---|
| 290 | my $work_dir = tempdir("$base_name.backup.XXXXXX", CLEANUP => 1, TMPDIR => 1); |
---|
| 291 | my $work_path = catfile($work_dir, $base_name); |
---|
| 292 | $RUN->( |
---|
| 293 | sprintf( |
---|
| 294 | "hotcopying %s to %s", $project->get_svn_live_path(), $work_path, |
---|
| 295 | ), |
---|
| 296 | sub {!system( |
---|
| 297 | qw{svnadmin hotcopy}, $project->get_svn_live_path(), $work_path, |
---|
| 298 | )}, |
---|
| 299 | # Note: "hotcopy" is not yet possible via SVN::Repos |
---|
| 300 | ); |
---|
| 301 | if (!exists($option_hash_ref->{'no-verify-integrity'})) { |
---|
| 302 | my $VERIFIED_REVISION_REGEX = qr{\A\*\s+Verified\s+revision\s+\d+\.}xms; |
---|
| 303 | $RUN->( |
---|
| 304 | "verifying integrity of SVN repository of $project", |
---|
| 305 | sub { |
---|
| 306 | my $pipe = IO::Pipe->new(); |
---|
| 307 | $pipe->reader(sprintf( |
---|
| 308 | qq{svnadmin verify %s 2>&1}, $work_path, |
---|
| 309 | )); |
---|
| 310 | while (my $line = $pipe->getline()) { |
---|
| 311 | if ($line !~ $VERIFIED_REVISION_REGEX) { # don't print |
---|
| 312 | print($line); |
---|
| 313 | } |
---|
| 314 | } |
---|
| 315 | return $pipe->close(); |
---|
| 316 | # Note: "verify" is not yet possible via SVN::Repos |
---|
| 317 | }, |
---|
| 318 | ); |
---|
| 319 | } |
---|
| 320 | _create_backup_archive( |
---|
| 321 | $work_path, |
---|
| 322 | $CONFIG->get_svn_backup_dir(), |
---|
| 323 | $project->get_svn_archive_base_name(), |
---|
| 324 | ); |
---|
| 325 | if (!exists($option_hash_ref->{'no-housekeep-dumps'})) { |
---|
| 326 | my $base_name = $project->get_svn_base_name(); |
---|
| 327 | my $dump_path = $CONFIG->get_svn_dump_dir(); |
---|
| 328 | my $youngest = _svnlook_youngest($work_path); |
---|
| 329 | # Note: could use SVN::Repos for "youngest" |
---|
| 330 | $RUN->( |
---|
| 331 | "housekeeping $dump_path/$base_name-*.gz", |
---|
| 332 | sub { |
---|
| 333 | my @rev_dump_paths; |
---|
| 334 | _get_files_from( |
---|
| 335 | $dump_path, |
---|
| 336 | sub { |
---|
| 337 | my ($dump_base_name, $path) = @_; |
---|
| 338 | my ($name, $rev) |
---|
| 339 | = $dump_base_name =~ qr{\A(.*)-(\d+)\.gz\z}msx; |
---|
| 340 | if ( !$name |
---|
| 341 | || !$rev |
---|
| 342 | || $name ne $base_name |
---|
| 343 | || $rev > $youngest |
---|
| 344 | ) { |
---|
| 345 | return; |
---|
| 346 | } |
---|
| 347 | push(@rev_dump_paths, $path); |
---|
| 348 | }, |
---|
| 349 | ); |
---|
| 350 | for my $rev_dump_path (@rev_dump_paths) { |
---|
| 351 | run_rmtree($rev_dump_path); |
---|
| 352 | } |
---|
| 353 | return 1; |
---|
| 354 | } |
---|
| 355 | ); |
---|
| 356 | } |
---|
| 357 | run_rmtree($work_dir); |
---|
| 358 | return 1; |
---|
| 359 | } |
---|
| 360 | |
---|
| 361 | # ------------------------------------------------------------------------------ |
---|
| 362 | # Backup the Trac environment of a project. |
---|
| 363 | sub backup_trac_environment { |
---|
| 364 | my ($option_hash_ref, $project) = @_; |
---|
| 365 | my $trac_live_path = $project->get_trac_live_path(); |
---|
| 366 | my $base_name = $project->get_name(); |
---|
| 367 | run_mkpath($CONFIG->get_trac_backup_dir()); |
---|
| 368 | my $work_dir = tempdir("$base_name.backup.XXXXXX", CLEANUP => 1, TMPDIR => 1); |
---|
| 369 | my $work_path = catfile($work_dir, $base_name); |
---|
| 370 | $RUNNER->run_with_retries( |
---|
| 371 | sprintf( |
---|
| 372 | qq{hotcopying %s to %s}, |
---|
| 373 | $project->get_trac_live_path(), |
---|
| 374 | $work_path, |
---|
| 375 | ), |
---|
| 376 | sub { |
---|
| 377 | return !system( |
---|
| 378 | q{trac-admin}, |
---|
| 379 | $project->get_trac_live_path(), |
---|
| 380 | q{hotcopy}, |
---|
| 381 | $work_path, |
---|
| 382 | ); |
---|
| 383 | }, |
---|
| 384 | ); |
---|
| 385 | if (!exists($option_hash_ref->{'no-verify-integrity'})) { |
---|
| 386 | my $db_path = catfile($work_path, qw{db trac.db}); |
---|
| 387 | my $db_name = catfile($project->get_name(), qw{db trac.db}); |
---|
| 388 | $RUNNER->run( |
---|
| 389 | "checking $db_name for integrity", |
---|
| 390 | sub { |
---|
| 391 | my $db_handle |
---|
| 392 | = DBI->connect(qq{dbi:SQLite:dbname=$db_path}, q{}, q{}); |
---|
| 393 | if (!$db_handle) { |
---|
| 394 | return; |
---|
| 395 | } |
---|
| 396 | my $rc = defined($db_handle->do(q{pragma integrity_check;})); |
---|
| 397 | $db_handle->disconnect(); |
---|
| 398 | return $rc; |
---|
| 399 | }, |
---|
| 400 | ); |
---|
| 401 | } |
---|
| 402 | _create_backup_archive( |
---|
| 403 | $work_path, |
---|
| 404 | $CONFIG->get_trac_backup_dir(), |
---|
| 405 | $project->get_trac_archive_base_name(), |
---|
| 406 | ); |
---|
| 407 | run_rmtree($work_dir); |
---|
| 408 | return 1; |
---|
| 409 | } |
---|
| 410 | |
---|
| 411 | # ------------------------------------------------------------------------------ |
---|
| 412 | # Backup misc files in the Trac live directory to the Trac backup directory. |
---|
| 413 | sub backup_trac_files { |
---|
| 414 | # (no argument) |
---|
| 415 | _copy_files($CONFIG->get_trac_live_dir(), $CONFIG->get_trac_backup_dir()); |
---|
| 416 | } |
---|
| 417 | |
---|
| 418 | # ------------------------------------------------------------------------------ |
---|
| 419 | # Distributes the central FCM working copy to standard locations. |
---|
| 420 | sub distribute_wc { |
---|
| 421 | my $rc = 1; |
---|
| 422 | my @RSYNC_OPTS = qw{--timeout=1800 --exclude=.*}; |
---|
| 423 | my @sources; |
---|
| 424 | for my $source_key (shellwords($CONFIG->get_mirror_keys())) { |
---|
| 425 | my $method = "get_$source_key"; |
---|
| 426 | if ($CONFIG->can($method)) { |
---|
| 427 | push(@sources, $CONFIG->$method()); |
---|
| 428 | } |
---|
| 429 | } |
---|
| 430 | for my $dest (shellwords($CONFIG->get_mirror_dests())) { |
---|
| 431 | $rc = $RUNNER->run_continue( |
---|
| 432 | "distributing FCM to $dest", |
---|
| 433 | sub { |
---|
| 434 | run_rsync( |
---|
| 435 | \@sources, $dest, |
---|
| 436 | [@RSYNC_OPTS, qw{-a --delete-excluded}], |
---|
| 437 | ); |
---|
| 438 | }, |
---|
| 439 | ) && $rc; |
---|
| 440 | } |
---|
| 441 | return $rc; |
---|
| 442 | } |
---|
| 443 | |
---|
| 444 | # ------------------------------------------------------------------------------ |
---|
| 445 | # Returns a filtered list of projects matching names in a list. |
---|
| 446 | sub filter_projects { |
---|
| 447 | my ($project_list_ref, $filter_list_ref) = @_; |
---|
| 448 | if (!@{$filter_list_ref}) { |
---|
| 449 | return @{$project_list_ref}; |
---|
| 450 | } |
---|
| 451 | my %project_of = map {($_->get_name(), $_)} @{$project_list_ref}; |
---|
| 452 | my @projects; |
---|
| 453 | my @unmatched_names; |
---|
| 454 | for my $name (@{$filter_list_ref}) { |
---|
| 455 | if (exists($project_of{$name})) { |
---|
| 456 | push(@projects, $project_of{$name}); |
---|
| 457 | } |
---|
| 458 | else { |
---|
| 459 | push(@unmatched_names, $name); |
---|
| 460 | } |
---|
| 461 | } |
---|
| 462 | if (@unmatched_names) { |
---|
| 463 | die("@unmatched_names: not found\n"); |
---|
| 464 | } |
---|
| 465 | return @projects; |
---|
| 466 | } |
---|
| 467 | |
---|
| 468 | # ------------------------------------------------------------------------------ |
---|
| 469 | # Returns a list of projects by searching the backup SVN directory. |
---|
| 470 | sub get_projects_from_svn_backup { |
---|
| 471 | # (no dummy argument) |
---|
| 472 | my $SVN_PROJECT_SUFFIX = $CONFIG->get_svn_project_suffix(); |
---|
| 473 | my @projects; |
---|
| 474 | _get_files_from( |
---|
| 475 | $CONFIG->get_svn_backup_dir(), |
---|
| 476 | sub { |
---|
| 477 | my ($base_name, $path) = @_; |
---|
| 478 | my $name = $base_name; |
---|
| 479 | if ($name !~ s{$SVN_PROJECT_SUFFIX\.tgz\z}{}xms) { |
---|
| 480 | return; |
---|
| 481 | } |
---|
| 482 | if (!-f $path) { |
---|
| 483 | return; |
---|
| 484 | } |
---|
| 485 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 486 | }, |
---|
| 487 | ); |
---|
| 488 | return @projects; |
---|
| 489 | } |
---|
| 490 | |
---|
| 491 | # ------------------------------------------------------------------------------ |
---|
| 492 | # Returns a list of projects by searching the live SVN directory. |
---|
| 493 | sub get_projects_from_svn_live { |
---|
| 494 | # (no dummy argument) |
---|
| 495 | my $SVN_PROJECT_SUFFIX = $CONFIG->get_svn_project_suffix(); |
---|
| 496 | my @projects; |
---|
| 497 | _get_files_from( |
---|
| 498 | $CONFIG->get_svn_live_dir(), |
---|
| 499 | sub { |
---|
| 500 | my ($base_name, $path) = @_; |
---|
| 501 | my $name = $base_name; |
---|
| 502 | $name =~ s{$SVN_PROJECT_SUFFIX\z}{}xms; |
---|
| 503 | if (!-d $path) { |
---|
| 504 | return; |
---|
| 505 | } |
---|
| 506 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 507 | }, |
---|
| 508 | ); |
---|
| 509 | return @projects; |
---|
| 510 | } |
---|
| 511 | |
---|
| 512 | # ------------------------------------------------------------------------------ |
---|
| 513 | # Returns a list of projects by searching the backup Trac directory. |
---|
| 514 | sub get_projects_from_trac_backup { |
---|
| 515 | # (no dummy argument) |
---|
| 516 | my @projects; |
---|
| 517 | _get_files_from( |
---|
| 518 | $CONFIG->get_trac_backup_dir(), |
---|
| 519 | sub { |
---|
| 520 | my ($base_name, $path) = @_; |
---|
| 521 | my $name = $base_name; |
---|
| 522 | if ($name !~ s{\.tgz\z}{}xms) { |
---|
| 523 | return; |
---|
| 524 | } |
---|
| 525 | if (!-f $path) { |
---|
| 526 | return; |
---|
| 527 | } |
---|
| 528 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 529 | }, |
---|
| 530 | ); |
---|
| 531 | return @projects; |
---|
| 532 | } |
---|
| 533 | |
---|
| 534 | # ------------------------------------------------------------------------------ |
---|
| 535 | # Returns a list of projects by searching the live Trac directory. |
---|
| 536 | sub get_projects_from_trac_live { |
---|
| 537 | # (no dummy argument) |
---|
| 538 | my @projects; |
---|
| 539 | _get_files_from( |
---|
| 540 | $CONFIG->get_trac_live_dir(), |
---|
| 541 | sub { |
---|
| 542 | my ($name, $path) = @_; |
---|
| 543 | if (!-d $path) { |
---|
| 544 | return; |
---|
| 545 | } |
---|
| 546 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 547 | }, |
---|
| 548 | ); |
---|
| 549 | return @projects; |
---|
| 550 | } |
---|
| 551 | |
---|
| 552 | # ------------------------------------------------------------------------------ |
---|
| 553 | # Return a HASH of valid users. If @only_users, then return only users matching |
---|
| 554 | # these IDs. |
---|
| 555 | sub get_users { |
---|
| 556 | my @only_users = @_; |
---|
| 557 | my $name = $CONFIG->get_user_info_tool(); |
---|
| 558 | if (!defined($USER_INFO_TOOL)) { |
---|
| 559 | my $class = $UTIL->class_load($USER_INFO_TOOL_OF{$name}); |
---|
| 560 | $USER_INFO_TOOL = $class->new({util => $UTIL}); |
---|
| 561 | } |
---|
| 562 | my $user_hash_ref = $USER_INFO_TOOL->get_users_info(@only_users); |
---|
| 563 | if (!%{$user_hash_ref}) { |
---|
| 564 | die("No user found via $name.\n"); |
---|
| 565 | } |
---|
| 566 | return $user_hash_ref; |
---|
| 567 | } |
---|
| 568 | |
---|
| 569 | # ------------------------------------------------------------------------------ |
---|
| 570 | # Housekeep logs generated by hook scripts of a SVN project. |
---|
| 571 | sub housekeep_svn_hook_logs { |
---|
| 572 | my ($project) = @_; |
---|
| 573 | my $project_path = $project->get_svn_live_path(); |
---|
| 574 | my $hook_source_dir = catfile($CONFIG->get_fcm_home(), 'etc', 'svn-hooks'); |
---|
| 575 | my $today = strftime("%Y%m%d", gmtime()); |
---|
| 576 | my $date_p1w = strftime("%Y%m%d", gmtime(time() - 604800)); # 1 week ago |
---|
| 577 | my $date_p4w = strftime("%Y%m%d", gmtime(time() - 2419200)); # 4 weeks ago |
---|
| 578 | my @hook_names = map {basename($_)} glob(catfile($hook_source_dir, q{*})); |
---|
| 579 | for my $hook_name (sort @hook_names) { |
---|
| 580 | my $log_path = catfile($project_path, 'log', $hook_name . '.log'); |
---|
| 581 | my $log_path_cur; |
---|
| 582 | # Determine whether log file is more than a week old |
---|
| 583 | if ( -l $log_path |
---|
| 584 | && index(readlink($log_path), $hook_name . '.log.') == 0 |
---|
| 585 | ) { |
---|
| 586 | my $path = readlink($log_path); |
---|
| 587 | my ($date) = $path =~ qr{\.log\.(\d{8}\d*)\z}msx; |
---|
| 588 | if ($date && $date > $date_p1w) { |
---|
| 589 | $log_path_cur = catfile($project_path, 'log', $path); |
---|
| 590 | } |
---|
| 591 | } |
---|
| 592 | # Create latest log, if necessary |
---|
| 593 | if (!$log_path_cur) { |
---|
| 594 | $log_path_cur = "$log_path.$today"; |
---|
| 595 | write_file($log_path_cur); |
---|
| 596 | } |
---|
| 597 | if ( !-e $log_path |
---|
| 598 | || !-l $log_path |
---|
| 599 | || readlink($log_path) ne basename($log_path_cur) |
---|
| 600 | ) { |
---|
| 601 | run_rmtree($log_path); |
---|
| 602 | run_symlink(basename($log_path_cur), $log_path); |
---|
| 603 | } |
---|
| 604 | # Remove logs older than $keep_threshold |
---|
| 605 | for my $path ( |
---|
| 606 | sort glob(catfile($project_path, 'log', $hook_name . '*.log.*')) |
---|
| 607 | ) { |
---|
| 608 | my ($date, $dot_gz) = $path =~ qr{\.log\.(\d{8}\d*)(\.gz)?\z}msx; |
---|
| 609 | if ( $date && $date <= $date_p4w |
---|
| 610 | || $date && $date <= $date_p1w && !-s $path |
---|
| 611 | ) { |
---|
| 612 | run_rmtree($path); |
---|
| 613 | } |
---|
| 614 | elsif ($date && $date <= $date_p1w && !$dot_gz) { |
---|
| 615 | $RUNNER->run( |
---|
| 616 | "gzip $path", |
---|
| 617 | sub {gzip($path, "$path.gz") && unlink($path)}, |
---|
| 618 | ); |
---|
| 619 | } |
---|
| 620 | } |
---|
| 621 | } |
---|
| 622 | my $group = $CONFIG->get_svn_group(); |
---|
| 623 | if ($group) { |
---|
| 624 | _chgrp_and_chmod(catfile($project_path, 'log'), $group); |
---|
| 625 | } |
---|
| 626 | } |
---|
| 627 | |
---|
| 628 | # ------------------------------------------------------------------------------ |
---|
| 629 | # Installs hook scripts to a SVN project. |
---|
| 630 | sub install_svn_hook { |
---|
| 631 | my ($project, $clean_mode) = @_; |
---|
| 632 | # Write hook environment configuration |
---|
| 633 | my $project_path = $project->get_svn_live_path(); |
---|
| 634 | my $conf_dest = catfile($project_path, qw{conf hooks-env}); |
---|
| 635 | write_file( |
---|
| 636 | $conf_dest, |
---|
| 637 | "[default]\n", |
---|
| 638 | map {sprintf("%s=%s\n", @{$_});} |
---|
| 639 | grep {$_->[1];} ( |
---|
| 640 | ['FCM_HOME', $CONFIG->get_fcm_home()], |
---|
| 641 | ['FCM_SITE_HOME', $CONFIG->get_fcm_site_home()], |
---|
| 642 | ['FCM_SVN_HOOK_ADMIN_EMAIL', $CONFIG->get_admin_email()], |
---|
| 643 | ['FCM_SVN_HOOK_COMMIT_DUMP_DIR', $CONFIG->get_svn_dump_dir()], |
---|
| 644 | ['FCM_SVN_HOOK_NOTIFICATION_FROM', $CONFIG->get_notification_from()], |
---|
| 645 | ['FCM_SVN_HOOK_REPOS_SUFFIX', $CONFIG->get_svn_project_suffix()], |
---|
| 646 | ['FCM_SVN_HOOK_TRAC_ROOT_DIR', $CONFIG->get_trac_live_dir()], |
---|
| 647 | ['PATH', $CONFIG->get_svn_hook_path_env()], |
---|
| 648 | ['TZ', 'UTC'], |
---|
| 649 | ) |
---|
| 650 | ); |
---|
| 651 | my %path_of = (); |
---|
| 652 | # Search for hook scripts: |
---|
| 653 | # * default sets |
---|
| 654 | # * selected items from top of repository, e.g. svnperms.conf |
---|
| 655 | # * site overrides |
---|
| 656 | _get_files_from( |
---|
| 657 | catfile($CONFIG->get_fcm_home(), 'etc', 'svn-hooks'), |
---|
| 658 | sub { |
---|
| 659 | my ($base_name, $path) = @_; |
---|
| 660 | if (index($base_name, q{.}) == 0 || -d $path) { |
---|
| 661 | return; |
---|
| 662 | } |
---|
| 663 | $path_of{$base_name} = $path; |
---|
| 664 | }, |
---|
| 665 | ); |
---|
| 666 | for my $line (qx{svnlook tree -N $project_path}) { |
---|
| 667 | chomp($line); |
---|
| 668 | my ($base_name) = $line =~ qr{\A\s*(.*)\z}msx; |
---|
| 669 | if (grep {$_ eq $base_name} @SVN_REPOS_ROOT_HOOK_ITEMS) { |
---|
| 670 | $path_of{$base_name} = "^/$base_name"; |
---|
| 671 | } |
---|
| 672 | } |
---|
| 673 | _get_files_from( |
---|
| 674 | catfile( |
---|
| 675 | $CONFIG->get_fcm_site_home(), 'svn-hooks', $project->get_name(), |
---|
| 676 | ), |
---|
| 677 | sub { |
---|
| 678 | my ($base_name, $path) = @_; |
---|
| 679 | if (index($base_name, q{.}) == 0 || -d $path) { |
---|
| 680 | return; |
---|
| 681 | } |
---|
| 682 | $path_of{$base_name} = $path; |
---|
| 683 | }, |
---|
| 684 | ); |
---|
| 685 | # Install hook scripts and associated files |
---|
| 686 | for my $base_name (sort keys(%path_of)) { |
---|
| 687 | my $hook_source = $path_of{$base_name}; |
---|
| 688 | my $hook_dest = catfile($project->get_svn_live_hook_path(), $base_name); |
---|
| 689 | if (index($hook_source, '^/') == 0) { |
---|
| 690 | $RUNNER->run( |
---|
| 691 | "install $hook_dest <- $hook_source", |
---|
| 692 | sub { |
---|
| 693 | my $source = "file://$project_path/$base_name"; |
---|
| 694 | !system(qw{svn export -q --force}, $source, $hook_dest) |
---|
| 695 | || die("\n"); |
---|
| 696 | chmod((stat($hook_dest))[2] | S_IRGRP | S_IROTH, $hook_dest); |
---|
| 697 | }, |
---|
| 698 | ); |
---|
| 699 | } |
---|
| 700 | else { |
---|
| 701 | run_copy($hook_source, $hook_dest); |
---|
| 702 | } |
---|
| 703 | } |
---|
| 704 | # Clean hook destination, if necessary |
---|
| 705 | if ($clean_mode) { |
---|
| 706 | my $hook_path = $project->get_svn_live_hook_path(); |
---|
| 707 | for my $path (sort glob(catfile($hook_path, q{*}))) { |
---|
| 708 | if (!exists($path_of{basename($path)})) { |
---|
| 709 | run_rmtree($path); |
---|
| 710 | } |
---|
| 711 | } |
---|
| 712 | } |
---|
| 713 | my $group = $CONFIG->get_svn_group(); |
---|
| 714 | if ($group) { |
---|
| 715 | _chgrp_and_chmod($project->get_svn_live_hook_path(), $group); |
---|
| 716 | } |
---|
| 717 | return 1; |
---|
| 718 | } |
---|
| 719 | |
---|
| 720 | # ------------------------------------------------------------------------------ |
---|
| 721 | # Updates the SVN password file. |
---|
| 722 | sub manage_users_in_svn_passwd { |
---|
| 723 | my ($user_ref) = @_; |
---|
| 724 | if (!$CONFIG->get_svn_passwd_file()) { |
---|
| 725 | return 1; |
---|
| 726 | } |
---|
| 727 | my $svn_passwd_file = catfile( |
---|
| 728 | $CONFIG->get_svn_live_dir(), |
---|
| 729 | $CONFIG->get_svn_passwd_file(), |
---|
| 730 | ); |
---|
| 731 | $RUNNER->run( |
---|
| 732 | "updating $svn_passwd_file", |
---|
| 733 | sub { |
---|
| 734 | my $USERS_SECTION = q{users}; |
---|
| 735 | my $svn_passwd_ini; |
---|
| 736 | my $is_changed; |
---|
| 737 | if (-f $svn_passwd_file) { |
---|
| 738 | $svn_passwd_ini |
---|
| 739 | = Config::IniFiles->new(q{-file} => $svn_passwd_file); |
---|
| 740 | } |
---|
| 741 | else { |
---|
| 742 | $svn_passwd_ini = Config::IniFiles->new(); |
---|
| 743 | $svn_passwd_ini->SetFileName($svn_passwd_file); |
---|
| 744 | $svn_passwd_ini->AddSection($USERS_SECTION); |
---|
| 745 | $is_changed = 1; |
---|
| 746 | } |
---|
| 747 | for my $name (($svn_passwd_ini->Parameters($USERS_SECTION))) { |
---|
| 748 | if (!exists($user_ref->{$name})) { |
---|
| 749 | $RUNNER->run( |
---|
| 750 | "removing $name from $svn_passwd_file", |
---|
| 751 | sub { |
---|
| 752 | return |
---|
| 753 | $svn_passwd_ini->delval($USERS_SECTION, $name); |
---|
| 754 | }, |
---|
| 755 | ); |
---|
| 756 | $is_changed = 1; |
---|
| 757 | } |
---|
| 758 | } |
---|
| 759 | for my $user (values(%{$user_ref})) { |
---|
| 760 | if (!defined($svn_passwd_ini->val($USERS_SECTION, "$user"))) { |
---|
| 761 | $RUNNER->run( |
---|
| 762 | "adding $user to $svn_passwd_file", |
---|
| 763 | sub { |
---|
| 764 | $svn_passwd_ini->newval( |
---|
| 765 | $USERS_SECTION, $user->get_name(), q{}, |
---|
| 766 | ), |
---|
| 767 | }, |
---|
| 768 | ); |
---|
| 769 | $is_changed = 1; |
---|
| 770 | } |
---|
| 771 | } |
---|
| 772 | return ($is_changed ? $svn_passwd_ini->RewriteConfig() : 1); |
---|
| 773 | }, |
---|
| 774 | ); |
---|
| 775 | return 1; |
---|
| 776 | } |
---|
| 777 | |
---|
| 778 | # ------------------------------------------------------------------------------ |
---|
| 779 | # Updates the Trac password file. |
---|
| 780 | sub manage_users_in_trac_passwd { |
---|
| 781 | my ($user_ref) = @_; |
---|
| 782 | if (!$CONFIG->get_trac_passwd_file()) { |
---|
| 783 | return 1; |
---|
| 784 | } |
---|
| 785 | my $trac_passwd_file = catfile( |
---|
| 786 | $CONFIG->get_trac_live_dir(), |
---|
| 787 | $CONFIG->get_trac_passwd_file(), |
---|
| 788 | ); |
---|
| 789 | $RUNNER->run( |
---|
| 790 | "updating $trac_passwd_file", |
---|
| 791 | sub { |
---|
| 792 | my %old_names; |
---|
| 793 | my %new_names = %{$user_ref}; |
---|
| 794 | if (-f $trac_passwd_file) { |
---|
| 795 | read_file( |
---|
| 796 | $trac_passwd_file, |
---|
| 797 | sub { |
---|
| 798 | my ($line) = @_; |
---|
| 799 | chomp($line); |
---|
| 800 | if ( |
---|
| 801 | !$line || $line =~ qr{\A\s*\z}xms # blank line |
---|
| 802 | || $line =~ qr{\A\s*\#}xms # comment line |
---|
| 803 | ) { |
---|
| 804 | return; |
---|
| 805 | } |
---|
| 806 | my ($name, $passwd) = split(qr{\s*:\s*}xms, $line); |
---|
| 807 | if (exists($new_names{$name})) { |
---|
| 808 | delete($new_names{$name}); |
---|
| 809 | } |
---|
| 810 | else { |
---|
| 811 | $old_names{$name} = 1; |
---|
| 812 | } |
---|
| 813 | }, |
---|
| 814 | ) || return; |
---|
| 815 | } |
---|
| 816 | else { |
---|
| 817 | write_file($trac_passwd_file) || return; |
---|
| 818 | } |
---|
| 819 | if (%old_names || %new_names) { |
---|
| 820 | for my $name (keys(%old_names)) { |
---|
| 821 | $RUNNER->run( |
---|
| 822 | "removing $name from $trac_passwd_file", |
---|
| 823 | sub { |
---|
| 824 | return !system( |
---|
| 825 | qw{htpasswd -D}, $trac_passwd_file, $name, |
---|
| 826 | ); |
---|
| 827 | }, |
---|
| 828 | ); |
---|
| 829 | } |
---|
| 830 | for my $name (keys(%new_names)) { |
---|
| 831 | $RUNNER->run( |
---|
| 832 | "adding $name to $trac_passwd_file", |
---|
| 833 | sub { |
---|
| 834 | return !system( |
---|
| 835 | qw{htpasswd -b}, $trac_passwd_file, $name, q{}, |
---|
| 836 | ); |
---|
| 837 | }, |
---|
| 838 | ); |
---|
| 839 | sleep(1); # ensure the random seed for htpasswd is changed |
---|
| 840 | } |
---|
| 841 | } |
---|
| 842 | return 1; |
---|
| 843 | }, |
---|
| 844 | # Note: can use HTTPD::UserAdmin, if it is installed |
---|
| 845 | ); |
---|
| 846 | return 1; |
---|
| 847 | } |
---|
| 848 | |
---|
| 849 | # ------------------------------------------------------------------------------ |
---|
| 850 | # Manages the session* tables in the DB of a Trac environment. |
---|
| 851 | sub manage_users_in_trac_db_of { |
---|
| 852 | my ($project, $user_ref) = @_; |
---|
| 853 | return $RUNNER->run_with_retries( |
---|
| 854 | sprintf( |
---|
| 855 | qq{checking/updating %s}, |
---|
| 856 | $project->get_trac_live_db_path(), |
---|
| 857 | ), |
---|
| 858 | sub {return _manage_users_in_trac_db_of($project, $user_ref)}, |
---|
| 859 | ); |
---|
| 860 | } |
---|
| 861 | |
---|
| 862 | # ------------------------------------------------------------------------------ |
---|
| 863 | # Recovers a SVN repository from its backup. |
---|
| 864 | sub recover_svn_repository { |
---|
| 865 | my ($project, $recover_dumps_option, $recover_hooks_option) = @_; |
---|
| 866 | if (-e $project->get_svn_live_path()) { |
---|
| 867 | die(sprintf( |
---|
| 868 | "%s: live repository exists.\n", |
---|
| 869 | $project->get_svn_live_path(), |
---|
| 870 | )); |
---|
| 871 | } |
---|
| 872 | run_mkpath($CONFIG->get_svn_live_dir()); |
---|
| 873 | my $base_name = $project->get_svn_base_name(); |
---|
| 874 | my $work_dir = tempdir( |
---|
| 875 | qq{$base_name.XXXXXX}, |
---|
| 876 | DIR => $CONFIG->get_svn_live_dir(), |
---|
| 877 | CLEANUP => 1, |
---|
| 878 | ); |
---|
| 879 | my $work_path = catfile($work_dir, $base_name); |
---|
| 880 | _extract_backup_archive($project->get_svn_backup_path(), $work_path); |
---|
| 881 | if ($recover_dumps_option) { |
---|
| 882 | my $youngest = _svnlook_youngest($work_path); |
---|
| 883 | my %dump_path_of; |
---|
| 884 | _get_files_from( |
---|
| 885 | $CONFIG->get_svn_dump_dir(), |
---|
| 886 | sub { |
---|
| 887 | my ($dump_base_name, $path) = @_; |
---|
| 888 | my ($name, $rev) = $dump_base_name =~ qr{\A(.*)-(\d+)\.gz\z}msx; |
---|
| 889 | if ( !$name |
---|
| 890 | || !$rev |
---|
| 891 | || $name ne $base_name |
---|
| 892 | || $rev <= $youngest |
---|
| 893 | ) { |
---|
| 894 | return; |
---|
| 895 | } |
---|
| 896 | $dump_path_of{$rev} = $path; |
---|
| 897 | }, |
---|
| 898 | ); |
---|
| 899 | for my $rev (sort {$a <=> $b} keys(%dump_path_of)) { |
---|
| 900 | my $dump_path = $dump_path_of{$rev}; |
---|
| 901 | $RUNNER->run( |
---|
| 902 | "loading $dump_path into $work_path", |
---|
| 903 | sub { |
---|
| 904 | my $pipe = IO::Pipe->new(); |
---|
| 905 | $pipe->writer(qw{svnadmin load}, $work_path); |
---|
| 906 | my $handle = IO::Zlib->new($dump_path, 'rb'); |
---|
| 907 | if (!$handle) { |
---|
| 908 | die("$dump_path: $!\n"); |
---|
| 909 | } |
---|
| 910 | while ($handle->read(my $buffer, $BUFFER_SIZE)) { |
---|
| 911 | $pipe->print($buffer); |
---|
| 912 | } |
---|
| 913 | $handle->close(); |
---|
| 914 | return ($pipe->close()); |
---|
| 915 | }, |
---|
| 916 | ); |
---|
| 917 | } |
---|
| 918 | } |
---|
| 919 | run_rename($work_path, $project->get_svn_live_path()); |
---|
| 920 | my $group = $CONFIG->get_svn_group(); |
---|
| 921 | if ($group) { |
---|
| 922 | _chgrp_and_chmod($project->get_svn_live_path(), $group); |
---|
| 923 | } |
---|
| 924 | if ($recover_hooks_option) { |
---|
| 925 | install_svn_hook($project); |
---|
| 926 | housekeep_svn_hook_logs($project); |
---|
| 927 | } |
---|
| 928 | return 1; |
---|
| 929 | } |
---|
| 930 | |
---|
| 931 | # ------------------------------------------------------------------------------ |
---|
| 932 | # Recovers a Trac environment from its backup. |
---|
| 933 | sub recover_trac_environment { |
---|
| 934 | my ($project) = @_; |
---|
| 935 | if (-e $project->get_trac_live_path()) { |
---|
| 936 | die(sprintf( |
---|
| 937 | "%s: live environment exists.\n", |
---|
| 938 | $project->get_trac_live_path(), |
---|
| 939 | )); |
---|
| 940 | } |
---|
| 941 | run_mkpath($CONFIG->get_trac_live_dir()); |
---|
| 942 | my $base_name = $project->get_name(); |
---|
| 943 | my $work_dir = tempdir( |
---|
| 944 | qq{$base_name.XXXXXX}, |
---|
| 945 | DIR => $CONFIG->get_trac_live_dir(), |
---|
| 946 | CLEANUP => 1, |
---|
| 947 | ); |
---|
| 948 | my $work_path = catfile($work_dir, $base_name); |
---|
| 949 | _extract_backup_archive($project->get_trac_backup_path(), $work_path); |
---|
| 950 | run_rename($work_path, $project->get_trac_live_path()); |
---|
| 951 | my $group = $CONFIG->get_trac_group(); |
---|
| 952 | if ($group) { |
---|
| 953 | _chgrp_and_chmod($project->get_trac_live_path(), $group); |
---|
| 954 | } |
---|
| 955 | } |
---|
| 956 | |
---|
| 957 | # ------------------------------------------------------------------------------ |
---|
| 958 | # Recover a file from the Trac backup directory to the Trac live directory. |
---|
| 959 | sub recover_trac_files { |
---|
| 960 | # (no argument) |
---|
| 961 | _copy_files( |
---|
| 962 | $CONFIG->get_trac_backup_dir(), |
---|
| 963 | $CONFIG->get_trac_live_dir(), |
---|
| 964 | $NO_OVERWRITE, |
---|
| 965 | qr{\.tgz\z}msx, |
---|
| 966 | ); |
---|
| 967 | } |
---|
| 968 | |
---|
| 969 | # ------------------------------------------------------------------------------ |
---|
| 970 | # Vacuum the database of a Trac environment. |
---|
| 971 | sub vacuum_trac_env_db { |
---|
| 972 | my ($project) = @_; |
---|
| 973 | $RUNNER->run( |
---|
| 974 | "performing vacuum on database of Trac environment for $project", |
---|
| 975 | sub { |
---|
| 976 | my $db_handle = _get_trac_db_handle_for($project); |
---|
| 977 | if (!$db_handle) { |
---|
| 978 | return; |
---|
| 979 | } |
---|
| 980 | $db_handle->do(q{vacuum;}) && $db_handle->disconnect(); |
---|
| 981 | }, |
---|
| 982 | ); |
---|
| 983 | } |
---|
| 984 | |
---|
| 985 | # ------------------------------------------------------------------------------ |
---|
| 986 | # Verify users. Return a list of bad users from @users. |
---|
| 987 | sub verify_users { |
---|
| 988 | my @users = @_; |
---|
| 989 | if (!defined($USER_INFO_TOOL)) { |
---|
| 990 | my $name = $CONFIG->get_user_info_tool(); |
---|
| 991 | my $class = $UTIL->class_load($USER_INFO_TOOL_OF{$name}); |
---|
| 992 | $USER_INFO_TOOL = $class->new({util => $UTIL}); |
---|
| 993 | } |
---|
| 994 | return $USER_INFO_TOOL->verify_users(@users); |
---|
| 995 | } |
---|
| 996 | |
---|
| 997 | # ------------------------------------------------------------------------------ |
---|
| 998 | # Changes/restores ownership and permission of a given $path to a given $group. |
---|
| 999 | sub _chgrp_and_chmod { |
---|
| 1000 | my ($path, $group) = @_; |
---|
| 1001 | my $gid = $group ? scalar(getgrnam($group)) : -1; |
---|
| 1002 | find( |
---|
| 1003 | sub { |
---|
| 1004 | my $file = $File::Find::name; |
---|
| 1005 | my $old_gid = (stat($file))[5]; |
---|
| 1006 | if ($old_gid != $gid) { |
---|
| 1007 | $RUNNER->run( |
---|
| 1008 | "changing group ownership for $file", |
---|
| 1009 | sub {return chown(-1, $gid, $file)}, |
---|
| 1010 | ); |
---|
| 1011 | } |
---|
| 1012 | my $old_mode = (stat($file))[2]; |
---|
| 1013 | my $mode = (stat($file))[2] | S_IRGRP | S_IWGRP; |
---|
| 1014 | if ($old_mode != $mode) { |
---|
| 1015 | $RUNNER->run( |
---|
| 1016 | "adding group write permission for $file", |
---|
| 1017 | sub {return chmod($mode, $file)}, |
---|
| 1018 | ); |
---|
| 1019 | } |
---|
| 1020 | }, |
---|
| 1021 | $path, |
---|
| 1022 | ); |
---|
| 1023 | return 1; |
---|
| 1024 | } |
---|
| 1025 | |
---|
| 1026 | # ------------------------------------------------------------------------------ |
---|
| 1027 | # Copies files immediately under $source to $target. |
---|
| 1028 | sub _copy_files { |
---|
| 1029 | my ($source, $target, $no_overwrite, $re_skip) = @_; |
---|
| 1030 | my @bases; |
---|
| 1031 | opendir(my $handle, $source) || die("$source: $!\n"); |
---|
| 1032 | while (my $base = readdir($handle)) { |
---|
| 1033 | if (-f catfile($source, $base)) { |
---|
| 1034 | if ($no_overwrite && -f catfile($target, $base)) { |
---|
| 1035 | warn("[SKIP] $base: already exists in $target.\n"); |
---|
| 1036 | } |
---|
| 1037 | elsif (!$re_skip || ($base !~ $re_skip)) { |
---|
| 1038 | push(@bases, $base); |
---|
| 1039 | } |
---|
| 1040 | } |
---|
| 1041 | } |
---|
| 1042 | closedir($handle); |
---|
| 1043 | run_mkpath($target); |
---|
| 1044 | for my $base (@bases) { |
---|
| 1045 | run_copy(map {catfile($_, $base)} ($source, $target)); |
---|
| 1046 | } |
---|
| 1047 | return 1; |
---|
| 1048 | } |
---|
| 1049 | |
---|
| 1050 | # ------------------------------------------------------------------------------ |
---|
| 1051 | # Creates backup archive from a path. |
---|
| 1052 | sub _create_backup_archive { |
---|
| 1053 | my ($source_path, $backup_dir, $archive_base_name) = @_; |
---|
| 1054 | my $source_dir = dirname($source_path); |
---|
| 1055 | my $source_base_name = basename($source_path); |
---|
| 1056 | run_mkpath($backup_dir); |
---|
| 1057 | my ($fh, $work_backup_path) |
---|
| 1058 | = tempfile(qq{$archive_base_name.XXXXXX}, DIR => $backup_dir); |
---|
| 1059 | close($fh); |
---|
| 1060 | run_create_archive($work_backup_path, $source_dir, $source_base_name); |
---|
| 1061 | my $backup_path = catfile($backup_dir, $archive_base_name); |
---|
| 1062 | run_rename($work_backup_path, $backup_path); |
---|
| 1063 | my $mode = (stat($backup_path))[2] | S_IRGRP | S_IROTH; |
---|
| 1064 | return chmod($mode, $backup_path); |
---|
| 1065 | } |
---|
| 1066 | |
---|
| 1067 | # ------------------------------------------------------------------------------ |
---|
| 1068 | # Extracts from a backup archive to a work path. |
---|
| 1069 | sub _extract_backup_archive { |
---|
| 1070 | my ($archive_path, $work_path) = @_; |
---|
| 1071 | run_extract_archive($archive_path, dirname($work_path)); |
---|
| 1072 | if (! -e $work_path) { |
---|
| 1073 | my ($base_name) = basename($work_path); |
---|
| 1074 | die("$base_name: does not exist in archive $archive_path.\n"); |
---|
| 1075 | } |
---|
| 1076 | return 1; |
---|
| 1077 | } |
---|
| 1078 | |
---|
| 1079 | # ------------------------------------------------------------------------------ |
---|
| 1080 | # Searches a directory for files and invokes a callback on each file. |
---|
| 1081 | sub _get_files_from { |
---|
| 1082 | my ($dir_path, $callback_ref) = @_; |
---|
| 1083 | my $dir_handle = IO::Dir->new($dir_path); |
---|
| 1084 | if (!defined($dir_handle)) { |
---|
| 1085 | return; |
---|
| 1086 | } |
---|
| 1087 | BASE_NAME: |
---|
| 1088 | while (my $base_name = $dir_handle->read()) { |
---|
| 1089 | my $path = catfile($dir_path, $base_name); |
---|
| 1090 | if (index($base_name, q{.}) == 0) { |
---|
| 1091 | next BASE_NAME; |
---|
| 1092 | } |
---|
| 1093 | $callback_ref->($base_name, $path); |
---|
| 1094 | } |
---|
| 1095 | return $dir_handle->close(); |
---|
| 1096 | } |
---|
| 1097 | |
---|
| 1098 | # ------------------------------------------------------------------------------ |
---|
| 1099 | # Returns a database handle for the database of a Trac environment. |
---|
| 1100 | sub _get_trac_db_handle_for { |
---|
| 1101 | my ($project) = @_; |
---|
| 1102 | my $db_path = $project->get_trac_live_db_path(); |
---|
| 1103 | return DBI->connect(qq{dbi:SQLite:dbname=$db_path}, q{}, q{}); |
---|
| 1104 | } |
---|
| 1105 | |
---|
| 1106 | # ------------------------------------------------------------------------------ |
---|
| 1107 | # Manages the session* tables in the DB of a Trac environment. |
---|
| 1108 | sub _manage_users_in_trac_db_of { |
---|
| 1109 | my ($project, $user_ref) = @_; |
---|
| 1110 | my $db_handle = _get_trac_db_handle_for($project); |
---|
| 1111 | if (!$db_handle) { |
---|
| 1112 | return; |
---|
| 1113 | } |
---|
| 1114 | SESSION: { |
---|
| 1115 | my $session_select_statement = $db_handle->prepare( |
---|
| 1116 | "SELECT sid FROM session WHERE authenticated == 1", |
---|
| 1117 | ); |
---|
| 1118 | my $session_insert_statement = $db_handle->prepare( |
---|
| 1119 | "INSERT INTO session VALUES (?, 1, 0)", |
---|
| 1120 | ); |
---|
| 1121 | my $session_delete_statement = $db_handle->prepare( |
---|
| 1122 | "DELETE FROM session WHERE sid == ?", |
---|
| 1123 | ); |
---|
| 1124 | $session_select_statement->execute(); |
---|
| 1125 | my $is_changed = 0; |
---|
| 1126 | my %session_old_users; |
---|
| 1127 | while (my ($sid) = $session_select_statement->fetchrow_array()) { |
---|
| 1128 | if (exists($user_ref->{$sid})) { |
---|
| 1129 | $session_old_users{$sid} = 1; |
---|
| 1130 | } |
---|
| 1131 | else { |
---|
| 1132 | $RUNNER->run( |
---|
| 1133 | "session: removing $sid", |
---|
| 1134 | sub{return $session_delete_statement->execute($sid)}, |
---|
| 1135 | ); |
---|
| 1136 | $is_changed = 1; |
---|
| 1137 | } |
---|
| 1138 | } |
---|
| 1139 | for my $sid (keys(%{$user_ref})) { |
---|
| 1140 | if (!exists($session_old_users{$sid})) { |
---|
| 1141 | $RUNNER->run( |
---|
| 1142 | "session: adding $sid", |
---|
| 1143 | sub {return $session_insert_statement->execute($sid)}, |
---|
| 1144 | ); |
---|
| 1145 | $is_changed = 1; |
---|
| 1146 | } |
---|
| 1147 | } |
---|
| 1148 | $session_select_statement->finish(); |
---|
| 1149 | $session_insert_statement->finish(); |
---|
| 1150 | $session_delete_statement->finish(); |
---|
| 1151 | } |
---|
| 1152 | SESSION_ATTRIBUTE: { |
---|
| 1153 | my $attribute_select_statement = $db_handle->prepare( |
---|
| 1154 | "SELECT sid,name,value FROM session_attribute " |
---|
| 1155 | . "WHERE authenticated == 1", |
---|
| 1156 | ); |
---|
| 1157 | my $attribute_insert_statement = $db_handle->prepare( |
---|
| 1158 | "INSERT INTO session_attribute VALUES (?, 1, ?, ?)", |
---|
| 1159 | ); |
---|
| 1160 | my $attribute_update_statement = $db_handle->prepare( |
---|
| 1161 | "UPDATE session_attribute SET value = ? " |
---|
| 1162 | . "WHERE sid = ? AND authenticated == 1 AND name == ?", |
---|
| 1163 | ); |
---|
| 1164 | my $attribute_delete_statement = $db_handle->prepare( |
---|
| 1165 | "DELETE FROM session_attribute WHERE sid == ?", |
---|
| 1166 | ); |
---|
| 1167 | my $attribute_delete_name_statement = $db_handle->prepare( |
---|
| 1168 | "DELETE FROM session_attribute WHERE sid == ? AND name == ?", |
---|
| 1169 | ); |
---|
| 1170 | $attribute_select_statement->execute(); |
---|
| 1171 | my %attribute_old_users; |
---|
| 1172 | my %deleted_users; |
---|
| 1173 | ROW: |
---|
| 1174 | while (my @row = $attribute_select_statement->fetchrow_array()) { |
---|
| 1175 | my ($sid, $name, $value) = @row; |
---|
| 1176 | my $user = exists($user_ref->{$sid})? $user_ref->{$sid} : undef; |
---|
| 1177 | if (defined($user)) { |
---|
| 1178 | my $getter |
---|
| 1179 | = $name eq 'name' ? 'get_display_name' |
---|
| 1180 | : $name eq 'email' ? 'get_email' |
---|
| 1181 | : undef; |
---|
| 1182 | if (!defined($getter)) { |
---|
| 1183 | next ROW; |
---|
| 1184 | } |
---|
| 1185 | $attribute_old_users{"$sid|$name"} = 1; |
---|
| 1186 | my $new_value = $user->$getter(); |
---|
| 1187 | if ($new_value && $new_value ne $value) { |
---|
| 1188 | $RUNNER->run( |
---|
| 1189 | "session_attribute: updating $name: $sid: $new_value", |
---|
| 1190 | sub {return $attribute_update_statement->execute( |
---|
| 1191 | $new_value, $sid, $name, |
---|
| 1192 | )}, |
---|
| 1193 | ); |
---|
| 1194 | } |
---|
| 1195 | elsif (!$new_value && $value) { |
---|
| 1196 | $RUNNER->run( |
---|
| 1197 | "session_attribute: removing $name: $sid", |
---|
| 1198 | sub {return $attribute_delete_name_statement->execute( |
---|
| 1199 | $sid, $name, |
---|
| 1200 | )}, |
---|
| 1201 | ); |
---|
| 1202 | } |
---|
| 1203 | } |
---|
| 1204 | elsif (!exists($deleted_users{$sid})) { |
---|
| 1205 | $deleted_users{$sid} = 1; |
---|
| 1206 | $RUNNER->run( |
---|
| 1207 | "session_attribute: removing $sid", |
---|
| 1208 | sub {return $attribute_delete_statement->execute($sid)}, |
---|
| 1209 | ); |
---|
| 1210 | } |
---|
| 1211 | } |
---|
| 1212 | for my $sid (keys(%{$user_ref})) { |
---|
| 1213 | my $user = $user_ref->{$sid}; |
---|
| 1214 | ATTRIB: |
---|
| 1215 | for ( |
---|
| 1216 | ['name' , $user->get_display_name()], |
---|
| 1217 | ['email', $user->get_email() ], |
---|
| 1218 | ) { |
---|
| 1219 | my ($name, $value) = @{$_}; |
---|
| 1220 | if (exists($attribute_old_users{"$sid|$name"})) { |
---|
| 1221 | next ATTRIB; |
---|
| 1222 | } |
---|
| 1223 | if ($value) { |
---|
| 1224 | $RUNNER->run( |
---|
| 1225 | "session_attribute: adding $name: $sid: $value", |
---|
| 1226 | sub {$attribute_insert_statement->execute( |
---|
| 1227 | $sid, $name, $value, |
---|
| 1228 | )}, |
---|
| 1229 | ); |
---|
| 1230 | } |
---|
| 1231 | } |
---|
| 1232 | } |
---|
| 1233 | $attribute_select_statement->finish(); |
---|
| 1234 | $attribute_insert_statement->finish(); |
---|
| 1235 | $attribute_update_statement->finish(); |
---|
| 1236 | $attribute_delete_statement->finish(); |
---|
| 1237 | } |
---|
| 1238 | return $db_handle->disconnect(); |
---|
| 1239 | } |
---|
| 1240 | |
---|
| 1241 | # ------------------------------------------------------------------------------ |
---|
| 1242 | # Returns the youngest revision of a SVN repository. |
---|
| 1243 | sub _svnlook_youngest { |
---|
| 1244 | my ($svn_repos_path) = @_; |
---|
| 1245 | my ($youngest) = qx{svnlook youngest $svn_repos_path}; |
---|
| 1246 | chomp($youngest); |
---|
| 1247 | return $youngest; |
---|
| 1248 | } |
---|
| 1249 | |
---|
| 1250 | 1; |
---|
| 1251 | __END__ |
---|
| 1252 | |
---|
| 1253 | =head1 NAME |
---|
| 1254 | |
---|
| 1255 | FCM::Admin::System |
---|
| 1256 | |
---|
| 1257 | =head1 SYNOPSIS |
---|
| 1258 | |
---|
| 1259 | use FCM::Admin::System qw{ ... }; |
---|
| 1260 | # ... see descriptions of individual functions for detail |
---|
| 1261 | |
---|
| 1262 | =head1 DESCRIPTION |
---|
| 1263 | |
---|
| 1264 | This module contains utility functions for the administration of Subversion |
---|
| 1265 | repositories and Trac environments hosted by the FCM team. |
---|
| 1266 | |
---|
| 1267 | =head1 FUNCTIONS |
---|
| 1268 | |
---|
| 1269 | =over 4 |
---|
| 1270 | |
---|
| 1271 | =item add_svn_repository($project_name) |
---|
| 1272 | |
---|
| 1273 | Creates a new Subversion repository. |
---|
| 1274 | |
---|
| 1275 | =item add_trac_environment($project_name) |
---|
| 1276 | |
---|
| 1277 | Creates a new Trac environment. |
---|
| 1278 | |
---|
| 1279 | =item backup_svn_repository(\%option,$project) |
---|
| 1280 | |
---|
| 1281 | Creates an archived hotcopy of $project's live SVN repository, and put it in the |
---|
| 1282 | SVN backup directory. If $option{'no-verify-integrity'} does not exist, it |
---|
| 1283 | verifies the integrity of the live repository before creating the hotcopy. If |
---|
| 1284 | $option{'no-pack'} does not exist, it packs the live repository before creating |
---|
| 1285 | the hotcopy. If $option{'no-housekeep-dumps'} does not exist, it housekeeps the |
---|
| 1286 | revision dumps of $project following a successful backup. |
---|
| 1287 | |
---|
| 1288 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1289 | |
---|
| 1290 | =item backup_trac_environment(\%option,$project) |
---|
| 1291 | |
---|
| 1292 | Creates an archived hotcopy of $project's live Trac environment, and put it in |
---|
| 1293 | the Trac backup directory. If $option{'no-verify-integrity'} does not exist, it |
---|
| 1294 | verifies the integrity of the database of the live environment before creating |
---|
| 1295 | the hotcopy. |
---|
| 1296 | |
---|
| 1297 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1298 | |
---|
| 1299 | =item backup_trac_files() |
---|
| 1300 | |
---|
| 1301 | Copies regular files immediately under the live Trac directory to the Trac |
---|
| 1302 | backup directory. |
---|
| 1303 | |
---|
| 1304 | =item distribute_wc() |
---|
| 1305 | |
---|
| 1306 | Distributes the central FCM working copy to standard locations. |
---|
| 1307 | |
---|
| 1308 | =item filter_projects($project_list_ref,$filter_list_ref) |
---|
| 1309 | |
---|
| 1310 | Filters the project list in $project_list_ref using a list of names in |
---|
| 1311 | $filter_list_ref. Returns a list of projects with names matching those in |
---|
| 1312 | $filter_list_ref. Returns the full list if $filter_list_ref points to an empty |
---|
| 1313 | list. |
---|
| 1314 | |
---|
| 1315 | =item get_projects_from_svn_backup() |
---|
| 1316 | |
---|
| 1317 | Returns a list of L<FCM::Admin::Project|FCM::Admin::Project> objects by |
---|
| 1318 | searching the SVN backup directory. By default, all valid projects are returned. |
---|
| 1319 | |
---|
| 1320 | =item get_projects_from_svn_live() |
---|
| 1321 | |
---|
| 1322 | Similar to get_projects_from_svn_backup(), but it searches the SVN live |
---|
| 1323 | directory. |
---|
| 1324 | |
---|
| 1325 | =item get_projects_from_trac_backup() |
---|
| 1326 | |
---|
| 1327 | Similar to get_projects_from_svn_backup(), but it searches the Trac backup |
---|
| 1328 | directory. |
---|
| 1329 | |
---|
| 1330 | =item get_projects_from_trac_live() |
---|
| 1331 | |
---|
| 1332 | Similar to get_projects_from_svn_backup(), but it searches the Trac live |
---|
| 1333 | directory. |
---|
| 1334 | |
---|
| 1335 | =item get_users(@only_users) |
---|
| 1336 | |
---|
| 1337 | Retrieves a list of users. Store results in a HASH, {user ID => user info, ...} |
---|
| 1338 | where each user info is stored in an instance of |
---|
| 1339 | L<FCM::Admin::System::User|FCM::Admin::System::User>. |
---|
| 1340 | |
---|
| 1341 | If no argument, return all valid users. If @only_users, return only those users |
---|
| 1342 | with matching user ID in @only_users. |
---|
| 1343 | |
---|
| 1344 | =item housekeep_svn_hook_logs($project) |
---|
| 1345 | |
---|
| 1346 | Housekeep logs generated by the hook scripts of the $project's SVN live |
---|
| 1347 | repository. |
---|
| 1348 | |
---|
| 1349 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1350 | |
---|
| 1351 | =item install_svn_hook($project, $clean_mode) |
---|
| 1352 | |
---|
| 1353 | Searches for hook scripts in the standard location and install them (as symbolic |
---|
| 1354 | links) in the I<hooks> directory of the $project's SVN live repository. |
---|
| 1355 | |
---|
| 1356 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1357 | |
---|
| 1358 | If $clean_mode is specified and is true, remove any items in the I<hooks> |
---|
| 1359 | directory that are not known to this install. |
---|
| 1360 | |
---|
| 1361 | =item manage_users_in_svn_passwd($user_ref) |
---|
| 1362 | |
---|
| 1363 | Using entries in the hash reference $user_ref, sets up or updates the SVN and |
---|
| 1364 | Trac password files. The $user_ref argument should be a reference to a hash, as |
---|
| 1365 | returned by get_users(). |
---|
| 1366 | |
---|
| 1367 | =item manage_users_in_trac_passwd($user_ref) |
---|
| 1368 | |
---|
| 1369 | Using entries in the hash reference $user_ref, sets up or updates the Trac |
---|
| 1370 | password files. The $user_ref argument should be a reference to a hash, as |
---|
| 1371 | returned by get_users(). |
---|
| 1372 | |
---|
| 1373 | =item manage_users_in_trac_db_of($project, $user_ref) |
---|
| 1374 | |
---|
| 1375 | Using entries in $user_ref, sets up or updates the session/session_attribute |
---|
| 1376 | tables in the databases of the live Trac environments. The $project argument |
---|
| 1377 | should be a L<FCM::Admin::Project|FCM::Admin::Project> object |
---|
| 1378 | and $user_ref should be a reference to a hash, as returned by get_users(). |
---|
| 1379 | |
---|
| 1380 | =item recover_svn_repository($project,$recover_dumps_option,$recover_hooks_option) |
---|
| 1381 | |
---|
| 1382 | Recovers a project's SVN repository using its backup. If $recover_dumps_option |
---|
| 1383 | is set to true, it will also attempt to load the latest revision dumps following |
---|
| 1384 | a successful recovery. If $recover_hooks_option is set to true, it will also |
---|
| 1385 | attempt to re-install the hook scripts following a successful recovery. |
---|
| 1386 | |
---|
| 1387 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1388 | |
---|
| 1389 | =item recover_trac_environment($project) |
---|
| 1390 | |
---|
| 1391 | Recovers a project's Trac environment using its backup. |
---|
| 1392 | |
---|
| 1393 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1394 | |
---|
| 1395 | =item recover_trac_files() |
---|
| 1396 | |
---|
| 1397 | Copies files immediately under the backup Trac directory to the Trac live |
---|
| 1398 | directory (if the files do not already exist). |
---|
| 1399 | |
---|
| 1400 | =item vacuum_trac_env_db($project) |
---|
| 1401 | |
---|
| 1402 | Connects to the database of a project's Trac environment, and issues the |
---|
| 1403 | "VACUUM" SQL command. |
---|
| 1404 | |
---|
| 1405 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1406 | |
---|
| 1407 | =back |
---|
| 1408 | |
---|
| 1409 | =head1 SEE ALSO |
---|
| 1410 | |
---|
| 1411 | L<FCM::Admin::Config|FCM::Admin::Config>, |
---|
| 1412 | L<FCM::Admin::Project|FCM::Admin::Project>, |
---|
| 1413 | L<FCM::Admin::Runner|FCM::Admin::Runner>, |
---|
| 1414 | L<FCM::Admin::User|FCM::Admin::User> |
---|
| 1415 | |
---|
| 1416 | =head1 COPYRIGHT |
---|
| 1417 | |
---|
| 1418 | E<169> Crown copyright Met Office. All rights reserved. |
---|
| 1419 | |
---|
| 1420 | =cut |
---|