source: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/System.pm @ 5475

Last change on this file since 5475 was 5129, checked in by abarral, 7 months ago

Re-add removed by mistake fcm

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