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/lib/FCM/Admin – NEMO

source: vendors/lib/FCM/Admin/System.pm @ 10669

Last change on this file since 10669 was 10669, checked in by nicolasmartin, 5 years ago

Import latest FCM release from Github into the repository for testing

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