make-apache-conf.sh: enhance and tidy up

[girocco.git] / toolbox / projtool.pl

#!/usr/bin/perl

# projtool.pl - command line Girocco project maintenance tool
# Copyright (C) 2016,2017,2020 Kyle J. McKay.  All rights reserved.
# License GPLv2+: GNU GPL version 2 or later.
# www.gnu.org/licenses/gpl-2.0.html
# This is free software: you are free to change and redistribute it.
# There is NO WARRANTY, to the extent permitted by law.

use strict;
use warnings;
use vars qw($VERSION);
BEGIN {*VERSION = \'1.0.1'}
use File::Basename;
use Digest::MD5 qw(md5_hex);
use IO::Socket;
use Cwd qw(realpath);
use POSIX qw(strftime);
use lib "__BASEDIR__";
use Girocco::Config;
use Girocco::Util;
use Girocco::HashUtil;
use Girocco::CLIUtil;
use Girocco::Project;
use Girocco::User;

exit(&main(@ARGV)||0);

our $help;
BEGIN {$help = <<'HELP'}
Usage: %s [--quiet] <command> <options>

       help [<command>]
              show full help or just for <command> if given

       list [--verbose] [--sort=lcname|name|owner|gid|no] [--owner] [<regexp>]
              list all projects (default is --sort=lcname)
              limit to project names matching <regex> if given
              match <regex> against owner instead of project name with --owner

       create [--force] [--no-alternates] [--orphan] [<option>...] <project>
              create new project <project> (prompted)
              <option> can be:
                  --no-alternates skip setup of objects/info/alternates
                  --orphan        allow creation of subproject w/o a parent
                  -p              use mkdir -p during --orphan creation
                  --no-password   set password crypt to invalid value "unknown"
                  --no-owner      leave the gitweb.owner config unset
                  --mirror=<url>  create a mirror from <url>
                  --full-mirror   mirror all refs
                  --push[=<list>] create a push project
                  --desc=<string> specify project description w/o prompt
                  --homepage=<url> specify project homepage URL w/o prompt
                  --defaults      do no interactive prompting at all
              Using --no-password skips the prompts for password, using
              --no-owner skips the prompt for owner and using --mirror=<url>
              or --push[=<list>] skips the prompts for mirror URL and
              heads-only and push users.  With --defaults if neither
              --mirror=<url> nor --push[=<list>] is given then --push will
              be implied.  Using --desc=<string> will force a specific
              description (including an empty string) and skip the prompt for
              it.  Otherwise a non-empty default description will always be
              supplied in lieu of an empty or omitted description.

       adopt [--force] [--type=mirror|push] [<option>...] <project> [<users>]
              adopt project <project>
              type of project is guessed if --type=<type> omitted
              <users> is same as <newuserslist> for setusers command
              <option> can be:
                  --dry-run     do all the checks but don't perform adoption
                  --verbose     show project info dump (useful with --dry-run)
                  --no-users    no push users at all (<users> must be omitted)
                  --no-owner    leave the gitweb.owner config totally unchanged
                  --owner=<val> set the gitweb.owner config to <val>
              Both --no-owner and --owner=<val> may NOT be given, with neither
              take owner from preexisting gitweb.owner else use admin setting.
              For mirrors <users> is ignored otherwise if no <users> and no
              --no-users option the push users list will consist of the single
              user name matching the owner or empty if none or more than one.
              With --dry-run <project> can be an absolute path to a git dir.

       remove [--force] [--really-delete] [--keep-forks] <project>
              remove project <project>
              do not move to _recyclebin with --really-delete (just rm -rf)
              remove projects with forks (by keeping forks) using --keep-forks

       show <project>
              show project <project>

       listheads <project>
              list all available heads for <project> and indicate current head

       listtags [--verbose] <project>
              list all ctags on project <project>

       deltags <project> [-i] <tagstodel>
              remove any ctags on project <project> present in <tagstodel>
              <tagstodel> is space or comma separated list of tags to remove
              with -i match against <tagstodel> without regard to letter case

       addtags <project> <tagstoadd>
              add ctags to project <project>
              <tagstoadd> is space or comma separated list of tags to add

       chpass [--force] <project> [random | unknown]
              change project <project> password (prompted)
              with "random" set to random password
              with "unknown" set password hash to invalid value "unknown"

       checkpw <project>
              check project <project> password for a match (prompted)

       gc [--force | --auto] [--redelta | --recompress] <project>
              run the gc.sh script on project <project>
              with --auto let the gc.sh script decide what to do
              with --force cause a full gc to take place (force_gc=1)
              with neither --auto nor --force do a mini or if needed a full gc
              (in other words just touch .needsgc and run gc.sh)
              with --redelta a full gc will use pack-objects --no-reuse-delta
              with --recompress a full gc uses pack-objects --no-reuse-object
              (--no-reuse-delta and --no-reuse-object are accepted as aliases)
              unless the global --quiet option is given show_progress=1 is used

       update [--force] [--quiet | --summary] <project>
              run the update.sh script on project <project>
              with --force cause a fetch to always take place (force_update=1)
              with --quiet only show errors (show_progress is left unset)
              with --summary show progress and ref summary (show_progress=1)
              with neither --quiet nor --summary show it all (show_progress=2)

       remirror [--force] <project>
              initiate a remirror of project <project>

       [set]owner [--force] <project> <newowner>
              set project <project> owner to <newowner>
              without "set" and only 1 arg, just show current project owner

       [set]desc [--force] <project> <newdesc>
              set project <project> description to <newdesc>
              without "set" and only 1 arg, just show current project desc

       [set]readme [--force] <project> <newsetting>
              set project <project> readme to <newsetting>
              <newsetting> is automatic|suppressed|-|[@]filename
              without "set" and only 2 args, just show current readme setting

       [set]head <project> <newhead>
              set project <project> HEAD symbolic ref to <newhead>
              without "set" and only 1 arg, just show current project HEAD

       [set]bool [--force] <project> <flagname> <boolvalue>
              set project <project> boolean <flagname> to <boolvalue>
              <flagname> is cleanmirror|reverseorder|summaryonly|statusupdtaes
              without "set" and only 2 args, just show current flag value

       [set]hooks [--force] <project> local | global | <path>
              set project <project> hookspath to local, global or <path>
              without "set" and only 1 arg, just show current hookspath

       [set]autogchack <project> <boolvalue> | unset
              set project <project> autogchack to <boolvalue> or "unset" it
              without "set" just show current autogchack setting if enabled
              with "set" autogchack must be enabled in Config.pm for the
              type of project and maintain-auto-gc-hack.sh is always run

       [set]url [--force] <project> <urlname> <newurlvalue>
              set project <project> url <urlname> to <newurlvalue>
              <urlname> is baseurl|homepage|notifyjson
              without "set" and only 2 args, just show current url value

       [set]msgs [--force] <project> <msgsname> <eaddrlist>
              set project <project> msgs <msgsname> to <addrlist>
              <msgsname> is notifymail|notifytag
              <eaddrlist> is space or comma separated list of email addresses
              without "set" and only 2 args, just show current msgs value

       [set]users [--force] <project> <newuserslist>
              set push project <project> users list to <newuserslist>
              <newuserslist> is space or comma separated list of user names
              without "set" and only 1 arg, just show current users list

       get <project> <fieldname>
              show project <project> field <fieldname>
              <fieldname> is owner|desc|readme|head|hooks|users
                          or <flagname>|autogchack|<urlname>|<msgsname>

       set [--force] <project> <fieldname> <newfieldvalue>
              set project <project> field <fieldname> to <newfieldvalue>
              <fieldname> same as for get
              <newfieldvalue> same as for corresponding set... command
HELP

our $quiet;
our $setopt;
sub die_usage {
        my $sub = shift || diename;
        if ($sub) {
                die "Invalid arguments to $sub command -- try \"help\"\n";
        } else {
                die "Invalid arguments -- try \"help\"\n";
        }
}

sub get_readme_desc {
        my $rm = shift;
        defined($rm) or $rm = '';
        if (length($rm)) {
                my $test = $rm;
                $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
                $test =~ s/\s+//s;
                return $test eq '' ? "suppressed" : "length " . length($rm);
        } else {
                return "automatic";
        }
}

sub get_ctag_counts {
        my $project = shift;
        my $compact = shift;
        my @ctags = ();
        foreach ($project->get_ctag_names) {
                my $val = 0;
                my $ct;
                if (open $ct, '<', $project->{path}."/ctags/$_") {
                        my $count = <$ct>;
                        close $ct;
                        defined $count or $count = '';
                        chomp $count;
                        $val = $count =~ /^[1-9]\d*$/ ? $count : 1;
                }
                if ($compact) {
                        if ($val == 1) {
                                push(@ctags, $_);
                        } elsif ($val > 1) {
                                push(@ctags, $_."(".$val.")");
                        }
                } else {
                        push(@ctags, [$_, $val]) if $val;
                }
        }
        @ctags;
}

sub get_clean_project {
        my $project = get_project(@_);
        delete $project->{loaded};
        delete $project->{base_path};
        delete $project->{ccrypt};
        /^orig/i || !defined($project->{$_}) and delete $project->{$_} foreach keys %$project;
        $project->{owner} = $project->{email}; delete $project->{email};
        $project->{homepage} = $project->{hp}; delete $project->{hp};
        $project->{baseurl} = $project->{url}; delete $project->{url};
        if (defined($project->{path}) && $project->{path} ne "") {
                my $rp = realpath($project->{path});
                defined($rp) && $rp ne "" and $project->{realpath} = $rp;
                if (-f "$rp/objects/info/packs") {
                        my $ipt = (stat _)[9];
                        defined($ipt) and $project->{infopackstime} =
                                strftime("%Y-%m-%d %H:%M:%S %z", localtime($ipt));
                }
        }
        my $owner = $project->{owner};
        if ($owner) {
                $owner = lc($owner);
                my @owner_users = map {$owner eq lc($$_[4]) ? $$_[1] : ()} get_all_users;
                $project->{owner_users} = \@owner_users if @owner_users;
        }
        my $projname = $project->{name};
        my @forks = grep {$$_[1] =~ m,^$projname/,} get_all_projects;
        $project->{has_forks} = 1 if @forks;
        $project->{has_alternates} = 1 if $project->has_alternates;
        my @bundles = $project->bundles;
        for (my $i = 0; $i < @bundles; ++$i) {
                my $secs = $bundles[$i]->[0];
                $bundles[$i]->[0] = strftime("%Y-%m-%d %H:%M:%S %z", localtime($secs));
                my $sz = $bundles[$i]->[2];
                1 while $sz =~ s/(?<=\d)(\d{3})(?:,|$)/,$1/g;
                $bundles[$i]->[2] = $sz;
        }
        delete $project->{bundles};
        $project->{bundles} = \@bundles if @bundles;
        $project->{mirror} = 0 unless $project->{mirror};
        $project->{is_empty} = 1 if $project->is_empty;
        delete $project->{showpush} unless $project->{showpush};
        delete $project->{users} if $project->{mirror};
        delete $project->{baseurl} unless $project->{mirror};
        delete $project->{banged} unless $project->{mirror};
        delete $project->{lastrefresh} unless $project->{mirror};
        delete $project->{cleanmirror} unless $project->{mirror};
        delete $project->{statusupdates} unless $project->{mirror};
        delete $project->{lastparentgc} unless $projname =~ m,/,;
        unless ($project->{banged}) {
                delete $project->{bangcount};
                delete $project->{bangfirstfail};
                delete $project->{bangmessagesent};
        }
        my $projhook = $project->_has_notifyhook;
        if (defined($projhook) && $projhook ne "") {
                $project->{notifyhook} = $projhook;
        } else {
                delete $project->{notifyhook};
        }
        $project->{README} = get_readme_desc($project->{README}) if exists($project->{README});
        my @tags = get_ctag_counts($project, 1);
        $project->{tags} = \@tags if @tags;
        my $projconfig = read_config_file_hash($project->{path}."/config");
        if (defined($projconfig) && defined($projconfig->{"core.hookspath"})) {
                my $ahp = $projconfig->{"core.hookspath"};
                my $rahp = realpath($ahp);
                my $lhp = $project->{path}."/hooks";
                my $rlhp = realpath($lhp);
                my $ghp = $Girocco::Config::reporoot."/_global/hooks";
                my $rghp = realpath($ghp);
                $project->{has_local_hooks} = 1 if
                        defined($rahp) && defined($rlhp) && $rahp eq $rlhp;
                $project->{has_global_hooks} = 1 if
                        defined($rahp) && defined($rghp) && $rahp eq $rghp;
                $project->{hookspath} = $ahp unless $ahp eq $lhp || $ahp eq $ghp;
        }
        $project;
}

sub clean_addrlist {
        my %seen = ();
        my @newlist = ();
        foreach (split(/[,\s]+/, $_[0])) {
                next unless $_;
                $seen{lc($_)} = 1, push(@newlist, $_) unless $seen{lc($_)};
        }
        return join(($_[1]||","), @newlist);
}

sub valid_addrlist {
        my $cleaned = clean_addrlist(join(" ", @_));
        return 1 if $cleaned eq "";
        valid_email_multi($cleaned) && length($cleaned) <= 512;
}

sub validate_users {
        my ($userlist, $force, $nodie, $quiet) = @_;
        my @newusers = ();
        my $badlist = 0;
        my %seenuser = ();
        my $mobok = $Girocco::Config::mob && $Girocco::Config::mob eq "mob";
        my %users = map({($$_[1] => $_)} get_all_users);
        foreach (split(/[\s,]+/, $userlist)) {
                if (exists($users{$_}) || $_ eq "everyone" || ($mobok && $_ eq "mob")) {
                        $seenuser{$_}=1, push(@newusers, $_) unless $seenuser{$_};
                        next;
                }
                if (Girocco::User::does_exist($_, 1)) {
                        if ($force) {
                                $seenuser{$_}=1, push(@newusers, $_) unless $seenuser{$_};
                        } else {
                                $badlist = 1;
                                warn "refusing to allow questionable user \"$_\" without --force\n" unless $nodie && $quiet;
                        }
                        next;
                }
                $badlist = 1;
                warn "invalid user: \"$_\"\n" unless $nodie && $quiet
        }
        die if $badlist && !$nodie;
        return @newusers;
}

sub is_default_desc {
        # "Unnamed repository; edit this file 'description' to name the repository."
        # "Unnamed repository; edit this file to name it for gitweb."
        local $_ = shift;
        return 0 unless defined($_);
        /Unnamed\s+repository;/i && /\s+edit\s+this\s+file\s+/i && /\s+to\s+name\s+/i;
}

sub valid_desc {
        my $test = shift;
        chomp $test;
        return 0 if $test =~ /[\r\n]/;
        $test =~ s/\s\s+/ /g;
        $test =~ s/^\s+//;
        $test =~ s/\s+$//;
        return $test ne '';
}

sub clean_desc {
        my $desc = shift;
        defined($desc) or $desc = '';
        chomp $desc;
        $desc = to_utf8($desc, 1);
        $desc =~ s/\s\s+/ /g;
        $desc =~ s/^\s+//;
        $desc =~ s/\s+$//;
        return $desc;
}

sub parse_options {
        Girocco::CLIUtil::_parse_options(
                sub {
                        warn((($_[0]eq'?')?"unrecognized":"missing argument for")." option \"$_[1]\"\n")
                                unless $quiet;
                        die_usage;
                }, @_);
}

sub cmd_list {
        my %sortsub = (
                lcname => sub {lc($$a[1]) cmp lc($$b[1])},
                name => sub {$$a[1] cmp $$b[1]},
                gid => sub {$$a[3] <=> $$b[3]},
                owner => sub {lc($$a[4]) cmp lc($$b[4]) || lc($$a[1]) cmp lc($$b[1])},
                no => sub {$$a[0] <=> $$b[0]},
        );
        my $sortopt = 'lcname';
        my ($verbose, $owner);
        parse_options(":sort" => \$sortopt, verbose => \$verbose, owner => \$owner);
        my $regex;
        if (@ARGV) {
                my $val = shift @ARGV;
                $regex = qr($val) or die "bad regex \"$val\"\n";
        }
        !@ARGV && exists($sortsub{$sortopt}) or die_usage;
        my $sortsub = $sortsub{$sortopt};
        my $grepsub = defined($regex) ? ($owner ? sub {$$_[4] =~ /$regex/} : sub {$$_[1] =~ /$regex/}) : sub {1};
        my @projects = sort($sortsub grep {&$grepsub} get_all_projects);
        if ($verbose) {
                print map(sprintf("%s\n", join(":", (@$_)[1..5])), @projects);
        } else {
                print map(sprintf("%s: %s\n", $$_[1], $$_[5] =~ /^:/ ? "<mirror>" : $$_[5]), @projects);
        }
        return 0;
}

sub cmd_create {
        my ($force, $noalternates, $orphanok, $optp, $nopasswd, $noowner, $defaults, $ispush, $pushusers,
                $ismirror, $desc, $fullmirror, $homepage);
        parse_options(
                force => \$force, "no-alternates" => \$noalternates, orphan => \$orphanok, p => \$optp,
                "no-password" => \$nopasswd, "no-owner" => \$noowner, defaults => \$defaults,
                "push" => \$ispush, ":push" => \$pushusers, ":mirror" => \$ismirror, ":desc" => \$desc,
                ":description" => \$desc, "full-mirror" => \$fullmirror, ":homepage" => \$homepage);
        @ARGV == 1 or die_usage;
        !defined($pushusers) || defined($ispush) or $ispush = 1;
        defined($ismirror) && $ismirror =~ /^\s*$/ and die "--mirror url must not be empty\n";
        die "--mirror and --push are mutually exclusive options\n" if $ismirror && $ispush;
        die "--full-mirror requires use of --mirror=<url> option\n" if $fullmirror && !$ismirror;
        !$defaults || defined($ispush) || defined($ismirror) or $ispush = 1;
        !$defaults || defined($nopasswd) or $nopasswd = 1;
        !$defaults || defined($noowner) or $noowner = 1;
        !defined($ispush) || defined($pushusers) or $pushusers = "";
        my $projname = $ARGV[0];
        $projname =~ s/\.git$//i;
        Girocco::Project::does_exist($projname, 1) and die "Project already exists: \"$projname\"\n";
        if (!Girocco::Project::valid_name($projname, $orphanok, $optp)) {
                warn "Refusing to create orphan project without --orphan\n"
                        if !$quiet && !$orphanok && Girocco::Project::valid_name($projname, 1, 1);
                warn "Required orphan parent directory does not exist (use -p): ",
                        $Girocco::Config::reporoot.'/'.Girocco::Project::get_forkee_name($projname), "\n"
                        if !$quiet && $orphanok && Girocco::Project::valid_name($projname, 1, 1);
                die "Invalid project name: \"$projname\"\n";
        }
        my ($forkee, $project) = ($projname =~ m#^(.*/)?([^/]+)$#);
        my $newtype = $forkee ? 'fork' : 'project';
        if (length($project) > 64) {
                die "The $newtype name is longer than 64 characters.  Do you really need that much?\n"
                        unless $force;
                warn "Allowing $newtype name longer than 64 characters with --force\n" unless $quiet;
        }
        unless ($Girocco::Config::push || $Girocco::Config::mirror) {
                die "Project creation disabled (no mirrors or push projects allowed)\n" unless $force;
                warn "Continuing with --force even though both push and mirror projects are disabled\n" unless $quiet;
        }
        print "Enter settings for new project \"$projname\"\n" unless $defaults;
        my %settings = ();
        $settings{noalternates} = $noalternates;
        if ($nopasswd) {
                $settings{crypt} = "unknown";
        } else {
                my $np1 = prompt_noecho_nl_or_die("Admin password for project $projname (echo is off)");
                $np1 ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
                my $np2 = prompt_noecho_nl_or_die("Retype admin password for project $projname");
                $np1 eq $np2 or die "Our high-paid security consultants have determined that\n" .
                        "the admin passwords you have entered do not match each other.\n";
                $settings{crypt} = scrypt_sha1($np1);
        }
        my $owner = "";
        unless ($noowner) {
                $owner = prompt_or_die("Owner/email name for project $projname");
                unless (valid_email($owner)) {
                        unless ($force) {
                                warn "Your email sure looks weird...?\n";
                                redo;
                        }
                        warn "Allowing invalid email with --force\n" unless $quiet;
                }
                if (length($owner) > 96) {
                        unless ($force) {
                                warn "Your email is longer than 96 characters.  Do you really need that much?\n";
                                redo;
                        }
                        warn "Allowing email longer than 96 characters with --force\n" unless $quiet;
                }
        }
        $settings{email} = $owner;
        my $baseurl = "";
        my $checkmirror = sub {
                my $checkurl = shift;
                unless (valid_repo_url($checkurl)) {
                        unless ($force) {
                                warn "Invalid mirror URL: \"$checkurl\"\n";
                                return undef;
                        }
                        warn "Allowing invalid mirror URL with --force\n" unless $quiet;
                }
                if ($Girocco::Config::restrict_mirror_hosts) {
                        my $mh = extract_url_hostname($checkurl);
                        unless (is_dns_hostname($mh)) {
                                unless ($force) {
                                        warn "Invalid non-DNS mirror URL: \"$checkurl\"\n";
                                        return undef;
                                }
                                warn "Allowing non-DNS mirror URL with --force\n" unless $quiet;
                        }
                        if (is_our_hostname($mh)) {
                                unless ($force) {
                                        warn "Invalid same-host mirror URL: \"$checkurl\"\n";
                                        return undef;
                                }
                                warn "Allowing same-host mirror URL with --force\n" unless $quiet;
                        }
                }
                return $checkurl;
        };
        if ($ispush || $ismirror) {
                !$ispush || $force || $Girocco::Config::push or
                        die "Push projects are disabled, create a mirror (or use --force)\n";
                !$ismirror || $force || $Girocco::Config::mirror or
                        die "Mirror projects are disabled, create a push project (or use --force)\n";
                if ($ismirror) {
                        &$checkmirror($ismirror) or die "Invalid --mirror URL\n";
                        $baseurl = $ismirror;
                        $settings{url} = $baseurl;
                        $settings{cleanmirror} = $fullmirror ? 0 : 1;
                } else {
                        my @newusers = ();
                        if ($pushusers !~ /^[\s,]*$/) {
                                eval {@newusers = validate_users($pushusers, $force); 1;} or
                                        die "Invalid --push user list\n";
                        }
                        $settings{users} = \@newusers;
                }
        } elsif ($force || $Girocco::Config::mirror) {{
                if ($force || $Girocco::Config::push) {
                        $baseurl = prompt_or_die("URL to mirror from (leave blank for push project)", "");
                } else {{
                        $baseurl = prompt_or_die("URL to mirror from");
                        unless ($baseurl ne "") {
                                warn "Push projects are disabled, you must enter a mirror URL (or use --force)\n";
                                redo;
                        }
                }}
                if ($baseurl ne "") {
                        &$checkmirror($baseurl) or redo;
                        $settings{url} = $baseurl;
                        $settings{cleanmirror} =
                                ynprompt_or_die("Mirror only heads, tags and notes (Y/n)", "Yes");
                }
        }}
        my $mirror = ($baseurl eq "") ? 0 : 1;
        my $checkdesc = sub {
                my $d = shift;
                if (length($d) > 1024) {
                        unless ($force) {
                                warn "Short description length greater than 1024 characters!\n";
                                return undef;
                        }
                        warn "Allowing short description length greater than 1024 characters\n" unless $quiet;
                }
                return $d;
        };
        if (defined($desc)) {
                $desc =~ s/^\s+//; $desc =~ s/\s+$//;
                $desc eq "" || &$checkdesc($desc) or
                        die "Invalid --desc description\n";
        } elsif (!$defaults) {
                $desc = prompt_or_die("Short description", "");
                $desc =~ s/^\s+//; $desc =~ s/\s+$//;
                $desc eq "" || &$checkdesc($desc) or redo;
                $desc = undef if $desc eq "";
        }
        defined($desc) or $desc = $mirror ? "Mirror of $baseurl" : "Push project $projname";
        $settings{desc} = $desc;
        my $checkhp = sub {
                my $hpurl = shift;
                unless (valid_web_url($hpurl)) {
                        unless ($force) {
                                warn "Invalid home page URL: \"$hpurl\"\n";
                                return undef;
                        }
                        warn "Allowing invalid home page URL with --force\n" unless $quiet;
                }
                return $hpurl;
        };
        if (defined($homepage)) {
                $homepage =~ s/^\s+//; $homepage =~ s/\s+$//;
                $homepage eq "" || &$checkhp($homepage) or
                        die "Invalid --homepage URL\n";
        } elsif (!$defaults) {
                $homepage = prompt_or_die("Home page URL", "");
                $homepage =~ s/^\s+//; $homepage =~ s/\s+$//;
                $homepage eq "" || &$checkhp($homepage) or redo;
                $homepage = undef if $homepage eq "";
        }
        $settings{hp} = $homepage;
        my $jsonurl = "";
        if (!$defaults) {
                $jsonurl = prompt_or_die("JSON notify POST URL", "");
                if ($jsonurl ne "" && !valid_web_url($jsonurl)) {
                        unless ($force) {
                                warn "Invalid JSON notify POST URL: \$jsonurl\"\n";
                                redo;
                        }
                        warn "Allowing invalid JSON notify POST URL with --force\n" unless $quiet;
                }
        }
        $settings{notifyjson} = $jsonurl;
        my $commitaddrs = "";
        if (!$defaults) {
                $commitaddrs = clean_addrlist(prompt_or_die("Commit notify email addr(s)", ""));
                if ($commitaddrs ne "" && !valid_addrlist($commitaddrs)) {
                        unless ($force) {
                                warn"invalid commit notify email address list (use --force to accept): \"$commitaddrs\"\n";
                                redo;
                        }
                        warn "using invalid commit notify email address list with --force\n" unless $quiet;
                }
        }
        $settings{notifymail} = $commitaddrs;
        $settings{reverseorder} = 1;
        $settings{reverseorder} = ynprompt_or_die("Oldest-to-newest commit order in emails", "Yes")
                if !$defaults && $commitaddrs ne "";
        $settings{summaryonly} = ynprompt_or_die("Summary only (no diff) in emails", "No")
                if !$defaults && $commitaddrs ne "";
        my $tagaddrs = "";
        if (!$defaults) {
                $tagaddrs = clean_addrlist(prompt_or_die("Tag notify email addr(s)", ""));
                if ($tagaddrs ne "" && !valid_addrlist($tagaddrs)) {
                        unless ($force) {
                                warn"invalid tag notify email address list (use --force to accept): \"$tagaddrs\"\n";
                                redo;
                        }
                        warn "using invalid tag notify email address list with --force\n" unless $quiet;
                }
        }
        $settings{notifytag} = $tagaddrs;
        if (!$mirror && !$ispush) {
                my @newusers = ();
                {
                        my $userlist = prompt_or_die("Push users", join(",", @newusers));
                        eval {@newusers = validate_users($userlist, $force); 1;} or redo;
                }
                $settings{users} = \@newusers;
        }
        my $newproj = Girocco::Project->ghost($projname, $mirror, $orphanok, $optp)
                or die "Girocco::Project->ghost call failed\n";
        my ($k, $v);
        $newproj->{$k} = $v while ($k, $v) = each(%settings);
        my $killowner = sub {
                system($Girocco::Config::git_bin, '--git-dir='.$newproj->{path},
                        'config', '--unset', "gitweb.owner");
        };
        if ($mirror) {
                $newproj->premirror or die "Girocco::Project->premirror failed\n";
                !$noowner or &$killowner;
                $newproj->clone or die "Girocco::Project->clone failed\n";
                warn "Project $projname created and cloning successfully initiated.\n"
                        unless $quiet;
        } else {
                $newproj->conjure or die "Girocco::Project->conjure failed\n";
                !$noowner or &$killowner;
                warn "New push project fork is empty due to use of --no-alternates\n"
                        if !$quiet && $projname =~ m,/, && $noalternates;
                warn "Project $projname successfully created.\n" unless $quiet;
        }
        return 0;
}

sub git_config {
        my $gd = shift;
        system($Girocco::Config::git_bin, "--git-dir=$gd", 'config', @_) == 0
                or die "\"git --git-dir='$gd' config ".join(" ", @_)."\" failed.\n";
}

sub cmd_adopt {
        my ($force, $type, $nousers, $dryrun, $noowner, $owner, $users, $verbose);
        parse_options(force => \$force, ":type" => \$type, "no-users" => \$nousers, "dry-run" => \$dryrun,
                "no-owner" => \$noowner,":owner" => \$owner, quiet => \$quiet, q =>\$quiet, verbose => \$verbose);
        @ARGV or die "Please give project name on command line.\n";
        my $projname = shift @ARGV;
        (!$noowner || !defined($owner)) && (!$nousers || !@ARGV) or die_usage;
        !defined($type) || $type eq "mirror" || $type eq "push" or die_usage;
        defined($type) or $type = "";
        my $projdir;
        if ($dryrun && $projname =~ m,^/[^.\s/\\:], && is_git_dir(realpath($projname))) {
                $projdir = realpath($projname);
                $projname = $projdir;
                $projname =~ s/\.git$//i;
                $projname =~ s,/+$,,;
                $projname =~ s,^.*/,,;
                $projname ne "" or $projname = $projdir;
        } else {
                $projname =~ s/\.git$//i;
                $projname ne "" or die "Invalid project name \"\".\n";
                unless (Girocco::Project::does_exist($projname, 1)) {
                        Girocco::Project::valid_name($projname, 1, 1)
                                or die "Invalid project name \"$projname\".\n";
                        die "No such project to adopt: $projname\n";
                }
                defined(Girocco::Project->load($projname))
                        and die "Project already known (no need to adopt): $projname\n";
                $projdir = $Girocco::Config::reporoot . "/" . $projname . ".git";
                is_git_dir($projdir) or die "Not a git directory: \"$projdir\"\n";
        }
        my $config = read_config_file($projdir . "/config");
        my %config = ();
        %config = map {($$_[0], defined($$_[1])?$$_[1]:"true")} @$config if defined($config);
        git_bool($config{"core.bare"}) or die "Not a bare git repository: \"$projdir\"\n";
        defined(read_HEAD_symref($projdir)) or die "Project with non-symbolic HEAD ref: \"$projdir\"\n";
        @ARGV and $users = [validate_users(join(" ", @ARGV), $force, 1, $quiet)];
        my $desc = "";
        if (-e "$projdir/description") {
                open my $fd, '<', "$projdir/description" or die "Cannot open \"$projdir/description\": $!\n";
                {
                        local $/;
                        $desc = <$fd>;
                }
                close $fd;
                defined $desc or $desc = "";
                chomp $desc;
                $desc = to_utf8($desc, 1);
                is_default_desc($desc) and $desc = "";
                if ($desc ne "" && !valid_desc($desc)) {
                        die "invalid 'description' file contents (use --force to accept): \"$desc\"\n"
                                unless $force;
                        warn "using invalid 'description' file contents  with --force\n" unless $quiet;
                }
                $desc = clean_desc($desc);
                if (length($desc) > 1024) {
                        die "description longer than 1024 chars (use --force to accept): \"$desc\"\n"
                                unless $force;
                        warn "using longer than 1024 char description with --force\n" unless $quiet;
                }
        }
        my $readme = "";
        if (-e "$projdir/README.html") {
                open my $fd, '<', "$projdir/README.html" or die "Cannot open \"$projdir/README.html\": $!\n";
                {
                        local $/;
                        $readme = <$fd>;
                }
                close $fd;
                defined $readme or $readme = "";
                $readme = to_utf8($readme, 1);
                $readme =~ s/\r\n?/\n/gs;
                $readme =~ s/^\s+//s;
                $readme =~ s/\s+$//s;
                $readme eq "" or $readme .= "\n";
                if (length($readme) > 8192) {
                        die "readme greater than 8192 chars is too long (use --force to override)\n"
                                unless $force;
                        warn "using readme greater than 8192 chars with --force\n" unless $quiet;
                }
                my $rd = get_readme_desc($readme);
                if ($rd ne "automatic" && $rd ne "suppressed") {
                        my $xmllint = qx(sh -c 'command -v xmllint'); chomp $xmllint;
                        if (-f $xmllint && -x $xmllint) {
                                my $dummy = {README => $readme};
                                my ($cnt, $err) = Girocco::Project::_lint_readme($dummy, 0);
                                if ($cnt) {
                                        my $msg = "xmllint: $cnt error";
                                        $msg .= "s" unless $cnt == 1;
                                        print STDERR "$msg\n", "-" x length($msg), "\n", $err
                                                unless $force && $quiet;
                                        exit(255) unless $force;
                                        warn "$projname: using invalid raw HTML with --force\n" unless $quiet;
                                }
                        } else {
                                die "xmllint not available, refusing to use raw HTML without --force\n"
                                        unless $force;
                                warn "xmllint not available using unchecked raw HTML with --force\n" unless $quiet;
                        }
                }
        }
        # Inspect any remotes now
        # Yes, Virginia, remote urls can be multi-valued
        my %remotes = ();
        foreach (@$config) {
                my ($k,$v) = @$_;
                next unless $k =~ /^remote\.([^\/].*?)\.([^.]+)$/; # remote name cannot start with "/"
                my ($name, $subkey) = ($1, $2);
                $remotes{$name}->{skip} = git_bool($v,1), next if $subkey eq "skipdefaultupdate" || $subkey eq "skipfetchall";
                $remotes{$name}->{mirror} = git_bool($v,1), next if $subkey eq "mirror"; # we might want this
                $remotes{$name}->{vcs} = $v, next if defined($v) && $v !~ /^\s*$/ && $subkey eq "vcs";
                push(@{$remotes{$name}->{$subkey}}, $v), next if defined($v) && $v !~ /^\s*$/ &&
                        ($subkey eq "url" || $subkey eq "fetch" || $subkey eq "push" || $subkey eq "pushurl");
        }
        # remotes.default is the default remote group to fetch for "git remote update" otherwise --all
        # the remote names in a group are separated by runs of [ \t\n] characters
        # remote names "", ".", ".." and any name starting with "/" are invalid
        # a remote with no url or vcs setting is not considered valid
        my @check = ();
        my $usingall = 0;
        if (exists($config{"remotes.default"})) {
                foreach (split(/[ \t\n]+/, $config{"remotes.default"})) {
                        next unless exists($remotes{$_});
                        my $rmt = $remotes{$_};
                        next if !exists($rmt->{url}) && !$rmt->{vcs};
                        push(@check, $_);
                }
        } else {
                $usingall = 1;
                my %seenrmt = ();
                foreach (@$config) {
                        my ($k,$v) = @$_;
                        next unless $k =~ /^remote\.([^\/].*?)\.[^.]+$/;
                        next if $seenrmt{$1};
                        $seenrmt{$1} = 1;
                        next unless exists($remotes{$1});
                        my $rmt = $remotes{$1};
                        next if $rmt->{skip} || (!exists($rmt->{url}) && !$rmt->{vcs});
                        push(@check, $1);
                }
        }
        my @needskip = (); # remotes that need skipDefaultUpdate set to true
        my $foundvcs = 0;
        my $foundfetch = 0;
        my $foundfetchwithmirror = 0;
        foreach (@check) {
                my $rmt = $remotes{$_};
                push(@needskip, $_) if $usingall && !exists($rmt->{fetch});
                next unless exists($rmt->{fetch});
                ++$foundfetch;
                ++$foundfetchwithmirror if $rmt->{mirror};
                ++$foundvcs if $rmt->{vcs} || (exists($rmt->{url}) && $rmt->{url}->[0] =~ /^[a-zA-Z0-9][a-zA-Z0-9+.-]*::/);
        }
        # if we have $foundvcs then we need to explicitly set fetch.prune to false
        # if we have $foundfetch > 1 then we need to explicitly set fetch.prune to false
        my $neednoprune = !exists($config{"fetch.prune"}) && ($foundvcs || $foundfetch > 1);
        my $baseurl = "";
        my $needfakeorigin = 0; # if true we need to set remote.origin.skipDefaultUpdate = true
        # if remote "origin" exists we always pick up its first url or use ""
        if (exists($remotes{origin})) {
                my $rmt = $remotes{origin};
                $baseurl = exists($rmt->{url}) ? $rmt->{url}->[0] : "";
                $needfakeorigin = !exists($rmt->{url}) && !$rmt->{vcs} && !$rmt->{skip};
        } else {
                $needfakeorigin = 1;
                # get the first url of the @check remotes
                foreach (@check) {
                        my $rmt = $remotes{$_};
                        next unless exists($rmt->{url});
                        next unless defined($rmt->{url}->[0]) && $rmt->{url}->[0] ne "";
                        $baseurl = $rmt->{url}->[0];
                        last;
                }
        }
        my $makemirror = $type eq "mirror" || ($type eq "" && $foundfetch);

        # If we have $foundfetch we want to make a mirror but complain if
        # we $foundfetchwithmirror as well unless we have --type=mirror.
        # Warn if we have --type=push and $foundfetch and !$foundfetchwithmirror.
        # Warn if we need to set fetch.prune=false when making a mirror
        # Warn if we need to create remote.origin.skipDefaultUpdate when making a mirror
        # Complain if @needskip AND !$usingall (warn with --force but don't set skip)
        # Warn if $usingall and any @needskip (and set them) if making a mirror
        # Warn if making a mirror and $baseurl eq ""
        # Warn if we have --type=mirror and !$foundfetch

        if ($makemirror) {
                warn "No base URL to mirror from for adopted \"$projname\"\n" unless $quiet || $baseurl ne "";
                warn "Adopting mirror \"$projname\" without any fetch remotes\n" unless $quiet || $foundfetch;
                if ($foundfetchwithmirror) {
                        warn "Refusing to adopt mirror \"$projname\" with active remote.<name>.mirror=true remote(s)\n".
                            "(Use --type=mirror to override)\n"
                                unless $type eq "mirror";
                        exit(255) unless $type eq "mirror" || $dryrun;
                        warn "Adopting mirror \"$projname\" with active remote.<name>.mirror=true remotes\n"
                                unless $quiet || $type ne "mirror";
                }
                warn "Setting explicit fetch.prune=false for adoption of mirror \"$projname\"\n"
                        if !$quiet && $neednoprune;
                warn "Setting remote.origin.skipDefaultUpdate=true for adoption of mirror \"$projname\"\n"
                        if !$quiet && $needfakeorigin;
                if (!$usingall && @needskip) {
                        warn "Refusing to adopt mirror empty fetch remote(s) (override with --force)\n"
                                unless $force;
                        exit(255) unless $force || $dryrun;
                        warn "Adopting mirror with empty fetch remote(s) with --force\n"
                                unless $quiet || !$force;
                }
                warn "Will set skipDefaultUpdate=true on non-fetch remote(s)\n" if !$quiet && $usingall && @needskip;
                warn "Adopting mirror with base URL \"$baseurl\"\n" unless $quiet || $baseurl eq "";
        } else {
                warn "Adopting push \"$projname\" but active non-mirror remotes are present\n"
                        if !$quiet && $foundfetch && !$foundfetchwithmirror;
        }

        if (!$noowner && !defined($owner)) {
                # Select the owner
                $owner = $config{"gitweb.owner"};
                if (!defined($owner) || $owner eq "") {
                        $owner = $Girocco::Config::admin;
                        warn "Using owner \"$owner\" for adopted project\n" unless $quiet;
                }
        }
        if (!$nousers && !$makemirror && !defined($users)) {
                # select user list for push project
                my $findowner = $owner;
                defined($findowner) or $findowner = $config{"gitweb.owner"};
                $findowner = lc($findowner) if defined($findowner);
                my @owner_users = ();
                @owner_users = map {$findowner eq lc($$_[4]) ? $$_[1] : ()} get_all_users
                        if defined($findowner) && $findowner ne "";
                defined($findowner) or $findowner = "";
                if (@owner_users <= 1) {
                        $users = \@owner_users;
                        warn "No users found that match owner \"$findowner\"\n" unless @owner_users || $quiet;
                } else {
                        $users = [];
                        warn "Found ".scalar(@owner_users)." users for owner \"$findowner\" (" .
                                join(" ", @owner_users) . ") not setting any\n" unless $quiet;
                }
        }
        defined($users) or $users = [];

        # Warn if we preserve an existing receive.denyNonFastForwards or receive.denyDeleteCurrent setting
        # Complain if core.logallrefupdates or logs subdir exists and contains any files (allow with --force
        # and warn about preserving the setting)

        warn "Preserving existing receive.denyNonFastForwards=true\n"
                if !$quiet && git_bool($config{"receive.denynonfastforwards"});
        warn "Preserving existing receive.denyDeleteCurrent=$config{'receive.denydeletecurrent'}\n"
                if !$quiet && exists($config{"receive.denydeletecurrent"}) &&
                    $config{"receive.denydeletecurrent"} ne "warn";

        my $reflogfiles = Girocco::Project::_contains_files("$projdir/logs");
        my $reflogactive = git_bool($config{"core.logallrefupdates"});
        if ($reflogactive || $reflogfiles) {
                warn "Refusing to adopt \"$projname\" with active ref logs without --force\n" if $reflogfiles && !$force;
                warn "Refusing to adopt \"$projname\" with core.logAllRefUpdates=true without --force\n" if $reflogactive && !$force;
                exit(255) unless $force || $dryrun;
                warn "Adopting \"$projname\" with active ref logs with --force\n" unless $quiet || ($reflogfiles && !$force);
                warn "Adopting \"$projname\" with core.logAllRefUpdates=true with --force\n" unless $quiet || ($reflogactive && !$force);
        }

        return 0 if $dryrun && !$verbose;

        my $newproj = eval {Girocco::Project->ghost($projname, $makemirror, 1, $dryrun)};
        defined($newproj) or die "Girocco::Project::ghost failed: $@\n";
        $newproj->{desc} = $desc;
        $newproj->{README} = $readme;
        $newproj->{url} = $baseurl if $makemirror || exists($config{"gitweb.baseurl"});
        $newproj->{email} = $owner if defined($owner);
        $newproj->{users} = $users;
        $newproj->{crypt} = "unknown";
        $newproj->{reverseorder} = 1 unless exists($config{"hooks.reverseorder"});
        $newproj->{summaryonly} = 1 unless exists($config{"hooks.summaryonly"});
        my $dummy = bless {}, "Girocco::Project";
        $dummy->{path} = "$projdir";
        $dummy->{configfilehash} = \%config;
        $dummy->_properties_load;
        delete $dummy->{origurl};
        foreach my $k (keys(%$dummy)) {
                $newproj->{$k} = $dummy->{$k}
                        if exists($dummy->{$k}) && !exists($newproj->{$k});
        }

        if ($verbose) {
                use Data::Dumper;
                my %info = %$newproj;
                $info{README} = get_readme_desc($info{README}) if exists($info{README});
                my $d = Data::Dumper->new([\%info], ['*'.$newproj->{name}]);
                $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
                print $d->Dump([\%info], ['*'.$newproj->{name}]);
        }
        return 0 if $dryrun;

        # Make any changes as needed for @needskip, $neednoprune and $needfakeorigin
        if ($makemirror) {
                git_config($projdir, "fetch.prune", "false") if $neednoprune;
                git_config($projdir, "remote.origin.skipDefaultUpdate", "true") if $needfakeorigin;
                if ($usingall && @needskip) {
                        git_config($projdir, "remote.$_.skipDefaultUpdate", "true") foreach @needskip;
                }
        }

        # Perform the actual adoption
        $newproj->adopt or die "Girocco::Project::adopt failed\n";

        # Perhaps restore core.logAllRefUpdates, receive.denyNonFastForwards and receive.denyDeleteCurrent
        git_config($projdir, "receive.denyNonFastForwards", "true")
                if git_bool($config{"receive.denynonfastforwards"});
        git_config($projdir, "receive.denyDeleteCurrent", $config{"receive.denydeletecurrent"})
                if exists($config{"receive.denydeletecurrent"}) &&
                   $config{"receive.denydeletecurrent"} ne "warn";
        git_config($projdir, "core.logAllRefUpdates", "true")
                if $reflogactive;

        # Success
        if ($makemirror) {
                warn "Mirror project \"$projname\" successfully adopted.\n" unless $quiet;
        } else {
                warn "Push project \"$projname\" successfully adopted.\n" unless $quiet;
        }
        return 0;
}

sub cmd_remove {
        my ($force, $reallydel, $keepforks);
        parse_options(force => \$force, "really-delete" => \$reallydel,
                "keep-forks" => \$keepforks, quiet => \$quiet, q =>\$quiet);
        @ARGV or die "Please give project name on command line.\n";
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        my $projname = $project->{name};
        my $isempty = !$project->{mirror} && $project->is_empty;
        if (!$project->{mirror} && !$isempty && $reallydel) {
                die "refusing to remove and delete non-empty push project without --force: $projname\n" unless $force;
                warn "allowing removal and deletion of non-empty push project with --force\n" unless $quiet;
        }
        my $altwarn;
        my $removenogc;
        if ($project->has_forks) {
                die "refusing to remove project with forks (use --keep-forks): $projname\n" unless $keepforks;
                warn "allowing removal of forked project while preserving its forks with --keep-forks\n" unless $quiet;
                # Run pseudo GC on that repository so that objects don't get lost within forks
                my $basedir = $Girocco::Config::basedir;
                my $projdir = $project->{path};
                warn "We have to run pseudo GC on the repo so that the forks don't lose data. Hang on...\n" unless $quiet;
                my $nogcrunning = sub {
                        die "Error: GC appears to be currently running on $projname\n"
                                if -e "$projdir/gc.pid" || -e "$projdir/.gc_in_progress";
                };
                &$nogcrunning;
                $removenogc = ! -e "$projdir/.nogc";
                recreate_file("$projdir/.nogc") if $removenogc;
                die "unable to create \"$projdir/.nogc\"\n" unless -e "$projdir/.nogc";
                delete $ENV{show_progress};
                $ENV{'show_progress'} = 1 unless $quiet;
                sleep 2; # *cough*
                &$nogcrunning;
                system("$basedir/toolbox/perform-pre-gc-linking.sh", "--include-packs", $projname) == 0
                        or die "Running pseudo GC on project $projname failed\n";
                $altwarn = 1;
        }
        my $archived;
        if (!$project->{mirror} && !$isempty && !$reallydel) {
                $archived = $project->archive_and_delete;
                unlink("$archived/.nogc") if $removenogc && defined($archived) && $archived ne "";
        } else {
                $project->delete;
        }
        warn "Project '$projname' removed from $Girocco::Config::name" .
                ($archived ? ", backup in '$archived'" : "") .".\n" unless $quiet;
        warn "Retained forks may now have unwanted objects/info/alternates lines\n" if $altwarn && !$quiet;
        return 0;
}

sub cmd_show {
        use Data::Dumper;
        @ARGV == 1 or die_usage;
        my $project = get_clean_project($ARGV[0]);
        my %info = %$project;
        my $d = Data::Dumper->new([\%info], ['*'.$project->{name}]);
        $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
        print $d->Dump([\%info], ['*'.$project->{name}]);
        return 0;
}

sub cmd_listheads {
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        my @heads = sort({lc($a) cmp lc($b)} $project->get_heads);
        my $cur = $project->{HEAD};
        defined($cur) or $cur = '';
        my $curmark = '*';
        my $headhash = get_git("--git-dir=$project->{path}", 'rev-parse', '--quiet', '--verify', 'HEAD');
        defined($headhash) or $headhash = '';
        chomp $headhash;
        $headhash or $curmark = '!';
        foreach (@heads) {
                my $mark = $_ eq $cur ? $curmark : ' ';
                print "$mark $_\n";
        }
        return 0;
}

sub cmd_listtags {
        my $vcnt = 0;
        shift(@ARGV), $vcnt=1 if @ARGV && ($ARGV[0] eq '--verbose' || $ARGV[0] eq '-v');
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        if ($vcnt) {
                print map("$$_[0]\t$$_[1]\n", get_ctag_counts($project));
        } else {
                print map("$_\n", $project->get_ctag_names);
        }
        return 0;
}

sub cmd_deltags {
        my $ic = 0;
        shift(@ARGV), $ic=1 if @ARGV && $ARGV[0] =~ /^(?:--?ignore-case|-i)$/i;
        @ARGV >= 2 or die_usage;
        my $project = get_project(shift @ARGV);
        my %curtags;
        if ($ic) {
                push(@{$curtags{lc($_)}}, $_) foreach $project->get_ctag_names;
        } else {
                push(@{$curtags{$_}}, $_) foreach $project->get_ctag_names;
        }
        my @deltags = ();
        my %seentag = ();
        my $ctags = join(" ", @ARGV);
        $ctags = lc($ctags) if $ic;
        foreach (split(/[\s,]+/, $ctags)) {
                next unless exists($curtags{$_});
                $seentag{$_}=1, push(@deltags, $_) unless $seentag{$_};
        }
        if (!@deltags) {
                warn $project->{name}, ": skipping removal of only non-existent tags\n" unless $quiet;
        } else {
                # Avoid touching anything other than the ctags
                foreach my $tg (@deltags) {
                        $project->delete_ctag($_) foreach @{$curtags{$tg}};
                }
                $project->_set_changed;
                $project->_set_forkchange;
                warn $project->{name}, ": specified tags have been removed\n" unless $quiet;
        }
        return 0;
}

sub cmd_addtags {
        @ARGV >= 2 or die_usage;
        my $project = get_project(shift @ARGV);
        my $ctags = join(" ", @ARGV);
        $ctags =~ /[^, a-zA-Z0-9:.+#_-]/ and
                die "Content tag(s) \"$ctags\" contain(s) evil character(s).\n";
        my $oldmask = umask();
        umask($oldmask & ~0060);
        my $changed = 0;
        foreach (split(/[\s,]+/, $ctags)) {
                ++$changed if $project->add_ctag($_, 1);
        }
        if ($changed) {
                $project->_set_changed;
                $project->_set_forkchange;
        }
        umask($oldmask);
        my $cnt = ($changed == 1) ? "1 content tag has" : $changed . " content tags have";
        warn $project->{name}, ": $cnt been added/updated\n" unless $quiet;
        return 0;
}

sub _get_random_val {
        my $p = shift;
        my $md5;
        {
                no warnings;
                $md5 = md5_hex(time . $$ . rand() . join(':',%$p));
        }
        $md5;
}

sub cmd_chpass {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        my $random = undef;
        pop(@ARGV), $random=lc($ARGV[1]) if @ARGV==2 && $ARGV[1] =~ /^(?:random|unknown)$/i;
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        die "refusing to change locked password of project \"$ARGV[0]\" without --force\n"
                if $project->is_password_locked;
        my ($newpw, $rmsg);
        if ($random) {
                if ($random eq "random") {
                        die "refusing to set random password without --force\n" unless $force;
                        $rmsg = "set to random value";
                        $newpw = _get_random_val($project);
                } else {
                        die "refusing to set password hash to '$random' without --force\n" unless $force;
                        $rmsg = "hash set to '$random'";
                        $newpw = $random;
                }
        } else {
                $rmsg = "updated";
                if (-t STDIN) {
                        print "Changing admin password for project $ARGV[0]\n";
                        my $np1 = prompt_noecho_nl_or_die("New password for project $ARGV[0] (echo is off)");
                        $np1 ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
                        my $np2 = prompt_noecho_nl_or_die("Retype new password for project $ARGV[0]");
                        $np1 eq $np2 or die "Our high-paid security consultants have determined that\n" .
                                "the admin passwords you have entered do not match each other.\n";
                        $newpw = $np1;
                } else {
                        $newpw = <STDIN>;
                        defined($newpw) or die "missing new password on STDIN\n";
                        chomp($newpw);
                }
        }
        $newpw ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
        my $old = $project->{crypt};
        $project->{crypt} = (defined($random) && $random ne "random") ? $newpw : scrypt_sha1($newpw);
        if (defined($old) && $old eq $project->{crypt}) {
                warn $project->{name}, ": skipping update of password hash to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than the password hash
                $project->_group_update;
                warn $project->{name}, ": admin password $rmsg (new hash stored)\n" unless $quiet;
        }
        return 0;
}

sub cmd_checkpw {
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        my $pwhash = $project->{crypt};
        defined($pwhash) or $pwhash = "";
        if ($pwhash eq "") {
                warn $project->{name}, ": no password required\n" unless $quiet;
                return 0;
        }
        if ($project->is_password_locked) {
                warn $project->{name}, ": password is locked\n" unless $quiet;
                exit 1;
        }
        my $checkpw;
        if (-t STDIN) {
                $checkpw = prompt_noecho_nl_or_die("Admin password for project $ARGV[0] (echo is off)");
                $checkpw ne "" or warn "checking for empty password as hash (very unlikely)\n" unless $quiet;
        } else {
                $checkpw = <STDIN>;
                defined($checkpw) or die "missing admin password on STDIN\n";
                chomp($checkpw);
        }
        unless (Girocco::CLIUtil::check_passwd_match($pwhash, $checkpw)) {
                warn "password check failure\n" unless $quiet;
                exit 1;
        }
        warn "admin password match\n" unless $quiet;
        return 0;
}

sub cmd_gc {
        my ($force, $auto, $redelta, $recompress);
        parse_options(force => \$force, quiet => \$quiet, q => \$quiet, auto => \$auto,
                redelta => \$redelta, "no-reuse-delta" => \$redelta, aggressive => \$force,
                recompress => \$recompress, "no-reuse-object" => $recompress);
        $force && $auto and die "--force and --auto are mutually exclusive options\n";
        @ARGV or die "Please give project name on command line.\n";
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        delete $ENV{show_progress};
        delete $ENV{force_gc};
        $quiet or $ENV{"show_progress"} = 1;
        $force and $ENV{"force_gc"} = 1;
        if (!$auto && !$force && ! -e $project->{path}."/.needsgc") {
                open NEEDSGC, '>', $project->{path}."/.needsgc" and close NEEDSGC;
        }
        my @args = ($Girocco::Config::basedir . "/jobd/gc.sh", $project->{name});
        $redelta && !$recompress and push(@args, "-f");
        $recompress and push(@args, "-F");
        my $lastgc = $project->{lastgc};
        system({$args[0]} @args) != 0 and return 1;
        # Do it again Sam, but only if lastgc was set, gc.sh succeeded and now it's not set
        if ($lastgc) {
                my $newlastgc = get_git("--git-dir=$project->{path}", 'config', '--get', 'gitweb.lastgc');
                if (!$newlastgc) {
                        system({$args[0]} @args) != 0 and return 1;
                }
        }
        return 0;
}

sub cmd_update {
        my ($force, $summary);
        parse_options(force => \$force, quiet => \$quiet, q => \$quiet, summary => \$summary);
        $quiet && $summary and die "--quiet and --summary are mutually exclusive options\n";
        @ARGV or die "Please give project name on command line.\n";
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        $project->{mirror} or die "Project \"$ARGV[0]\" is a push project, not a mirror project.\n";
        delete $ENV{show_progress};
        delete $ENV{force_update};
        if ($quiet) {
                $ENV{"show_progress"} = 0;
        } else {
                $ENV{"show_progress"} = ($summary ? 1 : 2);
        }
        $force and $ENV{"force_update"} = 1;
        system($Girocco::Config::basedir . "/jobd/update.sh", $project->{name}) != 0 and return 1;
        return 0;
}

sub cmd_remirror {
        my $force = 0;
        parse_options(force => \$force, quiet => \$quiet, q => \$quiet);
        @ARGV or die "Please give project name on command line.\n";
        @ARGV == 1 or die_usage;
        my $project = get_project($ARGV[0]);
        $project->{mirror} or die "Project \"$ARGV[0]\" is a push project, not a mirror project.\n";
        if ($project->{clone_in_progress} && !$project->{clone_failed}) {
                warn "Project \"$ARGV[0]\" already seems to have a clone underway at this moment.\n" unless $quiet && $force;
                exit(255) unless $force;
                yes_to_continue_or_die("Are you sure you want to force a remirror");
        }
        unlink($project->_clonefail_path);
        unlink($project->_clonelog_path);
        recreate_file($project->_clonep_path);
        my $sock = IO::Socket::UNIX->new($Girocco::Config::chroot.'/etc/taskd.socket') or
                die "cannot connect to taskd.socket: $!\n";
        select((select($sock),$|=1)[0]);
        $sock->print("clone ".$project->{name}."\n");
        # Just ignore reply, we are going to succeed anyway and the I/O
        # would apparently get quite hairy.
        $sock->flush();
        sleep 2; # *cough*
        $sock->close();
        warn "Project \"$ARGV[0]\" remirror initiated.\n" unless $quiet;
        return 0;
}

sub cmd_setowner {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV == 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
        my $project = get_project($ARGV[0]);
        if (@ARGV == 2 && !valid_email($ARGV[1])) {
                die "invalid owner/email (use --force to accept): \"$ARGV[1]\"\n"
                        unless $force;
                warn "using invalid owner/email with --force\n" unless $quiet;
        }
        if (@ARGV == 2 && length($ARGV[1]) > 96) {
                die "owner/email longer than 96 chars (use --force to accept): \"$ARGV[1]\"\n"
                        unless $force;
                warn "using longer than 96 char owner/email with --force\n" unless $quiet;
        }
        my $old = $project->{email};
        if (@ARGV == 1) {
                print "$old\n" if defined($old);
                return 0;
        }
        if (defined($old) && $old eq $ARGV[1]) {
                warn $project->{name}, ": skipping update of owner/email to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than "gitweb.owner"
                $project->_property_fput("email", $ARGV[1]);
                $project->_update_index;
                $project->_set_changed;
                warn $project->{name}, ": owner/email updated to \"$ARGV[1]\"\n" unless $quiet;
        }
        return 0;
}

sub cmd_setdesc {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV >= 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
        my $project = get_project(shift @ARGV);
        if (@ARGV && !valid_desc(join(" ", @ARGV))) {
                die "invalid description (use --force to accept): \"".join(" ", @ARGV)."\"\n"
                        unless $force;
                warn "using invalid description with --force\n" unless $quiet;
        }
        my $desc = clean_desc(join(" ", @ARGV));
        if (@ARGV && length($desc) > 1024) {
                die "description longer than 1024 chars (use --force to accept): \"$desc\"\n"
                        unless $force;
                warn "using longer than 1024 char description with --force\n" unless $quiet;
        }
        my $old = $project->{desc};
        if (!@ARGV) {
                print "$old\n" if defined($old);
                return 0;
        }
        if (defined($old) && $old eq $desc) {
                warn $project->{name}, ": skipping update of description to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than description file
                $project->_property_fput("desc", $desc);
                $project->_set_changed;
                warn $project->{name}, ": description updated to \"$desc\"\n" unless $quiet;
        }
        return 0;
}

sub cmd_setreadme {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV == 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
        my $project = get_project($ARGV[0]);
        my $old = $project->{README};
        if (@ARGV == 1) {
                chomp $old if defined($old);
                print "$old\n" if defined($old) && $old ne "";
                return 0;
        }
        my ($new, $raw, $newname);
        $newname = '';
        if ($ARGV[1] eq "-") {
                local $/;
                $new = <STDIN>;
                $raw = 1;
                $newname = "contents of <STDIN>";
        } elsif (lc($ARGV[1]) eq "automatic" || lc($ARGV[1]) eq "auto") {
                $new = "";
        } elsif (lc($ARGV[1]) eq "suppressed" || lc($ARGV[1]) eq "suppress") {
                $new = "<!-- suppress -->";
        } else {
                my $fn = $ARGV[1];
                $fn =~ s/^\@//;
                die "missing filename for README\n" unless $fn ne "";
                die "no such file: \"$fn\"\n" unless -f $fn && -r $fn;
                open F, '<', $fn or die "cannot open \"$fn\" for reading: $!\n";
                local $/;
                $new = <F>;
                close F;
                $raw = 1;
                $newname = "contents of \"$fn\"";
        }
        defined($new) or $new = '';
        $project->{README} = to_utf8($new, 1);
        $project->_cleanup_readme;
        if (length($project->{README}) > 8192) {
                die "readme greater than 8192 chars is too long (use --force to override)\n"
                        unless $force;
                warn "using readme greater than 8192 chars with --force\n" unless $quiet;
        }
        if ($raw) {
                my $rd = get_readme_desc($project->{README});
                if ($rd ne "automatic" && $rd ne "suppressed") {
                        my $xmllint = qx(command -v xmllint); chomp $xmllint;
                        if (-f $xmllint && -x $xmllint) {
                                my ($cnt, $err) = $project->_lint_readme(0);
                                if ($cnt) {
                                        my $msg = "xmllint: $cnt error";
                                        $msg .= "s" unless $cnt == 1;
                                        print STDERR "$msg\n", "-" x length($msg), "\n", $err
                                                unless $force && $quiet;
                                        exit(255) unless $force;
                                        warn $project->{name} . ": using invalid raw HTML with --force\n" unless $quiet;
                                }
                        } else {
                                die "xmllint not available, refusing to use raw HTML without --force\n"
                                        unless $force;
                                warn "xmllint not available using unchecked raw HTML with --force\n" unless $quiet;
                        }
                }
        }
        if (defined($old) && $old eq $project->{README}) {
                warn $project->{name}, ": skipping update of README to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than README.html file
                $project->_property_fput("README", $project->{README});
                $project->_set_changed;
                my $desc = get_readme_desc($project->{README});
                if ($newname) {
                        $newname .= " ($desc)";
                } else {
                        $newname = $desc;
                }
                warn $project->{name}, ": README updated to $newname\n" unless $quiet;
        }
        return 0;
}

sub valid_head {
        my ($proj, $newhead) = @_;
        my %okheads = map({($_ => 1)} $proj->get_heads);
        exists($okheads{$newhead});
}

sub cmd_sethead {
        @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
        my $project = get_project($ARGV[0]);
        if (@ARGV == 2 && !valid_head($project, $ARGV[1])) {
                die "invalid head (try \"@{[basename($0)]} listheads $ARGV[0]\"): \"$ARGV[1]\"\n";
        }
        my $old = $project->{HEAD};
        if (@ARGV == 1) {
                print "$old\n" if defined($old);
                return 0;
        }
        if (defined($old) && $old eq $ARGV[1]) {
                warn $project->{name}, ": skipping update of HEAD symref to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than the HEAD symref
                $project->set_HEAD($ARGV[1]);
                $project->_set_changed;
                warn $project->{name}, ": HEAD symref updated to \"refs/heads/$ARGV[1]\"\n" unless $quiet;
        }
        return 0;
}

sub cmd_sethooks {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV == 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
        my $project = get_project($ARGV[0]);
        my $projconfig = read_config_file_hash($project->{path}."/config");
        my $ghp = $Girocco::Config::reporoot."/_global/hooks";
        my $rghp = realpath($ghp);
        my $lhp = $project->{path}."/hooks";
        my $rlhp = realpath($lhp);
        my $ahp = "";
        my $rahp = undef;
        if (defined($projconfig) && defined($projconfig->{"core.hookspath"})) {
                $ahp = $projconfig->{"core.hookspath"};
                $rahp = realpath($ahp);
        }
        if (@ARGV == 1) {
                if (defined($rahp) && $rahp ne "") {
                        if ($rahp eq $rghp) {
                                my $nc = ($ahp eq $ghp ? "" : " non-canonical");
                                printf "%s \t(global%s)\n", $ahp, $nc;
                        } elsif ($rahp eq $rlhp) {
                                my $nc = ($ahp eq $lhp ? "" : " non-canonical");
                                printf "%s \t(local%s)\n", $ahp, $nc;
                        } elsif ($rahp ne $ahp) {
                                print "$ahp \t($rahp)\n";
                        } else {
                                print "$ahp\n";
                        }
                } elsif ($ahp ne "") {
                        print "$ahp \t(non-existent)\n";
                }
                return 0;
        }
        my $shp = $ARGV[1];
        if (lc($shp) eq "global") {
                $shp = $ghp;
        } elsif (lc($shp) eq "local") {
                $shp = $lhp;
        } elsif (substr($shp, 0, 2) eq "~/") {
                $shp = $ENV{"HOME"}.substr($shp,1);
        } elsif ($shp =~ m,^~([a-zA-Z_][a-zA-Z_0-9]*)((?:/.*)?)$,) {
                my $sfx = $2;
                my $hd = (getpwnam($1))[7];
                $shp = $hd . $sfx if defined($hd) && $hd ne "" && $hd ne "/" && -d $hd;
        }
        $shp ne "" && -d $shp or die "no such directory: $ARGV[1]\n";
        my $rshp = realpath($shp);
        defined($rshp) && $rshp ne "" or die "could not realpath: $ARGV[1]\n";
        $rshp =~ m,^/[^/], or die "invalid hookspath: $rshp\n";
        die "refusing to switch from current non-global hookspath without --force\n"
                if !$force && defined($rahp) && $rahp ne "" && $rahp ne $rghp && $rshp ne $rahp;
        if (!$force && defined($rahp) && $rahp ne "") {
                if ($rshp eq $rahp && ($ahp eq $ghp || $ahp eq $lhp)) {
                        warn $project->{name}, ": skipping update of hookspath to same effective value\n" unless $quiet;
                        return 0;
                }
        }
        $rshp = $ghp if $rshp eq $rghp;
        $rshp = $lhp if $rshp eq $rlhp;
        if ($rshp eq $ahp) {
                warn $project->{name}, ": skipping update of hookspath to same value\n" unless $quiet;
                return 0;
        }
        die "refusing to set neither local nor global hookspath without --force\n"
                if !$force && $rshp ne $ghp && $rshp ne $lhp;
        system($Girocco::Config::git_bin, '--git-dir='.$project->{path},
                'config', "core.hookspath", $rshp);
        my $newval = '"'.$rshp.'"';
        $newval = "global" if $rshp eq $ghp;
        $newval = "local" if $rshp eq $lhp;
        warn $project->{name}, ": hookspath set to $newval\n" unless $quiet;
        return 0;
}

our %boolfields;
BEGIN {
        %boolfields = (
                cleanmirror   => 1,
                reverseorder  => 0,
                summaryonly   => 0,
                statusupdates => 1,
        );
}

sub cmd_setbool {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV == 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage;
        my $project = get_project($ARGV[0]);
        if (!exists($boolfields{$ARGV[1]})) {
                die "invalid boolean field name: \"$ARGV[1]\" -- try \"help\"\n";
        }
        if (@ARGV == 3 && $boolfields{$ARGV[1]} && !$project->{mirror}) {
                die "invalid boolean field for non-mirror (use --force to accept): \"$ARGV[1]\"\n"
                        unless $force;
                warn "using mirror field on non-mirror with --force\n" unless $quiet;
        }
        if (@ARGV == 3 && !valid_bool($ARGV[2])) {
                die "invalid boolean value: \"$ARGV[2]\"\n";
        }
        my $bool = clean_bool($ARGV[2]);
        my $old = $project->{$ARGV[1]};
        if (@ARGV == 2) {
                print "$old\n" if defined($old);
                return 0;
        }
        if (defined($old) && $old eq $bool) {
                warn $project->{name}, ": skipping update of $ARGV[1] to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than $ARGV[1] field
                $project->_property_fput($ARGV[1], $bool);
                warn $project->{name}, ": $ARGV[1] updated to $bool\n" unless $quiet;
        }
        return 0;
}

sub cmd_setautogchack {
        @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
        my $project = get_project($ARGV[0]);
        my $aghok = $Girocco::Config::autogchack &&
                ($project->{mirror} || $Girocco::Config::autogchack ne "mirror");
        my $old = defined($project->{autogchack}) ? clean_bool($project->{autogchack}) : "unset";
        if (@ARGV == 1) {
                print "$old\n" if $aghok;
                return 0;
        }
        my $bool;
        if (lc($ARGV[1]) eq "unset") {
                $bool = "unset";
        } else {
                valid_bool($ARGV[1]) or die "invalid boolean value: \"$ARGV[1]\"\n";
                $bool = clean_bool($ARGV[1]);
        }
        if (!$aghok) {
                die "\$Girocco::Config::autogchack is false\n" unless $Girocco::Config::autogchack;
                die "\$Girocco::Config::autogchack is only enabled for mirrors\n";
        }
        if ($old eq $bool) {
                warn $project->{name}, ": autogchack value unchanged\n" unless $quiet;
        } else {
                if ($bool eq "unset") {
                        system($Girocco::Config::git_bin, '--git-dir='.$project->{path},
                                'config', '--unset', "girocco.autogchack");
                } else {
                        system($Girocco::Config::git_bin, '--git-dir='.$project->{path},
                                'config', '--bool', "girocco.autogchack", $bool);
                }
        }
        return system($Girocco::Config::basedir . "/jobd/maintain-auto-gc-hack.sh", $project->{name}) == 0
                ? 0 : 1;
}

sub valid_url {
        my ($url, $type) = @_;
        $type ne 'baseurl' and return valid_web_url($url);
        valid_repo_url($url) or return 0;
        if ($Girocco::Config::restrict_mirror_hosts) {
                my $mh = extract_url_hostname($url);
                is_dns_hostname($mh) or return 0;
                !is_our_hostname($mh) or return 0;
        }
        return 1;
}

our %urlfields;
BEGIN {
        %urlfields = (
                baseurl    => ["url"       , 1],
                homepage   => ["hp"        , 0],
                notifyjson => ["notifyjson", 0],
        );
}

sub cmd_seturl {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV == 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage;
        my $project = get_project($ARGV[0]);
        if (!exists($urlfields{$ARGV[1]})) {
                die "invalid URL field name: \"$ARGV[1]\" -- try \"help\"\n";
        }
        if (@ARGV == 3 && ${$urlfields{$ARGV[1]}}[1] && !$project->{mirror}) {
                die "invalid URL field for non-mirror (use --force to accept): \"$ARGV[1]\"\n"
                        unless $force;
                warn "using mirror field on non-mirror with --force\n" unless $quiet;
        }
        if (@ARGV == 3 && !valid_url($ARGV[2], $ARGV[1])) {
                die "invalid URL (use --force to accept): \"$ARGV[2]\"\n"
                        unless $force;
                warn "using invalid URL with --force\n" unless $quiet;
        }
        my $old = $project->{${$urlfields{$ARGV[1]}}[0]};
        if (@ARGV == 2) {
                print "$old\n" if defined($old);
                return 0;
        }
        if (defined($old) && $old eq $ARGV[2]) {
                warn $project->{name}, ": skipping update of $ARGV[1] to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than $ARGV[1]'s field
                $project->_property_fput(${$urlfields{$ARGV[1]}}[0], $ARGV[2]);
                if ($ARGV[1] eq "baseurl") {
                        $project->{url} = $ARGV[2];
                        $project->_set_bangagain;
                }
                $project->_set_changed unless $ARGV[1] eq "notifyjson";
                warn $project->{name}, ": $ARGV[1] updated to $ARGV[2]\n" unless $quiet;
        }
        return 0;
}

our %msgsfields;
BEGIN {
        %msgsfields = (
                notifymail => 1,
                notifytag  => 1,
        );
}

sub cmd_setmsgs {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV >= 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage;
        my $project = get_project(shift @ARGV);
        my $field = shift @ARGV;
        if (!exists($msgsfields{$field})) {
                die "invalid msgs field name: \"$field\" -- try \"help\"\n";
        }
        if (@ARGV && !valid_addrlist(@ARGV)) {
                die "invalid email address list (use --force to accept): \"".join(" ",@ARGV)."\"\n"
                        unless $force;
                warn "using invalid email address list with --force\n" unless $quiet;
        }
        my $old = $project->{$field};
        if (!@ARGV) {
                printf "%s\n", clean_addrlist($old, " ") if defined($old);
                return 0;
        }
        my $newlist = clean_addrlist(join(" ",@ARGV));
        if (defined($old) && $old eq $newlist) {
                warn $project->{name}, ": skipping update of $field to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than $field's field
                $project->_property_fput($field, $newlist);
                warn $project->{name}, ": $field updated to \"$newlist\"\n" unless $quiet;
        }
        return 0;
}

sub cmd_setusers {
        my $force = 0;
        shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
        @ARGV >= 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage;
        my $project = get_project(shift @ARGV);
        my $projname = $project->{name};
        !@ARGV || !$project->{mirror} or die "cannot set users list for mirror project: \"$projname\"\n";
        my @newusers = ();
        if (@ARGV) {
                eval {@newusers = validate_users(join(" ", @ARGV), $force); 1;} or exit 255;
                die "refusing to set empty users list without --force\n" unless @newusers || $force;
        }
        return 0 if !@ARGV && $project->{mirror};
        my $oldusers = $project->{users};
        if ($oldusers && ref($oldusers) eq "ARRAY") {
                $oldusers = join("\n", @$oldusers);
        } else {
                $oldusers = "";
        }
        if (!@ARGV) {
                print "$oldusers\n" if $oldusers ne "";
                return 0;
        }
        if ($oldusers eq join("\n", @newusers)) {
                warn "$projname: skipping update of users list to same value\n" unless $quiet;
        } else {
                # Avoid touching anything other than the users list
                $project->{users} = \@newusers;
                $project->_update_users;
                warn "$projname: users list updated to \"@{[join(',',@newusers)]}\"\n" unless $quiet;
        }
        return 0;
}

our %fieldnames;
BEGIN {
        %fieldnames = (
                owner         => [\&cmd_setowner,      0],
                desc          => [\&cmd_setdesc,       0],
                description   => [\&cmd_setdesc,       0],
                readme        => [\&cmd_setreadme,     0],
                head          => [\&cmd_sethead,       0],
                HEAD          => [\&cmd_sethead,       0],
                hooks         => [\&cmd_sethooks,      0],
                hookspath     => [\&cmd_sethooks,      0],
                cleanmirror   => [\&cmd_setbool,       1],
                reverseorder  => [\&cmd_setbool,       1],
                summaryonly   => [\&cmd_setbool,       1],
                statusupdates => [\&cmd_setbool,       1],
                autogchack    => [\&cmd_setautogchack, 0],
                baseurl       => [\&cmd_seturl,        1],
                homepage      => [\&cmd_seturl,        1],
                notifyjson    => [\&cmd_seturl,        1],
                notifymail    => [\&cmd_setmsgs,       1],
                notifytag     => [\&cmd_setmsgs,       1],
                users         => [\&cmd_setusers,      0],
        );
}

sub do_getset {
        $setopt = shift;
        my @newargs = ();
        push(@newargs, shift) if @_ && $_[0] eq '--force';
        my $field = $_[1];
        (($setopt && @_ >= 3) || @_ == 2) && exists($fieldnames{$field}) or die_usage;
        push(@newargs, shift);
        shift unless ${$fieldnames{$field}}[1];
        push(@newargs, @_);
        diename(($setopt ? "set " : "get ") . $field);
        @ARGV = @newargs;
        &{${$fieldnames{$field}}[0]}(@ARGV);
}

sub cmd_get {
        do_getset(0, @_);
}

sub cmd_set {
        do_getset(1, @_);
}

our %commands;
BEGIN {
        %commands = (
                list => \&cmd_list,
                create => \&cmd_create,
                adopt => \&cmd_adopt,
                remove => \&cmd_remove,
                trash => \&cmd_remove,
                delete => \&cmd_remove,
                show => \&cmd_show,
                listheads => \&cmd_listheads,
                listtags => \&cmd_listtags,
                listctags => \&cmd_listtags,
                deltags => \&cmd_deltags,
                delctags => \&cmd_deltags,
                addtags => \&cmd_addtags,
                addctags => \&cmd_addtags,
                chpass => \&cmd_chpass,
                checkpw => \&cmd_checkpw,
                gc => \&cmd_gc,
                update => \&cmd_update,
                remirror => \&cmd_remirror,
                setowner => \&cmd_setowner,
                setdesc => \&cmd_setdesc,
                setdescription => \&cmd_setdesc,
                setreadme => \&cmd_setreadme,
                sethead => \&cmd_sethead,
                sethooks => \&cmd_sethooks,
                sethookspath => \&cmd_sethooks,
                setbool => \&cmd_setbool,
                setboolean => \&cmd_setbool,
                setflag => \&cmd_setbool,
                setautogchack => \&cmd_setautogchack,
                seturl => \&cmd_seturl,
                setmsgs => \&cmd_setmsgs,
                setusers => \&cmd_setusers,
                get => \&cmd_get,
                set => \&cmd_set,
        );
}

sub dohelp {
        my $cmd = shift;
        my $bn = basename($0);
        printf "%s version %s\n\n", $bn, $VERSION;
        if (defined($cmd) && $cmd ne '') {
                $cmd =~ s/^set(?=[a-zA-Z])//i;
                my $cmdhelp = '';
                my ($lastmt, $incmd);
                foreach (split('\n', sprintf($help, $bn))) {
                        $lastmt || $incmd or $lastmt = /^\s*$/, next;
                        $incmd = 1 if $lastmt && /^\s*(?:\[?set\]?)?$cmd\s/;
                        last if $incmd && /^\s*$/;
                        $incmd and $cmdhelp .= $_ . "\n";
                        $lastmt = /^\s*$/;
                }
                print $cmdhelp and exit 0 if $cmdhelp;
        }
        printf $help, $bn;
        exit 0;
}

sub main {
        local *ARGV = \@_;
        shift, $quiet=1 if @ARGV && $ARGV[0] =~ /^(?:-q|--quiet)$/i;
        dohelp($ARGV[1]) if !@ARGV || @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i;
        my $command = shift;
        diename($command);
        $setopt = 1;
        if (!exists($commands{$command}) && exists($commands{"set".$command})) {
                $setopt = 0;
                $command = "set" . $command;
        }
        exists($commands{$command}) or die "Unknown command \"$command\" -- try \"help\"\n";
        dohelp($command) if @ARGV && ($ARGV[0] =~ /^(?:-h|-?-help)$/i ||
                $ARGV[0] =~ /^help$/i && !Girocco::Project::does_exist("help",1));
        &{$commands{$command}}(@ARGV);
}