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