toolbox/update-all-config.pl

   1 #!/usr/bin/perl
   2
   3 # update-all-config.pl - Update all out-of-date config
   4
   5 use strict;
   6 use warnings;
   7 use vars qw($VERSION);
   8 BEGIN {*VERSION = \'2.0'}
   9 use File::Basename;
  10 use File::Spec;
  11 use Cwd qw(realpath);
  12 use POSIX qw();
  13 use Getopt::Long;
  14 use Pod::Usage;
  15 BEGIN {
  16         eval 'require Pod::Text::Termcap; 1;' and
  17         @Pod::Usage::ISA = (qw( Pod::Text::Termcap ));
  18         defined($ENV{PERLDOC}) && $ENV{PERLDOC} ne "" or
  19         $ENV{PERLDOC} = "-oterm -oman";
  20 }
  21 use lib "__BASEDIR__";
  22 use Girocco::Config;
  23 use Girocco::Util;
  24 use Girocco::CLIUtil;
  25 use Girocco::Project;
  26
  27 my $shbin;
  28 BEGIN {
  29     $shbin = $Girocco::Config::posix_sh_bin;
  30     defined($shbin) && $shbin ne "" or $shbin = "/bin/sh";
  31 }
  32
  33 exit(&main(@ARGV)||0);
  34
  35 my ($dryrun, $force, $quiet);
  36
  37 sub die_usage {
  38         pod2usage(-exitval => 2);
  39 }
  40
  41 sub do_help {
  42         pod2usage(-verbose => 2, -exitval => 0);
  43 }
  44
  45 sub do_version {
  46         print basename($0), " version ", $VERSION, "\n";
  47         exit 0;
  48 }
  49
  50 my ($dmode, $dperm, $drwxmode, $fmode, $fmodeoct, $fperm, $wall);
  51 BEGIN {
  52         $dmode=02775;
  53         $dperm='drwxrwsr-x';
  54         $drwxmode='ug+rwx,o+rx';
  55         $fmode=0664;
  56         $fmodeoct='0664';
  57         $fperm='-rw-rw-r--';
  58         $wall=0;
  59 }
  60
  61 my $owning_group_id;
  62 my $htmlcache_owning_group_id;
  63 my $ctags_owning_group_id;
  64
  65 sub main {
  66         local *ARGV = \@_;
  67         my ($help, $version);
  68
  69         umask 002;
  70         close(DATA) if fileno(DATA);
  71         Getopt::Long::Configure('bundling');
  72         GetOptions(
  73                 'help|h'        => sub {do_help},
  74                 'version|V'     => sub {do_version},
  75                 'dry-run|n'     => \$dryrun,
  76                 'quiet|q'       => \$quiet,
  77                 'force|f'       => \$force,
  78         ) or die_usage;
  79         $dryrun and $quiet = 0;
  80
  81         -f jailed_file("/etc/group") or
  82                 die "Girocco group file not found: " . jailed_file("/etc/group") . "\n";
  83
  84         if (!defined($Girocco::Config::owning_group) || $Girocco::Config::owning_group eq "") {
  85                 die "\$Girocco::Config::owning_group unset, refusing to run without --force\n" unless $force;
  86                 $dmode=02777;
  87                 $dperm='drwxrwsrwx';
  88                 $drwxmode='a+rwx';
  89                 $fmode=0666;
  90                 $fmodeoct='0666';
  91                 $fperm='-rw-rw-rw-';
  92                 $wall=1;
  93                 warn "Mode 666 in effect\n" unless $quiet;
  94         } elsif (($owning_group_id = scalar(getgrnam($Girocco::Config::owning_group))) !~ /^\d+$/) {
  95                 die "\$Girocco::Config::owning_group invalid ($Girocco::Config::owning_group), refusing to run\n";
  96         }
  97         if (defined($owning_group_id) && $Girocco::Config::htmlcache_owning_group) {
  98                 die "\$Girocco::Config::htmlcache_owning_group invalid ($Girocco::Config::htmlcache_owning_group), refusing to run\n"
  99                 unless ($htmlcache_owning_group_id = scalar(getgrnam($Girocco::Config::htmlcache_owning_group))) =~ /^\d+$/;
 100         }
 101         if (defined($owning_group_id) && $Girocco::Config::ctags_owning_group) {
 102                 die "\$Girocco::Config::ctags_owning_group invalid ($Girocco::Config::ctags_owning_group), refusing to run\n"
 103                 unless ($ctags_owning_group_id = scalar(getgrnam($Girocco::Config::ctags_owning_group))) =~ /^\d+$/;
 104         }
 105
 106         my @allprojs = Girocco::Project::get_full_list;
 107         my @projects = ();
 108
 109         my $root = $Girocco::Config::reporoot;
 110         $root or die "\$Girocco::Config::reporoot is invalid\n";
 111         $root =~ s,/+$,,;
 112         $root ne "" or $root = "/";
 113         $root = realpath($root);
 114         $root = $1 if $root =~ m|^(/.+)$|;
 115         if (@ARGV) {
 116                 my %projnames = map {($_ => 1)} @allprojs;
 117                 foreach (@ARGV) {
 118                         s,/+$,,;
 119                         $_ or $_ = "/";
 120                         -d $_ and $_ = realpath($_);
 121                         $_ = $1 if $_ =~ m|^(.+)$|;
 122                         s,^\Q$root\E/,,;
 123                         s,\.git$,,;
 124                         if (!exists($projnames{$_})) {
 125                                 warn "$_: unknown to Girocco (not in etc/group)\n"
 126                                         unless $quiet;
 127                                 next;
 128                         }
 129                         push(@projects, $_);
 130                 }
 131         } else {
 132                 @projects = sort {lc($a) cmp lc($b)} @allprojs;
 133         }
 134
 135         nice_me(18);
 136         my $bad = 0;
 137         foreach (@projects) {
 138                 my $projdir = "$root/$_.git";
 139                 if (! -d $projdir) {
 140                         warn "$_: does not exist -- skipping\n" unless $quiet;
 141                         next;
 142                 }
 143                 if (!is_git_dir($projdir)) {
 144                         warn "$_: is not a .git directory -- skipping\n" unless $quiet;
 145                         next;
 146                 }
 147                 if (-e "$projdir/.noconfig") {
 148                         warn "$_: found .noconfig -- skipping\n" unless $quiet;
 149                         next;
 150                 }
 151                 if (!chdir($projdir)) {
 152                         warn "$_: chdir to project directory failed: $!\n" unless $quiet;
 153                         next;
 154                 }
 155                 process_one_project($_) or $bad = 1;
 156         }
 157
 158         return $bad ? 1 : 0;
 159 }
 160
 161 my (@mkdirs, @mkfiles);
 162 my (@fixdpermsdirs, @fixdpermsrwx, @fixfpermsfiles, @fixfpermsdirs);
 163 BEGIN {
 164         @mkdirs = qw(refs info hooks ctags htmlcache bundles reflogs objects objects/info);
 165         @mkfiles = qw(config info/lastactivity);
 166         @fixdpermsdirs = qw(. refs info ctags htmlcache bundles reflogs objects objects/info);
 167         @fixdpermsrwx = qw(refs objects);
 168         @fixfpermsfiles = qw(HEAD config description packed-refs README.html info/lastactivity
 169                 info/alternates info/http-alternates info/packs);
 170         @fixfpermsdirs = qw(ctags);
 171 }
 172
 173 my (@boolvars, @falsevars, @false0vars, @truevars);
 174 BEGIN {
 175         @boolvars = qw(gitweb.statusupdates);
 176         @falsevars = qw(core.ignorecase receive.denynonfastforwards);
 177         @false0vars = qw(receive.autogc);
 178         @truevars = qw(receive.fsckobjects receive.updateserverinfo repack.writebitmaps transfer.fsckobjects);
 179 }
 180
 181 my $hdr;
 182
 183 sub defval($$) {
 184         return defined($_[0]) ? $_[0] : $_[1];
 185 }
 186
 187 sub openfind_ {
 188         my $noe = shift;
 189         my $duperr;
 190         if ($noe) {{
 191                 open $duperr, '>&2' or last;
 192                 my $errfd = POSIX::open(File::Spec->devnull, &POSIX::O_RDWR);
 193                 defined($errfd) or close($duperr), $duperr = undef, last;
 194                 POSIX::dup2($errfd, 2) or close($duperr), $duperr = undef;
 195                 POSIX::close($errfd);
 196         }}
 197         my $fd;
 198         my $ans = open $fd, '-|', "find", @_;
 199         if ($noe && defined($duperr) && defined(fileno($duperr))) {
 200                 POSIX::dup2(fileno($duperr), 2);
 201                 close($duperr);
 202         }
 203         $ans or die "find failed: $!\n";
 204         return $fd;
 205 }
 206
 207 sub openfind { return openfind_(0, @_); }
 208 sub openfindne { return openfind_(1, @_); }
 209
 210 sub all_remotes
 211 {
 212         my $config = shift;
 213         return map({
 214                 my ($i,$r) = (index($_,"."),rindex($_,"."));
 215                 substr($_,$i+1,$r-$i-1);
 216         } grep(/^remote\.[^.].*\.url$/i, keys(%$config)));
 217 }
 218
 219 sub has_default_fetch_spec
 220 {
 221         my $config = shift;
 222         my $default = $config->{'remotes.default'};
 223         my @remotes = defined($default) ? split(' ', $default) : all_remotes($config);
 224         foreach (@remotes) {
 225                 defval($config->{"remote.$_.url"},"") ne "" or next;
 226                 !defined($default) && git_bool($config->{"remote.$_.skipdefaultupdate"}) and next;
 227                 defval($config->{"remote.$_.fetch"},"") ne "" and return 1;
 228         }
 229         return 0;
 230 }
 231
 232 sub is_native_git_mirror_url
 233 {
 234         my $bu = shift;
 235         defined($bu) && $bu ne "" or return 0;
 236         # All current or former natively supported by Git URLs return true:
 237         #  1. rsync: (removed in 2.8.0, also recognize rsync+ and rsync::)
 238         #  2. ftp:/ftps: (strongly discouraged)
 239         #  3. git:
 240         #  4. http:/https: (smart and non-smart)
 241         #  5. ssh:
 242         #  6. scp-like ssh syntax [user@]host:[^:/]
 243         return $bu =~ /^(?:
 244                 rsync[:+]       |
 245                 ftps?:          |
 246                 git:            |
 247                 https?:         |
 248                 ssh:            |
 249                 (?:[^\s:\@]+\@)?[^\s:\@+]+:(?!\/\/)[^\s:\\]
 250         )/xi;
 251 }
 252
 253 sub process_one_project
 254 {
 255         my ($proj) = @_;
 256         my $bad = 0;
 257         my $reallybad = 0;
 258         $hdr = 0;
 259         do {
 260                 if (! -d $_) {
 261                         if (-e $_) {
 262                                 warn "$proj: bypassing project, exists but not directory: $_\n" unless $quiet;
 263                                 $reallybad = $bad = 1;
 264                                 last;
 265                         } else {
 266                                 my $grpid = $owning_group_id;
 267                                 $grpid = $htmlcache_owning_group_id
 268                                         if $htmlcache_owning_group_id && $_ eq "htmlcache";
 269                                 $grpid = $ctags_owning_group_id
 270                                         if $ctags_owning_group_id && $_ eq "ctags";
 271                                 do_mkdir($proj, $_, $grpid) or $bad = 1, last;
 272                         }
 273                 }
 274         } foreach (@mkdirs);
 275         return 0 if $reallybad;
 276
 277         -d $_ && check_dperm($proj, $_) or $bad = 1 foreach (@fixdpermsdirs);
 278         my $fp = openfindne(@fixdpermsrwx, qw(-xdev -type d ( ! -path objects/?? -o -prune ) ! -perm), "-$drwxmode", "-print");
 279         while (<$fp>) {
 280                 chomp;
 281                 change_dpermrwx($proj, $_) or $bad = 1;
 282         }
 283         close($fp) or $bad = 1;
 284         $fp = openfind(qw(. -xdev -type d ( ! -path ./objects/?? -o -prune ) ! -perm -a+rx -print));
 285         while (<$fp>) {
 286                 chomp;
 287                 change_dpermrx($proj, $_) or $bad = 1;
 288         }
 289         close($fp) or $bad = 1;
 290
 291         do {
 292                 if (-e $_) {
 293                         if (! -f $_) {
 294                                 warn "$proj: bypassing project, exists but not file: $_\n" unless $quiet;
 295                                 $reallybad = $bad = 1;
 296                                 last;
 297                         }
 298                 } else {
 299                         my $result = "(dryrun)";
 300                         if (!$dryrun) {
 301                                 $result = "";
 302                                 my $tf;
 303                                 open($tf, '>', $_) && close ($tf) or $result = "FAILED", $bad = 1;
 304                         }
 305                         pmsg($proj, "$_: created", $result) unless $quiet;
 306                 }
 307         } foreach(@mkfiles);
 308         return 0 if $reallybad;
 309
 310         $dryrun || check_fperm($proj, "config") or $bad = 1;
 311         my $config = read_config_file_hash("config", !$quiet);
 312         if (!defined($config)) {
 313                 warn "$proj: could not read config file -- skipping\n" unless $quiet;
 314                 return 0;
 315         }
 316
 317         my $do_config = sub {
 318                 my ($item, $val) = @_;
 319                 my $oldval = defval($config->{$item},"");
 320                 my $result = "(dryrun)";
 321                 if (!$dryrun) {
 322                         $result = "";
 323                         system($Girocco::Config::git_bin, "config", "--file", "config", "--replace-all", $item, $val) == 0 or
 324                                 $result = "FAILED", $bad = 1;
 325                 }
 326                 if (!exists($config->{$item})) {
 327                         pmsg($proj, "config $item: created \"$val\"", $result) unless $quiet;
 328                 } else {
 329                         pmsg($proj, "config $item: \"$oldval\" -> \"$val\"", $result) unless $quiet;
 330                 }
 331         };
 332         my $do_config_unset = sub {
 333                 my ($item, $msg) = @_;
 334                 defined($msg) or $msg = "";
 335                 $msg eq "" or $msg = " " . $msg;
 336                 my $oldval = defval($config->{$item},"");
 337                 my $result = "(dryrun)";
 338                 if (!$dryrun) {
 339                         $result = "";
 340                         system($Girocco::Config::git_bin, "config", "--file", "config", "--unset-all", $item) == 0 or
 341                                 $result = "FAILED", $bad = 1;
 342                 }
 343                 pmsg($proj, "config $item: removed$msg \"$oldval\"", $result) unless $quiet;
 344         };
 345
 346         my $repovers = $config->{'core.repositoryformatversion'};
 347         if (!defined($repovers)) {
 348                 $repovers = "";
 349         } elsif ($repovers =~ /^[2345]$/) {
 350                 pmsg($proj, "WARNING: unknown core.repositoryformatversion value left unchanged: \"$repovers\"");
 351         } elsif ($repovers !~ /^[01]$/) {
 352                 pmsg($proj, "WARNING: replacing invalid core.repositoryformatversion value: \"$repovers\"") unless $quiet;
 353                 $repovers = "";
 354         }
 355         &$do_config('core.repositoryformatversion', 0) if $repovers eq "";
 356         my $hookspath = $Girocco::Config::reporoot . "/_global/hooks";
 357         my $cfghooks = defval($config->{'core.hookspath'},"");
 358         if ($cfghooks ne $hookspath) {
 359                 my $updatehookspath = 1;
 360                 $hookspath = $Girocco::Config::reporoot . "/$proj.git/hooks" if $Girocco::Config::localhooks;
 361                 if ($cfghooks =~ m{^/[^/]} && -d $cfghooks && -d "hooks") {
 362                         # tolerate this situation provided the realpath of $cfghooks
 363                         # matches the realpath of the hooks subdirectory and the hooks
 364                         # subdirectory exists; actually making sure the correct symlinks
 365                         # are present remains up to update-all-hooks not us
 366                         if (realpath($cfghooks) eq realpath("hooks")) {
 367                                 # we do, however, insist that it be stored exactly
 368                                 # as $reporoot/<project_name>.git/hooks in this case because
 369                                 # that's the only guaranteed version that works in the chroot
 370                                 $hookspath = $Girocco::Config::reporoot . "/$proj.git/hooks";
 371                                 $cfghooks eq $hookspath and $updatehookspath = 0;
 372                         }
 373                 }
 374                 &$do_config('core.hookspath', $hookspath) if $updatehookspath;
 375         }
 376         my $cmplvl = defval($config->{'core.compression'},"");
 377         if ($cmplvl !~ /^-?\d+$/ || $cmplvl < -1 || $cmplvl > 9 || "" . (0 + $cmplvl) ne "" . $cmplvl) {
 378                 pmsg($proj, "WARNING: replacing invalid core.compression value: \"$cmplvl\"") unless $cmplvl eq "" || $quiet;
 379                 $cmplvl = "";
 380         } elsif ($cmplvl != 5) {
 381                 pmsg($proj, "WARNING: suboptimal core.compression value left unchanged: \"$cmplvl\"") unless $quiet;
 382         }
 383         $cmplvl ne "" or &$do_config('core.compression', 5);
 384         my $grpshr = defval($config->{'core.sharedrepository'},"");
 385         if ($grpshr eq "" || (valid_bool($grpshr) && !git_bool($grpshr))) {
 386                 &$do_config('core.sharedrepository', 1);
 387         } elsif (!(valid_bool($grpshr) && git_bool($grpshr))) {
 388                 pmsg($proj, "WARNING: odd core.sharedrepository value left unchanged: \"$grpshr\"");
 389         }
 390         if (git_bool($config->{'core.bare'})) {
 391                 my $setlaru = 1;
 392                 my $laru = $config->{'core.logallrefupdates'};
 393                 if (defined($laru)) {
 394                         if (valid_bool($laru)) {
 395                                 $setlaru = 0;
 396                                 if (git_bool($laru)) {
 397                                         pmsg($proj, "WARNING: core.logallrefupdates is true (left unchanged)")
 398                                                 unless $quiet || -d "worktrees";
 399                                 }
 400                         } else {
 401                                 pmsg($proj, "WARNING: replacing non-boolean core.logallrefupdates value") unless $quiet;
 402                         }
 403                 }
 404                 !$setlaru or &$do_config('core.logallrefupdates', 'false');
 405         } else {
 406                 pmsg($proj, "WARNING: core.bare is not true (left unchanged)") unless $quiet;
 407         }
 408         my $precious = defval($config->{'extensions.preciousobjects'},"");
 409         valid_bool($precious) && git_bool($precious) or &$do_config('extensions.preciousobjects', 'true');
 410         defval($config->{'transfer.unpacklimit'},"") eq "1" or &$do_config('transfer.unpacklimit', 1);
 411         lc(defval($config->{'receive.denydeletecurrent'},"")) eq "warn" or &$do_config('receive.denydeletecurrent', 'warn');
 412         do {
 413                 !exists($config->{$_}) || valid_bool(defval($config->{$_},"")) or &$do_config_unset($_, "(not a boolean)");
 414         } foreach (@boolvars);
 415         do {
 416                 (valid_bool(defval($config->{$_},"")) && !git_bool($config->{$_})) or &$do_config($_, "false");
 417         } foreach (@falsevars);
 418         do {
 419                 (valid_bool(defval($config->{$_},"")) && !git_bool($config->{$_})) or &$do_config($_, 0);
 420         } foreach (@false0vars);
 421         do {
 422                 (valid_bool(defval($config->{$_},"")) && git_bool($config->{$_})) or &$do_config($_, "true");
 423         } foreach (@truevars);
 424
 425         if (defined($Girocco::Config::owning_group) && $Girocco::Config::owning_group ne "") {
 426                 $fp = openfind(qw(. -xdev ( -type d -o -type f ) ! -group), $Girocco::Config::owning_group, "-print");
 427                 while (<$fp>) {
 428                         chomp;
 429                         my $grpid = $owning_group_id;
 430                         $grpid = $htmlcache_owning_group_id if $htmlcache_owning_group_id && m{^\./htmlcache(?:/|$)}i;
 431                         $grpid = $ctags_owning_group_id if $ctags_owning_group_id && m{^\./ctags(?:/|$)}i;
 432                         change_group($proj, $_, $grpid) or $bad = 1;
 433                 }
 434                 close($fp) or $bad = 1;
 435         }
 436         foreach (@fixfpermsfiles) {
 437                 if (-e $_) {
 438                         if (! -f $_) {
 439                                 warn "$proj: bypassing project, exists but not file: $_\n" unless $quiet;
 440                                 $reallybad = $bad = 1;
 441                                 last;
 442                         }
 443                         check_fperm($proj, $_) or $bad = 1;
 444                 }
 445         }
 446         return 0 if $reallybad;
 447
 448         $fp = openfindne(@fixfpermsdirs, qw(-xdev -type f ! -perm), $fmodeoct, "-print");
 449         while (<$fp>) {
 450                 chomp;
 451                 check_fperm($proj, $_) or $bad = 1;
 452         }
 453         close($fp) or $bad = 1;
 454         $fp = openfind(qw(. -xdev -type f ! -perm -a+r -print));
 455         while (<$fp>) {
 456                 chomp;
 457                 check_fpermr($proj, $_) or $bad = 1;
 458         }
 459         close($fp) or $bad = 1;
 460         $fp = openfind(qw(. -xdev -type d ( -path ./hooks -o -path ./mob/hooks ) -prune -o -type f ( -perm -u=x -o -perm -g=x -o -perm -o=x ) -print));
 461         while (<$fp>) {
 462                 chomp;
 463                 check_fpermnox($proj, $_) or $bad = 1;
 464         }
 465         close($fp) or $bad = 1;
 466
 467         my $bu = defval($config->{'gitweb.baseurl'},"");
 468         if (-e ".nofetch") {
 469                 $bu eq "" or pmsg($proj, "WARNING: .nofetch exists but gitweb.baseurl is not empty ($bu)") unless $quiet;
 470         } else {
 471                 if ($bu eq "") {
 472                         if (has_default_fetch_spec($config)) {
 473                                 pmsg($proj, "WARNING: gitweb.baseurl is empty and .nofetch does not exist but fetch spec does") unless $quiet;
 474                         } else {
 475                                 pmsg($proj, "WARNING: gitweb.baseurl is empty and .nofetch does not exist") unless $quiet;
 476                         }
 477                 } elsif (is_native_git_mirror_url($bu) && !has_default_fetch_spec($config)) {
 478                         pmsg($proj, "WARNING: gitweb.baseurl is not empty but fetch spec is") unless $quiet;
 479                 }
 480         }
 481
 482         return !$bad;
 483 }
 484
 485 sub do_mkdir
 486 {
 487         my ($proj, $subdir, $grpid) = @_;
 488         my $result = "";
 489         if (!$dryrun) {
 490                 mkdir($subdir) && -d "$subdir" or $result = "FAILED";
 491                 if ($grpid && $grpid != $owning_group_id) {
 492                         my @info = stat($subdir);
 493                         if (@info < 6 || $info[2] eq "" || $info[4] eq "" || $info[5] eq "") {
 494                                 $result = "FAILED";
 495                         } elsif ($info[5] != $grpid) {
 496                                 if (!chown($info[4], $grpid, $subdir)) {
 497                                         $result = "FAILED";
 498                                         warn "chgrp: ($proj) $subdir: $!\n" unless $quiet;
 499                                 } elsif (!chmod($info[2] & 07777, $subdir)) {
 500                                         $result = "FAILED";
 501                                         warn "chmod: ($proj) $subdir: $!\n" unless $quiet;
 502                                 }
 503                         }
 504                 }
 505         } else {
 506                 $result = "(dryrun)";
 507         }
 508         pmsg($proj, "$subdir/: created", $result);
 509         return $result ne "FAILED";
 510 }
 511
 512 sub check_dperm {
 513         my ($proj, $subdir) = @_;
 514         my $oldmode = (stat($subdir))[2];
 515         if (!defined($oldmode) || $oldmode eq "") {
 516                 warn "chmod: ($proj) $subdir: No such file or directory\n" unless $quiet;
 517                 return 0;
 518         }
 519         my $newmode = ($oldmode & ~07777) | $dmode;
 520         $newmode == $oldmode and return 1;
 521         my $result = "";
 522         if (!$dryrun) {
 523                 if (!chmod($newmode & 07777, $subdir)) {
 524                         $result = "FAILED";
 525                         warn "chmod: ($proj) $subdir: $!\n" unless $quiet;
 526                 }
 527         } else {
 528                 $result = "(dryrun)";
 529         }
 530         pmsg($proj, "$subdir/:", get_mode_perm($oldmode), '->', get_mode_perm($newmode), $result);
 531         return $result ne "FAILED";
 532 }
 533
 534 sub change_dpermrwx {
 535         my ($proj, $subdir) = @_;
 536         my $oldmode = (stat($subdir))[2];
 537         if (!defined($oldmode) || $oldmode eq "") {
 538                 warn "chmod: ($proj) $subdir: No such file or directory\n" unless $quiet;
 539                 return 0;
 540         }
 541         my $newmode = $oldmode | ($wall ? 0777 : 0775);
 542         $newmode == $oldmode and return 1;
 543         my $result = "";
 544         if (!$dryrun) {
 545                 if (!chmod($newmode & 07777, $subdir)) {
 546                         $result = "FAILED";
 547                         warn "chmod: ($proj) $subdir: $!\n" unless $quiet;
 548                 }
 549         } else {
 550                 $result = "(dryrun)";
 551         }
 552         pmsg($proj, "$subdir/:", get_mode_perm($oldmode), '->', get_mode_perm($newmode), $result);
 553         return $result ne "FAILED";
 554 }
 555
 556 sub change_dpermrx {
 557         my ($proj, $subdir) = @_;
 558         $subdir =~ s,^\./,,;
 559         my $oldmode = (stat($subdir))[2];
 560         if (!defined($oldmode) || $oldmode eq "") {
 561                 warn "chmod: ($proj) $subdir: No such file or directory\n" unless $quiet;
 562                 return 0;
 563         }
 564         my $newmode = $oldmode | 0555;
 565         $newmode == $oldmode and return 1;
 566         my $result = "";
 567         if (!$dryrun) {
 568                 if (!chmod($newmode & 07777, $subdir)) {
 569                         $result = "FAILED";
 570                         warn "chmod: ($proj) $subdir: $!\n" unless $quiet;
 571                 }
 572         } else {
 573                 $result = "(dryrun)";
 574         }
 575         pmsg($proj, "$subdir/:", get_mode_perm($oldmode), '->', get_mode_perm($newmode), $result);
 576         return $result ne "FAILED";
 577 }
 578
 579 sub check_fperm {
 580         my ($proj, $file) = @_;
 581         my $oldmode = (stat($file))[2];
 582         if (!defined($oldmode) || $oldmode eq "") {
 583                 warn "chmod: ($proj) $file: No such file or directory\n" unless $quiet;
 584                 return 0;
 585         }
 586         my $newmode = ($oldmode & ~07777) | $fmode;
 587         $newmode == $oldmode and return 1;
 588         my $result = "";
 589         if (!$dryrun) {
 590                 if (!chmod($newmode & 07777, $file)) {
 591                         $result = "FAILED";
 592                         warn "chmod: ($proj) $file: $!\n" unless $quiet;
 593                 }
 594         } else {
 595                 $result = "(dryrun)";
 596         }
 597         pmsg($proj, "$file:", get_mode_perm($oldmode), '->', get_mode_perm($newmode), $result);
 598         return $result ne "FAILED";
 599 }
 600
 601 sub check_fpermr {
 602         my ($proj, $file) = @_;
 603         $file =~ s,^\./,,;
 604         my $oldmode = (stat($file))[2];
 605         if (!defined($oldmode) || $oldmode eq "") {
 606                 warn "chmod: ($proj) $file: No such file or directory\n" unless $quiet;
 607                 return 0;
 608         }
 609         my $newmode = $oldmode | 0444;
 610         $newmode == $oldmode and return 1;
 611         my $result = "";
 612         if (!$dryrun) {
 613                 if (!chmod($newmode & 07777, $file)) {
 614                         $result = "FAILED";
 615                         warn "chmod: ($proj) $file: $!\n" unless $quiet;
 616                 }
 617         } else {
 618                 $result = "(dryrun)";
 619         }
 620         pmsg($proj, "$file:", get_mode_perm($oldmode), '->', get_mode_perm($newmode), $result);
 621         return $result ne "FAILED";
 622 }
 623
 624 sub check_fpermnox {
 625         my ($proj, $file) = @_;
 626         $file =~ s,^\./,,;
 627         my $oldmode = (stat($file))[2];
 628         if (!defined($oldmode) || $oldmode eq "") {
 629                 warn "chmod: ($proj) $file: No such file or directory\n" unless $quiet;
 630                 return 0;
 631         }
 632         my $newmode = $oldmode & ~0111;
 633         $newmode == $oldmode and return 1;
 634         my $result = "";
 635         if (!$dryrun) {
 636                 if (!chmod($newmode & 07777, $file)) {
 637                         $result = "FAILED";
 638                         warn "chmod: ($proj) $file: $!\n" unless $quiet;
 639                 }
 640         } else {
 641                 $result = "(dryrun)";
 642         }
 643         pmsg($proj, "$file:", get_mode_perm($oldmode), '->', get_mode_perm($newmode), $result);
 644         return $result ne "FAILED";
 645 }
 646
 647 sub change_group {
 648         my ($proj, $item, $grpid) = @_;
 649         $item =~ s,^\./,,;
 650         my @info = stat($item);
 651         if (@info < 6 || $info[2] eq "" || $info[4] eq "" || $info[5] eq "") {
 652                 warn "chgrp: ($proj) $item: No such file or directory\n" unless $quiet;
 653                 return 0;
 654         }
 655         $info[5] == $grpid and return 1;
 656         my $result = "";
 657         if (!$dryrun) {
 658                 if (!chown($info[4], $grpid, $item)) {
 659                         $result = "FAILED";
 660                         warn "chgrp: ($proj) $item: $!\n" unless $quiet;
 661                 } elsif (!chmod($info[2] & 07777, $item)) {
 662                         $result = "FAILED";
 663                         warn "chmod: ($proj) $item: $!\n" unless $quiet;
 664                 }
 665         } else {
 666                 $result = "(dryrun)";
 667         }
 668         my $isdir = ((($info[2] >> 12) & 017) == 004) ? '/' : '';
 669         pmsg($proj, "$item$isdir: group", get_grp_nam($info[5]), '->', get_grp_nam($grpid), $result);
 670         return $result ne "FAILED";
 671 }
 672
 673 my $wrote; BEGIN {$wrote = ""}
 674 sub pmsg {
 675         my $proj = shift;
 676         my $msg = join(" ", @_);
 677         $msg =~ s/\s+$//;
 678         my $prefix = "";
 679         if (!$hdr) {
 680                 $prefix = $wrote . $proj . ":\n";
 681                 $hdr = 1;
 682         }
 683         print $prefix, "  ", join(' ', @_), "\n";
 684         $wrote = "\n";
 685 }
 686
 687 my %ftypes;
 688 BEGIN {%ftypes = (
 689         000 => '?',
 690         001 => 'p',
 691         002 => 'c',
 692         003 => '?',
 693         004 => 'd',
 694         005 => '?',
 695         006 => 'b',
 696         007 => '?',
 697         010 => '-',
 698         011 => '?',
 699         012 => 'l',
 700         013 => '?',
 701         014 => 's',
 702         015 => '?',
 703         016 => 'w',
 704         017 => '?'
 705 )}
 706 my %fperms;
 707 BEGIN {%fperms = (
 708         0 => '---',
 709         1 => '--x',
 710         2 => '-w-',
 711         3 => '-wx',
 712         4 => 'r--',
 713         5 => 'r-x',
 714         6 => 'rw-',
 715         7 => 'rwx'
 716 )}
 717
 718 sub get_mode_perm {
 719         my $mode = $_[0];
 720         my $str = $ftypes{($mode >> 12) & 017} .
 721                 $fperms{($mode >> 6) & 7} .
 722                 $fperms{($mode >> 3) & 7} .
 723                 $fperms{$mode & 7};
 724         substr($str,3,1) = ($mode & 0100) ? 's' : 'S' if $mode & 04000;
 725         substr($str,6,1) = ($mode & 0010) ? 's' : 'S' if $mode & 02000;
 726         substr($str,9,1) = ($mode & 0001) ? 't' : 'T' if $mode & 01000;
 727         return $str;
 728 }
 729
 730 sub get_perm {
 731         my $mode = (stat($_[0]))[2];
 732         defined($mode) or return '??????????';
 733         return get_mode_perm($mode);
 734 }
 735
 736 sub get_grp_nam {
 737         my $grpid = $_[0];
 738         defined($grpid) or return '?';
 739         my $grpnm = scalar(getgrgid($grpid));
 740         return defined($grpnm) && $grpnm ne "" ? $grpnm : $grpid;
 741 }
 742
 743 sub get_grp {
 744         my $grp = (stat($_[0]))[5];
 745         defined($grp) or return '?';
 746         return get_grp_nam($grp);
 747 }
 748
 749 __END__
 750
 751 =head1 NAME
 752
 753 update-all-config.pl - Update all projects' config settings
 754
 755 =head1 SYNOPSIS
 756
 757 update-all-config.pl [<options>] [<projname>]...
 758
 759  Options:
 760    -h | --help                  detailed instructions
 761    -V | --version               show version
 762    -n | --dry-run               show what would be done but don't do it
 763    -f | --force                 run without a Config.pm owning_group
 764    -q | --quiet                 suppress change messages
 765
 766  <projname>                     if given, only operate on these projects
 767
 768 =head1 OPTIONS
 769
 770 =over 8
 771
 772 =item B<-h>, B<--help>
 773
 774 Print the full description of update-all-config.pl's options.
 775
 776 =item B<-V>, B<--version>
 777
 778 Print the version of update-all-config.pl.
 779
 780 =item B<-n>, B<--dry-run>
 781
 782 Do not actually make any changes, just show what would be done without
 783 actually doing it.
 784
 785 =item B<-q>, B<--quiet>
 786
 787 Suppress the messages about what's actually being changed.  This option
 788 is ignored if B<--dry-run> is in effect.
 789
 790 The warnings about missing and unknown-to-Girocco projects are also
 791 suppressed by this option.
 792
 793 =item B<-f>, B<--force>
 794
 795 Allow running without a $Girocco::Config::owning_group set.  This is not
 796 recommended as it results in world-writable items being used (instead of
 797 just world-readable).
 798
 799 =item B<<projname>>
 800
 801 If no project names are specified then I<all> projects are processed.
 802
 803 If one or more project names are specified then only those projects are
 804 processed.  Specifying non-existent projects produces a warning for them,
 805 but the rest of the projects specified will still be processed.
 806
 807 Each B<projname> may be either a full absolute path starting with
 808 $Girocco::Config::reporoot or just the project name part with or without
 809 a trailing C<.git>.
 810
 811 Any explicitly specified projects that do exist but are not known to
 812 Girocco will be skipped (with a warning).
 813
 814 =back
 815
 816 =head1 DESCRIPTION
 817
 818 Inspect the C<config> files of Girocco projects (i.e. $GIT_DIR/config) and
 819 look for anomalies and out-of-date settings.
 820
 821 Additionally check the existence and permissions on various files and
 822 directories in the project.
 823
 824 If an explicity specified project is located under $Girocco::Config::reporoot
 825 but is not actually known to Girocco (i.e. it's not in the etc/group file)
 826 then it will be skipped.
 827
 828 By default, any anomalies or out-of-date settings will be corrected with a
 829 message to that effect.  However using B<--dry-run> will only show the
 830 correction(s) which would be made without making them and B<--quiet> will make
 831 the correction(s) without any messages.
 832
 833 Any projects that have a C<$GIT_DIR/.noconfig> file are always skipped (with a
 834 message unless B<--quiet> is used).
 835
 836 =cut