[1977] | 1 | # ------------------------------------------------------------------------------ |
---|
| 2 | # (C) Crown copyright Met Office. All rights reserved. |
---|
| 3 | # For further details please refer to the file COPYRIGHT.txt |
---|
| 4 | # which you should have received as part of this distribution. |
---|
| 5 | # ------------------------------------------------------------------------------ |
---|
| 6 | |
---|
| 7 | use strict; |
---|
| 8 | use warnings; |
---|
| 9 | |
---|
| 10 | package FCM::Admin::System; |
---|
| 11 | |
---|
| 12 | use Config::IniFiles; |
---|
| 13 | use DBI; # See also: DBD::SQLite |
---|
| 14 | use Exporter qw{import}; |
---|
| 15 | use FCM::Admin::Config; |
---|
| 16 | use FCM::Admin::Project; |
---|
| 17 | use FCM::Admin::Runner; |
---|
| 18 | use FCM::Admin::User; |
---|
| 19 | use FCM::Admin::Util qw{ |
---|
| 20 | read_file |
---|
| 21 | run_copy |
---|
| 22 | run_create_archive |
---|
| 23 | run_extract_archive |
---|
| 24 | run_mkpath |
---|
| 25 | run_rename |
---|
| 26 | run_rmtree |
---|
| 27 | run_rsync |
---|
| 28 | run_symlink |
---|
| 29 | write_file |
---|
| 30 | }; |
---|
| 31 | use Fcntl qw{:mode}; # for S_IRGRP, S_IWGRP, S_IROTH, etc |
---|
| 32 | use File::Basename qw{basename dirname}; |
---|
| 33 | use File::Find qw{find}; |
---|
| 34 | use File::Spec; |
---|
| 35 | use File::Temp qw{tempdir tempfile}; |
---|
| 36 | use IO::Dir; |
---|
| 37 | use IO::Pipe; |
---|
| 38 | use List::Util qw{first}; |
---|
| 39 | |
---|
| 40 | our @EXPORT_OK = qw{ |
---|
| 41 | add_trac_environment |
---|
| 42 | backup_svn_repository |
---|
| 43 | backup_trac_environment |
---|
| 44 | backup_trac_ini_file |
---|
| 45 | backup_trac_passwd_file |
---|
| 46 | distribute_wc |
---|
| 47 | filter_projects |
---|
| 48 | get_projects_from_svn_backup |
---|
| 49 | get_projects_from_svn_live |
---|
| 50 | get_projects_from_trac_backup |
---|
| 51 | get_projects_from_trac_live |
---|
| 52 | get_users |
---|
| 53 | install_svn_hook |
---|
| 54 | manage_users_in_svn_passwd |
---|
| 55 | manage_users_in_trac_passwd |
---|
| 56 | manage_users_in_trac_db_of |
---|
| 57 | recover_svn_repository |
---|
| 58 | recover_trac_environment |
---|
| 59 | recover_trac_ini_file |
---|
| 60 | recover_trac_passwd_file |
---|
| 61 | vacuum_trac_env_db |
---|
| 62 | }; |
---|
| 63 | |
---|
| 64 | # ------------------------------------------------------------------------------ |
---|
| 65 | # Adds a new Trac environment. |
---|
| 66 | sub add_trac_environment { |
---|
| 67 | my ($project_name, $admin_user_list_ref, $authorised_option) = @_; |
---|
| 68 | my $project = FCM::Admin::Project->new({name => $project_name}); |
---|
| 69 | if (-e $project->get_trac_live_path()) { |
---|
| 70 | die(sprintf( |
---|
| 71 | "%s: Trac environment already exists at %s.\n", |
---|
| 72 | $project_name, |
---|
| 73 | $project->get_trac_live_path(), |
---|
| 74 | )); |
---|
| 75 | } |
---|
| 76 | my @repository_arguments = (q{}, q{}); |
---|
| 77 | if (-d $project->get_svn_live_path()) { |
---|
| 78 | @repository_arguments = (q{svn}, $project->get_svn_live_path()); |
---|
| 79 | } |
---|
| 80 | my @TRAC_ADMIN = (q{trac-admin}, $project->get_trac_live_path()); |
---|
| 81 | FCM::Admin::Runner->instance()->run( |
---|
| 82 | "initialising Trac environment", |
---|
| 83 | sub {return !system( |
---|
| 84 | @TRAC_ADMIN, |
---|
| 85 | q{initenv}, |
---|
| 86 | $project_name, |
---|
| 87 | q{sqlite:db/trac.db}, |
---|
| 88 | @repository_arguments, |
---|
| 89 | q{--inherit=../../trac.ini}, |
---|
| 90 | )}, |
---|
| 91 | ); |
---|
| 92 | _chgrp_and_chmod_trac_environment_for($project); |
---|
| 93 | for my $item (qw{component1 component2}) { |
---|
| 94 | FCM::Admin::Runner->instance()->run( |
---|
| 95 | "removing example component $item", |
---|
| 96 | sub {return !system(@TRAC_ADMIN, q{component remove}, $item)}, |
---|
| 97 | ); |
---|
| 98 | } |
---|
| 99 | for my $item (qw{1.0 2.0}) { |
---|
| 100 | FCM::Admin::Runner->instance()->run( |
---|
| 101 | "removing example version $item", |
---|
| 102 | sub {return !system(@TRAC_ADMIN, q{version remove}, $item)}, |
---|
| 103 | ); |
---|
| 104 | } |
---|
| 105 | for my $item (qw{milestone1 milestone2 milestone3 milestone4}) { |
---|
| 106 | FCM::Admin::Runner->instance()->run( |
---|
| 107 | "removing example milestone $item", |
---|
| 108 | sub {return !system(@TRAC_ADMIN, q{milestone remove}, $item)}, |
---|
| 109 | ); |
---|
| 110 | } |
---|
| 111 | for my $item ( |
---|
| 112 | ['major' => 'normal' ], |
---|
| 113 | ['critical' => 'major' ], |
---|
| 114 | ['blocker' => 'critical'], |
---|
| 115 | ) { |
---|
| 116 | my ($old, $new) = @{$item}; |
---|
| 117 | FCM::Admin::Runner->instance()->run( |
---|
| 118 | "changing priority $old to $new", |
---|
| 119 | sub {return !system(@TRAC_ADMIN, qw{priority change}, $old, $new)}, |
---|
| 120 | ); |
---|
| 121 | } |
---|
| 122 | FCM::Admin::Runner->instance()->run( |
---|
| 123 | "adding admin permission", |
---|
| 124 | sub {return !system(@TRAC_ADMIN, qw{permission add admin TRAC_ADMIN})}, |
---|
| 125 | ); |
---|
| 126 | if (ref($admin_user_list_ref) eq 'ARRAY') { |
---|
| 127 | for my $item (@{$admin_user_list_ref}) { |
---|
| 128 | FCM::Admin::Runner->instance()->run( |
---|
| 129 | "adding admin user $item", |
---|
| 130 | sub {return !system( |
---|
| 131 | @TRAC_ADMIN, qw{permission add}, $item, q{admin}, |
---|
| 132 | )}, |
---|
| 133 | ); |
---|
| 134 | } |
---|
| 135 | } |
---|
| 136 | if ($authorised_option) { |
---|
| 137 | for my $item (qw{TICKET_CREATE TICKET_MODIFY WIKI_CREATE WIKI_MODIFY}) { |
---|
| 138 | FCM::Admin::Runner->instance()->run( |
---|
| 139 | "removing authenticated write permission", |
---|
| 140 | sub {return !system( |
---|
| 141 | @TRAC_ADMIN, qw{permission remove authenticated}, $item, |
---|
| 142 | )}, |
---|
| 143 | ); |
---|
| 144 | FCM::Admin::Runner->instance()->run( |
---|
| 145 | "adding authorised write permission", |
---|
| 146 | sub {return !system(@TRAC_ADMIN, qw{permission add authorised}, $item)}, |
---|
| 147 | ); |
---|
| 148 | } |
---|
| 149 | } |
---|
| 150 | my $auth = $authorised_option ? q{authorised} : q{authenticated}; |
---|
| 151 | FCM::Admin::Runner->instance()->run( |
---|
| 152 | "adding TICKET_EDIT_CC permission to $auth", |
---|
| 153 | sub {return !system(@TRAC_ADMIN, qw{permission add}, $auth, qw{TICKET_EDIT_CC})}, |
---|
| 154 | ); |
---|
| 155 | FCM::Admin::Runner->instance()->run( |
---|
| 156 | "updating configuration file", |
---|
| 157 | sub { |
---|
| 158 | my $project_trac_ini_file = $project->get_trac_live_ini_path(); |
---|
| 159 | my $project_trac_ini = Config::IniFiles->new( |
---|
| 160 | q{-file} => $project_trac_ini_file, |
---|
| 161 | ); |
---|
| 162 | if (!$project_trac_ini) { |
---|
| 163 | die("$project_trac_ini_file: cannot open.\n"); |
---|
| 164 | } |
---|
| 165 | my $SECTION = q{project}; |
---|
| 166 | if (!$project_trac_ini->SectionExists($SECTION)) { |
---|
| 167 | $project_trac_ini->AddSection($SECTION); |
---|
| 168 | } |
---|
| 169 | if (!$project_trac_ini->newval($SECTION, q{descr}, $project->get_name())) { |
---|
| 170 | die("$project_trac_ini_file: cannot set value.\n"); |
---|
| 171 | } |
---|
| 172 | return $project_trac_ini->RewriteConfig(); |
---|
| 173 | }, |
---|
| 174 | ); |
---|
| 175 | return 1; |
---|
| 176 | } |
---|
| 177 | |
---|
| 178 | # ------------------------------------------------------------------------------ |
---|
| 179 | # Backup the SVN repository of a project. |
---|
| 180 | sub backup_svn_repository { |
---|
| 181 | my ($project, $housekeep_dumps_option, $verify_integrity_option) = @_; |
---|
| 182 | if ($verify_integrity_option) { |
---|
| 183 | _verify_svn_repository($project); |
---|
| 184 | } |
---|
| 185 | my $work_dir = tempdir(CLEANUP => 1); |
---|
| 186 | my $work_path |
---|
| 187 | = File::Spec->catfile($work_dir, $project->get_svn_base_name()); |
---|
| 188 | FCM::Admin::Runner->instance()->run( |
---|
| 189 | sprintf( |
---|
| 190 | "hotcopying %s to %s", $project->get_svn_live_path(), $work_path, |
---|
| 191 | ), |
---|
| 192 | sub {return !system( |
---|
| 193 | qw{svnadmin hotcopy}, $project->get_svn_live_path(), $work_path, |
---|
| 194 | )}, |
---|
| 195 | # Note: "hotcopy" is not yet possible via SVN::Repos |
---|
| 196 | ); |
---|
| 197 | _create_backup_archive( |
---|
| 198 | $work_path, |
---|
| 199 | FCM::Admin::Config->instance()->get_svn_backup_dir(), |
---|
| 200 | $project->get_svn_archive_base_name(), |
---|
| 201 | ); |
---|
| 202 | if ($housekeep_dumps_option) { |
---|
| 203 | my $dump_path = $project->get_svn_dump_path(); |
---|
| 204 | my $youngest = _svnlook_youngest($work_path); |
---|
| 205 | # Note: could use SVN::Repos for "youngest" |
---|
| 206 | FCM::Admin::Runner->instance()->run( |
---|
| 207 | "housekeeping dumps in $dump_path", |
---|
| 208 | sub { |
---|
| 209 | my @rev_dump_paths; |
---|
| 210 | _get_files_from( |
---|
| 211 | $dump_path, |
---|
| 212 | sub { |
---|
| 213 | my ($base_name, $path) = @_; |
---|
| 214 | if ($base_name !~ qr{\A\d+\z}xms) { # is numeric |
---|
| 215 | return; |
---|
| 216 | } |
---|
| 217 | if ($base_name > $youngest) { |
---|
| 218 | return; |
---|
| 219 | } |
---|
| 220 | push(@rev_dump_paths, $path); |
---|
| 221 | }, |
---|
| 222 | ); |
---|
| 223 | for my $rev_dump_path (@rev_dump_paths) { |
---|
| 224 | run_rmtree($rev_dump_path); |
---|
| 225 | } |
---|
| 226 | return 1; |
---|
| 227 | } |
---|
| 228 | ); |
---|
| 229 | } |
---|
| 230 | return 1; |
---|
| 231 | } |
---|
| 232 | |
---|
| 233 | # ------------------------------------------------------------------------------ |
---|
| 234 | # Backup the Trac environment of a project. |
---|
| 235 | sub backup_trac_environment { |
---|
| 236 | my ($project, $verify_integrity_option) = @_; |
---|
| 237 | my $trac_live_path = $project->get_trac_live_path(); |
---|
| 238 | if ($verify_integrity_option) { |
---|
| 239 | my $db_path = $project->get_trac_live_db_path(); |
---|
| 240 | FCM::Admin::Runner->instance()->run( |
---|
| 241 | "checking $db_path for integrity", |
---|
| 242 | sub { |
---|
| 243 | my $db_handle |
---|
| 244 | = DBI->connect(qq{dbi:SQLite:dbname=$db_path}, q{}, q{}); |
---|
| 245 | if (!$db_handle) { |
---|
| 246 | return; |
---|
| 247 | } |
---|
| 248 | my $rc = defined($db_handle->do(q{pragma integrity_check;})); |
---|
| 249 | $db_handle->disconnect(); |
---|
| 250 | return $rc; |
---|
| 251 | }, |
---|
| 252 | ); |
---|
| 253 | } |
---|
| 254 | # Make sure the project INI file is owned by the correct group |
---|
| 255 | my $project_trac_ini_file = $project->get_trac_live_ini_path(); |
---|
| 256 | my $gid = FCM::Admin::Config->instance()->get_trac_gid(); |
---|
| 257 | FCM::Admin::Runner->instance()->run( |
---|
| 258 | "changing group ownership for $project_trac_ini_file", |
---|
| 259 | sub {return chown(-1, $gid, $project_trac_ini_file)}, |
---|
| 260 | ); |
---|
| 261 | my $work_dir = tempdir(CLEANUP => 1); |
---|
| 262 | my $work_path = File::Spec->catfile($work_dir, $project->get_name()); |
---|
| 263 | FCM::Admin::Runner->instance()->run_with_retries( |
---|
| 264 | sprintf( |
---|
| 265 | qq{hotcopying %s to %s}, |
---|
| 266 | $project->get_trac_live_path(), |
---|
| 267 | $work_path, |
---|
| 268 | ), |
---|
| 269 | sub { |
---|
| 270 | return !system( |
---|
| 271 | q{trac-admin}, |
---|
| 272 | $project->get_trac_live_path(), |
---|
| 273 | q{hotcopy}, |
---|
| 274 | $work_path, |
---|
| 275 | ); |
---|
| 276 | }, |
---|
| 277 | ); |
---|
| 278 | _create_backup_archive( |
---|
| 279 | $work_path, |
---|
| 280 | FCM::Admin::Config->instance()->get_trac_backup_dir(), |
---|
| 281 | $project->get_trac_archive_base_name(), |
---|
| 282 | ); |
---|
| 283 | return 1; |
---|
| 284 | } |
---|
| 285 | |
---|
| 286 | # ------------------------------------------------------------------------------ |
---|
| 287 | # Backup the Trac (central) INI file. |
---|
| 288 | sub backup_trac_ini_file { |
---|
| 289 | # (no argument) |
---|
| 290 | return _backup_trac_file( |
---|
| 291 | FCM::Admin::Config->instance()->get_trac_ini_file() |
---|
| 292 | ); |
---|
| 293 | } |
---|
| 294 | |
---|
| 295 | # ------------------------------------------------------------------------------ |
---|
| 296 | # Backup the Trac password file. |
---|
| 297 | sub backup_trac_passwd_file { |
---|
| 298 | # (no argument) |
---|
| 299 | return _backup_trac_file( |
---|
| 300 | FCM::Admin::Config->instance()->get_trac_passwd_file() |
---|
| 301 | ); |
---|
| 302 | } |
---|
| 303 | |
---|
| 304 | # ------------------------------------------------------------------------------ |
---|
| 305 | # Distributes the central FCM working copy to standard locations. |
---|
| 306 | sub distribute_wc { |
---|
| 307 | my $rc = 1; |
---|
| 308 | my $CONFIG = FCM::Admin::Config->instance(); |
---|
| 309 | my $RUNNER = FCM::Admin::Runner->instance(); |
---|
| 310 | my @RSYNC_OPTS = qw{-v --timeout=1800 --exclude=.*}; |
---|
| 311 | my $FCM_WC = $CONFIG->get_fcm_wc(); |
---|
| 312 | my @SOURCES = map {File::Spec->catfile($FCM_WC, $_)} qw{bin etc lib man}; |
---|
| 313 | for my $location (@{$CONFIG->get_fcm_dist_on_HPCs()}) { |
---|
| 314 | $rc = $RUNNER->run_continue( |
---|
| 315 | "distributing FCM to the HPCs", |
---|
| 316 | sub { |
---|
| 317 | run_rsync( |
---|
| 318 | \@SOURCES, $location, |
---|
| 319 | [@RSYNC_OPTS, qw{-a --delete-excluded}], |
---|
| 320 | ); |
---|
| 321 | }, |
---|
| 322 | ) && $rc; |
---|
| 323 | } |
---|
| 324 | $rc = $RUNNER->run_continue( |
---|
| 325 | "distributing FCM to the desktop sync location", |
---|
| 326 | sub { |
---|
| 327 | run_rsync( |
---|
| 328 | \@SOURCES, $CONFIG->get_fcm_dist_on_desktops(), |
---|
| 329 | [@RSYNC_OPTS, q{-rltoD}], |
---|
| 330 | ); |
---|
| 331 | }, |
---|
| 332 | ) && $rc; |
---|
| 333 | return $rc; |
---|
| 334 | } |
---|
| 335 | |
---|
| 336 | # ------------------------------------------------------------------------------ |
---|
| 337 | # Returns a filtered list of projects matching names in a list. |
---|
| 338 | sub filter_projects { |
---|
| 339 | my ($project_list_ref, $filter_list_ref) = @_; |
---|
| 340 | if (!@{$filter_list_ref}) { |
---|
| 341 | return @{$project_list_ref}; |
---|
| 342 | } |
---|
| 343 | my %project_of = map {($_->get_name(), $_)} @{$project_list_ref}; |
---|
| 344 | my @projects; |
---|
| 345 | my @unmatched_names; |
---|
| 346 | for my $name (@{$filter_list_ref}) { |
---|
| 347 | if (exists($project_of{$name})) { |
---|
| 348 | push(@projects, $project_of{$name}); |
---|
| 349 | } |
---|
| 350 | else { |
---|
| 351 | push(@unmatched_names, $name); |
---|
| 352 | } |
---|
| 353 | } |
---|
| 354 | if (@unmatched_names) { |
---|
| 355 | die("@unmatched_names: not found\n"); |
---|
| 356 | } |
---|
| 357 | return @projects; |
---|
| 358 | } |
---|
| 359 | |
---|
| 360 | # ------------------------------------------------------------------------------ |
---|
| 361 | # Returns a list of projects by searching the backup SVN directory. |
---|
| 362 | sub get_projects_from_svn_backup { |
---|
| 363 | # (no dummy argument) |
---|
| 364 | my $SVN_PROJECT_SUFFIX |
---|
| 365 | = FCM::Admin::Config->instance()->get_svn_project_suffix(); |
---|
| 366 | my @projects; |
---|
| 367 | _get_files_from( |
---|
| 368 | FCM::Admin::Config->instance()->get_svn_backup_dir(), |
---|
| 369 | sub { |
---|
| 370 | my ($base_name, $path) = @_; |
---|
| 371 | my $name = $base_name; |
---|
| 372 | if ($name !~ s{$SVN_PROJECT_SUFFIX\.tgz\z}{}xms) { |
---|
| 373 | return; |
---|
| 374 | } |
---|
| 375 | if (!-f $path) { |
---|
| 376 | return; |
---|
| 377 | } |
---|
| 378 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 379 | }, |
---|
| 380 | ); |
---|
| 381 | return @projects; |
---|
| 382 | } |
---|
| 383 | |
---|
| 384 | # ------------------------------------------------------------------------------ |
---|
| 385 | # Returns a list of projects by searching the live SVN directory. |
---|
| 386 | sub get_projects_from_svn_live { |
---|
| 387 | # (no dummy argument) |
---|
| 388 | my $SVN_PROJECT_SUFFIX |
---|
| 389 | = FCM::Admin::Config->instance()->get_svn_project_suffix(); |
---|
| 390 | my @projects; |
---|
| 391 | _get_files_from( |
---|
| 392 | FCM::Admin::Config->instance()->get_svn_live_dir(), |
---|
| 393 | sub { |
---|
| 394 | my ($base_name, $path) = @_; |
---|
| 395 | my $name = $base_name; |
---|
| 396 | $name =~ s{$SVN_PROJECT_SUFFIX\z}{}xms; |
---|
| 397 | if (!-d $path) { |
---|
| 398 | return; |
---|
| 399 | } |
---|
| 400 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 401 | }, |
---|
| 402 | ); |
---|
| 403 | return @projects; |
---|
| 404 | } |
---|
| 405 | |
---|
| 406 | # ------------------------------------------------------------------------------ |
---|
| 407 | # Returns a list of projects by searching the backup Trac directory. |
---|
| 408 | sub get_projects_from_trac_backup { |
---|
| 409 | # (no dummy argument) |
---|
| 410 | my @projects; |
---|
| 411 | _get_files_from( |
---|
| 412 | FCM::Admin::Config->instance()->get_trac_backup_dir(), |
---|
| 413 | sub { |
---|
| 414 | my ($base_name, $path) = @_; |
---|
| 415 | my $name = $base_name; |
---|
| 416 | if ($name !~ s{\.tgz\z}{}xms) { |
---|
| 417 | return; |
---|
| 418 | } |
---|
| 419 | if (!-f $path) { |
---|
| 420 | return; |
---|
| 421 | } |
---|
| 422 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 423 | }, |
---|
| 424 | ); |
---|
| 425 | return @projects; |
---|
| 426 | } |
---|
| 427 | |
---|
| 428 | # ------------------------------------------------------------------------------ |
---|
| 429 | # Returns a list of projects by searching the live Trac directory. |
---|
| 430 | sub get_projects_from_trac_live { |
---|
| 431 | # (no dummy argument) |
---|
| 432 | my @projects; |
---|
| 433 | _get_files_from( |
---|
| 434 | FCM::Admin::Config->instance()->get_trac_live_dir(), |
---|
| 435 | sub { |
---|
| 436 | my ($name, $path) = @_; |
---|
| 437 | if (!-d $path) { |
---|
| 438 | return; |
---|
| 439 | } |
---|
| 440 | push(@projects, FCM::Admin::Project->new({name => $name})); |
---|
| 441 | }, |
---|
| 442 | ); |
---|
| 443 | return @projects; |
---|
| 444 | } |
---|
| 445 | |
---|
| 446 | # ------------------------------------------------------------------------------ |
---|
| 447 | # Gets a list of users using the mail aliases and the POSIX password DB. |
---|
| 448 | sub get_users { |
---|
| 449 | # (no dummy argument) |
---|
| 450 | my %email_of; |
---|
| 451 | FCM::Admin::Runner->instance()->run( |
---|
| 452 | "retrieving entries from the mail aliases", |
---|
| 453 | sub { |
---|
| 454 | my $pipe = IO::Pipe->new(); |
---|
| 455 | $pipe->reader(qw{getent aliases}); |
---|
| 456 | ALIASES_LINE: |
---|
| 457 | while (my $line = $pipe->getline()) { |
---|
| 458 | chomp($line); |
---|
| 459 | my ($name, @emails) = split(qr{\s*[:,]\s*}xms, $line); |
---|
| 460 | if (scalar(@emails) != 1) { |
---|
| 461 | next ALIASES_LINE; |
---|
| 462 | } |
---|
| 463 | $emails[0] =~ s{\s}{}gxms; |
---|
| 464 | $emails[0] =~ s{\@metoffice\.com\z}{\@metoffice.gov.uk}xms; |
---|
| 465 | if ($emails[0] !~ qr{\.uk\z}xms) { # is a .uk e-mail address |
---|
| 466 | next ALIASES_LINE; |
---|
| 467 | } |
---|
| 468 | $email_of{$name} = $emails[0]; |
---|
| 469 | } |
---|
| 470 | return $pipe->close(); |
---|
| 471 | }, |
---|
| 472 | ); |
---|
| 473 | my %user_of; |
---|
| 474 | USER: |
---|
| 475 | while (my ($name, $gecos, $dir, $shell) = (getpwent())[0, 6, 7, 8]) { |
---|
| 476 | if (exists($user_of{$name})) { |
---|
| 477 | next USER; |
---|
| 478 | } |
---|
| 479 | if (!$dir || index($dir, '/home') != 0) { |
---|
| 480 | next USER; |
---|
| 481 | } |
---|
| 482 | if (!$shell || $shell =~ qr{false\z}xms) { # ends with "false" |
---|
| 483 | next USER; |
---|
| 484 | } |
---|
| 485 | my $email = $email_of{$name}; |
---|
| 486 | if (!$email && $name =~ qr{\A([a-z]+(?:\.[a-z]+)+)\z}xms) { |
---|
| 487 | # Handles user IDs such as john.smith |
---|
| 488 | $email = $name . q{@metoffice.gov.uk}; |
---|
| 489 | } |
---|
| 490 | if (!$email) { |
---|
| 491 | next USER; |
---|
| 492 | } |
---|
| 493 | $user_of{$name} = FCM::Admin::User->new({ |
---|
| 494 | name => $name, |
---|
| 495 | display_name => (split(qr{\s*,\s*}xms, $gecos))[0], |
---|
| 496 | # $gecos contains "display name, location, phone" |
---|
| 497 | email => $email, |
---|
| 498 | }); |
---|
| 499 | } |
---|
| 500 | endpwent(); |
---|
| 501 | if (keys(%user_of) < FCM::Admin::Config->instance()->get_user_number_min()) { |
---|
| 502 | die("Number of users below minimum threshold.\n"); |
---|
| 503 | } |
---|
| 504 | return (wantarray() ? %user_of : \%user_of); |
---|
| 505 | } |
---|
| 506 | |
---|
| 507 | # ------------------------------------------------------------------------------ |
---|
| 508 | # Installs hook scripts to a SVN project. |
---|
| 509 | sub install_svn_hook { |
---|
| 510 | my ($project) = @_; |
---|
| 511 | my %path_of; |
---|
| 512 | my $svn_hook_dir = FCM::Admin::Config->instance()->get_svn_hook_dir(); |
---|
| 513 | my $project_svn_hook_dir |
---|
| 514 | = File::Spec->catfile($svn_hook_dir, $project->get_name()); |
---|
| 515 | for my $dir ($svn_hook_dir, $project_svn_hook_dir) { |
---|
| 516 | _get_files_from( |
---|
| 517 | $dir, |
---|
| 518 | sub { |
---|
| 519 | my ($base_name, $path) = @_; |
---|
| 520 | if (index($base_name, q{.}) == 0 || !-f $path) { |
---|
| 521 | return; |
---|
| 522 | } |
---|
| 523 | $path_of{$base_name} = $path; |
---|
| 524 | }, |
---|
| 525 | ); |
---|
| 526 | } |
---|
| 527 | for my $key (keys(%path_of)) { |
---|
| 528 | my $hook_source = $path_of{$key}; |
---|
| 529 | my $hook_dest |
---|
| 530 | = File::Spec->catfile($project->get_svn_live_hook_path(), $key); |
---|
| 531 | if (-l $hook_dest) { |
---|
| 532 | my $symlink = readlink($hook_dest); |
---|
| 533 | if ($symlink ne $hook_source) { |
---|
| 534 | run_rmtree($hook_dest); |
---|
| 535 | run_symlink($hook_source, $hook_dest); |
---|
| 536 | } |
---|
| 537 | } |
---|
| 538 | else { |
---|
| 539 | if (-e $hook_dest) { |
---|
| 540 | run_rename($hook_dest, "$hook_dest.old"); |
---|
| 541 | } |
---|
| 542 | run_symlink($hook_source, $hook_dest); |
---|
| 543 | } |
---|
| 544 | } |
---|
| 545 | return 1; |
---|
| 546 | } |
---|
| 547 | |
---|
| 548 | # ------------------------------------------------------------------------------ |
---|
| 549 | # Updates the SVN password file. |
---|
| 550 | sub manage_users_in_svn_passwd { |
---|
| 551 | my ($user_ref) = @_; |
---|
| 552 | my $svn_passwd_file = File::Spec->catfile( |
---|
| 553 | FCM::Admin::Config->instance()->get_svn_live_dir(), |
---|
| 554 | FCM::Admin::Config->instance()->get_svn_passwd_file(), |
---|
| 555 | ); |
---|
| 556 | FCM::Admin::Runner->instance()->run( |
---|
| 557 | "updating $svn_passwd_file", |
---|
| 558 | sub { |
---|
| 559 | my $USERS_SECTION = q{users}; |
---|
| 560 | my $svn_passwd_ini; |
---|
| 561 | my $is_changed; |
---|
| 562 | if (-f $svn_passwd_file && -r $svn_passwd_file) { |
---|
| 563 | $svn_passwd_ini |
---|
| 564 | = Config::IniFiles->new(q{-file} => $svn_passwd_file); |
---|
| 565 | } |
---|
| 566 | else { |
---|
| 567 | $svn_passwd_ini = Config::IniFiles->new(); |
---|
| 568 | $svn_passwd_ini->SetFileName($svn_passwd_file); |
---|
| 569 | $svn_passwd_ini->AddSection($USERS_SECTION); |
---|
| 570 | $is_changed = 1; |
---|
| 571 | } |
---|
| 572 | for my $name (($svn_passwd_ini->Parameters($USERS_SECTION))) { |
---|
| 573 | if (!exists($user_ref->{$name})) { |
---|
| 574 | FCM::Admin::Runner->instance()->run( |
---|
| 575 | "removing $name from $svn_passwd_file", |
---|
| 576 | sub { |
---|
| 577 | return |
---|
| 578 | $svn_passwd_ini->delval($USERS_SECTION, $name); |
---|
| 579 | }, |
---|
| 580 | ); |
---|
| 581 | $is_changed = 1; |
---|
| 582 | } |
---|
| 583 | } |
---|
| 584 | for my $user (values(%{$user_ref})) { |
---|
| 585 | if (!defined($svn_passwd_ini->val($USERS_SECTION, "$user"))) { |
---|
| 586 | FCM::Admin::Runner->instance()->run( |
---|
| 587 | "adding $user to $svn_passwd_file", |
---|
| 588 | sub {return $svn_passwd_ini->newval( |
---|
| 589 | $USERS_SECTION, $user->get_name(), q{}, |
---|
| 590 | )}, |
---|
| 591 | ); |
---|
| 592 | $is_changed = 1; |
---|
| 593 | } |
---|
| 594 | } |
---|
| 595 | return ($is_changed ? $svn_passwd_ini->RewriteConfig() : 1); |
---|
| 596 | }, |
---|
| 597 | ); |
---|
| 598 | return 1; |
---|
| 599 | } |
---|
| 600 | |
---|
| 601 | # ------------------------------------------------------------------------------ |
---|
| 602 | # Updates the Trac password file. |
---|
| 603 | sub manage_users_in_trac_passwd { |
---|
| 604 | my ($user_ref) = @_; |
---|
| 605 | my $trac_passwd_file = File::Spec->catfile( |
---|
| 606 | FCM::Admin::Config->instance()->get_trac_live_dir(), |
---|
| 607 | FCM::Admin::Config->instance()->get_trac_passwd_file(), |
---|
| 608 | ); |
---|
| 609 | FCM::Admin::Runner->instance()->run( |
---|
| 610 | "updating $trac_passwd_file", |
---|
| 611 | sub { |
---|
| 612 | my %old_names; |
---|
| 613 | my %new_names = %{$user_ref}; |
---|
| 614 | if (-f $trac_passwd_file && -r $trac_passwd_file) { |
---|
| 615 | read_file( |
---|
| 616 | $trac_passwd_file, |
---|
| 617 | sub { |
---|
| 618 | my ($line) = @_; |
---|
| 619 | chomp($line); |
---|
| 620 | if ( |
---|
| 621 | !$line || $line =~ qr{\A\s*\z}xms # blank line |
---|
| 622 | || $line =~ qr{\A\s*\#}xms # comment line |
---|
| 623 | ) { |
---|
| 624 | return; |
---|
| 625 | } |
---|
| 626 | my ($name, $passwd) = split(qr{\s*:\s*}xms, $line); |
---|
| 627 | if (exists($new_names{$name})) { |
---|
| 628 | delete($new_names{$name}); |
---|
| 629 | } |
---|
| 630 | else { |
---|
| 631 | $old_names{$name} = 1; |
---|
| 632 | } |
---|
| 633 | }, |
---|
| 634 | ) || return; |
---|
| 635 | } |
---|
| 636 | else { |
---|
| 637 | write_file($trac_passwd_file) || return; |
---|
| 638 | } |
---|
| 639 | if (%old_names || %new_names) { |
---|
| 640 | for my $name (keys(%old_names)) { |
---|
| 641 | FCM::Admin::Runner->instance()->run( |
---|
| 642 | "removing $name from $trac_passwd_file", |
---|
| 643 | sub { |
---|
| 644 | return !system( |
---|
| 645 | qw{htpasswd -D}, $trac_passwd_file, $name, |
---|
| 646 | ); |
---|
| 647 | }, |
---|
| 648 | ); |
---|
| 649 | } |
---|
| 650 | for my $name (keys(%new_names)) { |
---|
| 651 | FCM::Admin::Runner->instance()->run( |
---|
| 652 | "adding $name to $trac_passwd_file", |
---|
| 653 | sub { |
---|
| 654 | return !system( |
---|
| 655 | qw{htpasswd -b}, $trac_passwd_file, $name, q{}, |
---|
| 656 | ); |
---|
| 657 | }, |
---|
| 658 | ); |
---|
| 659 | sleep(1); # ensure the random seed for htpasswd is changed |
---|
| 660 | } |
---|
| 661 | } |
---|
| 662 | return 1; |
---|
| 663 | }, |
---|
| 664 | # Note: can use HTTPD::UserAdmin, if it is installed |
---|
| 665 | ); |
---|
| 666 | return 1; |
---|
| 667 | } |
---|
| 668 | |
---|
| 669 | # ------------------------------------------------------------------------------ |
---|
| 670 | # Manages the session* tables in the DB of a Trac environment. |
---|
| 671 | sub manage_users_in_trac_db_of { |
---|
| 672 | my ($project, $user_ref) = @_; |
---|
| 673 | return FCM::Admin::Runner->instance()->run_with_retries( |
---|
| 674 | sprintf( |
---|
| 675 | qq{checking/updating %s}, |
---|
| 676 | $project->get_trac_live_db_path(), |
---|
| 677 | ), |
---|
| 678 | sub {return _manage_users_in_trac_db_of($project, $user_ref)}, |
---|
| 679 | ); |
---|
| 680 | } |
---|
| 681 | |
---|
| 682 | # ------------------------------------------------------------------------------ |
---|
| 683 | # Recovers a SVN repository from its backup. |
---|
| 684 | sub recover_svn_repository { |
---|
| 685 | my ($project, $recover_dumps_option, $recover_hooks_option) = @_; |
---|
| 686 | my $config = FCM::Admin::Config->instance(); |
---|
| 687 | if (-e $project->get_svn_live_path()) { |
---|
| 688 | die(sprintf( |
---|
| 689 | "%s: live repository exists.\n", |
---|
| 690 | $project->get_svn_live_path(), |
---|
| 691 | )); |
---|
| 692 | } |
---|
| 693 | run_mkpath($config->get_svn_live_dir()); |
---|
| 694 | my $base_name = $project->get_svn_base_name(); |
---|
| 695 | my $work_dir = tempdir( |
---|
| 696 | qq{$base_name.XXXXXX}, |
---|
| 697 | DIR => $config->get_svn_live_dir(), |
---|
| 698 | CLEANUP => 1, |
---|
| 699 | ); |
---|
| 700 | my $work_path = File::Spec->catfile($work_dir, $base_name); |
---|
| 701 | _extract_backup_archive($project->get_svn_backup_path(), $work_path); |
---|
| 702 | if ($recover_dumps_option) { |
---|
| 703 | my $youngest = _svnlook_youngest($work_path); |
---|
| 704 | my @rev_dump_paths; |
---|
| 705 | _get_files_from( |
---|
| 706 | $project->get_svn_dump_path(), |
---|
| 707 | sub { |
---|
| 708 | my ($base_name, $path) = @_; |
---|
| 709 | if ($base_name !~ qr{\A\d+\z}xms) { # is numeric |
---|
| 710 | return; |
---|
| 711 | } |
---|
| 712 | if ($base_name <= $youngest) { |
---|
| 713 | return; |
---|
| 714 | } |
---|
| 715 | push(@rev_dump_paths, $path); |
---|
| 716 | }, |
---|
| 717 | ); |
---|
| 718 | # Note: sorts basenames of @rev_dump_paths into numeric ascending order |
---|
| 719 | # using a Schwartzian Transform |
---|
| 720 | @rev_dump_paths |
---|
| 721 | = map {$_->[0]} |
---|
| 722 | sort {$a->[1] <=> $b->[1]} |
---|
| 723 | map {[$_, basename($_)]} |
---|
| 724 | @rev_dump_paths; |
---|
| 725 | for my $rev_dump_path (@rev_dump_paths) { |
---|
| 726 | FCM::Admin::Runner->instance()->run( |
---|
| 727 | "loading $rev_dump_path into $work_path", |
---|
| 728 | sub { |
---|
| 729 | my $pipe = IO::Pipe->new(); |
---|
| 730 | $pipe->writer(qw{svnadmin load}, $work_path); |
---|
| 731 | read_file($rev_dump_path, sub {$pipe->print($_[0])}); |
---|
| 732 | return ($pipe->close()); |
---|
| 733 | }, |
---|
| 734 | ); |
---|
| 735 | } |
---|
| 736 | } |
---|
| 737 | run_rename($work_path, $project->get_svn_live_path()); |
---|
| 738 | if ($recover_hooks_option) { |
---|
| 739 | install_svn_hook($project); |
---|
| 740 | } |
---|
| 741 | return 1; |
---|
| 742 | } |
---|
| 743 | |
---|
| 744 | # ------------------------------------------------------------------------------ |
---|
| 745 | # Recovers a Trac environment from its backup. |
---|
| 746 | sub recover_trac_environment { |
---|
| 747 | my ($project) = @_; |
---|
| 748 | if (-e $project->get_trac_live_path()) { |
---|
| 749 | die(sprintf( |
---|
| 750 | "%s: live environment exists.\n", |
---|
| 751 | $project->get_trac_live_path(), |
---|
| 752 | )); |
---|
| 753 | } |
---|
| 754 | my $config = FCM::Admin::Config->instance(); |
---|
| 755 | run_mkpath($config->get_trac_live_dir()); |
---|
| 756 | my $base_name = $project->get_name(); |
---|
| 757 | my $work_dir = tempdir( |
---|
| 758 | qq{$base_name.XXXXXX}, |
---|
| 759 | DIR => $config->get_trac_live_dir(), |
---|
| 760 | CLEANUP => 1, |
---|
| 761 | ); |
---|
| 762 | my $work_path = File::Spec->catfile($work_dir, $base_name); |
---|
| 763 | _extract_backup_archive($project->get_trac_backup_path(), $work_path); |
---|
| 764 | run_rename($work_path, $project->get_trac_live_path()); |
---|
| 765 | _chgrp_and_chmod_trac_environment_for($project); |
---|
| 766 | } |
---|
| 767 | |
---|
| 768 | # ------------------------------------------------------------------------------ |
---|
| 769 | # Recover the Trac (central) INI file. |
---|
| 770 | sub recover_trac_ini_file { |
---|
| 771 | # (no argument) |
---|
| 772 | return _recover_trac_file( |
---|
| 773 | FCM::Admin::Config->instance()->get_trac_ini_file() |
---|
| 774 | ); |
---|
| 775 | } |
---|
| 776 | |
---|
| 777 | # ------------------------------------------------------------------------------ |
---|
| 778 | # Recover the Trac password file. |
---|
| 779 | sub recover_trac_passwd_file { |
---|
| 780 | # (no argument) |
---|
| 781 | return _recover_trac_file( |
---|
| 782 | FCM::Admin::Config->instance()->get_trac_passwd_file() |
---|
| 783 | ); |
---|
| 784 | } |
---|
| 785 | |
---|
| 786 | # ------------------------------------------------------------------------------ |
---|
| 787 | # Vacuum the database of a Trac environment. |
---|
| 788 | sub vacuum_trac_env_db { |
---|
| 789 | my ($project) = @_; |
---|
| 790 | FCM::Admin::Runner->instance()->run( |
---|
| 791 | "performing vacuum on database of Trac environment for $project", |
---|
| 792 | sub { |
---|
| 793 | my $db_handle = _get_trac_db_handle_for($project); |
---|
| 794 | if (!$db_handle) { |
---|
| 795 | return; |
---|
| 796 | } |
---|
| 797 | $db_handle->do(q{vacuum;}) && $db_handle->disconnect(); |
---|
| 798 | }, |
---|
| 799 | ); |
---|
| 800 | } |
---|
| 801 | |
---|
| 802 | # ------------------------------------------------------------------------------ |
---|
| 803 | # Backup a file in the Trac live directory to the Trac backup directory. |
---|
| 804 | sub _backup_trac_file { |
---|
| 805 | my ($base_name) = @_; |
---|
| 806 | my $live_path = File::Spec->catfile( |
---|
| 807 | FCM::Admin::Config->instance()->get_trac_live_dir(), $base_name); |
---|
| 808 | my $backup_path = File::Spec->catfile( |
---|
| 809 | FCM::Admin::Config->instance()->get_trac_backup_dir(), $base_name); |
---|
| 810 | return |
---|
| 811 | run_mkpath(FCM::Admin::Config->instance()->get_trac_backup_dir()) |
---|
| 812 | && run_copy($live_path, $backup_path); |
---|
| 813 | } |
---|
| 814 | |
---|
| 815 | # ------------------------------------------------------------------------------ |
---|
| 816 | # Changes/restores ownership and permission of a project's Trac environment. |
---|
| 817 | sub _chgrp_and_chmod_trac_environment_for { |
---|
| 818 | my ($project) = @_; |
---|
| 819 | my $gid = FCM::Admin::Config->instance()->get_trac_gid(); |
---|
| 820 | find( |
---|
| 821 | sub { |
---|
| 822 | my $file = $File::Find::name; |
---|
| 823 | FCM::Admin::Runner->instance()->run( |
---|
| 824 | "changing group ownership for $file", |
---|
| 825 | sub {return chown(-1, $gid, $file)}, |
---|
| 826 | ); |
---|
| 827 | my $mode = (stat($file))[2] | S_IWGRP; |
---|
| 828 | FCM::Admin::Runner->instance()->run( |
---|
| 829 | "adding group write permission for $file", |
---|
| 830 | sub {return chmod($mode, $file)}, |
---|
| 831 | ); |
---|
| 832 | }, |
---|
| 833 | $project->get_trac_live_path(), |
---|
| 834 | ); |
---|
| 835 | return 1; |
---|
| 836 | } |
---|
| 837 | |
---|
| 838 | # ------------------------------------------------------------------------------ |
---|
| 839 | # Creates backup archive from a path. |
---|
| 840 | sub _create_backup_archive { |
---|
| 841 | my ($source_path, $backup_dir, $archive_base_name) = @_; |
---|
| 842 | my $source_dir = dirname($source_path); |
---|
| 843 | my $source_base_name = basename($source_path); |
---|
| 844 | run_mkpath($backup_dir); |
---|
| 845 | my ($fh, $work_backup_path) |
---|
| 846 | = tempfile(qq{$archive_base_name.XXXXXX}, DIR => $backup_dir); |
---|
| 847 | close($fh); |
---|
| 848 | run_create_archive($work_backup_path, $source_dir, $source_base_name); |
---|
| 849 | my $backup_path = File::Spec->catfile($backup_dir, $archive_base_name); |
---|
| 850 | run_rename($work_backup_path, $backup_path); |
---|
| 851 | my $mode = (stat($backup_path))[2] | S_IRGRP | S_IROTH; |
---|
| 852 | return chmod($mode, $backup_path); |
---|
| 853 | } |
---|
| 854 | |
---|
| 855 | # ------------------------------------------------------------------------------ |
---|
| 856 | # Extracts from a backup archive to a work path. |
---|
| 857 | sub _extract_backup_archive { |
---|
| 858 | my ($archive_path, $work_path) = @_; |
---|
| 859 | run_extract_archive($archive_path, dirname($work_path)); |
---|
| 860 | if (! -e $work_path) { |
---|
| 861 | my ($base_name) = basename($work_path); |
---|
| 862 | die("$base_name: does not exist in archive $archive_path.\n"); |
---|
| 863 | } |
---|
| 864 | return 1; |
---|
| 865 | } |
---|
| 866 | |
---|
| 867 | # ------------------------------------------------------------------------------ |
---|
| 868 | # Searches a directory for files and invokes a callback on each file. |
---|
| 869 | sub _get_files_from { |
---|
| 870 | my ($dir_path, $callback_ref) = @_; |
---|
| 871 | my $dir_handle = IO::Dir->new($dir_path); |
---|
| 872 | if (!defined($dir_handle)) { |
---|
| 873 | return; |
---|
| 874 | } |
---|
| 875 | BASE_NAME: |
---|
| 876 | while (my $base_name = $dir_handle->read()) { |
---|
| 877 | my $path = File::Spec->catfile($dir_path, $base_name); |
---|
| 878 | if (index($base_name, q{.}) == 0) { |
---|
| 879 | next BASE_NAME; |
---|
| 880 | } |
---|
| 881 | $callback_ref->($base_name, $path); |
---|
| 882 | } |
---|
| 883 | return $dir_handle->close(); |
---|
| 884 | } |
---|
| 885 | |
---|
| 886 | # ------------------------------------------------------------------------------ |
---|
| 887 | # Returns a database handle for the database of a Trac environment. |
---|
| 888 | sub _get_trac_db_handle_for { |
---|
| 889 | my ($project) = @_; |
---|
| 890 | my $db_path = $project->get_trac_live_db_path(); |
---|
| 891 | return DBI->connect(qq{dbi:SQLite:dbname=$db_path}, q{}, q{}); |
---|
| 892 | } |
---|
| 893 | |
---|
| 894 | # ------------------------------------------------------------------------------ |
---|
| 895 | # Manages the session* tables in the DB of a Trac environment. |
---|
| 896 | sub _manage_users_in_trac_db_of { |
---|
| 897 | my ($project, $user_ref) = @_; |
---|
| 898 | my $db_handle = _get_trac_db_handle_for($project); |
---|
| 899 | if (!$db_handle) { |
---|
| 900 | return; |
---|
| 901 | } |
---|
| 902 | SESSION: { |
---|
| 903 | my $session_select_statement = $db_handle->prepare( |
---|
| 904 | "SELECT sid FROM session WHERE authenticated == 1", |
---|
| 905 | ); |
---|
| 906 | my $session_insert_statement = $db_handle->prepare( |
---|
| 907 | "INSERT INTO session VALUES (?, 1, 0)", |
---|
| 908 | ); |
---|
| 909 | my $session_delete_statement = $db_handle->prepare( |
---|
| 910 | "DELETE FROM session WHERE sid == ?", |
---|
| 911 | ); |
---|
| 912 | $session_select_statement->execute(); |
---|
| 913 | my $is_changed = 0; |
---|
| 914 | my %session_old_users; |
---|
| 915 | while (my ($sid) = $session_select_statement->fetchrow_array()) { |
---|
| 916 | if (exists($user_ref->{$sid})) { |
---|
| 917 | $session_old_users{$sid} = 1; |
---|
| 918 | } |
---|
| 919 | else { |
---|
| 920 | FCM::Admin::Runner->instance()->run( |
---|
| 921 | "session: removing $sid", |
---|
| 922 | sub{return $session_delete_statement->execute($sid)}, |
---|
| 923 | ); |
---|
| 924 | $is_changed = 1; |
---|
| 925 | } |
---|
| 926 | } |
---|
| 927 | for my $sid (keys(%{$user_ref})) { |
---|
| 928 | if (!exists($session_old_users{$sid})) { |
---|
| 929 | FCM::Admin::Runner->instance()->run( |
---|
| 930 | "session: adding $sid", |
---|
| 931 | sub {return $session_insert_statement->execute($sid)}, |
---|
| 932 | ); |
---|
| 933 | $is_changed = 1; |
---|
| 934 | } |
---|
| 935 | } |
---|
| 936 | $session_select_statement->finish(); |
---|
| 937 | $session_insert_statement->finish(); |
---|
| 938 | $session_delete_statement->finish(); |
---|
| 939 | } |
---|
| 940 | SESSION_ATTRIBUTE: { |
---|
| 941 | my $attribute_select_statement = $db_handle->prepare( |
---|
| 942 | "SELECT sid,name,value FROM session_attribute " |
---|
| 943 | . "WHERE authenticated == 1", |
---|
| 944 | ); |
---|
| 945 | my $attribute_insert_statement = $db_handle->prepare( |
---|
| 946 | "INSERT INTO session_attribute VALUES (?, 1, ?, ?)", |
---|
| 947 | ); |
---|
| 948 | my $attribute_update_statement = $db_handle->prepare( |
---|
| 949 | "UPDATE session_attribute SET value = ? " |
---|
| 950 | . "WHERE sid = ? and authenticated == 1 and name == ?", |
---|
| 951 | ); |
---|
| 952 | my $attribute_delete_statement = $db_handle->prepare( |
---|
| 953 | "DELETE FROM session_attribute WHERE sid == ?", |
---|
| 954 | ); |
---|
| 955 | $attribute_select_statement->execute(); |
---|
| 956 | my %attribute_old_users; |
---|
| 957 | ROW: |
---|
| 958 | while (my @row = $attribute_select_statement->fetchrow_array()) { |
---|
| 959 | my ($sid, $name, $value) = @row; |
---|
| 960 | my $user = exists($user_ref->{$sid})? $user_ref->{$sid} : undef; |
---|
| 961 | if (defined($user)) { |
---|
| 962 | $attribute_old_users{$sid} = 1; |
---|
| 963 | my $getter |
---|
| 964 | = $name eq 'name' ? 'get_display_name' |
---|
| 965 | : $name eq 'email' ? 'get_email' |
---|
| 966 | : undef; |
---|
| 967 | if (!defined($getter)) { |
---|
| 968 | next ROW; |
---|
| 969 | } |
---|
| 970 | if ($user->$getter() ne $value) { |
---|
| 971 | my $new_value = $user->$getter(); |
---|
| 972 | FCM::Admin::Runner->instance()->run( |
---|
| 973 | "session_attribute: updating $name: $sid: $new_value", |
---|
| 974 | sub {return $attribute_update_statement->execute( |
---|
| 975 | $new_value, $sid, $name, |
---|
| 976 | )}, |
---|
| 977 | ); |
---|
| 978 | } |
---|
| 979 | } |
---|
| 980 | else { |
---|
| 981 | FCM::Admin::Runner->instance()->run( |
---|
| 982 | "session_attribute: removing $sid", |
---|
| 983 | sub {return $attribute_delete_statement->execute($sid)}, |
---|
| 984 | ); |
---|
| 985 | } |
---|
| 986 | } |
---|
| 987 | USER: |
---|
| 988 | for my $sid (keys(%{$user_ref})) { |
---|
| 989 | if (exists($attribute_old_users{$sid})) { |
---|
| 990 | next USER; |
---|
| 991 | } |
---|
| 992 | my $user = $user_ref->{$sid}; |
---|
| 993 | my $display_name = $user->get_display_name(); |
---|
| 994 | my $email = $user->get_email(); |
---|
| 995 | FCM::Admin::Runner->instance()->run( |
---|
| 996 | "session_attribute: adding name: $sid: $display_name", |
---|
| 997 | sub {return $attribute_insert_statement->execute( |
---|
| 998 | $sid, 'name', $display_name, |
---|
| 999 | )}, |
---|
| 1000 | ); |
---|
| 1001 | FCM::Admin::Runner->instance()->run( |
---|
| 1002 | "session_attribute: adding email: $sid: $email", |
---|
| 1003 | sub {return $attribute_insert_statement->execute( |
---|
| 1004 | $sid, 'email', $email, |
---|
| 1005 | )}, |
---|
| 1006 | ); |
---|
| 1007 | } |
---|
| 1008 | $attribute_select_statement->finish(); |
---|
| 1009 | $attribute_insert_statement->finish(); |
---|
| 1010 | $attribute_update_statement->finish(); |
---|
| 1011 | $attribute_delete_statement->finish(); |
---|
| 1012 | } |
---|
| 1013 | return $db_handle->disconnect(); |
---|
| 1014 | } |
---|
| 1015 | |
---|
| 1016 | # ------------------------------------------------------------------------------ |
---|
| 1017 | # Recover a file from the Trac backup directory to the Trac live directory. |
---|
| 1018 | sub _recover_trac_file { |
---|
| 1019 | my ($base_name) = @_; |
---|
| 1020 | my $live_path = File::Spec->catfile( |
---|
| 1021 | FCM::Admin::Config->instance()->get_trac_live_dir(), $base_name); |
---|
| 1022 | if (-e $live_path) { |
---|
| 1023 | die(sprintf("$live_path: file exists.\n")); |
---|
| 1024 | } |
---|
| 1025 | my $backup_path = File::Spec->catfile( |
---|
| 1026 | FCM::Admin::Config->instance()->get_trac_backup_dir(), $base_name); |
---|
| 1027 | return |
---|
| 1028 | run_mkpath(FCM::Admin::Config->instance()->get_trac_live_dir()) |
---|
| 1029 | && run_copy($backup_path, $live_path); |
---|
| 1030 | } |
---|
| 1031 | |
---|
| 1032 | # ------------------------------------------------------------------------------ |
---|
| 1033 | # Returns the youngest revision of a SVN repository. |
---|
| 1034 | sub _svnlook_youngest { |
---|
| 1035 | my ($svn_repos_path) = @_; |
---|
| 1036 | my ($youngest) = qx{svnlook youngest $svn_repos_path}; |
---|
| 1037 | chomp($youngest); |
---|
| 1038 | return $youngest; |
---|
| 1039 | } |
---|
| 1040 | |
---|
| 1041 | # ------------------------------------------------------------------------------ |
---|
| 1042 | # Verifies the integrity of a SVN repository. |
---|
| 1043 | sub _verify_svn_repository { |
---|
| 1044 | my ($project) = @_; |
---|
| 1045 | my $VERIFIED_REVISION_REGEX = qr{\A\*\s+Verified\s+revision\s+\d+\.}xms; |
---|
| 1046 | FCM::Admin::Runner->instance()->run( |
---|
| 1047 | "verifying integrity of SVN repository of $project", |
---|
| 1048 | sub { |
---|
| 1049 | my $pipe = IO::Pipe->new(); |
---|
| 1050 | $pipe->reader(sprintf( |
---|
| 1051 | qq{svnadmin verify %s 2>&1}, $project->get_svn_live_path(), |
---|
| 1052 | )); |
---|
| 1053 | while (my $line = $pipe->getline()) { |
---|
| 1054 | if ($line !~ $VERIFIED_REVISION_REGEX) { # don't print |
---|
| 1055 | print($line); |
---|
| 1056 | } |
---|
| 1057 | } |
---|
| 1058 | return $pipe->close(); |
---|
| 1059 | # Note: "verify" is not yet possible via SVN::Repos |
---|
| 1060 | }, |
---|
| 1061 | ); |
---|
| 1062 | } |
---|
| 1063 | |
---|
| 1064 | 1; |
---|
| 1065 | __END__ |
---|
| 1066 | |
---|
| 1067 | =head1 NAME |
---|
| 1068 | |
---|
| 1069 | FCM::Admin::System |
---|
| 1070 | |
---|
| 1071 | =head1 SYNOPSIS |
---|
| 1072 | |
---|
| 1073 | use FCM::Admin::System qw{ ... }; |
---|
| 1074 | # ... see descriptions of individual functions for detail |
---|
| 1075 | |
---|
| 1076 | =head1 DESCRIPTION |
---|
| 1077 | |
---|
| 1078 | This module contains utility functions for the administration of Subversion |
---|
| 1079 | repositories and Trac environments hosted by the FCM team. |
---|
| 1080 | |
---|
| 1081 | =head1 FUNCTIONS |
---|
| 1082 | |
---|
| 1083 | =over 4 |
---|
| 1084 | |
---|
| 1085 | =item add_trac_environment($project_name, $admin_user_list_ref, $authorised_option) |
---|
| 1086 | |
---|
| 1087 | Creates a new Trac environment. |
---|
| 1088 | |
---|
| 1089 | =item backup_svn_repository($project,$housekeep_dumps_option,$verify_integrity_option) |
---|
| 1090 | |
---|
| 1091 | Creates an archived hotcopy of $project's live SVN repository, and put it in the |
---|
| 1092 | SVN backup directory. If $verify_integrity_option is set to true, it verifies |
---|
| 1093 | the integrity of the live repository before creating the hotcopy. If |
---|
| 1094 | $housekeep_dumps_option is set to true, it housekeeps the revision dumps of |
---|
| 1095 | $project following a successful backup. |
---|
| 1096 | |
---|
| 1097 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1098 | |
---|
| 1099 | =item backup_trac_environment($project,$verify_integrity_option) |
---|
| 1100 | |
---|
| 1101 | Creates an archived hotcopy of $project's live Trac environment, and put it in |
---|
| 1102 | the Trac backup directory. If $verify_integrity_option is set to true, it |
---|
| 1103 | verifies the integrity of the database of the live environment before creating |
---|
| 1104 | the hotcopy. |
---|
| 1105 | |
---|
| 1106 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1107 | |
---|
| 1108 | =item backup_trac_ini_file() |
---|
| 1109 | |
---|
| 1110 | Copies the live Trac (central) INI file to the Trac backup directory. |
---|
| 1111 | |
---|
| 1112 | =item backup_trac_passwd_file() |
---|
| 1113 | |
---|
| 1114 | Copies the live Trac password file to the Trac backup directory. |
---|
| 1115 | |
---|
| 1116 | =item distribute_wc() |
---|
| 1117 | |
---|
| 1118 | Distributes the central FCM working copy to standard locations. |
---|
| 1119 | |
---|
| 1120 | =item filter_projects($project_list_ref,$filter_list_ref) |
---|
| 1121 | |
---|
| 1122 | Filters the project list in $project_list_ref using a list of names in |
---|
| 1123 | $filter_list_ref. Returns a list of projects with names matching those in |
---|
| 1124 | $filter_list_ref. Returns the full list if $filter_list_ref points to an empty |
---|
| 1125 | list. |
---|
| 1126 | |
---|
| 1127 | =item get_projects_from_svn_backup() |
---|
| 1128 | |
---|
| 1129 | Returns a list of L<FCM::Admin::Project|FCM::Admin::Project> objects by |
---|
| 1130 | searching the SVN backup directory. By default, all valid projects are returned. |
---|
| 1131 | |
---|
| 1132 | =item get_projects_from_svn_live() |
---|
| 1133 | |
---|
| 1134 | Similar to get_projects_from_svn_backup(), but it searches the SVN live |
---|
| 1135 | directory. |
---|
| 1136 | |
---|
| 1137 | =item get_projects_from_trac_backup() |
---|
| 1138 | |
---|
| 1139 | Similar to get_projects_from_svn_backup(), but it searches the Trac backup |
---|
| 1140 | directory. |
---|
| 1141 | |
---|
| 1142 | =item get_projects_from_trac_live() |
---|
| 1143 | |
---|
| 1144 | Similar to get_projects_from_svn_backup(), but it searches the Trac live |
---|
| 1145 | directory. |
---|
| 1146 | |
---|
| 1147 | =item get_users() |
---|
| 1148 | |
---|
| 1149 | Retrieves a list of users using the mail aliases and the POSIX password |
---|
| 1150 | database. It also makes a naive attempt to filter out admin accounts. In LIST |
---|
| 1151 | context, returns a hash with keys = user IDs and values = user details (as |
---|
| 1152 | L<FCM::Admin::System::User|FCM::Admin::System::User> objects). In SCALAR |
---|
| 1153 | context, returns a reference to the same hash. |
---|
| 1154 | |
---|
| 1155 | =item install_svn_hook($project) |
---|
| 1156 | |
---|
| 1157 | Searches for hook scripts in the standard location and install them (as symbolic |
---|
| 1158 | links) in the I<hooks> directory of the $project's SVN live repository. |
---|
| 1159 | |
---|
| 1160 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1161 | |
---|
| 1162 | =item manage_users_in_svn_passwd($user_ref) |
---|
| 1163 | |
---|
| 1164 | Using entries in the hash reference $user_ref, sets up or updates the SVN and |
---|
| 1165 | Trac password files. The $user_ref argument should be a reference to a hash, as |
---|
| 1166 | returned by get_users(). |
---|
| 1167 | |
---|
| 1168 | =item manage_users_in_trac_passwd($user_ref) |
---|
| 1169 | |
---|
| 1170 | Using entries in the hash reference $user_ref, sets up or updates the Trac |
---|
| 1171 | password files. The $user_ref argument should be a reference to a hash, as |
---|
| 1172 | returned by get_users(). |
---|
| 1173 | |
---|
| 1174 | =item manage_users_in_trac_db_of($project, $user_ref) |
---|
| 1175 | |
---|
| 1176 | Using entries in $user_ref, sets up or updates the session/session_attribute |
---|
| 1177 | tables in the databases of the live Trac environments. The $project argument |
---|
| 1178 | should be a L<FCM::Admin::Project|FCM::Admin::Project> object |
---|
| 1179 | and $user_ref should be a reference to a hash, as returned by get_users(). |
---|
| 1180 | |
---|
| 1181 | =item recover_svn_repository($project,$recover_dumps_option,$recover_hooks_option) |
---|
| 1182 | |
---|
| 1183 | Recovers a project's SVN repository using its backup. If $recover_dumps_option |
---|
| 1184 | is set to true, it will also attempt to load the latest revision dumps following |
---|
| 1185 | a successful recovery. If $recover_hooks_option is set to true, it will also |
---|
| 1186 | attempt to re-install the hook scripts following a successful recovery. |
---|
| 1187 | |
---|
| 1188 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1189 | |
---|
| 1190 | =item recover_trac_environment($project) |
---|
| 1191 | |
---|
| 1192 | Recovers a project's Trac environment using its backup. |
---|
| 1193 | |
---|
| 1194 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1195 | |
---|
| 1196 | =item recover_trac_ini_file() |
---|
| 1197 | |
---|
| 1198 | Copies the backup Trac (central) INI file to the Trac live directory (if it does |
---|
| 1199 | not exist). |
---|
| 1200 | |
---|
| 1201 | =item recover_trac_passwd_file() |
---|
| 1202 | |
---|
| 1203 | Copies the backup Trac password file to the Trac live directory (if it does not |
---|
| 1204 | exist). |
---|
| 1205 | |
---|
| 1206 | =item vacuum_trac_env_db($project) |
---|
| 1207 | |
---|
| 1208 | Connects to the database of a project's Trac environment, and issues the |
---|
| 1209 | "VACUUM" SQL command. |
---|
| 1210 | |
---|
| 1211 | $project should be a L<FCM::Admin::Project|FCM::Admin::Project> object. |
---|
| 1212 | |
---|
| 1213 | =back |
---|
| 1214 | |
---|
| 1215 | =head1 SEE ALSO |
---|
| 1216 | |
---|
| 1217 | L<FCM::Admin::Config|FCM::Admin::Config>, |
---|
| 1218 | L<FCM::Admin::Project|FCM::Admin::Project>, |
---|
| 1219 | L<FCM::Admin::Runner|FCM::Admin::Runner>, |
---|
| 1220 | L<FCM::Admin::User|FCM::Admin::User>, |
---|
| 1221 | L<FCM::Admin::Util|FCM::Admin::Util> |
---|
| 1222 | |
---|
| 1223 | =head1 COPYRIGHT |
---|
| 1224 | |
---|
| 1225 | E<169> Crown copyright Met Office. All rights reserved. |
---|
| 1226 | |
---|
| 1227 | =cut |
---|