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