New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
System.pm in vendors/fcm/current/examples/lib/FCM/Admin – NEMO

source: vendors/fcm/current/examples/lib/FCM/Admin/System.pm @ 1977

Last change on this file since 1977 was 1977, checked in by flavoni, 14 years ago

importing fcm vendor
File size: 42.2 KB
Line 
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
7use strict;
8use warnings;
9
10package FCM::Admin::System;
11
12use Config::IniFiles;
13use DBI; # See also: DBD::SQLite
14use Exporter qw{import};
15use FCM::Admin::Config;
16use FCM::Admin::Project;
17use FCM::Admin::Runner;
18use FCM::Admin::User;
19use 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};
31use Fcntl qw{:mode}; # for S_IRGRP, S_IWGRP, S_IROTH, etc
32use File::Basename qw{basename dirname};
33use File::Find qw{find};
34use File::Spec;
35use File::Temp qw{tempdir tempfile};
36use IO::Dir;
37use IO::Pipe;
38use List::Util qw{first};
39
40our @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.
66sub 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.
180sub 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.
235sub 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.
288sub 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.
297sub 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.
306sub 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.
338sub 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.
362sub 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.
386sub 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.
408sub 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.
430sub 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.
448sub 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.
509sub 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.
550sub 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.
603sub 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.
671sub 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.
684sub 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.
746sub 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.
770sub 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.
779sub 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.
788sub 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.
804sub _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.
817sub _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.
840sub _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.
857sub _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.
869sub _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.
888sub _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.
896sub _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.
1018sub _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.
1034sub _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.
1043sub _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
10641;
1065__END__
1066
1067=head1 NAME
1068
1069FCM::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
1078This module contains utility functions for the administration of Subversion
1079repositories 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
1087Creates a new Trac environment.
1088
1089=item backup_svn_repository($project,$housekeep_dumps_option,$verify_integrity_option)
1090
1091Creates an archived hotcopy of $project's live SVN repository, and put it in the
1092SVN backup directory. If $verify_integrity_option is set to true, it verifies
1093the 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
1101Creates an archived hotcopy of $project's live Trac environment, and put it in
1102the Trac backup directory. If $verify_integrity_option is set to true, it
1103verifies the integrity of the database of the live environment before creating
1104the hotcopy.
1105
1106$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
1107
1108=item backup_trac_ini_file()
1109
1110Copies the live Trac (central) INI file to the Trac backup directory.
1111
1112=item backup_trac_passwd_file()
1113
1114Copies the live Trac password file to the Trac backup directory.
1115
1116=item distribute_wc()
1117
1118Distributes the central FCM working copy to standard locations.
1119
1120=item filter_projects($project_list_ref,$filter_list_ref)
1121
1122Filters 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
1125list.
1126
1127=item get_projects_from_svn_backup()
1128
1129Returns a list of L<FCM::Admin::Project|FCM::Admin::Project> objects by
1130searching the SVN backup directory. By default, all valid projects are returned.
1131
1132=item get_projects_from_svn_live()
1133
1134Similar to get_projects_from_svn_backup(), but it searches the SVN live
1135directory.
1136
1137=item get_projects_from_trac_backup()
1138
1139Similar to get_projects_from_svn_backup(), but it searches the Trac backup
1140directory.
1141
1142=item get_projects_from_trac_live()
1143
1144Similar to get_projects_from_svn_backup(), but it searches the Trac live
1145directory.
1146
1147=item get_users()
1148
1149Retrieves a list of users using the mail aliases and the POSIX password
1150database. It also makes a naive attempt to filter out admin accounts. In LIST
1151context, returns a hash with keys = user IDs and values = user details (as
1152L<FCM::Admin::System::User|FCM::Admin::System::User> objects). In SCALAR
1153context, returns a reference to the same hash.
1154
1155=item install_svn_hook($project)
1156
1157Searches for hook scripts in the standard location and install them (as symbolic
1158links) 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
1164Using entries in the hash reference $user_ref, sets up or updates the SVN and
1165Trac password files. The $user_ref argument should be a reference to a hash, as
1166returned by get_users().
1167
1168=item manage_users_in_trac_passwd($user_ref)
1169
1170Using entries in the hash reference $user_ref, sets up or updates the Trac
1171password files. The $user_ref argument should be a reference to a hash, as
1172returned by get_users().
1173
1174=item manage_users_in_trac_db_of($project, $user_ref)
1175
1176Using entries in $user_ref, sets up or updates the session/session_attribute
1177tables in the databases of the live Trac environments. The $project argument
1178should be a L<FCM::Admin::Project|FCM::Admin::Project> object
1179and $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
1183Recovers a project's SVN repository using its backup. If $recover_dumps_option
1184is set to true, it will also attempt to load the latest revision dumps following
1185a successful recovery. If $recover_hooks_option is set to true, it will also
1186attempt 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
1192Recovers 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
1198Copies the backup Trac (central) INI file to the Trac live directory (if it does
1199not exist).
1200
1201=item recover_trac_passwd_file()
1202
1203Copies the backup Trac password file to the Trac live directory (if it does not
1204exist).
1205
1206=item vacuum_trac_env_db($project)
1207
1208Connects 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
1217L<FCM::Admin::Config|FCM::Admin::Config>,
1218L<FCM::Admin::Project|FCM::Admin::Project>,
1219L<FCM::Admin::Runner|FCM::Admin::Runner>,
1220L<FCM::Admin::User|FCM::Admin::User>,
1221L<FCM::Admin::Util|FCM::Admin::Util>
1222
1223=head1 COPYRIGHT
1224
1225E<169> Crown copyright Met Office. All rights reserved.
1226
1227=cut
Note: See TracBrowser for help on using the repository browser.