toolbox/projtool.pl

   1 #!/usr/bin/perl
   2
   3 # projtool.pl - command line Girocco project maintenance tool
   4 # Copyright (C) 2016,2017,2020 Kyle J. McKay.  All rights reserved.
   5 # License GPLv2+: GNU GPL version 2 or later.
   6 # www.gnu.org/licenses/gpl-2.0.html
   7 # This is free software: you are free to change and redistribute it.
   8 # There is NO WARRANTY, to the extent permitted by law.
   9
  10 use strict;
  11 use warnings;
  12 use vars qw($VERSION);
  13 BEGIN {*VERSION = \'1.0.3'}
  14 use File::Basename;
  15 use Digest::MD5 qw(md5_hex);
  16 use IO::Socket;
  17 use Cwd qw(realpath);
  18 use POSIX qw(strftime);
  19 use lib "__BASEDIR__";
  20 use Girocco::Config;
  21 use Girocco::Util;
  22 use Girocco::HashUtil;
  23 use Girocco::CLIUtil;
  24 use Girocco::Project;
  25 use Girocco::User;
  26
  27 exit(&main(@ARGV)||0);
  28
  29 our $help;
  30 BEGIN {my @a; /^(.*)$/s && push(@a, $1) foreach @ARGV; @ARGV=@a;}
  31 BEGIN {$help = <<'HELP'}
  32 Usage: %s [<global option>...] <command> <options>
  33
  34        global options:
  35                   -q | --quiet    suppress warning messages
  36                   -p | --pager    force output to be paginated
  37                   --no-pager      never paginate output
  38
  39        help [<command>]
  40               show full help or just for <command> if given
  41
  42        list [--verbose] [--sort=lcname|name|owner|gid|no] [--owner] [<regexp>]
  43               list all projects (default is --sort=lcname)
  44               limit to project names matching <regex> if given
  45               match <regex> against owner instead of project name with --owner
  46
  47        create [--force] [--no-alternates] [--orphan] [<option>...] <project>
  48               create new project <project> (prompted)
  49               <option> can be:
  50                   --no-alternates skip setup of objects/info/alternates
  51                   --orphan        allow creation of subproject w/o a parent
  52                   -p              use mkdir -p during --orphan creation
  53                   --no-password   set password crypt to invalid value "unknown"
  54                   --no-owner      leave the gitweb.owner config unset
  55                   --mirror=<url>  create a mirror from <url>
  56                   --full-mirror   mirror all refs
  57                   --push[=<list>] create a push project
  58                   --desc=<string> specify project description w/o prompt
  59                   --homepage=<url> specify project homepage URL w/o prompt
  60                   --defaults      do no interactive prompting at all
  61               Using --no-password skips the prompts for password, using
  62               --no-owner skips the prompt for owner and using --mirror=<url>
  63               or --push[=<list>] skips the prompts for mirror URL and
  64               heads-only and push users.  With --defaults if neither
  65               --mirror=<url> nor --push[=<list>] is given then --push will
  66               be implied.  Using --desc=<string> will force a specific
  67               description (including an empty string) and skip the prompt for
  68               it.  Otherwise a non-empty default description will always be
  69               supplied in lieu of an empty or omitted description.
  70
  71        adopt [--force] [--type=mirror|push] [<option>...] <project> [<users>]
  72               adopt project <project>
  73               type of project is guessed if --type=<type> omitted
  74               <users> is same as <newuserslist> for setusers command
  75               <option> can be:
  76                   --dry-run     do all the checks but don't perform adoption
  77                   --verbose     show project info dump (useful with --dry-run)
  78                   --no-users    no push users at all (<users> must be omitted)
  79                   --no-owner    leave the gitweb.owner config totally unchanged
  80                   --owner=<val> set the gitweb.owner config to <val>
  81               Both --no-owner and --owner=<val> may NOT be given, with neither
  82               take owner from preexisting gitweb.owner else use admin setting.
  83               For mirrors <users> is ignored otherwise if no <users> and no
  84               --no-users option the push users list will consist of the single
  85               user name matching the owner or empty if none or more than one.
  86               With --dry-run <project> can be an absolute path to a git dir.
  87
  88        remove [--force] [--really-delete] [--keep-forks] <project>
  89               remove project <project>
  90               do not move to _recyclebin with --really-delete (just rm -rf)
  91               remove projects with forks (by keeping forks) using --keep-forks
  92
  93        show <project>
  94               show project <project>
  95
  96        listheads <project>
  97               list all available heads for <project> and indicate current head
  98
  99        listtags [--verbose] <project>
 100               list all ctags on project <project>
 101
 102        deltags <project> [-i] <tagstodel>
 103               remove any ctags on project <project> present in <tagstodel>
 104               <tagstodel> is space or comma separated list of tags to remove
 105               with -i match against <tagstodel> without regard to letter case
 106
 107        addtags <project> <tagstoadd>
 108               add ctags to project <project>
 109               <tagstoadd> is space or comma separated list of tags to add
 110
 111        chpass [--force] <project> [random | unknown]
 112               change project <project> password (prompted)
 113               with "random" set to random password
 114               with "unknown" set password hash to invalid value "unknown"
 115
 116        checkpw <project>
 117               check project <project> password for a match (prompted)
 118
 119        gc [--force | --auto] [--redelta | --recompress] <project>
 120               run the gc.sh script on project <project>
 121               with --auto let the gc.sh script decide what to do
 122               with --force cause a full gc to take place (force_gc=1)
 123               with neither --auto nor --force do a mini or if needed a full gc
 124               (in other words just touch .needsgc and run gc.sh)
 125               with --redelta a full gc will use pack-objects --no-reuse-delta
 126               with --recompress a full gc uses pack-objects --no-reuse-object
 127               (--no-reuse-delta and --no-reuse-object are accepted as aliases)
 128               unless the global --quiet option is given show_progress=1 is used
 129
 130        update [--force] [--quiet | --summary] <project>
 131               run the update.sh script on project <project>
 132               with --force cause a fetch to always take place (force_update=1)
 133               with --quiet only show errors (show_progress is left unset)
 134               with --summary show progress and ref summary (show_progress=1)
 135               with neither --quiet nor --summary show it all (show_progress=2)
 136
 137        remirror [--force] <project>
 138               initiate a remirror of project <project>
 139
 140        [set]owner [--force] <project> <newowner>
 141               set project <project> owner to <newowner>
 142               without "set" and only 1 arg, just show current project owner
 143
 144        [set]desc [--force] <project> <newdesc>
 145               set project <project> description to <newdesc>
 146               without "set" and only 1 arg, just show current project desc
 147
 148        [set]readme [--force] [--format=<readmetype>] <project> [<newsetting>]
 149               set project <project> readme to <newsetting>
 150               <readmetype> is markdown|plain|html (default is no change)
 151               <newsetting> is automatic|suppressed|-|[@]filename
 152               with "set" <readmetype> and/or <newsetting> is required
 153               without "set" and only 2 args, just show current readme setting
 154
 155        [set]head <project> <newhead>
 156               set project <project> HEAD symbolic ref to <newhead>
 157               without "set" and only 1 arg, just show current project HEAD
 158
 159        [set]bool [--force] <project> <flagname> <boolvalue>
 160               set project <project> boolean <flagname> to <boolvalue>
 161               <flagname> is cleanmirror|reverseorder|summaryonly|statusupdtaes
 162               without "set" and only 2 args, just show current flag value
 163
 164        [set]hooks [--force] <project> local | global | <path>
 165               set project <project> hookspath to local, global or <path>
 166               without "set" and only 1 arg, just show current hookspath
 167
 168        [set]autogchack <project> <boolvalue> | unset
 169               set project <project> autogchack to <boolvalue> or "unset" it
 170               without "set" just show current autogchack setting if enabled
 171               with "set" autogchack must be enabled in Config.pm for the
 172               type of project and maintain-auto-gc-hack.sh is always run
 173
 174        [set]url [--force] <project> <urlname> <newurlvalue>
 175               set project <project> url <urlname> to <newurlvalue>
 176               <urlname> is baseurl|homepage|notifyjson
 177               without "set" and only 2 args, just show current url value
 178
 179        [set]msgs [--force] <project> <msgsname> <eaddrlist>
 180               set project <project> msgs <msgsname> to <addrlist>
 181               <msgsname> is notifymail|notifytag
 182               <eaddrlist> is space or comma separated list of email addresses
 183               without "set" and only 2 args, just show current msgs value
 184
 185        [set]users [--force] <project> <newuserslist>
 186               set push project <project> users list to <newuserslist>
 187               <newuserslist> is space or comma separated list of user names
 188               without "set" and only 1 arg, just show current users list
 189
 190        [set]jsontype <project> <newjsontype>
 191               set project <project> JSON Content-Type to <newjsontype>
 192               <newjsontype> is x-www-form-urlencoded or json
 193               without "set" and only 1 arg, just show current jsontype
 194
 195        [set]jsonsecret <project> <newjsonsecret>
 196               set project <project> JSON secret to <newjsonsecret>
 197               <newjsonsecret> is a string (empty string disables signatures)
 198               without "set" and only 1 arg, just show current jsonsecret
 199
 200        get <project> <fieldname>
 201               show project <project> field <fieldname>
 202               <fieldname> is owner|desc|readme|head|hooks|users|jsontype
 203                       or jsonsecret|<flagname>|autogchack|<urlname>|<msgsname>
 204
 205        set [--force] <project> <fieldname> <newfieldvalue>
 206               set project <project> field <fieldname> to <newfieldvalue>
 207               <fieldname> same as for get
 208               <newfieldvalue> same as for corresponding set... command
 209 HELP
 210
 211 our $quiet;
 212 our $usepager;
 213 our $setopt;
 214 sub die_usage {
 215         my $sub = shift || diename;
 216         if ($sub) {
 217                 die "Invalid arguments to $sub command -- try \"help\"\n";
 218         } else {
 219                 die "Invalid arguments -- try \"help\"\n";
 220         }
 221 }
 222
 223 sub get_readme_len {
 224         my $rm = shift;
 225         defined($rm) or $rm = '';
 226         return "length " . length($rm);
 227 }
 228
 229 sub get_readme_desc {
 230         my $rm = shift;
 231         defined($rm) or $rm = '';
 232         if (length($rm)) {
 233                 my $test = $rm;
 234                 $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
 235                 $test =~ s/\s+//s;
 236                 return $test eq '' ? "suppressed" : "length " . length($rm);
 237         } else {
 238                 return "automatic";
 239         }
 240 }
 241
 242 sub get_ctag_counts {
 243         my $project = shift;
 244         my $compact = shift;
 245         my @ctags = ();
 246         foreach ($project->get_ctag_names) {
 247                 my $val = 0;
 248                 my $ct;
 249                 if (open $ct, '<', $project->{path}."/ctags/$_") {
 250                         my $count = <$ct>;
 251                         close $ct;
 252                         defined $count or $count = '';
 253                         chomp $count;
 254                         $val = $count =~ /^[1-9]\d*$/ ? $count : 1;
 255                 }
 256                 if ($compact) {
 257                         if ($val == 1) {
 258                                 push(@ctags, $_);
 259                         } elsif ($val > 1) {
 260                                 push(@ctags, $_."(".$val.")");
 261                         }
 262                 } else {
 263                         push(@ctags, [$_, $val]) if $val;
 264                 }
 265         }
 266         @ctags;
 267 }
 268
 269 sub get_clean_project {
 270         my $project = get_project(@_);
 271         delete $project->{loaded};
 272         delete $project->{base_path};
 273         delete $project->{ccrypt};
 274         /^orig/i || !defined($project->{$_}) and delete $project->{$_} foreach keys %$project;
 275         $project->{owner} = $project->{email}; delete $project->{email};
 276         $project->{homepage} = $project->{hp}; delete $project->{hp};
 277         $project->{baseurl} = $project->{url}; delete $project->{url};
 278         if (defined($project->{path}) && $project->{path} ne "") {
 279                 my $rp = realpath($project->{path});
 280                 defined($rp) && $rp ne "" and $project->{realpath} = $rp;
 281                 if (-f "$rp/objects/info/packs") {
 282                         my $ipt = (stat _)[9];
 283                         defined($ipt) and $project->{infopackstime} =
 284                                 strftime("%Y-%m-%d %H:%M:%S %z", localtime($ipt));
 285                 }
 286         }
 287         my $owner = $project->{owner};
 288         if ($owner) {
 289                 $owner = lc($owner);
 290                 my @owner_users = map {$owner eq lc($$_[4]) ? $$_[1] : ()} get_all_users;
 291                 $project->{owner_users} = \@owner_users if @owner_users;
 292         }
 293         my $projname = $project->{name};
 294         my @forks = grep {$$_[1] =~ m,^$projname/,} get_all_projects;
 295         $project->{has_forks} = 1 if @forks;
 296         $project->{has_alternates} = 1 if $project->has_alternates;
 297         my @bundles = $project->bundles;
 298         for (my $i = 0; $i < @bundles; ++$i) {
 299                 my $secs = $bundles[$i]->[0];
 300                 $bundles[$i]->[0] = strftime("%Y-%m-%d %H:%M:%S %z", localtime($secs));
 301                 my $sz = $bundles[$i]->[2];
 302                 1 while $sz =~ s/(?<=\d)(\d{3})(?:,|$)/,$1/g;
 303                 $bundles[$i]->[2] = $sz;
 304         }
 305         delete $project->{bundles};
 306         $project->{bundles} = \@bundles if @bundles;
 307         $project->{mirror} = 0 unless $project->{mirror};
 308         $project->{is_empty} = 1 if $project->is_empty;
 309         delete $project->{showpush} unless $project->{showpush};
 310         delete $project->{users} if $project->{mirror};
 311         delete $project->{baseurl} unless $project->{mirror};
 312         delete $project->{banged} unless $project->{mirror};
 313         delete $project->{lastrefresh} unless $project->{mirror};
 314         delete $project->{cleanmirror} unless $project->{mirror};
 315         delete $project->{statusupdates} unless $project->{mirror};
 316         delete $project->{lastparentgc} unless $projname =~ m,/,;
 317         unless ($project->{banged}) {
 318                 delete $project->{bangcount};
 319                 delete $project->{bangfirstfail};
 320                 delete $project->{bangmessagesent};
 321         }
 322         my $projhook = $project->_has_notifyhook;
 323         if (defined($projhook) && $projhook ne "") {
 324                 $project->{notifyhook} = $projhook;
 325         } else {
 326                 delete $project->{notifyhook};
 327         }
 328         $project->{README} = get_readme_desc($project->{README}) if exists($project->{README});
 329         $project->{READMEDATA} = get_readme_len($project->{READMEDATA}) if exists($project->{READMEDATA});
 330         my @tags = get_ctag_counts($project, 1);
 331         $project->{tags} = \@tags if @tags;
 332         my $projconfig = read_config_file_hash($project->{path}."/config");
 333         if (defined($projconfig) && defined($projconfig->{"core.hookspath"})) {
 334                 my $ahp = $projconfig->{"core.hookspath"};
 335                 my $rahp = realpath($ahp);
 336                 my $lhp = $project->{path}."/hooks";
 337                 my $rlhp = realpath($lhp);
 338                 my $ghp = $Girocco::Config::reporoot."/_global/hooks";
 339                 my $rghp = realpath($ghp);
 340                 $project->{has_local_hooks} = 1 if
 341                         defined($rahp) && defined($rlhp) && $rahp eq $rlhp;
 342                 $project->{has_global_hooks} = 1 if
 343                         defined($rahp) && defined($rghp) && $rahp eq $rghp;
 344                 $project->{hookspath} = $ahp unless $ahp eq $lhp || $ahp eq $ghp;
 345         }
 346         $project;
 347 }
 348
 349 sub clean_addrlist {
 350         my %seen = ();
 351         my @newlist = ();
 352         foreach (split(/[,\s]+/, $_[0])) {
 353                 next unless $_;
 354                 $seen{lc($_)} = 1, push(@newlist, $_) unless $seen{lc($_)};
 355         }
 356         return join(($_[1]||","), @newlist);
 357 }
 358
 359 sub valid_addrlist {
 360         my $cleaned = clean_addrlist(join(" ", @_));
 361         return 1 if $cleaned eq "";
 362         valid_email_multi($cleaned) && length($cleaned) <= 512;
 363 }
 364
 365 sub validate_users {
 366         my ($userlist, $force, $nodie) = @_;
 367         my @newusers = ();
 368         my $badlist = 0;
 369         my %seenuser = ();
 370         my $mobok = $Girocco::Config::mob && $Girocco::Config::mob eq "mob";
 371         my %users = map({($$_[1] => $_)} get_all_users);
 372         foreach (split(/[\s,]+/, $userlist)) {
 373                 if (exists($users{$_}) || $_ eq "everyone" || ($mobok && $_ eq "mob")) {
 374                         $seenuser{$_}=1, push(@newusers, $_) unless $seenuser{$_};
 375                         next;
 376                 }
 377                 if (Girocco::User::does_exist($_, 1)) {
 378                         if ($force) {
 379                                 $seenuser{$_}=1, push(@newusers, $_) unless $seenuser{$_};
 380                         } else {
 381                                 $badlist = 1;
 382                                 warn "refusing to allow questionable user \"$_\" without --force\n" unless $nodie && $quiet;
 383                         }
 384                         next;
 385                 }
 386                 $badlist = 1;
 387                 warn "invalid user: \"$_\"\n" unless $nodie && $quiet
 388         }
 389         die if $badlist && !$nodie;
 390         return @newusers;
 391 }
 392
 393 sub is_default_desc {
 394         # "Unnamed repository; edit this file 'description' to name the repository."
 395         # "Unnamed repository; edit this file to name it for gitweb."
 396         local $_ = shift;
 397         return 0 unless defined($_);
 398         /Unnamed\s+repository;/i && /\s+edit\s+this\s+file\s+/i && /\s+to\s+name\s+/i;
 399 }
 400
 401 sub valid_desc {
 402         my $test = shift;
 403         chomp $test;
 404         return 0 if $test =~ /[\r\n]/;
 405         $test =~ s/\s\s+/ /g;
 406         $test =~ s/^\s+//;
 407         $test =~ s/\s+$//;
 408         return $test ne '';
 409 }
 410
 411 sub clean_desc {
 412         my $desc = shift;
 413         defined($desc) or $desc = '';
 414         chomp $desc;
 415         $desc = to_utf8($desc, 1);
 416         $desc =~ s/\s\s+/ /g;
 417         $desc =~ s/^\s+//;
 418         $desc =~ s/\s+$//;
 419         return $desc;
 420 }
 421
 422 sub parse_options {
 423         Girocco::CLIUtil::_parse_options(
 424                 sub {
 425                         warn((($_[0]eq'?')?"unrecognized":"missing argument for")." option \"$_[1]\"\n")
 426                                 unless $quiet;
 427                         die_usage;
 428                 }, @_);
 429 }
 430
 431 sub cmd_list {
 432         my %sortsub = (
 433                 lcname => sub {lc($$a[1]) cmp lc($$b[1])},
 434                 name => sub {$$a[1] cmp $$b[1]},
 435                 gid => sub {$$a[3] <=> $$b[3]},
 436                 owner => sub {lc($$a[4]) cmp lc($$b[4]) || lc($$a[1]) cmp lc($$b[1])},
 437                 no => sub {$$a[0] <=> $$b[0]},
 438         );
 439         my $sortopt = 'lcname';
 440         my ($verbose, $owner);
 441         parse_options(":sort" => \$sortopt, verbose => \$verbose, owner => \$owner);
 442         my $regex;
 443         if (@ARGV) {
 444                 my $val = shift @ARGV;
 445                 $regex = qr($val) or die "bad regex \"$val\"\n";
 446         }
 447         !@ARGV && exists($sortsub{$sortopt}) or die_usage;
 448         my $sortsub = $sortsub{$sortopt};
 449         my $grepsub = defined($regex) ? ($owner ? sub {$$_[4] =~ /$regex/} : sub {$$_[1] =~ /$regex/}) : sub {1};
 450         my @projects = sort($sortsub grep {&$grepsub} get_all_projects);
 451         if ($verbose) {
 452                 print map(sprintf("%s\n", join(":", (@$_)[1..5])), @projects);
 453         } else {
 454                 print map(sprintf("%s: %s\n", $$_[1], $$_[5] =~ /^:/ ? "<mirror>" : $$_[5]), @projects);
 455         }
 456         return 0;
 457 }
 458
 459 sub cmd_create {
 460         my ($force, $noalternates, $orphanok, $optp, $nopasswd, $noowner, $defaults, $ispush, $pushusers,
 461                 $ismirror, $desc, $fullmirror, $homepage);
 462         parse_options(
 463                 force => \$force, "no-alternates" => \$noalternates, orphan => \$orphanok, p => \$optp,
 464                 "no-password" => \$nopasswd, "no-owner" => \$noowner, defaults => \$defaults,
 465                 "push" => \$ispush, ":push" => \$pushusers, ":mirror" => \$ismirror, ":desc" => \$desc,
 466                 ":description" => \$desc, "full-mirror" => \$fullmirror, ":homepage" => \$homepage);
 467         @ARGV == 1 or die_usage;
 468         !defined($pushusers) || defined($ispush) or $ispush = 1;
 469         defined($ismirror) && $ismirror =~ /^\s*$/ and die "--mirror url must not be empty\n";
 470         die "--mirror and --push are mutually exclusive options\n" if $ismirror && $ispush;
 471         die "--full-mirror requires use of --mirror=<url> option\n" if $fullmirror && !$ismirror;
 472         !$defaults || defined($ispush) || defined($ismirror) or $ispush = 1;
 473         !$defaults || defined($nopasswd) or $nopasswd = 1;
 474         !$defaults || defined($noowner) or $noowner = 1;
 475         !defined($ispush) || defined($pushusers) or $pushusers = "";
 476         my $projname = $ARGV[0];
 477         $projname =~ s/\.git$//i;
 478         Girocco::Project::does_exist($projname, 1) and die "Project already exists: \"$projname\"\n";
 479         if (!Girocco::Project::valid_name($projname, $orphanok, $optp)) {
 480                 warn "Refusing to create orphan project without --orphan\n"
 481                         if !$quiet && !$orphanok && Girocco::Project::valid_name($projname, 1, 1);
 482                 warn "Required orphan parent directory does not exist (use -p): ",
 483                         $Girocco::Config::reporoot.'/'.Girocco::Project::get_forkee_name($projname), "\n"
 484                         if !$quiet && $orphanok && Girocco::Project::valid_name($projname, 1, 1);
 485                 die "Invalid project name: \"$projname\"\n";
 486         }
 487         my ($forkee, $project) = ($projname =~ m#^(.*/)?([^/]+)$#);
 488         my $newtype = $forkee ? 'fork' : 'project';
 489         if (length($project) > 64) {
 490                 die "The $newtype name is longer than 64 characters.  Do you really need that much?\n"
 491                         unless $force;
 492                 warn "Allowing $newtype name longer than 64 characters with --force\n" unless $quiet;
 493         }
 494         unless ($Girocco::Config::push || $Girocco::Config::mirror) {
 495                 die "Project creation disabled (no mirrors or push projects allowed)\n" unless $force;
 496                 warn "Continuing with --force even though both push and mirror projects are disabled\n" unless $quiet;
 497         }
 498         print "Enter settings for new project \"$projname\"\n" unless $defaults;
 499         my %settings = ();
 500         $settings{noalternates} = $noalternates;
 501         if ($nopasswd) {
 502                 $settings{crypt} = "unknown";
 503         } else {
 504                 my $np1 = prompt_noecho_nl_or_die("Admin password for project $projname (echo is off)");
 505                 $np1 ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
 506                 my $np2 = prompt_noecho_nl_or_die("Retype admin password for project $projname");
 507                 $np1 eq $np2 or die "Our high-paid security consultants have determined that\n" .
 508                         "the admin passwords you have entered do not match each other.\n";
 509                 $settings{crypt} = scrypt_sha1($np1);
 510         }
 511         my $owner = "";
 512         unless ($noowner) {
 513                 $owner = prompt_or_die("Owner/email name for project $projname");
 514                 unless (valid_email($owner)) {
 515                         unless ($force) {
 516                                 warn "Your email sure looks weird...?\n";
 517                                 redo;
 518                         }
 519                         warn "Allowing invalid email with --force\n" unless $quiet;
 520                 }
 521                 if (length($owner) > 96) {
 522                         unless ($force) {
 523                                 warn "Your email is longer than 96 characters.  Do you really need that much?\n";
 524                                 redo;
 525                         }
 526                         warn "Allowing email longer than 96 characters with --force\n" unless $quiet;
 527                 }
 528         }
 529         $settings{email} = $owner;
 530         my $baseurl = "";
 531         my $checkmirror = sub {
 532                 my $checkurl = shift;
 533                 unless (valid_repo_url($checkurl)) {
 534                         unless ($force) {
 535                                 warn "Invalid mirror URL: \"$checkurl\"\n";
 536                                 return undef;
 537                         }
 538                         warn "Allowing invalid mirror URL with --force\n" unless $quiet;
 539                 }
 540                 if ($Girocco::Config::restrict_mirror_hosts) {
 541                         my $mh = extract_url_hostname($checkurl);
 542                         unless (is_dns_hostname($mh)) {
 543                                 unless ($force) {
 544                                         warn "Invalid non-DNS mirror URL: \"$checkurl\"\n";
 545                                         return undef;
 546                                 }
 547                                 warn "Allowing non-DNS mirror URL with --force\n" unless $quiet;
 548                         }
 549                         if (is_our_hostname($mh)) {
 550                                 unless ($force) {
 551                                         warn "Invalid same-host mirror URL: \"$checkurl\"\n";
 552                                         return undef;
 553                                 }
 554                                 warn "Allowing same-host mirror URL with --force\n" unless $quiet;
 555                         }
 556                 }
 557                 return $checkurl;
 558         };
 559         if ($ispush || $ismirror) {
 560                 !$ispush || $force || $Girocco::Config::push or
 561                         die "Push projects are disabled, create a mirror (or use --force)\n";
 562                 !$ismirror || $force || $Girocco::Config::mirror or
 563                         die "Mirror projects are disabled, create a push project (or use --force)\n";
 564                 if ($ismirror) {
 565                         &$checkmirror($ismirror) or die "Invalid --mirror URL\n";
 566                         $baseurl = $ismirror;
 567                         $settings{url} = $baseurl;
 568                         $settings{cleanmirror} = $fullmirror ? 0 : 1;
 569                 } else {
 570                         my @newusers = ();
 571                         if ($pushusers !~ /^[\s,]*$/) {
 572                                 eval {@newusers = validate_users($pushusers, $force); 1;} or
 573                                         die "Invalid --push user list\n";
 574                         }
 575                         $settings{users} = \@newusers;
 576                 }
 577         } elsif ($force || $Girocco::Config::mirror) {{
 578                 if ($force || $Girocco::Config::push) {
 579                         $baseurl = prompt_or_die("URL to mirror from (leave blank for push project)", "");
 580                 } else {{
 581                         $baseurl = prompt_or_die("URL to mirror from");
 582                         unless ($baseurl ne "") {
 583                                 warn "Push projects are disabled, you must enter a mirror URL (or use --force)\n";
 584                                 redo;
 585                         }
 586                 }}
 587                 if ($baseurl ne "") {
 588                         &$checkmirror($baseurl) or redo;
 589                         $settings{url} = $baseurl;
 590                         $settings{cleanmirror} =
 591                                 ynprompt_or_die("Mirror only heads, tags and notes (Y/n)", "Yes");
 592                 }
 593         }}
 594         my $mirror = ($baseurl eq "") ? 0 : 1;
 595         my $checkdesc = sub {
 596                 my $d = shift;
 597                 if (length($d) > 1024) {
 598                         unless ($force) {
 599                                 warn "Short description length greater than 1024 characters!\n";
 600                                 return undef;
 601                         }
 602                         warn "Allowing short description length greater than 1024 characters\n" unless $quiet;
 603                 }
 604                 return $d;
 605         };
 606         if (defined($desc)) {
 607                 $desc =~ s/^\s+//; $desc =~ s/\s+$//;
 608                 $desc eq "" || &$checkdesc($desc) or
 609                         die "Invalid --desc description\n";
 610         } elsif (!$defaults) {
 611                 $desc = prompt_or_die("Short description", "");
 612                 $desc =~ s/^\s+//; $desc =~ s/\s+$//;
 613                 $desc eq "" || &$checkdesc($desc) or redo;
 614                 $desc = undef if $desc eq "";
 615         }
 616         defined($desc) or $desc = $mirror ? "Mirror of $baseurl" : "Push project $projname";
 617         $settings{desc} = $desc;
 618         my $checkhp = sub {
 619                 my $hpurl = shift;
 620                 unless (valid_web_url($hpurl)) {
 621                         unless ($force) {
 622                                 warn "Invalid home page URL: \"$hpurl\"\n";
 623                                 return undef;
 624                         }
 625                         warn "Allowing invalid home page URL with --force\n" unless $quiet;
 626                 }
 627                 return $hpurl;
 628         };
 629         if (defined($homepage)) {
 630                 $homepage =~ s/^\s+//; $homepage =~ s/\s+$//;
 631                 $homepage eq "" || &$checkhp($homepage) or
 632                         die "Invalid --homepage URL\n";
 633         } elsif (!$defaults) {
 634                 $homepage = prompt_or_die("Home page URL", "");
 635                 $homepage =~ s/^\s+//; $homepage =~ s/\s+$//;
 636                 $homepage eq "" || &$checkhp($homepage) or redo;
 637                 $homepage = undef if $homepage eq "";
 638         }
 639         $settings{hp} = $homepage;
 640         my $jsonurl = "";
 641         if (!$defaults) {
 642                 $jsonurl = prompt_or_die("JSON notify POST URL", "");
 643                 if ($jsonurl ne "" && !valid_web_url($jsonurl)) {
 644                         unless ($force) {
 645                                 warn "Invalid JSON notify POST URL: \$jsonurl\"\n";
 646                                 redo;
 647                         }
 648                         warn "Allowing invalid JSON notify POST URL with --force\n" unless $quiet;
 649                 }
 650         }
 651         $settings{notifyjson} = $jsonurl;
 652         my $commitaddrs = "";
 653         if (!$defaults) {
 654                 $commitaddrs = clean_addrlist(prompt_or_die("Commit notify email addr(s)", ""));
 655                 if ($commitaddrs ne "" && !valid_addrlist($commitaddrs)) {
 656                         unless ($force) {
 657                                 warn"invalid commit notify email address list (use --force to accept): \"$commitaddrs\"\n";
 658                                 redo;
 659                         }
 660                         warn "using invalid commit notify email address list with --force\n" unless $quiet;
 661                 }
 662         }
 663         $settings{notifymail} = $commitaddrs;
 664         $settings{reverseorder} = 1;
 665         $settings{reverseorder} = ynprompt_or_die("Oldest-to-newest commit order in emails", "Yes")
 666                 if !$defaults && $commitaddrs ne "";
 667         $settings{summaryonly} = ynprompt_or_die("Summary only (no diff) in emails", "No")
 668                 if !$defaults && $commitaddrs ne "";
 669         my $tagaddrs = "";
 670         if (!$defaults) {
 671                 $tagaddrs = clean_addrlist(prompt_or_die("Tag notify email addr(s)", ""));
 672                 if ($tagaddrs ne "" && !valid_addrlist($tagaddrs)) {
 673                         unless ($force) {
 674                                 warn"invalid tag notify email address list (use --force to accept): \"$tagaddrs\"\n";
 675                                 redo;
 676                         }
 677                         warn "using invalid tag notify email address list with --force\n" unless $quiet;
 678                 }
 679         }
 680         $settings{notifytag} = $tagaddrs;
 681         if (!$mirror && !$ispush) {
 682                 my @newusers = ();
 683                 {
 684                         my $userlist = prompt_or_die("Push users", join(",", @newusers));
 685                         eval {@newusers = validate_users($userlist, $force); 1;} or redo;
 686                 }
 687                 $settings{users} = \@newusers;
 688         }
 689         my $newproj = Girocco::Project->ghost($projname, $mirror, $orphanok, $optp)
 690                 or die "Girocco::Project->ghost call failed\n";
 691         my ($k, $v);
 692         $newproj->{$k} = $v while ($k, $v) = each(%settings);
 693         my $killowner = sub {
 694                 system($Girocco::Config::git_bin, '--git-dir='.$newproj->{path},
 695                         'config', '--unset', "gitweb.owner");
 696         };
 697         if ($mirror) {
 698                 $newproj->premirror or die "Girocco::Project->premirror failed\n";
 699                 !$noowner or &$killowner;
 700                 $newproj->clone or die "Girocco::Project->clone failed\n";
 701                 warn "Project $projname created and cloning successfully initiated.\n"
 702                         unless $quiet;
 703         } else {
 704                 $newproj->conjure or die "Girocco::Project->conjure failed\n";
 705                 !$noowner or &$killowner;
 706                 warn "New push project fork is empty due to use of --no-alternates\n"
 707                         if !$quiet && $projname =~ m,/, && $noalternates;
 708                 warn "Project $projname successfully created.\n" unless $quiet;
 709         }
 710         return 0;
 711 }
 712
 713 sub git_config {
 714         my $gd = shift;
 715         system($Girocco::Config::git_bin, "--git-dir=$gd", 'config', @_) == 0
 716                 or die "\"git --git-dir='$gd' config ".join(" ", @_)."\" failed.\n";
 717 }
 718
 719 sub cmd_adopt {
 720         my ($force, $type, $nousers, $dryrun, $noowner, $owner, $users, $verbose);
 721         parse_options(force => \$force, ":type" => \$type, "no-users" => \$nousers, "dry-run" => \$dryrun,
 722                 "no-owner" => \$noowner,":owner" => \$owner, quiet => \$quiet, q =>\$quiet, verbose => \$verbose);
 723         @ARGV or die "Please give project name on command line.\n";
 724         my $projname = shift @ARGV;
 725         (!$noowner || !defined($owner)) && (!$nousers || !@ARGV) or die_usage;
 726         !defined($type) || $type eq "mirror" || $type eq "push" or die_usage;
 727         defined($type) or $type = "";
 728         my $projdir;
 729         if ($dryrun && $projname =~ m,^/[^.\s/\\:], && is_git_dir(realpath($projname))) {
 730                 $projdir = realpath($projname);
 731                 $projname = $projdir;
 732                 $projname =~ s/\.git$//i;
 733                 $projname =~ s,/+$,,;
 734                 $projname =~ s,^.*/,,;
 735                 $projname ne "" or $projname = $projdir;
 736         } else {
 737                 $projname =~ s/\.git$//i;
 738                 $projname ne "" or die "Invalid project name \"\".\n";
 739                 unless (Girocco::Project::does_exist($projname, 1)) {
 740                         Girocco::Project::valid_name($projname, 1, 1)
 741                                 or die "Invalid project name \"$projname\".\n";
 742                         die "No such project to adopt: $projname\n";
 743                 }
 744                 defined(Girocco::Project->load($projname))
 745                         and die "Project already known (no need to adopt): $projname\n";
 746                 $projdir = $Girocco::Config::reporoot . "/" . $projname . ".git";
 747                 is_git_dir($projdir) or die "Not a git directory: \"$projdir\"\n";
 748         }
 749         my $config = read_config_file($projdir . "/config");
 750         my %config = ();
 751         %config = map {($$_[0], defined($$_[1])?$$_[1]:"true")} @$config if defined($config);
 752         git_bool($config{"core.bare"}) or die "Not a bare git repository: \"$projdir\"\n";
 753         defined(read_HEAD_symref($projdir)) or die "Project with non-symbolic HEAD ref: \"$projdir\"\n";
 754         @ARGV and $users = [validate_users(join(" ", @ARGV), $force, 1)];
 755         my $desc = "";
 756         if (-e "$projdir/description") {
 757                 open my $fd, '<', "$projdir/description" or die "Cannot open \"$projdir/description\": $!\n";
 758                 {
 759                         local $/;
 760                         $desc = <$fd>;
 761                 }
 762                 close $fd;
 763                 defined $desc or $desc = "";
 764                 chomp $desc;
 765                 $desc = to_utf8($desc, 1);
 766                 is_default_desc($desc) and $desc = "";
 767                 if ($desc ne "" && !valid_desc($desc)) {
 768                         die "invalid 'description' file contents (use --force to accept): \"$desc\"\n"
 769                                 unless $force;
 770                         warn "using invalid 'description' file contents  with --force\n" unless $quiet;
 771                 }
 772                 $desc = clean_desc($desc);
 773                 if (length($desc) > 1024) {
 774                         die "description longer than 1024 chars (use --force to accept): \"$desc\"\n"
 775                                 unless $force;
 776                         warn "using longer than 1024 char description with --force\n" unless $quiet;
 777                 }
 778         }
 779         my $readme = "";
 780         my $origreadme = "";
 781         my $readmedata = "";
 782         my $origreadmedata = "";
 783         my $readmetype = Girocco::Project::_normalize_rmtype($config{"girocco.readmetype"},1);
 784         if (-e "$projdir/README.html") {
 785                 open my $fd, '<', "$projdir/README.html" or die "Cannot open \"$projdir/README.html\": $!\n";
 786                 {
 787                         local $/;
 788                         $readme = <$fd>;
 789                 }
 790                 close $fd;
 791                 defined $readme or $readme = "";
 792                 $readme = to_utf8($readme, 1);
 793                 $readme =~ s/\r\n?/\n/gs;
 794                 $readme =~ s/^\s+//s;
 795                 $readme =~ s/\s+$//s;
 796                 $readme eq "" or $readme .= "\n";
 797                 $origreadme = $readme;
 798                 if (-e "$projdir/README.dat") {
 799                         open my $fd2, '<', "$projdir/README.dat" or die "Cannot open \"$projdir/README.dat\": $!\n";
 800                         {
 801                                 local $/;
 802                                 $readmedata = <$fd2>;
 803                         }
 804                         close $fd2;
 805                         defined $readmedata or $readmedata = "";
 806                         $readmedata = to_utf8($readmedata, 1);
 807                         $readmedata =~ s/\r\n?/\n/gs;
 808                         $readmedata =~ s/^\s+//s;
 809                         $readmedata =~ s/\s+$//s;
 810                         $readmedata eq "" or $readmedata .= "\n";
 811                         $origreadmedata = $readmedata;
 812                 }
 813                 !$readmetype && length($readme) && !length($readmedata) and do {
 814                         # the old HTML format
 815                         $readmetype = 'HTML';
 816                         $readmedata = $readme;
 817                 };
 818                 if (length($readmedata) > 8192) {
 819                         die "readme greater than 8192 chars is too long (use --force to override)\n"
 820                                 unless $force;
 821                         warn "using readme greater than 8192 chars with --force\n" unless $quiet;
 822                 }
 823                 {
 824                         my $dummy = {READMEDATA => $readmedata, rmtype => $readmetype, name => $projname};
 825                         my ($cnt, $err) = Girocco::Project::_lint_readme($dummy, 0);
 826                         if ($cnt) {
 827                                 my $msg = "README: $cnt error";
 828                                 $msg .= "s" unless $cnt == 1;
 829                                 print STDERR "$msg\n", "-" x length($msg), "\n", $err
 830                                         unless $force && $quiet;
 831                                 exit(255) unless $force && $readmetype eq 'HTML';
 832                                 warn "$projname: using invalid raw HTML with --force\n" unless $quiet;
 833                         } else {
 834                                 $readme = $dummy->{README};
 835                         }
 836                 }
 837         }
 838         $readmetype or $readmetype = Girocco::Project::_normalize_rmtype(""); # use default type
 839         # Inspect any remotes now
 840         # Yes, Virginia, remote urls can be multi-valued
 841         my %remotes = ();
 842         foreach (@$config) {
 843                 my ($k,$v) = @$_;
 844                 next unless $k =~ /^remote\.([^\/].*?)\.([^.]+)$/; # remote name cannot start with "/"
 845                 my ($name, $subkey) = ($1, $2);
 846                 $remotes{$name}->{skip} = git_bool($v,1), next if $subkey eq "skipdefaultupdate" || $subkey eq "skipfetchall";
 847                 $remotes{$name}->{mirror} = git_bool($v,1), next if $subkey eq "mirror"; # we might want this
 848                 $remotes{$name}->{vcs} = $v, next if defined($v) && $v !~ /^\s*$/ && $subkey eq "vcs";
 849                 push(@{$remotes{$name}->{$subkey}}, $v), next if defined($v) && $v !~ /^\s*$/ &&
 850                         ($subkey eq "url" || $subkey eq "fetch" || $subkey eq "push" || $subkey eq "pushurl");
 851         }
 852         # remotes.default is the default remote group to fetch for "git remote update" otherwise --all
 853         # the remote names in a group are separated by runs of [ \t\n] characters
 854         # remote names "", ".", ".." and any name starting with "/" are invalid
 855         # a remote with no url or vcs setting is not considered valid
 856         my @check = ();
 857         my $usingall = 0;
 858         if (exists($config{"remotes.default"})) {
 859                 foreach (split(/[ \t\n]+/, $config{"remotes.default"})) {
 860                         next unless exists($remotes{$_});
 861                         my $rmt = $remotes{$_};
 862                         next if !exists($rmt->{url}) && !$rmt->{vcs};
 863                         push(@check, $_);
 864                 }
 865         } else {
 866                 $usingall = 1;
 867                 my %seenrmt = ();
 868                 foreach (@$config) {
 869                         my ($k,$v) = @$_;
 870                         next unless $k =~ /^remote\.([^\/].*?)\.[^.]+$/;
 871                         next if $seenrmt{$1};
 872                         $seenrmt{$1} = 1;
 873                         next unless exists($remotes{$1});
 874                         my $rmt = $remotes{$1};
 875                         next if $rmt->{skip} || (!exists($rmt->{url}) && !$rmt->{vcs});
 876                         push(@check, $1);
 877                 }
 878         }
 879         my @needskip = (); # remotes that need skipDefaultUpdate set to true
 880         my $foundvcs = 0;
 881         my $foundfetch = 0;
 882         my $foundfetchwithmirror = 0;
 883         foreach (@check) {
 884                 my $rmt = $remotes{$_};
 885                 push(@needskip, $_) if $usingall && !exists($rmt->{fetch});
 886                 next unless exists($rmt->{fetch});
 887                 ++$foundfetch;
 888                 ++$foundfetchwithmirror if $rmt->{mirror};
 889                 ++$foundvcs if $rmt->{vcs} || (exists($rmt->{url}) && $rmt->{url}->[0] =~ /^[a-zA-Z0-9][a-zA-Z0-9+.-]*::/);
 890         }
 891         # if we have $foundvcs then we need to explicitly set fetch.prune to false
 892         # if we have $foundfetch > 1 then we need to explicitly set fetch.prune to false
 893         my $neednoprune = !exists($config{"fetch.prune"}) && ($foundvcs || $foundfetch > 1);
 894         my $baseurl = "";
 895         my $needfakeorigin = 0; # if true we need to set remote.origin.skipDefaultUpdate = true
 896         # if remote "origin" exists we always pick up its first url or use ""
 897         if (exists($remotes{origin})) {
 898                 my $rmt = $remotes{origin};
 899                 $baseurl = exists($rmt->{url}) ? $rmt->{url}->[0] : "";
 900                 $needfakeorigin = !exists($rmt->{url}) && !$rmt->{vcs} && !$rmt->{skip};
 901         } else {
 902                 $needfakeorigin = 1;
 903                 # get the first url of the @check remotes
 904                 foreach (@check) {
 905                         my $rmt = $remotes{$_};
 906                         next unless exists($rmt->{url});
 907                         next unless defined($rmt->{url}->[0]) && $rmt->{url}->[0] ne "";
 908                         $baseurl = $rmt->{url}->[0];
 909                         last;
 910                 }
 911         }
 912         my $makemirror = $type eq "mirror" || ($type eq "" && $foundfetch);
 913
 914         # If we have $foundfetch we want to make a mirror but complain if
 915         # we $foundfetchwithmirror as well unless we have --type=mirror.
 916         # Warn if we have --type=push and $foundfetch and !$foundfetchwithmirror.
 917         # Warn if we need to set fetch.prune=false when making a mirror
 918         # Warn if we need to create remote.origin.skipDefaultUpdate when making a mirror
 919         # Complain if @needskip AND !$usingall (warn with --force but don't set skip)
 920         # Warn if $usingall and any @needskip (and set them) if making a mirror
 921         # Warn if making a mirror and $baseurl eq ""
 922         # Warn if we have --type=mirror and !$foundfetch
 923
 924         if ($makemirror) {
 925                 warn "No base URL to mirror from for adopted \"$projname\"\n" unless $quiet || $baseurl ne "";
 926                 warn "Adopting mirror \"$projname\" without any fetch remotes\n" unless $quiet || $foundfetch;
 927                 if ($foundfetchwithmirror) {
 928                         warn "Refusing to adopt mirror \"$projname\" with active remote.<name>.mirror=true remote(s)\n".
 929                             "(Use --type=mirror to override)\n"
 930                                 unless $type eq "mirror";
 931                         exit(255) unless $type eq "mirror" || $dryrun;
 932                         warn "Adopting mirror \"$projname\" with active remote.<name>.mirror=true remotes\n"
 933                                 unless $quiet || $type ne "mirror";
 934                 }
 935                 warn "Setting explicit fetch.prune=false for adoption of mirror \"$projname\"\n"
 936                         if !$quiet && $neednoprune;
 937                 warn "Setting remote.origin.skipDefaultUpdate=true for adoption of mirror \"$projname\"\n"
 938                         if !$quiet && $needfakeorigin;
 939                 if (!$usingall && @needskip) {
 940                         warn "Refusing to adopt mirror empty fetch remote(s) (override with --force)\n"
 941                                 unless $force;
 942                         exit(255) unless $force || $dryrun;
 943                         warn "Adopting mirror with empty fetch remote(s) with --force\n"
 944                                 unless $quiet || !$force;
 945                 }
 946                 warn "Will set skipDefaultUpdate=true on non-fetch remote(s)\n" if !$quiet && $usingall && @needskip;
 947                 warn "Adopting mirror with base URL \"$baseurl\"\n" unless $quiet || $baseurl eq "";
 948         } else {
 949                 warn "Adopting push \"$projname\" but active non-mirror remotes are present\n"
 950                         if !$quiet && $foundfetch && !$foundfetchwithmirror;
 951         }
 952
 953         if (!$noowner && !defined($owner)) {
 954                 # Select the owner
 955                 $owner = $config{"gitweb.owner"};
 956                 if (!defined($owner) || $owner eq "") {
 957                         $owner = $Girocco::Config::admin;
 958                         warn "Using owner \"$owner\" for adopted project\n" unless $quiet;
 959                 }
 960         }
 961         if (!$nousers && !$makemirror && !defined($users)) {
 962                 # select user list for push project
 963                 my $findowner = $owner;
 964                 defined($findowner) or $findowner = $config{"gitweb.owner"};
 965                 $findowner = lc($findowner) if defined($findowner);
 966                 my @owner_users = ();
 967                 @owner_users = map {$findowner eq lc($$_[4]) ? $$_[1] : ()} get_all_users
 968                         if defined($findowner) && $findowner ne "";
 969                 defined($findowner) or $findowner = "";
 970                 if (@owner_users <= 1) {
 971                         $users = \@owner_users;
 972                         warn "No users found that match owner \"$findowner\"\n" unless @owner_users || $quiet;
 973                 } else {
 974                         $users = [];
 975                         warn "Found ".scalar(@owner_users)." users for owner \"$findowner\" (" .
 976                                 join(" ", @owner_users) . ") not setting any\n" unless $quiet;
 977                 }
 978         }
 979         defined($users) or $users = [];
 980
 981         # Warn if we preserve an existing receive.denyNonFastForwards or receive.denyDeleteCurrent setting
 982         # Complain if core.logallrefupdates or logs subdir exists and contains any files (allow with --force
 983         # and warn about preserving the setting)
 984
 985         warn "Preserving existing receive.denyNonFastForwards=true\n"
 986                 if !$quiet && git_bool($config{"receive.denynonfastforwards"});
 987         warn "Preserving existing receive.denyDeleteCurrent=$config{'receive.denydeletecurrent'}\n"
 988                 if !$quiet && exists($config{"receive.denydeletecurrent"}) &&
 989                     $config{"receive.denydeletecurrent"} ne "warn";
 990
 991         my $reflogfiles = Girocco::Project::_contains_files("$projdir/logs");
 992         my $reflogactive = git_bool($config{"core.logallrefupdates"});
 993         if ($reflogactive || $reflogfiles) {
 994                 warn "Refusing to adopt \"$projname\" with active ref logs without --force\n" if $reflogfiles && !$force;
 995                 warn "Refusing to adopt \"$projname\" with core.logAllRefUpdates=true without --force\n" if $reflogactive && !$force;
 996                 exit(255) unless $force || $dryrun;
 997                 warn "Adopting \"$projname\" with active ref logs with --force\n" unless $quiet || ($reflogfiles && !$force);
 998                 warn "Adopting \"$projname\" with core.logAllRefUpdates=true with --force\n" unless $quiet || ($reflogactive && !$force);
 999         }
1000
1001         return 0 if $dryrun && !$verbose;
1002
1003         my $newproj = eval {Girocco::Project->ghost($projname, $makemirror, 1, $dryrun)};
1004         defined($newproj) or die "Girocco::Project::ghost failed: $@\n";
1005         $newproj->{desc} = $desc;
1006         $newproj->{README} = $readme;
1007         $newproj->{READMEDATA} = $readmedata;
1008         $newproj->{rmtype} = $readmetype;
1009         $newproj->{url} = $baseurl if $makemirror || exists($config{"gitweb.baseurl"});
1010         $newproj->{email} = $owner if defined($owner);
1011         $newproj->{users} = $users;
1012         $newproj->{crypt} = "unknown";
1013         $newproj->{reverseorder} = 1 unless exists($config{"hooks.reverseorder"});
1014         $newproj->{summaryonly} = 1 unless exists($config{"hooks.summaryonly"});
1015         my $dummy = bless {}, "Girocco::Project";
1016         $dummy->{path} = "$projdir";
1017         $dummy->{configfilehash} = \%config;
1018         $dummy->_properties_load;
1019         delete $dummy->{origurl};
1020         foreach my $k (keys(%$dummy)) {
1021                 $newproj->{$k} = $dummy->{$k}
1022                         if exists($dummy->{$k}) && !exists($newproj->{$k});
1023         }
1024
1025         if ($verbose) {
1026                 use Data::Dumper;
1027                 my %info = %$newproj;
1028                 $info{README} = get_readme_desc($info{README}) if exists($info{README});
1029                 my $d = Data::Dumper->new([\%info], ['*'.$newproj->{name}]);
1030                 $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
1031                 print $d->Dump([\%info], ['*'.$newproj->{name}]);
1032         }
1033         return 0 if $dryrun;
1034
1035         # Make any changes as needed for @needskip, $neednoprune and $needfakeorigin
1036         if ($makemirror) {
1037                 git_config($projdir, "fetch.prune", "false") if $neednoprune;
1038                 git_config($projdir, "remote.origin.skipDefaultUpdate", "true") if $needfakeorigin;
1039                 if ($usingall && @needskip) {
1040                         git_config($projdir, "remote.$_.skipDefaultUpdate", "true") foreach @needskip;
1041                 }
1042         }
1043
1044         # Write out any README.dat/README.html changes before the actual Adoption
1045         # Otherwise they will get stepped on.  The Girocco::Project::adopt function
1046         # does not know how to validate README.html during adoption like the above code does.
1047         if ($readmedata ne $origreadmedata) {
1048                 open my $fd, '>', "$projdir/README.dat" or die "Cannot write \"$projdir/README.dat\": $!\n";
1049                 print $fd $readmedata or die "Error writing \"$projdir/README.dat\": $!\n";
1050                 close $fd or die "Error closing \"$projdir/README.dat\": $!\n";
1051         }
1052         if ($readme ne $origreadme || ! -e "$projdir/README.html") {
1053                 open my $fd, '>', "$projdir/README.html" or die "Cannot write \"$projdir/README.html\": $!\n";
1054                 print $fd $readme or die "Error writing \"$projdir/README.html\": $!\n";
1055                 close $fd or die "Error closing \"$projdir/README.html\": $!\n";
1056         }
1057         git_config($projdir, "girocco.rmtype", $readmetype);
1058
1059         # Perform the actual adoption
1060         $newproj->adopt or die "Girocco::Project::adopt failed\n";
1061
1062         # Perhaps restore core.logAllRefUpdates, receive.denyNonFastForwards and receive.denyDeleteCurrent
1063         git_config($projdir, "receive.denyNonFastForwards", "true")
1064                 if git_bool($config{"receive.denynonfastforwards"});
1065         git_config($projdir, "receive.denyDeleteCurrent", $config{"receive.denydeletecurrent"})
1066                 if exists($config{"receive.denydeletecurrent"}) &&
1067                    $config{"receive.denydeletecurrent"} ne "warn";
1068         git_config($projdir, "core.logAllRefUpdates", "true")
1069                 if $reflogactive;
1070
1071         # Success
1072         if ($makemirror) {
1073                 warn "Mirror project \"$projname\" successfully adopted.\n" unless $quiet;
1074         } else {
1075                 warn "Push project \"$projname\" successfully adopted.\n" unless $quiet;
1076         }
1077         return 0;
1078 }
1079
1080 sub cmd_remove {
1081         my ($force, $reallydel, $keepforks);
1082         parse_options(force => \$force, "really-delete" => \$reallydel,
1083                 "keep-forks" => \$keepforks, quiet => \$quiet, q =>\$quiet);
1084         @ARGV or die "Please give project name on command line.\n";
1085         @ARGV == 1 or die_usage;
1086         my $project = get_project($ARGV[0]);
1087         my $projname = $project->{name};
1088         my $isempty = !$project->{mirror} && $project->is_empty;
1089         if (!$project->{mirror} && !$isempty && $reallydel) {
1090                 die "refusing to remove and delete non-empty push project without --force: $projname\n" unless $force;
1091                 warn "allowing removal and deletion of non-empty push project with --force\n" unless $quiet;
1092         }
1093         my $altwarn;
1094         my $removenogc;
1095         if ($project->has_forks) {
1096                 die "refusing to remove project with forks (use --keep-forks): $projname\n" unless $keepforks;
1097                 warn "allowing removal of forked project while preserving its forks with --keep-forks\n" unless $quiet;
1098                 # Run pseudo GC on that repository so that objects don't get lost within forks
1099                 my $basedir = $Girocco::Config::basedir;
1100                 my $projdir = $project->{path};
1101                 warn "We have to run pseudo GC on the repo so that the forks don't lose data. Hang on...\n" unless $quiet;
1102                 my $nogcrunning = sub {
1103                         die "Error: GC appears to be currently running on $projname\n"
1104                                 if -e "$projdir/gc.pid" || -e "$projdir/.gc_in_progress";
1105                 };
1106                 &$nogcrunning;
1107                 $removenogc = ! -e "$projdir/.nogc";
1108                 recreate_file("$projdir/.nogc") if $removenogc;
1109                 die "unable to create \"$projdir/.nogc\"\n" unless -e "$projdir/.nogc";
1110                 delete $ENV{show_progress};
1111                 $ENV{'show_progress'} = 1 unless $quiet;
1112                 sleep 2; # *cough*
1113                 &$nogcrunning;
1114                 system("$basedir/toolbox/perform-pre-gc-linking.sh", "--include-packs", $projname) == 0
1115                         or die "Running pseudo GC on project $projname failed\n";
1116                 $altwarn = 1;
1117         }
1118         my $archived;
1119         if (!$project->{mirror} && !$isempty && !$reallydel) {
1120                 $archived = $project->archive_and_delete;
1121                 unlink("$archived/.nogc") if $removenogc && defined($archived) && $archived ne "";
1122         } else {
1123                 $project->delete;
1124         }
1125         warn "Project '$projname' removed from $Girocco::Config::name" .
1126                 ($archived ? ", backup in '$archived'" : "") .".\n" unless $quiet;
1127         warn "Retained forks may now have unwanted objects/info/alternates lines\n" if $altwarn && !$quiet;
1128         return 0;
1129 }
1130
1131 sub cmd_show {
1132         use Data::Dumper;
1133         @ARGV == 1 or die_usage;
1134         my $project = get_clean_project($ARGV[0]);
1135         my %info = %$project;
1136         my $d = Data::Dumper->new([\%info], ['*'.$project->{name}]);
1137         $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
1138         print $d->Dump([\%info], ['*'.$project->{name}]);
1139         return 0;
1140 }
1141
1142 sub cmd_listheads {
1143         @ARGV == 1 or die_usage;
1144         my $project = get_project($ARGV[0]);
1145         my @heads = sort({lc($a) cmp lc($b)} $project->get_heads);
1146         my $cur = $project->{HEAD};
1147         defined($cur) or $cur = '';
1148         my $curmark = '*';
1149         my $headhash = get_git("--git-dir=$project->{path}", 'rev-parse', '--quiet', '--verify', 'HEAD');
1150         defined($headhash) or $headhash = '';
1151         chomp $headhash;
1152         $headhash or $curmark = '!';
1153         foreach (@heads) {
1154                 my $mark = $_ eq $cur ? $curmark : ' ';
1155                 print "$mark $_\n";
1156         }
1157         return 0;
1158 }
1159
1160 sub cmd_listtags {
1161         my $vcnt = 0;
1162         shift(@ARGV), $vcnt=1 if @ARGV && ($ARGV[0] eq '--verbose' || $ARGV[0] eq '-v');
1163         @ARGV == 1 or die_usage;
1164         my $project = get_project($ARGV[0]);
1165         if ($vcnt) {
1166                 print map("$$_[0]\t$$_[1]\n", get_ctag_counts($project));
1167         } else {
1168                 print map("$_\n", $project->get_ctag_names);
1169         }
1170         return 0;
1171 }
1172
1173 sub cmd_deltags {
1174         my $ic = 0;
1175         shift(@ARGV), $ic=1 if @ARGV && $ARGV[0] =~ /^(?:--?ignore-case|-i)$/i;
1176         @ARGV >= 2 or die_usage;
1177         my $project = get_project(shift @ARGV);
1178         my %curtags;
1179         if ($ic) {
1180                 push(@{$curtags{lc($_)}}, $_) foreach $project->get_ctag_names;
1181         } else {
1182                 push(@{$curtags{$_}}, $_) foreach $project->get_ctag_names;
1183         }
1184         my @deltags = ();
1185         my %seentag = ();
1186         my $ctags = join(" ", @ARGV);
1187         $ctags = lc($ctags) if $ic;
1188         foreach (split(/[\s,]+/, $ctags)) {
1189                 next unless exists($curtags{$_});
1190                 $seentag{$_}=1, push(@deltags, $_) unless $seentag{$_};
1191         }
1192         if (!@deltags) {
1193                 warn $project->{name}, ": skipping removal of only non-existent tags\n" unless $quiet;
1194         } else {
1195                 # Avoid touching anything other than the ctags
1196                 foreach my $tg (@deltags) {
1197                         $project->delete_ctag($_) foreach @{$curtags{$tg}};
1198                 }
1199                 $project->_set_changed;
1200                 $project->_set_forkchange;
1201                 warn $project->{name}, ": specified tags have been removed\n" unless $quiet;
1202         }
1203         return 0;
1204 }
1205
1206 sub cmd_addtags {
1207         @ARGV >= 2 or die_usage;
1208         my $project = get_project(shift @ARGV);
1209         my $ctags = join(" ", @ARGV);
1210         $ctags =~ /[^, a-zA-Z0-9:.+#_-]/ and
1211                 die "Content tag(s) \"$ctags\" contain(s) evil character(s).\n";
1212         my $oldmask = umask();
1213         umask($oldmask & ~0060);
1214         my $changed = 0;
1215         foreach (split(/[\s,]+/, $ctags)) {
1216                 ++$changed if $project->add_ctag($_, 1);
1217         }
1218         if ($changed) {
1219                 $project->_set_changed;
1220                 $project->_set_forkchange;
1221         }
1222         umask($oldmask);
1223         my $cnt = ($changed == 1) ? "1 content tag has" : $changed . " content tags have";
1224         warn $project->{name}, ": $cnt been added/updated\n" unless $quiet;
1225         return 0;
1226 }
1227
1228 sub _get_random_val {
1229         my $p = shift;
1230         my $md5;
1231         {
1232                 no warnings;
1233                 $md5 = md5_hex(time . $$ . rand() . join(':',%$p));
1234         }
1235         $md5;
1236 }
1237
1238 sub cmd_chpass {
1239         my $force = 0;
1240         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1241         my $random = undef;
1242         pop(@ARGV), $random=lc($ARGV[1]) if @ARGV==2 && $ARGV[1] =~ /^(?:random|unknown)$/i;
1243         @ARGV == 1 or die_usage;
1244         my $project = get_project($ARGV[0]);
1245         die "refusing to change locked password of project \"$ARGV[0]\" without --force\n"
1246                 if $project->is_password_locked;
1247         my ($newpw, $rmsg);
1248         if ($random) {
1249                 if ($random eq "random") {
1250                         die "refusing to set random password without --force\n" unless $force;
1251                         $rmsg = "set to random value";
1252                         $newpw = _get_random_val($project);
1253                 } else {
1254                         die "refusing to set password hash to '$random' without --force\n" unless $force;
1255                         $rmsg = "hash set to '$random'";
1256                         $newpw = $random;
1257                 }
1258         } else {
1259                 $rmsg = "updated";
1260                 if (-t STDIN) {
1261                         print "Changing admin password for project $ARGV[0]\n";
1262                         my $np1 = prompt_noecho_nl_or_die("New password for project $ARGV[0] (echo is off)");
1263                         $np1 ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
1264                         my $np2 = prompt_noecho_nl_or_die("Retype new password for project $ARGV[0]");
1265                         $np1 eq $np2 or die "Our high-paid security consultants have determined that\n" .
1266                                 "the admin passwords you have entered do not match each other.\n";
1267                         $newpw = $np1;
1268                 } else {
1269                         $newpw = <STDIN>;
1270                         defined($newpw) or die "missing new password on STDIN\n";
1271                         chomp($newpw);
1272                 }
1273         }
1274         $newpw ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
1275         my $old = $project->{crypt};
1276         $project->{crypt} = (defined($random) && $random ne "random") ? $newpw : scrypt_sha1($newpw);
1277         if (defined($old) && $old eq $project->{crypt}) {
1278                 warn $project->{name}, ": skipping update of password hash to same value\n" unless $quiet;
1279         } else {
1280                 # Avoid touching anything other than the password hash
1281                 $project->_group_update;
1282                 warn $project->{name}, ": admin password $rmsg (new hash stored)\n" unless $quiet;
1283         }
1284         return 0;
1285 }
1286
1287 sub cmd_checkpw {
1288         @ARGV == 1 or die_usage;
1289         my $project = get_project($ARGV[0]);
1290         my $pwhash = $project->{crypt};
1291         defined($pwhash) or $pwhash = "";
1292         if ($pwhash eq "") {
1293                 warn $project->{name}, ": no password required\n" unless $quiet;
1294                 return 0;
1295         }
1296         if ($project->is_password_locked) {
1297                 warn $project->{name}, ": password is locked\n" unless $quiet;
1298                 exit 1;
1299         }
1300         my $checkpw;
1301         if (-t STDIN) {
1302                 $checkpw = prompt_noecho_nl_or_die("Admin password for project $ARGV[0] (echo is off)");
1303                 $checkpw ne "" or warn "checking for empty password as hash (very unlikely)\n" unless $quiet;
1304         } else {
1305                 $checkpw = <STDIN>;
1306                 defined($checkpw) or die "missing admin password on STDIN\n";
1307                 chomp($checkpw);
1308         }
1309         unless (Girocco::CLIUtil::check_passwd_match($pwhash, $checkpw)) {
1310                 warn "password check failure\n" unless $quiet;
1311                 exit 1;
1312         }
1313         warn "admin password match\n" unless $quiet;
1314         return 0;
1315 }
1316
1317 sub cmd_gc {
1318         my ($force, $auto, $redelta, $recompress);
1319         parse_options(force => \$force, quiet => \$quiet, q => \$quiet, auto => \$auto,
1320                 redelta => \$redelta, "no-reuse-delta" => \$redelta, aggressive => \$force,
1321                 recompress => \$recompress, "no-reuse-object" => $recompress);
1322         $force && $auto and die "--force and --auto are mutually exclusive options\n";
1323         @ARGV or die "Please give project name on command line.\n";
1324         @ARGV == 1 or die_usage;
1325         my $project = get_project($ARGV[0]);
1326         delete $ENV{show_progress};
1327         delete $ENV{force_gc};
1328         $quiet or $ENV{"show_progress"} = 1;
1329         $force and $ENV{"force_gc"} = 1;
1330         if (!$auto && !$force && ! -e $project->{path}."/.needsgc") {
1331                 open NEEDSGC, '>', $project->{path}."/.needsgc" and close NEEDSGC;
1332         }
1333         my @args = ($Girocco::Config::basedir . "/jobd/gc.sh", $project->{name});
1334         $redelta && !$recompress and push(@args, "-f");
1335         $recompress and push(@args, "-F");
1336         my $lastgc = $project->{lastgc};
1337         system({$args[0]} @args) != 0 and return 1;
1338         # Do it again Sam, but only if lastgc was set, gc.sh succeeded and now it's not set
1339         if ($lastgc) {
1340                 my $newlastgc = get_git("--git-dir=$project->{path}", 'config', '--get', 'gitweb.lastgc');
1341                 if (!$newlastgc) {
1342                         system({$args[0]} @args) != 0 and return 1;
1343                 }
1344         }
1345         return 0;
1346 }
1347
1348 sub cmd_update {
1349         my ($force, $summary);
1350         parse_options(force => \$force, quiet => \$quiet, q => \$quiet, summary => \$summary);
1351         $quiet && $summary and die "--quiet and --summary are mutually exclusive options\n";
1352         @ARGV or die "Please give project name on command line.\n";
1353         @ARGV == 1 or die_usage;
1354         my $project = get_project($ARGV[0]);
1355         $project->{mirror} or die "Project \"$ARGV[0]\" is a push project, not a mirror project.\n";
1356         delete $ENV{show_progress};
1357         delete $ENV{force_update};
1358         if ($quiet) {
1359                 $ENV{"show_progress"} = 0;
1360         } else {
1361                 $ENV{"show_progress"} = ($summary ? 1 : 2);
1362         }
1363         $force and $ENV{"force_update"} = 1;
1364         system($Girocco::Config::basedir . "/jobd/update.sh", $project->{name}) != 0 and return 1;
1365         return 0;
1366 }
1367
1368 sub cmd_remirror {
1369         my $force = 0;
1370         parse_options(force => \$force, quiet => \$quiet, q => \$quiet);
1371         @ARGV or die "Please give project name on command line.\n";
1372         @ARGV == 1 or die_usage;
1373         my $project = get_project($ARGV[0]);
1374         $project->{mirror} or die "Project \"$ARGV[0]\" is a push project, not a mirror project.\n";
1375         if ($project->{clone_in_progress} && !$project->{clone_failed}) {
1376                 warn "Project \"$ARGV[0]\" already seems to have a clone underway at this moment.\n" unless $quiet && $force;
1377                 exit(255) unless $force;
1378                 yes_to_continue_or_die("Are you sure you want to force a remirror");
1379         }
1380         unlink($project->_clonefail_path);
1381         unlink($project->_clonelog_path);
1382         recreate_file($project->_clonep_path);
1383         my $sock = IO::Socket::UNIX->new($Girocco::Config::chroot.'/etc/taskd.socket') or
1384                 die "cannot connect to taskd.socket: $!\n";
1385         select((select($sock),$|=1)[0]);
1386         $sock->print("clone ".$project->{name}."\n");
1387         # Just ignore reply, we are going to succeed anyway and the I/O
1388         # would apparently get quite hairy.
1389         $sock->flush();
1390         sleep 2; # *cough*
1391         $sock->close();
1392         warn "Project \"$ARGV[0]\" remirror initiated.\n" unless $quiet;
1393         return 0;
1394 }
1395
1396 sub cmd_setowner {
1397         my $force = 0;
1398         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1399         @ARGV == 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
1400         my $project = get_project($ARGV[0]);
1401         if (@ARGV == 2 && !valid_email($ARGV[1])) {
1402                 die "invalid owner/email (use --force to accept): \"$ARGV[1]\"\n"
1403                         unless $force;
1404                 warn "using invalid owner/email with --force\n" unless $quiet;
1405         }
1406         if (@ARGV == 2 && length($ARGV[1]) > 96) {
1407                 die "owner/email longer than 96 chars (use --force to accept): \"$ARGV[1]\"\n"
1408                         unless $force;
1409                 warn "using longer than 96 char owner/email with --force\n" unless $quiet;
1410         }
1411         my $old = $project->{email};
1412         if (@ARGV == 1) {
1413                 print "$old\n" if defined($old);
1414                 return 0;
1415         }
1416         if (defined($old) && $old eq $ARGV[1]) {
1417                 warn $project->{name}, ": skipping update of owner/email to same value\n" unless $quiet;
1418         } else {
1419                 # Avoid touching anything other than "gitweb.owner"
1420                 $project->_property_fput("email", $ARGV[1]);
1421                 $project->_update_index;
1422                 $project->_set_changed;
1423                 warn $project->{name}, ": owner/email updated to \"$ARGV[1]\"\n" unless $quiet;
1424         }
1425         return 0;
1426 }
1427
1428 sub cmd_setdesc {
1429         my $force = 0;
1430         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1431         @ARGV >= 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
1432         my $project = get_project(shift @ARGV);
1433         if (@ARGV && !valid_desc(join(" ", @ARGV))) {
1434                 die "invalid description (use --force to accept): \"".join(" ", @ARGV)."\"\n"
1435                         unless $force;
1436                 warn "using invalid description with --force\n" unless $quiet;
1437         }
1438         my $desc = clean_desc(join(" ", @ARGV));
1439         if (@ARGV && length($desc) > 1024) {
1440                 die "description longer than 1024 chars (use --force to accept): \"$desc\"\n"
1441                         unless $force;
1442                 warn "using longer than 1024 char description with --force\n" unless $quiet;
1443         }
1444         my $old = $project->{desc};
1445         if (!@ARGV) {
1446                 print "$old\n" if defined($old);
1447                 return 0;
1448         }
1449         if (defined($old) && $old eq $desc) {
1450                 warn $project->{name}, ": skipping update of description to same value\n" unless $quiet;
1451         } else {
1452                 # Avoid touching anything other than description file
1453                 $project->_property_fput("desc", $desc);
1454                 $project->_set_changed;
1455                 warn $project->{name}, ": description updated to \"$desc\"\n" unless $quiet;
1456         }
1457         return 0;
1458 }
1459
1460 sub cmd_setreadme {
1461         my ($force, $readmetype) = (0, undef);
1462         parse_options(force => \$force, ":type" => \$readmetype, ":format" => \$readmetype);
1463         @ARGV == 1 && defined($readmetype) and push(@ARGV, undef);
1464         @ARGV == 2 || (@ARGV == 1 && !$force && !defined($readmetype) && !$setopt) or die_usage;
1465         defined($readmetype) and $readmetype = Girocco::Project::_normalize_rmtype($readmetype,1);
1466         defined($readmetype) && !$readmetype and die_usage;
1467         my $project = get_project($ARGV[0]);
1468         my $old = $project->{READMEDATA};
1469         if (@ARGV == 1) {
1470                 chomp $old if defined($old);
1471                 print "$old\n" if defined($old) && $old ne "";
1472                 return 0;
1473         }
1474         $readmetype or $readmetype = $project->{rmtype};
1475         my ($new, $raw, $newname);
1476         $newname = '';
1477         if (!defined($ARGV[1])) {
1478                 $new = $old;
1479                 $newname = "original README data";
1480                 $readmetype ne $project->{rmtype} && $new ne "" and $raw = 1;
1481         } elsif ($ARGV[1] eq "-") {
1482                 local $/;
1483                 $new = <STDIN>;
1484                 $raw = 1;
1485                 $newname = "contents of <STDIN>";
1486         } elsif (lc($ARGV[1]) eq "automatic" || lc($ARGV[1]) eq "auto") {
1487                 $new = "";
1488         } elsif (lc($ARGV[1]) eq "suppressed" || lc($ARGV[1]) eq "suppress") {
1489                 $new = "<!-- suppress -->";
1490         } else {
1491                 my $fn = $ARGV[1];
1492                 $fn =~ s/^\@//;
1493                 die "missing filename for README\n" unless $fn ne "";
1494                 die "no such file: \"$fn\"\n" unless -f $fn && -r $fn;
1495                 open F, '<', $fn or die "cannot open \"$fn\" for reading: $!\n";
1496                 local $/;
1497                 $new = <F>;
1498                 close F;
1499                 $raw = 1;
1500                 $newname = "contents of \"$fn\"";
1501         }
1502         defined($new) or $new = '';
1503         my $origrmtype = $project->{rmtype};
1504         $project->{rmtype} = $readmetype;
1505         $project->{READMEDATA} = to_utf8($new, 1);
1506         $project->_cleanup_readme;
1507         if (length($project->{READMEDATA}) > 8192) {
1508                 die "readme greater than 8192 chars is too long (use --force to override)\n"
1509                         unless $force;
1510                 warn "using readme greater than 8192 chars with --force\n" unless $quiet;
1511         }
1512         if ($raw) {
1513                 my ($cnt, $err) = $project->_lint_readme(0);
1514                 if ($cnt) {
1515                         my $msg = "README: $cnt error";
1516                         $msg .= "s" unless $cnt == 1;
1517                         print STDERR "$msg\n", "-" x length($msg), "\n", $err
1518                                 unless $force && $quiet;
1519                         exit(255) unless $force && $project->{rmtype} eq 'HTML';
1520                         warn $project->{name} . ": using invalid raw HTML with --force\n" unless $quiet;
1521                         $project->{README} = $project->{READMEDATA};
1522                 }
1523         }
1524         if (defined($old) && $old eq $project->{READMEDATA} && $readmetype eq $origrmtype && !$force) {
1525                 warn $project->{name}, ": skipping update of README to same value\n" unless $quiet;
1526         } else {
1527                 # Avoid touching anything other than README.html file
1528                 $project->_property_fput("READMEDATA", $project->{READMEDATA}, 1);
1529                 $project->_property_fput("README", $project->{README});
1530                 $project->_property_fput("rmtype", $readmetype) if $readmetype ne $origrmtype;
1531                 $project->_set_changed;
1532                 my $desc = get_readme_desc($project->{README});
1533                 if ($newname) {
1534                         $newname .= " ($desc)";
1535                 } else {
1536                         $newname = $desc;
1537                 }
1538                 warn $project->{name}, ": README $readmetype format updated to $newname\n" unless $quiet;
1539         }
1540         return 0;
1541 }
1542
1543 sub valid_head {
1544         my ($proj, $newhead) = @_;
1545         my %okheads = map({($_ => 1)} $proj->get_heads);
1546         exists($okheads{$newhead});
1547 }
1548
1549 sub cmd_sethead {
1550         @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
1551         my $project = get_project($ARGV[0]);
1552         if (@ARGV == 2 && !valid_head($project, $ARGV[1])) {
1553                 die "invalid head (try \"@{[basename($0)]} listheads $ARGV[0]\"): \"$ARGV[1]\"\n";
1554         }
1555         my $old = $project->{HEAD};
1556         if (@ARGV == 1) {
1557                 print "$old\n" if defined($old);
1558                 return 0;
1559         }
1560         if (defined($old) && $old eq $ARGV[1]) {
1561                 warn $project->{name}, ": skipping update of HEAD symref to same value\n" unless $quiet;
1562         } else {
1563                 # Avoid touching anything other than the HEAD symref
1564                 $project->set_HEAD($ARGV[1]);
1565                 $project->_set_changed;
1566                 warn $project->{name}, ": HEAD symref updated to \"refs/heads/$ARGV[1]\"\n" unless $quiet;
1567         }
1568         return 0;
1569 }
1570
1571 sub cmd_sethooks {
1572         my $force = 0;
1573         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1574         @ARGV == 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
1575         my $project = get_project($ARGV[0]);
1576         my $projconfig = read_config_file_hash($project->{path}."/config");
1577         my $ghp = $Girocco::Config::reporoot."/_global/hooks";
1578         my $rghp = realpath($ghp);
1579         my $lhp = $project->{path}."/hooks";
1580         my $rlhp = realpath($lhp);
1581         my $ahp = "";
1582         my $rahp = undef;
1583         if (defined($projconfig) && defined($projconfig->{"core.hookspath"})) {
1584                 $ahp = $projconfig->{"core.hookspath"};
1585                 $rahp = realpath($ahp);
1586         }
1587         if (@ARGV == 1) {
1588                 if (defined($rahp) && $rahp ne "") {
1589                         if ($rahp eq $rghp) {
1590                                 my $nc = ($ahp eq $ghp ? "" : " non-canonical");
1591                                 printf "%s \t(global%s)\n", $ahp, $nc;
1592                         } elsif ($rahp eq $rlhp) {
1593                                 my $nc = ($ahp eq $lhp ? "" : " non-canonical");
1594                                 printf "%s \t(local%s)\n", $ahp, $nc;
1595                         } elsif ($rahp ne $ahp) {
1596                                 print "$ahp \t($rahp)\n";
1597                         } else {
1598                                 print "$ahp\n";
1599                         }
1600                 } elsif ($ahp ne "") {
1601                         print "$ahp \t(non-existent)\n";
1602                 }
1603                 return 0;
1604         }
1605         my $shp = $ARGV[1];
1606         if (lc($shp) eq "global") {
1607                 $shp = $ghp;
1608         } elsif (lc($shp) eq "local") {
1609                 $shp = $lhp;
1610         } elsif (substr($shp, 0, 2) eq "~/") {
1611                 $shp = $ENV{"HOME"}.substr($shp,1);
1612         } elsif ($shp =~ m,^~([a-zA-Z_][a-zA-Z_0-9]*)((?:/.*)?)$,) {
1613                 my $sfx = $2;
1614                 my $hd = (getpwnam($1))[7];
1615                 $shp = $hd . $sfx if defined($hd) && $hd ne "" && $hd ne "/" && -d $hd;
1616         }
1617         $shp ne "" && -d $shp or die "no such directory: $ARGV[1]\n";
1618         my $rshp = realpath($shp);
1619         defined($rshp) && $rshp ne "" or die "could not realpath: $ARGV[1]\n";
1620         $rshp =~ m,^/[^/], or die "invalid hookspath: $rshp\n";
1621         die "refusing to switch from current non-global hookspath without --force\n"
1622                 if !$force && defined($rahp) && $rahp ne "" && $rahp ne $rghp && $rshp ne $rahp;
1623         if (!$force && defined($rahp) && $rahp ne "") {
1624                 if ($rshp eq $rahp && ($ahp eq $ghp || $ahp eq $lhp)) {
1625                         warn $project->{name}, ": skipping update of hookspath to same effective value\n" unless $quiet;
1626                         return 0;
1627                 }
1628         }
1629         $rshp = $ghp if $rshp eq $rghp;
1630         $rshp = $lhp if $rshp eq $rlhp;
1631         if ($rshp eq $ahp) {
1632                 warn $project->{name}, ": skipping update of hookspath to same value\n" unless $quiet;
1633                 return 0;
1634         }
1635         die "refusing to set neither local nor global hookspath without --force\n"
1636                 if !$force && $rshp ne $ghp && $rshp ne $lhp;
1637         system($Girocco::Config::git_bin, '--git-dir='.$project->{path},
1638                 'config', "core.hookspath", $rshp);
1639         my $newval = '"'.$rshp.'"';
1640         $newval = "global" if $rshp eq $ghp;
1641         $newval = "local" if $rshp eq $lhp;
1642         warn $project->{name}, ": hookspath set to $newval\n" unless $quiet;
1643         return 0;
1644 }
1645
1646 our %boolfields;
1647 BEGIN {
1648         %boolfields = (
1649                 cleanmirror   => 1,
1650                 reverseorder  => 0,
1651                 summaryonly   => 0,
1652                 statusupdates => 1,
1653         );
1654 }
1655
1656 sub cmd_setbool {
1657         my $force = 0;
1658         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1659         @ARGV == 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage;
1660         my $project = get_project($ARGV[0]);
1661         if (!exists($boolfields{$ARGV[1]})) {
1662                 die "invalid boolean field name: \"$ARGV[1]\" -- try \"help\"\n";
1663         }
1664         if (@ARGV == 3 && $boolfields{$ARGV[1]} && !$project->{mirror}) {
1665                 die "invalid boolean field for non-mirror (use --force to accept): \"$ARGV[1]\"\n"
1666                         unless $force;
1667                 warn "using mirror field on non-mirror with --force\n" unless $quiet;
1668         }
1669         if (@ARGV == 3 && !valid_bool($ARGV[2])) {
1670                 die "invalid boolean value: \"$ARGV[2]\"\n";
1671         }
1672         my $bool = clean_bool($ARGV[2]);
1673         my $old = $project->{$ARGV[1]};
1674         if (@ARGV == 2) {
1675                 print "$old\n" if defined($old);
1676                 return 0;
1677         }
1678         if (defined($old) && $old eq $bool) {
1679                 warn $project->{name}, ": skipping update of $ARGV[1] to same value\n" unless $quiet;
1680         } else {
1681                 # Avoid touching anything other than $ARGV[1] field
1682                 $project->_property_fput($ARGV[1], $bool);
1683                 warn $project->{name}, ": $ARGV[1] updated to $bool\n" unless $quiet;
1684         }
1685         return 0;
1686 }
1687
1688 sub cmd_setjsontype {
1689         @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
1690         my $project = get_project($ARGV[0]);
1691         my $jsontype;
1692         if (@ARGV == 2) {
1693                 my $jt = lc($ARGV[1]);
1694                 index($jt, "/") >= 0 or $jt = "application/".$jt;
1695                 $jt eq 'application/x-www-form-urlencoded' ||
1696                 $jt eq 'application/json' or
1697                         die "invalid jsontype value: \"$ARGV[1]\"\n";
1698                 $jsontype = $jt;
1699         }
1700         my $old = $project->{jsontype};
1701         if (@ARGV == 1) {
1702                 print "$old\n" if defined($old);
1703                 return 0;
1704         }
1705         if (defined($old) && $old eq $jsontype) {
1706                 warn $project->{name}, ": skipping update of jsontype to same value\n" unless $quiet;
1707         } else {
1708                 # Avoid touching anything other than jsontype field
1709                 $project->_property_fput('jsontype', $jsontype);
1710                 warn $project->{name}, ": jsontype updated to $jsontype\n" unless $quiet;
1711         }
1712         return 0;
1713 }
1714
1715 sub cmd_setjsonsecret {
1716         @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
1717         my $project = get_project($ARGV[0]);
1718         my $jsonsecret;
1719         if (@ARGV == 2) {
1720                 my $js = $ARGV[1];
1721                 $js =~ s/^\s+//; $js =~ s/\s+$//;
1722                 $jsonsecret = $js;
1723         }
1724         my $old = $project->{jsonsecret};
1725         if (@ARGV == 1) {
1726                 print "$old\n" if defined($old);
1727                 return 0;
1728         }
1729         if (defined($old) && $old eq $jsonsecret) {
1730                 warn $project->{name}, ": skipping update of jsonsecret to same value\n" unless $quiet;
1731         } else {
1732                 # Avoid touching anything other than jsonsecret field
1733                 $project->_property_fput('jsonsecret', $jsonsecret);
1734                 warn $project->{name}, ": jsonsecret updated to \"$jsonsecret\"\n" unless $quiet;
1735         }
1736         return 0;
1737 }
1738
1739 sub cmd_setautogchack {
1740         @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
1741         my $project = get_project($ARGV[0]);
1742         my $aghok = $Girocco::Config::autogchack &&
1743                 ($project->{mirror} || $Girocco::Config::autogchack ne "mirror");
1744         my $old = defined($project->{autogchack}) ? clean_bool($project->{autogchack}) : "unset";
1745         if (@ARGV == 1) {
1746                 print "$old\n" if $aghok;
1747                 return 0;
1748         }
1749         my $bool;
1750         if (lc($ARGV[1]) eq "unset") {
1751                 $bool = "unset";
1752         } else {
1753                 valid_bool($ARGV[1]) or die "invalid boolean value: \"$ARGV[1]\"\n";
1754                 $bool = clean_bool($ARGV[1]);
1755         }
1756         if (!$aghok) {
1757                 die "\$Girocco::Config::autogchack is false\n" unless $Girocco::Config::autogchack;
1758                 die "\$Girocco::Config::autogchack is only enabled for mirrors\n";
1759         }
1760         if ($old eq $bool) {
1761                 warn $project->{name}, ": autogchack value unchanged\n" unless $quiet;
1762         } else {
1763                 if ($bool eq "unset") {
1764                         system($Girocco::Config::git_bin, '--git-dir='.$project->{path},
1765                                 'config', '--unset', "girocco.autogchack");
1766                 } else {
1767                         system($Girocco::Config::git_bin, '--git-dir='.$project->{path},
1768                                 'config', '--bool', "girocco.autogchack", $bool);
1769                 }
1770         }
1771         return system($Girocco::Config::basedir . "/jobd/maintain-auto-gc-hack.sh", $project->{name}) == 0
1772                 ? 0 : 1;
1773 }
1774
1775 sub valid_url {
1776         my ($url, $type) = @_;
1777         $type ne 'baseurl' and return valid_web_url($url);
1778         valid_repo_url($url) or return 0;
1779         if ($Girocco::Config::restrict_mirror_hosts) {
1780                 my $mh = extract_url_hostname($url);
1781                 is_dns_hostname($mh) or return 0;
1782                 !is_our_hostname($mh) or return 0;
1783         }
1784         return 1;
1785 }
1786
1787 our %urlfields;
1788 BEGIN {
1789         %urlfields = (
1790                 baseurl    => ["url"       , 1],
1791                 homepage   => ["hp"        , 0],
1792                 notifyjson => ["notifyjson", 0],
1793         );
1794 }
1795
1796 sub cmd_seturl {
1797         my $force = 0;
1798         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1799         @ARGV == 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage;
1800         my $project = get_project($ARGV[0]);
1801         if (!exists($urlfields{$ARGV[1]})) {
1802                 die "invalid URL field name: \"$ARGV[1]\" -- try \"help\"\n";
1803         }
1804         if (@ARGV == 3 && ${$urlfields{$ARGV[1]}}[1] && !$project->{mirror}) {
1805                 die "invalid URL field for non-mirror (use --force to accept): \"$ARGV[1]\"\n"
1806                         unless $force;
1807                 warn "using mirror field on non-mirror with --force\n" unless $quiet;
1808         }
1809         if (@ARGV == 3 && !valid_url($ARGV[2], $ARGV[1])) {
1810                 die "invalid URL (use --force to accept): \"$ARGV[2]\"\n"
1811                         unless $force;
1812                 warn "using invalid URL with --force\n" unless $quiet;
1813         }
1814         my $old = $project->{${$urlfields{$ARGV[1]}}[0]};
1815         if (@ARGV == 2) {
1816                 print "$old\n" if defined($old);
1817                 return 0;
1818         }
1819         if (defined($old) && $old eq $ARGV[2]) {
1820                 warn $project->{name}, ": skipping update of $ARGV[1] to same value\n" unless $quiet;
1821         } else {
1822                 # Avoid touching anything other than $ARGV[1]'s field
1823                 $project->_property_fput(${$urlfields{$ARGV[1]}}[0], $ARGV[2]);
1824                 if ($ARGV[1] eq "baseurl") {
1825                         $project->{url} = $ARGV[2];
1826                         $project->_set_bangagain;
1827                 }
1828                 $project->_set_changed unless $ARGV[1] eq "notifyjson";
1829                 warn $project->{name}, ": $ARGV[1] updated to $ARGV[2]\n" unless $quiet;
1830         }
1831         return 0;
1832 }
1833
1834 our %msgsfields;
1835 BEGIN {
1836         %msgsfields = (
1837                 notifymail => 1,
1838                 notifytag  => 1,
1839         );
1840 }
1841
1842 sub cmd_setmsgs {
1843         my $force = 0;
1844         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1845         @ARGV >= 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage;
1846         my $project = get_project(shift @ARGV);
1847         my $field = shift @ARGV;
1848         if (!exists($msgsfields{$field})) {
1849                 die "invalid msgs field name: \"$field\" -- try \"help\"\n";
1850         }
1851         if (@ARGV && !valid_addrlist(@ARGV)) {
1852                 die "invalid email address list (use --force to accept): \"".join(" ",@ARGV)."\"\n"
1853                         unless $force;
1854                 warn "using invalid email address list with --force\n" unless $quiet;
1855         }
1856         my $old = $project->{$field};
1857         if (!@ARGV) {
1858                 printf "%s\n", clean_addrlist($old, " ") if defined($old);
1859                 return 0;
1860         }
1861         my $newlist = clean_addrlist(join(" ",@ARGV));
1862         if (defined($old) && $old eq $newlist) {
1863                 warn $project->{name}, ": skipping update of $field to same value\n" unless $quiet;
1864         } else {
1865                 # Avoid touching anything other than $field's field
1866                 $project->_property_fput($field, $newlist);
1867                 warn $project->{name}, ": $field updated to \"$newlist\"\n" unless $quiet;
1868         }
1869         return 0;
1870 }
1871
1872 sub cmd_setusers {
1873         my $force = 0;
1874         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1875         @ARGV >= 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
1876         my $project = get_project(shift @ARGV);
1877         my $projname = $project->{name};
1878         !@ARGV || !$project->{mirror} or die "cannot set users list for mirror project: \"$projname\"\n";
1879         my @newusers = ();
1880         if (@ARGV) {
1881                 eval {@newusers = validate_users(join(" ", @ARGV), $force); 1;} or exit 255;
1882                 die "refusing to set empty users list without --force\n" unless @newusers || $force;
1883         }
1884         return 0 if !@ARGV && $project->{mirror};
1885         my $oldusers = $project->{users};
1886         if ($oldusers && ref($oldusers) eq "ARRAY") {
1887                 $oldusers = join("\n", @$oldusers);
1888         } else {
1889                 $oldusers = "";
1890         }
1891         if (!@ARGV) {
1892                 print "$oldusers\n" if $oldusers ne "";
1893                 return 0;
1894         }
1895         if ($oldusers eq join("\n", @newusers)) {
1896                 warn "$projname: skipping update of users list to same value\n" unless $quiet;
1897         } else {
1898                 # Avoid touching anything other than the users list
1899                 $project->{users} = \@newusers;
1900                 $project->_update_users;
1901                 warn "$projname: users list updated to \"@{[join(',',@newusers)]}\"\n" unless $quiet;
1902         }
1903         return 0;
1904 }
1905
1906 our %fieldnames;
1907 BEGIN {
1908         %fieldnames = (
1909                 owner         => [\&cmd_setowner,      0],
1910                 desc          => [\&cmd_setdesc,       0],
1911                 description   => [\&cmd_setdesc,       0],
1912                 readme        => [\&cmd_setreadme,     0],
1913                 head          => [\&cmd_sethead,       0],
1914                 HEAD          => [\&cmd_sethead,       0],
1915                 hooks         => [\&cmd_sethooks,      0],
1916                 hookspath     => [\&cmd_sethooks,      0],
1917                 cleanmirror   => [\&cmd_setbool,       1],
1918                 reverseorder  => [\&cmd_setbool,       1],
1919                 summaryonly   => [\&cmd_setbool,       1],
1920                 statusupdates => [\&cmd_setbool,       1],
1921                 autogchack    => [\&cmd_setautogchack, 0],
1922                 baseurl       => [\&cmd_seturl,        1],
1923                 homepage      => [\&cmd_seturl,        1],
1924                 notifyjson    => [\&cmd_seturl,        1],
1925                 jsontype      => [\&cmd_setjsontype,   0],
1926                 jsonsecret    => [\&cmd_setjsonsecret, 0],
1927                 notifymail    => [\&cmd_setmsgs,       1],
1928                 notifytag     => [\&cmd_setmsgs,       1],
1929                 users         => [\&cmd_setusers,      0],
1930         );
1931 }
1932
1933 sub do_getset {
1934         $setopt = shift;
1935         my @newargs = ();
1936         push(@newargs, shift) if @_ && $_[0] eq '--force';
1937         my $field = $_[1];
1938         (($setopt && @_ >= 3) || @_ == 2) && exists($fieldnames{$field}) or die_usage;
1939         push(@newargs, shift);
1940         shift unless ${$fieldnames{$field}}[1];
1941         push(@newargs, @_);
1942         diename(($setopt ? "set " : "get ") . $field);
1943         @ARGV = @newargs;
1944         &{${$fieldnames{$field}}[0]}(@ARGV);
1945 }
1946
1947 sub cmd_get {
1948         do_getset(0, @_);
1949 }
1950
1951 sub cmd_set {
1952         do_getset(1, @_);
1953 }
1954
1955 our %commands;
1956 BEGIN {
1957         %commands = (
1958                 list => \&cmd_list,
1959                 create => \&cmd_create,
1960                 adopt => \&cmd_adopt,
1961                 remove => \&cmd_remove,
1962                 trash => \&cmd_remove,
1963                 delete => \&cmd_remove,
1964                 show => \&cmd_show,
1965                 listheads => \&cmd_listheads,
1966                 listtags => \&cmd_listtags,
1967                 listctags => \&cmd_listtags,
1968                 deltags => \&cmd_deltags,
1969                 delctags => \&cmd_deltags,
1970                 addtags => \&cmd_addtags,
1971                 addctags => \&cmd_addtags,
1972                 chpass => \&cmd_chpass,
1973                 checkpw => \&cmd_checkpw,
1974                 gc => \&cmd_gc,
1975                 update => \&cmd_update,
1976                 remirror => \&cmd_remirror,
1977                 setowner => \&cmd_setowner,
1978                 setdesc => \&cmd_setdesc,
1979                 setdescription => \&cmd_setdesc,
1980                 setreadme => \&cmd_setreadme,
1981                 sethead => \&cmd_sethead,
1982                 sethooks => \&cmd_sethooks,
1983                 sethookspath => \&cmd_sethooks,
1984                 setbool => \&cmd_setbool,
1985                 setboolean => \&cmd_setbool,
1986                 setflag => \&cmd_setbool,
1987                 setautogchack => \&cmd_setautogchack,
1988                 seturl => \&cmd_seturl,
1989                 setjsontype => \&cmd_setjsontype,
1990                 setjsonsecret => \&cmd_setjsonsecret,
1991                 setmsgs => \&cmd_setmsgs,
1992                 setusers => \&cmd_setusers,
1993                 get => \&cmd_get,
1994                 set => \&cmd_set,
1995         );
1996 }
1997 our %nopager;
1998 BEGIN {
1999         %nopager = map({$_ => 1} qw(
2000                 create
2001                 chpass
2002                 checkpw
2003         ));
2004 }
2005
2006 sub dohelp {
2007         my $cmd = shift;
2008         my $bn = basename($0);
2009         setup_pager_stdout($usepager);
2010         printf "%s version %s\n\n", $bn, $VERSION;
2011         if (defined($cmd) && $cmd ne '') {
2012                 $cmd =~ s/^set(?=[a-zA-Z])//i;
2013                 my $cmdhelp = '';
2014                 my ($lastmt, $incmd);
2015                 foreach (split('\n', sprintf($help, $bn))) {
2016                         $lastmt || $incmd or $lastmt = /^\s*$/, next;
2017                         $incmd = 1 if $lastmt && /^\s*(?:\[?set\]?)?$cmd\s/;
2018                         last if $incmd && /^\s*$/;
2019                         $incmd and $cmdhelp .= $_ . "\n";
2020                         $lastmt = /^\s*$/;
2021                 }
2022                 print $cmdhelp and exit 0 if $cmdhelp;
2023         }
2024         printf $help, $bn;
2025         exit 0;
2026 }
2027
2028 sub main {
2029         local *ARGV = \@_;
2030         {
2031                 shift, $quiet=1, redo if @ARGV && $ARGV[0] =~ /^(?:-q|--quiet)$/i;
2032                 shift, $usepager=1, redo if @ARGV && $ARGV[0] =~ /^(?:-p|--pager|--paginate)$/i;
2033                 shift, $usepager=0, redo if @ARGV && $ARGV[0] =~ /^(?:--no-pager|--no-paginate)$/i;
2034         }
2035         dohelp($ARGV[1]) if !@ARGV || @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i;
2036         my $command = shift;
2037         diename($command);
2038         $setopt = 1;
2039         if (!exists($commands{$command}) && exists($commands{"set".$command})) {
2040                 $setopt = 0;
2041                 $command = "set" . $command;
2042         }
2043         exists($commands{$command}) or die "Unknown command \"$command\" -- try \"help\"\n";
2044         dohelp($command) if @ARGV && ($ARGV[0] =~ /^(?:-h|-?-help)$/i ||
2045                 $ARGV[0] =~ /^help$/i && !Girocco::Project::does_exist("help",1));
2046         $nopager{$command} and $usepager = 0;
2047         setup_pager_stdout($usepager);
2048         &{$commands{$command}}(@ARGV);
2049 }