3 # projtool.pl - command line Girocco project maintenance tool
4 # Copyright (C) 2016,2017,2020,2021 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.
12 use vars
qw($VERSION);
13 BEGIN {*VERSION = \'1.0.6'}
15 use Digest::MD5 qw(md5_hex);
18 use POSIX
qw(strftime);
19 use lib
"__BASEDIR__";
22 use Girocco
::HashUtil
;
27 exit(&main
(@ARGV)||0);
30 BEGIN {my @a; /^(.*)$/s && push(@a, $1) foreach @ARGV; @ARGV=@a;}
31 BEGIN {$help = <<'HELP'}
32 Usage: %s [<global option>...] <command> <options>
35 -q | --quiet suppress warning messages
36 -p | --pager force output to be paginated
37 --no-pager never paginate output
39 Note that as a convenience, where an existing <project> is required as
40 an argument, a path to the project may be given instead of the name in
41 most places. The "remove" and "prune" commands only accept names.
42 Since a matching project name takes precedence over a path, to force
43 interpretation as a path, start the path with "/" or "./" or "../".
44 Giving "." will find the project matching the current working directory.
47 show full help or just for <command> if given
49 list [--verbose] [--sort=lcname|name|owner|gid|no] [--owner] [<regexp>]
50 list all projects (default is --sort=lcname)
51 limit to project names matching <regex> if given
52 match <regex> against owner instead of project name with --owner
54 create [--force] [--no-alternates] [--orphan] [<option>...] <project>
55 create new project <project> (prompted)
57 --no-alternates skip setup of objects/info/alternates
58 --orphan allow creation of subproject w/o a parent
59 -p use mkdir -p during --orphan creation
60 --no-password set password crypt to invalid value "unknown"
61 --no-owner leave the gitweb.owner config unset
62 --mirror=<url> create a mirror from <url>
63 --full-mirror mirror all refs
64 --push[=<list>] create a push project
65 --desc=<string> specify project description w/o prompt
66 --homepage=<url> specify project homepage URL w/o prompt
67 --defaults do no interactive prompting at all
68 Using --no-password skips the prompts for password, using
69 --no-owner skips the prompt for owner and using --mirror=<url>
70 or --push[=<list>] skips the prompts for mirror URL and
71 heads-only and push users. With --defaults if neither
72 --mirror=<url> nor --push[=<list>] is given then --push will
73 be implied. Using --desc=<string> will force a specific
74 description (including an empty string) and skip the prompt for
75 it. Otherwise a non-empty default description will always be
76 supplied in lieu of an empty or omitted description.
78 adopt [--force] [--type=mirror|push] [<option>...] <project> [<users>]
79 adopt project <project>
80 type of project is guessed if --type=<type> omitted
81 <users> is same as <newuserslist> for setusers command
83 --dry-run do all the checks but don't perform adoption
84 --verbose show project info dump (useful with --dry-run)
85 --no-users no push users at all (<users> must be omitted)
86 --no-owner leave the gitweb.owner config totally unchanged
87 --owner=<val> set the gitweb.owner config to <val>
88 Both --no-owner and --owner=<val> may NOT be given, with neither
89 take owner from preexisting gitweb.owner else use admin setting.
90 For mirrors <users> is ignored otherwise if no <users> and no
91 --no-users option the push users list will consist of the single
92 user name matching the owner or empty if none or more than one.
93 With --dry-run <project> can be an absolute path to a git dir.
95 remove [--force] [--really-delete] [--keep-forks] <project>
96 remove project <project>
97 do not move to _recyclebin with --really-delete (just rm -rf)
98 remove projects with forks (by keeping forks) using --keep-forks
100 prune [--quiet] (--force | --dry-run) [<project>...]
101 check to see if any projects (default is all projects) are
102 missing the associated project directory on disk.
103 Requires either --force or --dry-run option to operate.
104 With --dry-run only show what would be done.
105 With --prune actually remove any extraneous project(s).
106 With --dry-run exit code is non-zero if any action needed.
107 With --quiet, suppress output message, if any.
110 show project <project>
112 verify [--quiet] [--dir] <project>
113 show the canonical project name for <project> (which might
114 be a path) if and only if it exists. With --dir show the
115 canonical full path to the project directory instead.
116 If the project name is invalid or does not exist, display
117 an error (unless --quiet is used). Exit status will be 0
118 if project found, non-zero otherwise.
120 urls [--push] <project>
121 show available fetch/push URLs for <project>
122 Note that this does NOT include non-Git protocol URLs such
123 as any home page or any upstream URL for a mirror project --
124 those are all accessible via the "show" command.
125 The URLs shown are those that would be shown by gitweb.cgi.
126 With --push only show push urls (mirrors have no push urls)
129 list all available heads for <project> and indicate current head
131 listtags [--verbose] <project>
132 list all ctags on project <project>
133 with --verbose include tag counts
135 deltags <project> [-i] <tagstodel>
136 remove any ctags on project <project> present in <tagstodel>
137 <tagstodel> is space or comma separated list of tags to remove
138 with -i match against <tagstodel> without regard to letter case
140 addtags <project> <tagstoadd>
141 add ctags to project <project>
142 <tagstoadd> is space or comma separated list of tags to add
144 chpass [--force] <project> [random | unknown]
145 change project <project> password (prompted)
146 with "random" set to random password
147 with "unknown" set password hash to invalid value "unknown"
150 check project <project> password for a match (prompted)
152 gc [--force | --auto] [--redelta | --recompress] <project>
153 run the gc.sh script on project <project>
154 with --auto let the gc.sh script decide what to do
155 with --force cause a full gc to take place (force_gc=1)
156 with neither --auto nor --force do a mini or if needed a full gc
157 (in other words just touch .needsgc and run gc.sh)
158 with --redelta a full gc will use pack-objects --no-reuse-delta
159 with --recompress a full gc uses pack-objects --no-reuse-object
160 (--no-reuse-delta and --no-reuse-object are accepted as aliases)
161 with --aggressive activate the --force and --redelta options
162 unless the global --quiet option is given show_progress=1 is used
164 update [--force] [--quiet | --summary] <project>
165 run the update.sh script on project <project>
166 with --force cause a fetch to always take place (force_update=1)
167 with --quiet only show errors (show_progress is left unset)
168 with --summary show progress and ref summary (show_progress=1)
169 with neither --quiet nor --summary show it all (show_progress=2)
171 remirror [--force] <project>
172 initiate a remirror of project <project>
174 [set]owner [--force] <project> <newowner>
175 set project <project> owner to <newowner>
176 without "set" and only 1 arg, just show current project owner
178 [set]desc [--force] <project> <newdesc>
179 set project <project> description to <newdesc>
180 without "set" and only 1 arg, just show current project desc
182 [set]readme [--force] [--format=<readmetype>] <project> [<newsetting>]
183 set project <project> readme to <newsetting>
184 <readmetype> is markdown|plain|html (default is no change)
185 <newsetting> is automatic|suppressed|-|[@]filename
186 with "set" <readmetype> and/or <newsetting> is required
187 without "set" and only 2 args, just show current readme setting
189 [set]head <project> <newhead>
190 set project <project> HEAD symbolic ref to <newhead>
191 without "set" and only 1 arg, just show current project HEAD
193 [set]bool [--force] <project> <flagname> <boolvalue>
194 set project <project> boolean <flagname> to <boolvalue>
195 <flagname> is cleanmirror|reverseorder|summaryonly|statusupdtaes
196 without "set" and only 2 args, just show current flag value
198 [set]hooks [--force] <project> local | global | <path>
199 set project <project> hookspath to local, global or <path>
200 without "set" and only 1 arg, just show current hookspath
202 [set]autogchack <project> <boolvalue> | unset
203 set project <project> autogchack to <boolvalue> or "unset" it
204 without "set" just show current autogchack setting if enabled
205 with "set" autogchack must be enabled in Config.pm for the
206 type of project and maintain-auto-gc-hack.sh is always run
208 [set]url [--force] <project> <urlname> <newurlvalue>
209 set project <project> url <urlname> to <newurlvalue>
210 <urlname> is baseurl|homepage|notifyjson
211 without "set" and only 2 args, just show current url value
213 [set]msgs [--force] <project> <msgsname> <eaddrlist>
214 set project <project> msgs <msgsname> to <addrlist>
215 <msgsname> is notifymail|notifytag
216 <eaddrlist> is space or comma separated list of email addresses
217 without "set" and only 2 args, just show current msgs value
219 [set]users [--force] <project> <newuserslist>
220 set push project <project> users list to <newuserslist>
221 <newuserslist> is space or comma separated list of user names
222 without "set" and only 1 arg, just show current users list
224 [set]jsontype <project> <newjsontype>
225 set project <project> JSON Content-Type to <newjsontype>
226 <newjsontype> is x-www-form-urlencoded or json
227 without "set" and only 1 arg, just show current jsontype
229 [set]jsonsecret <project> <newjsonsecret>
230 set project <project> JSON secret to <newjsonsecret>
231 <newjsonsecret> is a string (empty string disables signatures)
232 without "set" and only 1 arg, just show current jsonsecret
234 get <project> <fieldname>
235 show project <project> field <fieldname>
236 <fieldname> is owner|desc|readme|head|hooks|users|jsontype
237 or jsonsecret|<flagname>|autogchack|<urlname>|<msgsname>
239 set [--force] <project> <fieldname> <newfieldvalue>
240 set project <project> field <fieldname> to <newfieldvalue>
241 <fieldname> same as for get
242 <newfieldvalue> same as for corresponding set... command
249 my $sub = shift || diename
;
251 die "Invalid arguments to $sub command -- try \"help\"\n";
253 die "Invalid arguments -- try \"help\"\n";
259 defined($rm) or $rm = '';
260 return "length " . length($rm);
263 sub get_readme_desc
{
265 defined($rm) or $rm = '';
268 $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
270 return $test eq '' ?
"suppressed" : "length " . length($rm);
276 sub get_ctag_counts
{
280 foreach ($project->get_ctag_names) {
283 if (open $ct, '<', $project->{path
}."/ctags/$_") {
286 defined $count or $count = '';
288 $val = $count =~ /^[1-9]\d*$/ ?
$count : 1;
294 push(@ctags, $_."(".$val.")");
297 push(@ctags, [$_, $val]) if $val;
303 sub get_clean_project
{
304 my $project = get_project_harder
(@_);
305 delete $project->{loaded
};
306 delete $project->{base_path
};
307 delete $project->{ccrypt
};
308 /^orig/i || !defined($project->{$_}) and delete $project->{$_} foreach keys %$project;
309 $project->{owner
} = $project->{email
}; delete $project->{email
};
310 $project->{homepage
} = $project->{hp
}; delete $project->{hp
};
311 $project->{baseurl
} = $project->{url
}; delete $project->{url
};
312 if (defined($project->{path
}) && $project->{path
} ne "") {
313 my $rp = realpath
($project->{path
});
314 defined($rp) && $rp ne "" and $project->{realpath
} = $rp;
315 if (-f
"$rp/objects/info/packs") {
316 my $ipt = (stat _
)[9];
317 defined($ipt) and $project->{infopackstime
} =
318 strftime
("%Y-%m-%d %H:%M:%S %z", localtime($ipt));
321 my $owner = $project->{owner
};
324 my @owner_users = map {$owner eq lc($$_[4]) ?
$$_[1] : ()} get_all_users
;
325 $project->{owner_users
} = \
@owner_users if @owner_users;
327 my $projname = $project->{name
};
328 my @forks = grep {$$_[1] =~ m
,^$projname/,} get_all_projects
;
329 $project->{has_forks
} = 1 if @forks;
330 $project->{has_alternates
} = 1 if $project->has_alternates;
331 my @bundles = $project->bundles;
332 for (my $i = 0; $i < @bundles; ++$i) {
333 my $secs = $bundles[$i]->[0];
334 $bundles[$i]->[0] = strftime
("%Y-%m-%d %H:%M:%S %z", localtime($secs));
335 my $sz = $bundles[$i]->[2];
336 1 while $sz =~ s/(?<=\d)(\d{3})(?:,|$)/,$1/g;
337 $bundles[$i]->[2] = $sz;
339 delete $project->{bundles
};
340 $project->{bundles
} = \
@bundles if @bundles;
341 $project->{mirror
} = 0 unless $project->{mirror
};
342 $project->{is_empty
} = 1 if $project->is_empty;
343 delete $project->{showpush
} unless $project->{showpush
};
344 delete $project->{users
} if $project->{mirror
};
345 delete $project->{baseurl
} unless $project->{mirror
};
346 delete $project->{banged
} unless $project->{mirror
};
347 delete $project->{lastrefresh
} unless $project->{mirror
};
348 delete $project->{cleanmirror
} unless $project->{mirror
};
349 delete $project->{statusupdates
} unless $project->{mirror
};
350 delete $project->{lastparentgc
} unless $projname =~ m
,/,;
351 unless ($project->{banged
}) {
352 delete $project->{bangcount
};
353 delete $project->{bangfirstfail
};
354 delete $project->{bangmessagesent
};
356 my $projhook = $project->_has_notifyhook;
357 if (defined($projhook) && $projhook ne "") {
358 $project->{notifyhook
} = $projhook;
360 delete $project->{notifyhook
};
362 $project->{README
} = get_readme_desc
($project->{README
}) if exists($project->{README
});
363 $project->{READMEDATA
} = get_readme_len
($project->{READMEDATA
}) if exists($project->{READMEDATA
});
364 my @tags = get_ctag_counts
($project, 1);
365 $project->{tags
} = \
@tags if @tags;
366 my $projconfig = read_config_file_hash
($project->{path
}."/config");
367 if (defined($projconfig) && defined($projconfig->{"core.hookspath"})) {
368 my $ahp = $projconfig->{"core.hookspath"};
369 my $rahp = realpath
($ahp);
370 my $lhp = $project->{path
}."/hooks";
371 my $rlhp = realpath
($lhp);
372 my $ghp = $Girocco::Config
::reporoot
."/_global/hooks";
373 my $rghp = realpath
($ghp);
374 $project->{has_local_hooks
} = 1 if
375 defined($rahp) && defined($rlhp) && $rahp eq $rlhp;
376 $project->{has_global_hooks
} = 1 if
377 defined($rahp) && defined($rghp) && $rahp eq $rghp;
378 $project->{hookspath
} = $ahp unless $ahp eq $lhp || $ahp eq $ghp;
386 foreach (split(/[,\s]+/, $_[0])) {
388 $seen{lc($_)} = 1, push(@newlist, $_) unless $seen{lc($_)};
390 return join(($_[1]||","), @newlist);
394 my $cleaned = clean_addrlist
(join(" ", @_));
395 return 1 if $cleaned eq "";
396 valid_email_multi
($cleaned) && length($cleaned) <= 512;
400 my ($userlist, $force, $nodie) = @_;
404 my $mobok = $Girocco::Config
::mob
&& $Girocco::Config
::mob
eq "mob";
405 my %users = map({($$_[1] => $_)} get_all_users
);
406 foreach (split(/[\s,]+/, $userlist)) {
407 if (exists($users{$_}) || $_ eq "everyone" || ($mobok && $_ eq "mob")) {
408 $seenuser{$_}=1, push(@newusers, $_) unless $seenuser{$_};
411 if (Girocco
::User
::does_exist
($_, 1)) {
413 $seenuser{$_}=1, push(@newusers, $_) unless $seenuser{$_};
416 warn "refusing to allow questionable user \"$_\" without --force\n" unless $nodie && $quiet;
421 warn "invalid user: \"$_\"\n" unless $nodie && $quiet
423 die if $badlist && !$nodie;
427 sub is_default_desc
{
428 # "Unnamed repository; edit this file 'description' to name the repository."
429 # "Unnamed repository; edit this file to name it for gitweb."
431 return 0 unless defined($_);
432 /Unnamed\s+repository;/i && /\s+edit\s+this\s+file\s+/i && /\s+to\s+name\s+/i;
438 return 0 if $test =~ /[\r\n]/;
439 $test =~ s/\s\s+/ /g;
447 defined($desc) or $desc = '';
449 $desc = to_utf8
($desc, 1);
450 $desc =~ s/\s\s+/ /g;
457 Girocco
::CLIUtil
::_parse_options
(
459 warn((($_[0]eq'?')?
"unrecognized":"missing argument for")." option \"$_[1]\"\n")
467 lcname
=> sub {lc($$a[1]) cmp lc($$b[1])},
468 name
=> sub {$$a[1] cmp $$b[1]},
469 gid
=> sub {$$a[3] <=> $$b[3]},
470 owner
=> sub {lc($$a[4]) cmp lc($$b[4]) || lc($$a[1]) cmp lc($$b[1])},
471 no => sub {$$a[0] <=> $$b[0]},
473 my $sortopt = 'lcname';
474 my ($verbose, $owner);
475 parse_options
(":sort" => \
$sortopt, verbose
=> \
$verbose, owner
=> \
$owner);
478 my $val = shift @ARGV;
479 $regex = qr
($val) or die "bad regex \"$val\"\n";
481 !@ARGV && exists($sortsub{$sortopt}) or die_usage
;
482 my $sortsub = $sortsub{$sortopt};
483 my $grepsub = defined($regex) ?
($owner ?
sub {$$_[4] =~ /$regex/} : sub {$$_[1] =~ /$regex/}) : sub {1};
484 my @projects = sort($sortsub grep {&$grepsub} get_all_projects
);
486 print map(sprintf("%s\n", join(":", (@
$_)[1..5])), @projects);
488 print map(sprintf("%s: %s\n", $$_[1], $$_[5] =~ /^:/ ?
"<mirror>" : $$_[5]), @projects);
494 my ($force, $noalternates, $orphanok, $optp, $nopasswd, $noowner, $defaults, $ispush, $pushusers,
495 $ismirror, $desc, $fullmirror, $homepage);
497 force
=> \
$force, "no-alternates" => \
$noalternates, orphan
=> \
$orphanok, p
=> \
$optp,
498 "no-password" => \
$nopasswd, "no-owner" => \
$noowner, defaults
=> \
$defaults,
499 "push" => \
$ispush, ":push" => \
$pushusers, ":mirror" => \
$ismirror, ":desc" => \
$desc,
500 ":description" => \
$desc, "full-mirror" => \
$fullmirror, ":homepage" => \
$homepage);
501 @ARGV == 1 or die_usage
;
502 !defined($pushusers) || defined($ispush) or $ispush = 1;
503 defined($ismirror) && $ismirror =~ /^\s*$/ and die "--mirror url must not be empty\n";
504 die "--mirror and --push are mutually exclusive options\n" if $ismirror && $ispush;
505 die "--full-mirror requires use of --mirror=<url> option\n" if $fullmirror && !$ismirror;
506 !$defaults || defined($ispush) || defined($ismirror) or $ispush = 1;
507 !$defaults || defined($nopasswd) or $nopasswd = 1;
508 !$defaults || defined($noowner) or $noowner = 1;
509 !defined($ispush) || defined($pushusers) or $pushusers = "";
510 my $projname = $ARGV[0];
511 $projname =~ s/\.git$//i;
512 Girocco
::Project
::does_exist
($projname, 1) and die "Project already exists: \"$projname\"\n";
513 if (!Girocco
::Project
::valid_name
($projname, $orphanok, $optp)) {
514 warn "Refusing to create orphan project without --orphan\n"
515 if !$quiet && !$orphanok && Girocco
::Project
::valid_name
($projname, 1, 1);
516 warn "Required orphan parent directory does not exist (use -p): ",
517 $Girocco::Config
::reporoot
.'/'.Girocco
::Project
::get_forkee_name
($projname), "\n"
518 if !$quiet && $orphanok && Girocco
::Project
::valid_name
($projname, 1, 1);
519 die "Invalid project name: \"$projname\"\n";
521 my ($forkee, $project) = ($projname =~ m
#^(.*/)?([^/]+)$#);
522 my $newtype = $forkee ?
'fork' : 'project';
523 if (length($project) > 64) {
524 die "The $newtype name is longer than 64 characters. Do you really need that much?\n"
526 warn "Allowing $newtype name longer than 64 characters with --force\n" unless $quiet;
528 unless ($Girocco::Config
::push || $Girocco::Config
::mirror
) {
529 die "Project creation disabled (no mirrors or push projects allowed)\n" unless $force;
530 warn "Continuing with --force even though both push and mirror projects are disabled\n" unless $quiet;
532 print "Enter settings for new project \"$projname\"\n" unless $defaults;
534 $settings{noalternates
} = $noalternates;
536 $settings{crypt} = "unknown";
538 my $np1 = prompt_noecho_nl_or_die
("Admin password for project $projname (echo is off)");
539 $np1 ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
540 my $np2 = prompt_noecho_nl_or_die
("Retype admin password for project $projname");
541 $np1 eq $np2 or die "Our high-paid security consultants have determined that\n" .
542 "the admin passwords you have entered do not match each other.\n";
543 $settings{crypt} = scrypt_sha1
($np1);
547 $owner = prompt_or_die
("Owner/email name for project $projname");
548 unless (valid_email
($owner)) {
550 warn "Your email sure looks weird...?\n";
553 warn "Allowing invalid email with --force\n" unless $quiet;
555 if (length($owner) > 96) {
557 warn "Your email is longer than 96 characters. Do you really need that much?\n";
560 warn "Allowing email longer than 96 characters with --force\n" unless $quiet;
563 $settings{email
} = $owner;
565 my $checkmirror = sub {
566 my $checkurl = shift;
567 unless (valid_repo_url
($checkurl)) {
569 warn "Invalid mirror URL: \"$checkurl\"\n";
572 warn "Allowing invalid mirror URL with --force\n" unless $quiet;
574 if ($Girocco::Config
::restrict_mirror_hosts
) {
575 my $mh = extract_url_hostname
($checkurl);
576 unless (is_dns_hostname
($mh)) {
578 warn "Invalid non-DNS mirror URL: \"$checkurl\"\n";
581 warn "Allowing non-DNS mirror URL with --force\n" unless $quiet;
583 if (is_our_hostname
($mh)) {
585 warn "Invalid same-host mirror URL: \"$checkurl\"\n";
588 warn "Allowing same-host mirror URL with --force\n" unless $quiet;
593 if ($ispush || $ismirror) {
594 !$ispush || $force || $Girocco::Config
::push or
595 die "Push projects are disabled, create a mirror (or use --force)\n";
596 !$ismirror || $force || $Girocco::Config
::mirror
or
597 die "Mirror projects are disabled, create a push project (or use --force)\n";
599 &$checkmirror($ismirror) or die "Invalid --mirror URL\n";
600 $baseurl = $ismirror;
601 $settings{url
} = $baseurl;
602 $settings{cleanmirror
} = $fullmirror ?
0 : 1;
605 if ($pushusers !~ /^[\s,]*$/) {
606 eval {@newusers = validate_users
($pushusers, $force); 1;} or
607 die "Invalid --push user list\n";
609 $settings{users
} = \
@newusers;
611 } elsif ($force || $Girocco::Config
::mirror
) {{
612 if ($force || $Girocco::Config
::push) {
613 $baseurl = prompt_or_die
("URL to mirror from (leave blank for push project)", "");
615 $baseurl = prompt_or_die
("URL to mirror from");
616 unless ($baseurl ne "") {
617 warn "Push projects are disabled, you must enter a mirror URL (or use --force)\n";
621 if ($baseurl ne "") {
622 &$checkmirror($baseurl) or redo;
623 $settings{url
} = $baseurl;
624 $settings{cleanmirror
} =
625 ynprompt_or_die
("Mirror only heads, tags and notes (Y/n)", "Yes");
628 my $mirror = ($baseurl eq "") ?
0 : 1;
629 my $checkdesc = sub {
631 if (length($d) > 1024) {
633 warn "Short description length greater than 1024 characters!\n";
636 warn "Allowing short description length greater than 1024 characters\n" unless $quiet;
640 if (defined($desc)) {
641 $desc =~ s/^\s+//; $desc =~ s/\s+$//;
642 $desc eq "" || &$checkdesc($desc) or
643 die "Invalid --desc description\n";
644 } elsif (!$defaults) {{
645 $desc = prompt_or_die
("Short description", "");
646 $desc =~ s/^\s+//; $desc =~ s/\s+$//;
647 $desc eq "" || &$checkdesc($desc) or redo;
648 $desc = undef if $desc eq "";
650 defined($desc) or $desc = $mirror ?
"Mirror of $baseurl" : "Push project $projname";
651 $settings{desc
} = $desc;
654 unless (valid_web_url
($hpurl)) {
656 warn "Invalid home page URL: \"$hpurl\"\n";
659 warn "Allowing invalid home page URL with --force\n" unless $quiet;
663 if (defined($homepage)) {
664 $homepage =~ s/^\s+//; $homepage =~ s/\s+$//;
665 $homepage eq "" || &$checkhp($homepage) or
666 die "Invalid --homepage URL\n";
667 } elsif (!$defaults) {{
668 $homepage = prompt_or_die
("Home page URL", "");
669 $homepage =~ s/^\s+//; $homepage =~ s/\s+$//;
670 $homepage eq "" || &$checkhp($homepage) or redo;
671 $homepage = undef if $homepage eq "";
673 $settings{hp
} = $homepage;
676 $jsonurl = prompt_or_die
("JSON notify POST URL", "");
677 if ($jsonurl ne "" && !valid_web_url
($jsonurl)) {
679 warn "Invalid JSON notify POST URL: \$jsonurl\"\n";
682 warn "Allowing invalid JSON notify POST URL with --force\n" unless $quiet;
685 $settings{notifyjson
} = $jsonurl;
686 my $commitaddrs = "";
688 $commitaddrs = clean_addrlist
(prompt_or_die
("Commit notify email addr(s)", ""));
689 if ($commitaddrs ne "" && !valid_addrlist
($commitaddrs)) {
691 warn"invalid commit notify email address list (use --force to accept): \"$commitaddrs\"\n";
694 warn "using invalid commit notify email address list with --force\n" unless $quiet;
697 $settings{notifymail
} = $commitaddrs;
698 $settings{reverseorder
} = 1;
699 $settings{reverseorder
} = ynprompt_or_die
("Oldest-to-newest commit order in emails", "Yes")
700 if !$defaults && $commitaddrs ne "";
701 $settings{summaryonly
} = ynprompt_or_die
("Summary only (no diff) in emails", "No")
702 if !$defaults && $commitaddrs ne "";
705 $tagaddrs = clean_addrlist
(prompt_or_die
("Tag notify email addr(s)", ""));
706 if ($tagaddrs ne "" && !valid_addrlist
($tagaddrs)) {
708 warn"invalid tag notify email address list (use --force to accept): \"$tagaddrs\"\n";
711 warn "using invalid tag notify email address list with --force\n" unless $quiet;
714 $settings{notifytag
} = $tagaddrs;
715 if (!$mirror && !$ispush) {{
718 my $userlist = prompt_or_die
("Push users", join(",", @newusers));
719 eval {@newusers = validate_users
($userlist, $force); 1;} or redo;
721 $settings{users
} = \
@newusers;
723 my $newproj = Girocco
::Project
->ghost($projname, $mirror, $orphanok, $optp)
724 or die "Girocco::Project->ghost call failed\n";
726 $newproj->{$k} = $v while ($k, $v) = each(%settings);
727 my $killowner = sub {
728 system($Girocco::Config
::git_bin
, '--git-dir='.$newproj->{path
},
729 'config', '--unset', "gitweb.owner");
732 $newproj->premirror or die "Girocco::Project->premirror failed\n";
733 !$noowner or &$killowner;
734 $newproj->clone or die "Girocco::Project->clone failed\n";
735 warn "Project $projname created and cloning successfully initiated.\n"
738 $newproj->conjure or die "Girocco::Project->conjure failed\n";
739 !$noowner or &$killowner;
740 warn "New push project fork is empty due to use of --no-alternates\n"
741 if !$quiet && $projname =~ m
,/, && $noalternates;
742 warn "Project $projname successfully created.\n" unless $quiet;
749 system($Girocco::Config
::git_bin
, "--git-dir=$gd", 'config', @_) == 0
750 or die "\"git --git-dir='$gd' config ".join(" ", @_)."\" failed.\n";
754 my ($force, $type, $nousers, $dryrun, $noowner, $owner, $users, $verbose);
755 parse_options
(force
=> \
$force, ":type" => \
$type, "no-users" => \
$nousers, "dry-run" => \
$dryrun,
756 "no-owner" => \
$noowner,":owner" => \
$owner, quiet
=> \
$quiet, q
=>\
$quiet, verbose
=> \
$verbose);
757 @ARGV or die "Please give project name on command line.\n";
758 my $projname = shift @ARGV;
759 (!$noowner || !defined($owner)) && (!$nousers || !@ARGV) or die_usage
;
760 !defined($type) || $type eq "mirror" || $type eq "push" or die_usage
;
761 defined($type) or $type = "";
763 if ($dryrun && $projname =~ m
,^/[^.\s/\\:], && is_git_dir
(realpath
($projname))) {
764 $projdir = realpath
($projname);
765 $projname = $projdir;
766 $projname =~ s/\.git$//i;
767 $projname =~ s
,/+$,,;
768 $projname =~ s
,^.*/,,;
769 $projname ne "" or $projname = $projdir;
771 $projname =~ s/\.git$//i;
772 $projname ne "" or die "Invalid project name \"\".\n";
773 unless (Girocco
::Project
::does_exist
($projname, 1)) {
774 Girocco
::Project
::valid_name
($projname, 1, 1)
775 or die "Invalid project name \"$projname\".\n";
776 die "No such project to adopt: $projname\n";
778 defined(Girocco
::Project
->load($projname))
779 and die "Project already known (no need to adopt): $projname\n";
780 $projdir = $Girocco::Config
::reporoot
. "/" . $projname . ".git";
781 is_git_dir
($projdir) or die "Not a git directory: \"$projdir\"\n";
783 my $config = read_config_file
($projdir . "/config");
785 %config = map {($$_[0], defined($$_[1])?
$$_[1]:"true")} @
$config if defined($config);
786 git_bool
($config{"core.bare"}) or die "Not a bare git repository: \"$projdir\"\n";
787 defined(read_HEAD_symref
($projdir)) or die "Project with non-symbolic HEAD ref: \"$projdir\"\n";
788 @ARGV and $users = [validate_users
(join(" ", @ARGV), $force, 1)];
790 if (-e
"$projdir/description") {
791 open my $fd, '<', "$projdir/description" or die "Cannot open \"$projdir/description\": $!\n";
797 defined $desc or $desc = "";
799 $desc = to_utf8
($desc, 1);
800 is_default_desc
($desc) and $desc = "";
801 if ($desc ne "" && !valid_desc
($desc)) {
802 die "invalid 'description' file contents (use --force to accept): \"$desc\"\n"
804 warn "using invalid 'description' file contents with --force\n" unless $quiet;
806 $desc = clean_desc
($desc);
807 if (length($desc) > 1024) {
808 die "description longer than 1024 chars (use --force to accept): \"$desc\"\n"
810 warn "using longer than 1024 char description with --force\n" unless $quiet;
816 my $origreadmedata = "";
817 my $readmetype = Girocco
::Project
::_normalize_rmtype
($config{"girocco.readmetype"},1);
818 if (-e
"$projdir/README.html") {
819 open my $fd, '<', "$projdir/README.html" or die "Cannot open \"$projdir/README.html\": $!\n";
825 defined $readme or $readme = "";
826 $readme = to_utf8
($readme, 1);
827 $readme =~ s/\r\n?/\n/gs;
828 $readme =~ s/^\s+//s;
829 $readme =~ s/\s+$//s;
830 $readme eq "" or $readme .= "\n";
831 $origreadme = $readme;
832 if (-e
"$projdir/README.dat") {
833 open my $fd2, '<', "$projdir/README.dat" or die "Cannot open \"$projdir/README.dat\": $!\n";
836 $readmedata = <$fd2>;
839 defined $readmedata or $readmedata = "";
840 $readmedata = to_utf8
($readmedata, 1);
841 $readmedata =~ s/\r\n?/\n/gs;
842 $readmedata =~ s/^\s+//s;
843 $readmedata =~ s/\s+$//s;
844 $readmedata eq "" or $readmedata .= "\n";
845 $origreadmedata = $readmedata;
847 !$readmetype && length($readme) && !length($readmedata) and do {
848 # the old HTML format
849 $readmetype = 'HTML';
850 $readmedata = $readme;
852 if (length($readmedata) > 8192) {
853 die "readme greater than 8192 chars is too long (use --force to override)\n"
855 warn "using readme greater than 8192 chars with --force\n" unless $quiet;
858 my $dummy = {READMEDATA
=> $readmedata, rmtype
=> $readmetype, name
=> $projname};
859 my ($cnt, $err) = Girocco
::Project
::_lint_readme
($dummy, 0);
861 my $msg = "README: $cnt error";
862 $msg .= "s" unless $cnt == 1;
863 print STDERR
"$msg\n", "-" x
length($msg), "\n", $err
864 unless $force && $quiet;
865 exit(255) unless $force && $readmetype eq 'HTML';
866 warn "$projname: using invalid raw HTML with --force\n" unless $quiet;
868 $readme = $dummy->{README
};
872 $readmetype or $readmetype = Girocco
::Project
::_normalize_rmtype
(""); # use default type
873 # Inspect any remotes now
874 # Yes, Virginia, remote urls can be multi-valued
878 next unless $k =~ /^remote\.([^\/].*?
)\
.([^.]+)$/; # remote name cannot start with "/"
879 my ($name, $subkey) = ($1, $2);
880 $remotes{$name}->{skip} = git_bool($v,1), next if $subkey eq "skipdefaultupdate
" || $subkey eq "skipfetchall
";
881 $remotes{$name}->{mirror} = git_bool($v,1), next if $subkey eq "mirror
"; # we might want this
882 $remotes{$name}->{vcs} = $v, next if defined($v) && $v !~ /^\s*$/ && $subkey eq "vcs
";
883 push(@{$remotes{$name}->{$subkey}}, $v), next if defined($v) && $v !~ /^\s*$/ &&
884 ($subkey eq "url
" || $subkey eq "fetch
" || $subkey eq "push" || $subkey eq "pushurl
");
886 # remotes.default is the default remote group to fetch for "git remote update
" otherwise --all
887 # the remote names in a group are separated by runs of [ \t\n] characters
888 # remote names "", ".", ".." and any name starting with "/" are invalid
889 # a remote with no url or vcs setting is not considered valid
892 if (exists($config{"remotes
.default"})) {
893 foreach (split(/[ \t\n]+/, $config{"remotes
.default"})) {
894 next unless exists($remotes{$_});
895 my $rmt = $remotes{$_};
896 next if !exists($rmt->{url}) && !$rmt->{vcs};
904 next unless $k =~ /^remote\.([^\/].*?)\.[^.]+$/;
905 next if $seenrmt{$1};
907 next unless exists($remotes{$1});
908 my $rmt = $remotes{$1};
909 next if $rmt->{skip} || (!exists($rmt->{url}) && !$rmt->{vcs});
913 my @needskip = (); # remotes that need skipDefaultUpdate set to true
916 my $foundfetchwithmirror = 0;
918 my $rmt = $remotes{$_};
919 push(@needskip, $_) if $usingall && !exists($rmt->{fetch});
920 next unless exists($rmt->{fetch});
922 ++$foundfetchwithmirror if $rmt->{mirror};
923 ++$foundvcs if $rmt->{vcs} || (exists($rmt->{url}) && $rmt->{url}->[0] =~ /^[a-zA-Z0-9][a-zA-Z0-9+.-]*::/);
925 # if we have $foundvcs then we need to explicitly set fetch.prune to false
926 # if we have $foundfetch > 1 then we need to explicitly set fetch.prune to false
927 my $neednoprune = !exists($config{"fetch
.prune
"}) && ($foundvcs || $foundfetch > 1);
929 my $needfakeorigin = 0; # if true we need to set remote.origin.skipDefaultUpdate = true
930 # if remote "origin
" exists we always pick up its first url or use ""
931 if (exists($remotes{origin})) {
932 my $rmt = $remotes{origin};
933 $baseurl = exists($rmt->{url}) ? $rmt->{url}->[0] : "";
934 $needfakeorigin = !exists($rmt->{url}) && !$rmt->{vcs} && !$rmt->{skip};
937 # get the first url of the @check remotes
939 my $rmt = $remotes{$_};
940 next unless exists($rmt->{url});
941 next unless defined($rmt->{url}->[0]) && $rmt->{url}->[0] ne "";
942 $baseurl = $rmt->{url}->[0];
946 my $makemirror = $type eq "mirror
" || ($type eq "" && $foundfetch);
948 # If we have $foundfetch we want to make a mirror but complain if
949 # we $foundfetchwithmirror as well unless we have --type=mirror.
950 # Warn if we have --type=push and $foundfetch and !$foundfetchwithmirror.
951 # Warn if we need to set fetch.prune=false when making a mirror
952 # Warn if we need to create remote.origin.skipDefaultUpdate when making a mirror
953 # Complain if @needskip AND !$usingall (warn with --force but don't set skip)
954 # Warn if $usingall and any @needskip (and set them) if making a mirror
955 # Warn if making a mirror and $baseurl eq ""
956 # Warn if we have --type=mirror and !$foundfetch
959 warn "No base URL to mirror from
for adopted
\"$projname\"\n" unless $quiet || $baseurl ne "";
960 warn "Adopting mirror
\"$projname\" without any fetch remotes
\n" unless $quiet || $foundfetch;
961 if ($foundfetchwithmirror) {
962 warn "Refusing to adopt mirror
\"$projname\" with active remote
.<name
>.mirror
=true remote
(s
)\n".
963 "(Use
--type
=mirror to override
)\n"
964 unless $type eq "mirror
";
965 exit(255) unless $type eq "mirror
" || $dryrun;
966 warn "Adopting mirror
\"$projname\" with active remote
.<name
>.mirror
=true remotes
\n"
967 unless $quiet || $type ne "mirror
";
969 warn "Setting explicit fetch
.prune
=false
for adoption of mirror
\"$projname\"\n"
970 if !$quiet && $neednoprune;
971 warn "Setting remote
.origin
.skipDefaultUpdate
=true
for adoption of mirror
\"$projname\"\n"
972 if !$quiet && $needfakeorigin;
973 if (!$usingall && @needskip) {
974 warn "Refusing to adopt mirror empty fetch remote
(s
) (override with
--force
)\n"
976 exit(255) unless $force || $dryrun;
977 warn "Adopting mirror with empty fetch remote
(s
) with
--force
\n"
978 unless $quiet || !$force;
980 warn "Will set skipDefaultUpdate
=true on non
-fetch remote
(s
)\n" if !$quiet && $usingall && @needskip;
981 warn "Adopting mirror with base URL
\"$baseurl\"\n" unless $quiet || $baseurl eq "";
983 warn "Adopting
push \"$projname\" but active non
-mirror remotes are present
\n"
984 if !$quiet && $foundfetch && !$foundfetchwithmirror;
987 if (!$noowner && !defined($owner)) {
989 $owner = $config{"gitweb
.owner
"};
990 if (!defined($owner) || $owner eq "") {
991 $owner = $Girocco::Config::admin;
992 warn "Using owner
\"$owner\" for adopted project
\n" unless $quiet;
995 if (!$nousers && !$makemirror && !defined($users)) {
996 # select user list for push project
997 my $findowner = $owner;
998 defined($findowner) or $findowner = $config{"gitweb
.owner
"};
999 $findowner = lc($findowner) if defined($findowner);
1000 my @owner_users = ();
1001 @owner_users = map {$findowner eq lc($$_[4]) ? $$_[1] : ()} get_all_users
1002 if defined($findowner) && $findowner ne "";
1003 defined($findowner) or $findowner = "";
1004 if (@owner_users <= 1) {
1005 $users = \@owner_users;
1006 warn "No users found that match owner
\"$findowner\"\n" unless @owner_users || $quiet;
1009 warn "Found
".scalar(@owner_users)." users
for owner
\"$findowner\" (" .
1010 join(" ", @owner_users) . ") not setting any
\n" unless $quiet;
1013 defined($users) or $users = [];
1015 # Warn if we preserve an existing receive.denyNonFastForwards or receive.denyDeleteCurrent setting
1016 # Complain if core.logallrefupdates or logs subdir exists and contains any files (allow with --force
1017 # and warn about preserving the setting)
1019 warn "Preserving existing receive
.denyNonFastForwards
=true
\n"
1020 if !$quiet && git_bool($config{"receive
.denynonfastforwards
"});
1021 warn "Preserving existing receive
.denyDeleteCurrent
=$config{'receive.denydeletecurrent'}\n"
1022 if !$quiet && exists($config{"receive
.denydeletecurrent
"}) &&
1023 $config{"receive
.denydeletecurrent
"} ne "warn";
1025 my $reflogfiles = Girocco::Project::_contains_files("$projdir/logs
");
1026 my $reflogactive = git_bool($config{"core
.logallrefupdates
"});
1027 if ($reflogactive || $reflogfiles) {
1028 warn "Refusing to adopt
\"$projname\" with active
ref logs without
--force
\n" if $reflogfiles && !$force;
1029 warn "Refusing to adopt
\"$projname\" with core
.logAllRefUpdates
=true without
--force
\n" if $reflogactive && !$force;
1030 exit(255) unless $force || $dryrun;
1031 warn "Adopting
\"$projname\" with active
ref logs with
--force
\n" unless $quiet || ($reflogfiles && !$force);
1032 warn "Adopting
\"$projname\" with core
.logAllRefUpdates
=true with
--force
\n" unless $quiet || ($reflogactive && !$force);
1035 return 0 if $dryrun && !$verbose;
1037 my $newproj = eval {Girocco::Project->ghost($projname, $makemirror, 1, $dryrun)};
1038 defined($newproj) or die "Girocco
::Project
::ghost failed
: $@
\n";
1039 $newproj->{desc} = $desc;
1040 $newproj->{README} = $readme;
1041 $newproj->{READMEDATA} = $readmedata;
1042 $newproj->{rmtype} = $readmetype;
1043 $newproj->{url} = $baseurl if $makemirror || exists($config{"gitweb
.baseurl
"});
1044 $newproj->{email} = $owner if defined($owner);
1045 $newproj->{users} = $users;
1046 $newproj->{crypt} = "unknown
";
1047 $newproj->{reverseorder} = 1 unless exists($config{"hooks
.reverseorder
"});
1048 $newproj->{summaryonly} = 1 unless exists($config{"hooks
.summaryonly
"});
1049 my $dummy = bless {}, "Girocco
::Project
";
1050 $dummy->{path} = "$projdir";
1051 $dummy->{configfilehash} = \%config;
1052 $dummy->_properties_load;
1053 delete $dummy->{origurl};
1054 foreach my $k (keys(%$dummy)) {
1055 $newproj->{$k} = $dummy->{$k}
1056 if exists($dummy->{$k}) && !exists($newproj->{$k});
1061 my %info = %$newproj;
1062 $info{README} = get_readme_desc($info{README}) if exists($info{README});
1063 my $d = Data::Dumper->new([\%info], ['*'.$newproj->{name}]);
1064 $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
1065 print $d->Dump([\%info], ['*'.$newproj->{name}]);
1067 return 0 if $dryrun;
1069 # Make any changes as needed for @needskip, $neednoprune and $needfakeorigin
1071 git_config($projdir, "fetch
.prune
", "false
") if $neednoprune;
1072 git_config($projdir, "remote
.origin
.skipDefaultUpdate
", "true
") if $needfakeorigin;
1073 if ($usingall && @needskip) {
1074 git_config($projdir, "remote
.$_.skipDefaultUpdate
", "true
") foreach @needskip;
1078 # Write out any README.dat/README.html changes before the actual Adoption
1079 # Otherwise they will get stepped on. The Girocco::Project::adopt function
1080 # does not know how to validate README.html during adoption like the above code does.
1081 if ($readmedata ne $origreadmedata) {
1082 open my $fd, '>', "$projdir/README.dat" or die "Cannot write \"$projdir/README
.dat
\": $!\n";
1083 print $fd $readmedata or die "Error writing
\"$projdir/README
.dat
\": $!\n";
1084 close $fd or die "Error closing
\"$projdir/README
.dat
\": $!\n";
1086 if ($readme ne $origreadme || ! -e "$projdir/README
.html
") {
1087 open my $fd, '>', "$projdir/README.html" or die "Cannot write \"$projdir/README
.html
\": $!\n";
1088 print $fd $readme or die "Error writing
\"$projdir/README
.html
\": $!\n";
1089 close $fd or die "Error closing
\"$projdir/README
.html
\": $!\n";
1091 git_config($projdir, "girocco
.rmtype
", $readmetype);
1093 # Perform the actual adoption
1094 $newproj->adopt or die "Girocco
::Project
::adopt failed
\n";
1096 # Perhaps restore core.logAllRefUpdates, receive.denyNonFastForwards and receive.denyDeleteCurrent
1097 git_config($projdir, "receive
.denyNonFastForwards
", "true
")
1098 if git_bool($config{"receive
.denynonfastforwards
"});
1099 git_config($projdir, "receive
.denyDeleteCurrent
", $config{"receive
.denydeletecurrent
"})
1100 if exists($config{"receive
.denydeletecurrent
"}) &&
1101 $config{"receive
.denydeletecurrent
"} ne "warn";
1102 git_config($projdir, "core
.logAllRefUpdates
", "true
")
1107 warn "Mirror project
\"$projname\" successfully adopted
.\n" unless $quiet;
1109 warn "Push project
\"$projname\" successfully adopted
.\n" unless $quiet;
1115 my ($force, $reallydel, $keepforks);
1116 parse_options(force => \$force, "really
-delete" => \$reallydel,
1117 "keep
-forks
" => \$keepforks, quiet => \$quiet, q =>\$quiet);
1118 @ARGV or die "Please give project name on command line
.\n";
1119 @ARGV == 1 or die_usage;
1120 my $project = get_project($ARGV[0]); # for safety only names accepted here
1121 my $projname = $project->{name};
1122 my $isempty = !$project->{mirror} && $project->is_empty;
1123 if (!$project->{mirror} && !$isempty && $reallydel) {
1124 die "refusing to remove
and delete non
-empty
push project without
--force
: $projname\n" unless $force;
1125 warn "allowing removal
and deletion of non
-empty
push project with
--force
\n" unless $quiet;
1129 if ($project->has_forks) {
1130 die "refusing to remove project with forks
(use --keep
-forks
): $projname\n" unless $keepforks;
1131 warn "allowing removal of forked project
while preserving its forks with
--keep
-forks
\n" unless $quiet;
1132 # Run pseudo GC on that repository so that objects don't get lost within forks
1133 my $basedir = $Girocco::Config::basedir;
1134 my $projdir = $project->{path};
1135 warn "We have to run pseudo GC on the repo so that the forks don
't lose data. Hang on...\n" unless $quiet;
1136 my $nogcrunning = sub {
1137 die "Error: GC appears to be currently running on $projname\n"
1138 if -e "$projdir/gc.pid" || -e "$projdir/.gc_in_progress";
1141 $removenogc = ! -e "$projdir/.nogc";
1142 recreate_file("$projdir/.nogc") if $removenogc;
1143 die "unable to create \"$projdir/.nogc\"\n" unless -e "$projdir/.nogc";
1144 delete $ENV{show_progress};
1145 $ENV{'show_progress
'} = 1 unless $quiet;
1148 system("$basedir/toolbox/perform-pre-gc-linking.sh", "--include-packs", $projname) == 0
1149 or die "Running pseudo GC on project $projname failed\n";
1153 if (!$project->{mirror} && !$isempty && !$reallydel) {
1154 $archived = $project->archive_and_delete;
1155 unlink("$archived/.nogc") if $removenogc && defined($archived) && $archived ne "";
1159 warn "Project '$projname' removed from $Girocco::Config::name" .
1160 ($archived ? ", backup in '$archived'" : "") .".\n" unless $quiet;
1161 warn "Retained forks may now have unwanted objects/info/alternates lines\n" if $altwarn && !$quiet;
1166 my ($force, $dryrun);
1167 parse_options(force => \$force, "dry-run" => \$dryrun, "quiet" => \$quiet);
1168 ($force && !$dryrun) || (!$force && $dryrun) or die_usage;
1170 my %allprojs = map({($$_[0] => $_)} Girocco::Project::get_full_list_extended());
1171 my @allprojs = sort({lc($a) cmp lc($b) || $a cmp $b} keys(%allprojs));
1173 @projs or @projs = @allprojs;
1174 my $bd = $Girocco::Config::reporoot.'/';
1177 !$seen{$_} && $allprojs{$_} && ${$allprojs{$_}}[2] >= 65536 or next;
1179 /^[a-zA-Z0-9]/ or next;
1180 my $pd = $bd . $_ . '.git
';
1182 warn "$_: no such directory: $pd\n" unless $quiet;
1185 warn "$_: exists but not directory: $pd\n" unless $quiet;
1189 warn "\n" if @remove && !$quiet;
1191 return 0 unless @remove;
1192 my $msg = "Would remove ".scalar(@remove). " project entr";
1193 $msg .= (@remove == 1 ? "y" : "ies");
1195 $msg .= join("", map("\t$_\n", @remove));
1196 print $msg unless $quiet;
1199 my $msg = "Removed ".scalar(@remove). " project entr";
1200 $msg .= (@remove == 1 ? "y" : "ies");
1202 $msg .= join("", map("\t$_\n", @remove));
1203 my %remove = map({$_ => 1} @remove);
1204 filedb_atomic_edit(jailed_file('/etc/group
'), sub {
1205 my ($name,undef,$gid) = split /:/;
1206 $gid =~ /^\d+$/ && $gid >= 65536 or return $_;
1207 $name =~ /^[a-zA-Z0-9]/ or return $_;
1208 !exists($remove{$name}) and return $_;
1210 print $msg unless $quiet;
1216 @ARGV == 1 or die_usage;
1217 my $project = get_clean_project($ARGV[0]);
1218 my %info = %$project;
1219 my $d = Data::Dumper->new([\%info], ['*'.$project->{name}]);
1220 $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
1221 print $d->Dump([\%info], ['*'.$project->{name}]);
1226 use Scalar::Util ();
1228 my $rt = sub { return ref($_[0]) ? Scalar::Util::reftype($_[0]) : '' };
1229 parse_options("quiet" => \$quiet, "dir" => \$dirfp, "directory" => \$dirfp, "git-dir" =>\$dirfp);
1230 @ARGV == 1 or die_usage;
1231 my $project = undef;
1234 $project = get_project_harder($ARGV[0]);
1236 $pname = $project->{name} if &$rt($project) eq 'HASH
';
1237 defined($pname) && $pname ne "" or $project = undef;
1238 !$@ && &$rt($project) ne 'HASH
' and $@ = "No such project: \"$ARGV[0]\"\n";
1239 warn $@ if $@ && !$quiet;
1241 $dirfp && defined($project->{path}) && $project->{path} ne "" and
1242 $pname = $project->{path};
1243 printf "%s\n", $pname;
1249 parse_options("push" => \$pushonly);
1251 @ARGV == 1 or die_usage;
1252 my $project = get_project_harder($ARGV[0]);
1253 my $suffix = "/".$project->{name}.".git";
1254 @Gitweb::Config::git_base_url_list = ();
1255 @Gitweb::Config::git_base_push_urls = ();
1256 @Gitweb::Config::git_base_mirror_urls = ();
1258 package Gitweb::Config;
1259 do $Girocco::Config::basedir."/gitweb/gitweb_config.perl";
1260 !$! or die "could not read gitweb_config.perl: $!\n";
1261 !$@ or die "could not parse gitweb_config.perl: $@\n";
1263 my @fetch_urls = ();
1269 ref($_) eq 'ARRAY
' or die "expected ARRAY ref";
1271 defined($u) && $u ne "" and
1272 push(@$array, $u.$suffix);
1273 } elsif (defined($_) && $_ ne "") {
1274 push(@$array, $_.$suffix);
1280 $items{$_} = 1 foreach @_;
1283 &$add_url(\@fetch_urls, @Gitweb::Config::git_base_url_list);
1284 if ($project->{mirror}) {
1285 &$add_url(\@fetch_urls, @Gitweb::Config::git_base_mirror_urls);
1287 &$add_url(\@push_urls, @Gitweb::Config::git_base_push_urls);
1291 push(@urls, &$uniq(@push_urls));
1293 push(@urls, &$uniq(@fetch_urls, @push_urls));
1295 print map "$_\n", @urls;
1300 @ARGV == 1 or die_usage;
1301 my $project = get_project_harder($ARGV[0]);
1302 my @heads = sort({lc($a) cmp lc($b)} $project->get_heads);
1303 my $cur = $project->{HEAD};
1304 defined($cur) or $cur = '';
1306 my $headhash = get_git("--git-dir=$project->{path}", 'rev
-parse
', '--quiet
', '--verify
', 'HEAD
');
1307 defined($headhash) or $headhash = '';
1309 $headhash or $curmark = '!';
1311 my $mark = $_ eq $cur ? $curmark : ' ';
1319 shift(@ARGV), $vcnt=1 if @ARGV && ($ARGV[0] eq '--verbose
' || $ARGV[0] eq '-v
');
1320 @ARGV == 1 or die_usage;
1321 my $project = get_project_harder($ARGV[0]);
1323 print map("$$_[0]\t$$_[1]\n", get_ctag_counts($project));
1325 print map("$_\n", $project->get_ctag_names);
1332 shift(@ARGV), $ic=1 if @ARGV && $ARGV[0] =~ /^(?:--?ignore-case|-i)$/i;
1333 @ARGV >= 2 or die_usage;
1334 my $project = get_project_harder(shift @ARGV);
1337 push(@{$curtags{lc($_)}}, $_) foreach $project->get_ctag_names;
1339 push(@{$curtags{$_}}, $_) foreach $project->get_ctag_names;
1343 my $ctags = join(" ", @ARGV);
1344 $ctags = lc($ctags) if $ic;
1345 foreach (split(/[\s,]+/, $ctags)) {
1346 next unless exists($curtags{$_});
1347 $seentag{$_}=1, push(@deltags, $_) unless $seentag{$_};
1350 warn $project->{name}, ": skipping removal of only non-existent tags\n" unless $quiet;
1352 # Avoid touching anything other than the ctags
1353 foreach my $tg (@deltags) {
1354 $project->delete_ctag($_) foreach @{$curtags{$tg}};
1356 $project->_set_changed;
1357 $project->_set_forkchange;
1358 warn $project->{name}, ": specified tags have been removed\n" unless $quiet;
1364 @ARGV >= 2 or die_usage;
1365 my $project = get_project_harder(shift @ARGV);
1366 my $ctags = join(" ", @ARGV);
1367 $ctags =~ /[^, a-zA-Z0-9:.+#_-]/ and
1368 die "Content tag(s) \"$ctags\" contain(s) evil character(s).\n";
1369 my $oldmask = umask();
1370 umask($oldmask & ~0060);
1372 foreach (split(/[\s,]+/, $ctags)) {
1373 ++$changed if $project->add_ctag($_, 1);
1376 $project->_set_changed;
1377 $project->_set_forkchange;
1380 my $cnt = ($changed == 1) ? "1 content tag has" : $changed . " content tags have";
1381 warn $project->{name}, ": $cnt been added/updated\n" unless $quiet;
1385 sub _get_random_val {
1390 $md5 = md5_hex(time . $$ . rand() . join(':',%$p));
1397 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force
';
1399 pop(@ARGV), $random=lc($ARGV[1]) if @ARGV==2 && $ARGV[1] =~ /^(?:random|unknown)$/i;
1400 @ARGV == 1 or die_usage;
1401 my $project = get_project_harder($ARGV[0]);
1402 die "refusing to change locked password of project \"$ARGV[0]\" without --force\n"
1403 if $project->is_password_locked;
1406 if ($random eq "random") {
1407 die "refusing to set random password without --force\n" unless $force;
1408 $rmsg = "set to random value";
1409 $newpw = _get_random_val($project);
1411 die "refusing to set password hash to '$random' without --force\n" unless $force;
1412 $rmsg = "hash set to '$random'";
1418 print "Changing admin password for project $ARGV[0]\n";
1419 my $np1 = prompt_noecho_nl_or_die("New password for project $ARGV[0] (echo is off)");
1420 $np1 ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
1421 my $np2 = prompt_noecho_nl_or_die("Retype new password for project $ARGV[0]");
1422 $np1 eq $np2 or die "Our high-paid security consultants have determined that\n" .
1423 "the admin passwords you have entered do not match each other.\n";
1427 defined($newpw) or die "missing new password on STDIN\n";
1431 $newpw ne "" or die "empty passwords are not permitted (brokenness will ensue)\n";
1432 my $old = $project->{crypt};
1433 $project->{crypt} = (defined($random) && $random ne "random") ? $newpw : scrypt_sha1($newpw);
1434 if (defined($old) && $old eq $project->{crypt}) {
1435 warn $project->{name}, ": skipping update of password hash to same value\n" unless $quiet;
1437 # Avoid touching anything other than the password hash
1438 $project->_group_update;
1439 warn $project->{name}, ": admin password $rmsg (new hash stored)\n" unless $quiet;
1445 @ARGV == 1 or die_usage;
1446 my $project = get_project_harder($ARGV[0]);
1447 my $pwhash = $project->{crypt};
1448 defined($pwhash) or $pwhash = "";
1449 if ($pwhash eq "") {
1450 warn $project->{name}, ": no password required\n" unless $quiet;
1453 if ($project->is_password_locked) {
1454 warn $project->{name}, ": password is locked\n" unless $quiet;
1459 $checkpw = prompt_noecho_nl_or_die("Admin password for project $ARGV[0] (echo is off)");
1460 $checkpw ne "" or warn "checking for empty password as hash (very unlikely)\n" unless $quiet;
1463 defined($checkpw) or die "missing admin password on STDIN\n";
1466 unless (Girocco::CLIUtil::check_passwd_match($pwhash, $checkpw)) {
1467 warn "password check failure\n" unless $quiet;
1470 warn "admin password match\n" unless $quiet;
1475 my ($force, $auto, $redelta, $recompress, $aggressive);
1476 parse_options(force => \$force, quiet => \$quiet, q => \$quiet, auto => \$auto,
1477 redelta => \$redelta, "no-reuse-delta" => \$redelta, aggressive => \$force,
1478 recompress => \$recompress, "no-reuse-object" => $recompress,
1479 aggressive => \$aggressive);
1480 $aggressive and $force = $redelta = 1;
1481 $force && $auto and die "--force and --auto are mutually exclusive options\n";
1482 @ARGV or die "Please give project name on command line.\n";
1483 @ARGV == 1 or die_usage;
1484 my $project = get_project_harder($ARGV[0]);
1485 delete $ENV{show_progress};
1486 delete $ENV{force_gc};
1487 $quiet or $ENV{"show_progress"} = 1;
1488 $force and $ENV{"force_gc"} = 1;
1489 if (!$auto && !$force && ! -e $project->{path}."/.needsgc") {
1490 open NEEDSGC, '>', $project->{path}."/.needsgc" and close NEEDSGC;
1492 my @args = ($Girocco::Config::basedir . "/jobd/gc.sh", $project->{name});
1493 $redelta && !$recompress and push(@args, "-f");
1494 $recompress and push(@args, "-F");
1495 my $lastgc = $project->{lastgc};
1496 system({$args[0]} @args) != 0 and return 1;
1497 # Do it again Sam, but only if lastgc was set, gc.sh succeeded and now it's
not set
1499 my $newlastgc = get_git
("--git-dir=$project->{path}", 'config', '--get', 'gitweb.lastgc');
1501 system({$args[0]} @args) != 0 and return 1;
1508 my ($force, $summary);
1509 parse_options
(force
=> \
$force, quiet
=> \
$quiet, q
=> \
$quiet, summary
=> \
$summary);
1510 $quiet && $summary and die "--quiet and --summary are mutually exclusive options\n";
1511 @ARGV or die "Please give project name on command line.\n";
1512 @ARGV == 1 or die_usage
;
1513 my $project = get_project_harder
($ARGV[0]);
1514 $project->{mirror
} or die "Project \"$ARGV[0]\" is a push project, not a mirror project.\n";
1515 delete $ENV{show_progress
};
1516 delete $ENV{force_update
};
1518 $ENV{"show_progress"} = 0;
1520 $ENV{"show_progress"} = ($summary ?
1 : 2);
1522 $force and $ENV{"force_update"} = 1;
1523 system($Girocco::Config
::basedir
. "/jobd/update.sh", $project->{name
}) != 0 and return 1;
1529 parse_options
(force
=> \
$force, quiet
=> \
$quiet, q
=> \
$quiet);
1530 @ARGV or die "Please give project name on command line.\n";
1531 @ARGV == 1 or die_usage
;
1532 my $project = get_project_harder
($ARGV[0]);
1533 $project->{mirror
} or die "Project \"$ARGV[0]\" is a push project, not a mirror project.\n";
1534 if ($project->{clone_in_progress
} && !$project->{clone_failed
}) {
1535 warn "Project \"$ARGV[0]\" already seems to have a clone underway at this moment.\n" unless $quiet && $force;
1536 exit(255) unless $force;
1537 yes_to_continue_or_die
("Are you sure you want to force a remirror");
1539 unlink($project->_clonefail_path);
1540 unlink($project->_clonelog_path);
1541 recreate_file
($project->_clonep_path);
1542 my $sock = IO
::Socket
::UNIX
->new($Girocco::Config
::chroot.'/etc/taskd.socket') or
1543 die "cannot connect to taskd.socket: $!\n";
1544 select((select($sock),$|=1)[0]);
1545 $sock->print("clone ".$project->{name
}."\n");
1546 # Just ignore reply, we are going to succeed anyway and the I/O
1547 # would apparently get quite hairy.
1551 warn "Project \"$ARGV[0]\" remirror initiated.\n" unless $quiet;
1557 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1558 @ARGV == 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage
;
1559 my $project = get_project_harder
($ARGV[0]);
1560 if (@ARGV == 2 && !valid_email
($ARGV[1])) {
1561 die "invalid owner/email (use --force to accept): \"$ARGV[1]\"\n"
1563 warn "using invalid owner/email with --force\n" unless $quiet;
1565 if (@ARGV == 2 && length($ARGV[1]) > 96) {
1566 die "owner/email longer than 96 chars (use --force to accept): \"$ARGV[1]\"\n"
1568 warn "using longer than 96 char owner/email with --force\n" unless $quiet;
1570 my $old = $project->{email
};
1572 print "$old\n" if defined($old);
1575 if (defined($old) && $old eq $ARGV[1]) {
1576 warn $project->{name
}, ": skipping update of owner/email to same value\n" unless $quiet;
1578 # Avoid touching anything other than "gitweb.owner"
1579 $project->_property_fput("email", $ARGV[1]);
1580 $project->_update_index;
1581 $project->_set_changed;
1582 warn $project->{name
}, ": owner/email updated to \"$ARGV[1]\"\n" unless $quiet;
1589 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1590 @ARGV >= 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage
;
1591 my $project = get_project_harder
(shift @ARGV);
1592 if (@ARGV && !valid_desc
(join(" ", @ARGV))) {
1593 die "invalid description (use --force to accept): \"".join(" ", @ARGV)."\"\n"
1595 warn "using invalid description with --force\n" unless $quiet;
1597 my $desc = clean_desc
(join(" ", @ARGV));
1598 if (@ARGV && length($desc) > 1024) {
1599 die "description longer than 1024 chars (use --force to accept): \"$desc\"\n"
1601 warn "using longer than 1024 char description with --force\n" unless $quiet;
1603 my $old = $project->{desc
};
1605 print "$old\n" if defined($old);
1608 if (defined($old) && $old eq $desc) {
1609 warn $project->{name
}, ": skipping update of description to same value\n" unless $quiet;
1611 # Avoid touching anything other than description file
1612 $project->_property_fput("desc", $desc);
1613 $project->_set_changed;
1614 warn $project->{name
}, ": description updated to \"$desc\"\n" unless $quiet;
1620 my ($force, $readmetype) = (0, undef);
1621 parse_options
(force
=> \
$force, ":type" => \
$readmetype, ":format" => \
$readmetype);
1622 @ARGV == 1 && defined($readmetype) and push(@ARGV, undef);
1623 @ARGV == 2 || (@ARGV == 1 && !$force && !defined($readmetype) && !$setopt) or die_usage
;
1624 defined($readmetype) and $readmetype = Girocco
::Project
::_normalize_rmtype
($readmetype,1);
1625 defined($readmetype) && !$readmetype and die_usage
;
1626 my $project = get_project_harder
($ARGV[0]);
1627 my $old = $project->{READMEDATA
};
1629 chomp $old if defined($old);
1630 print "$old\n" if defined($old) && $old ne "";
1633 $readmetype or $readmetype = $project->{rmtype
};
1634 my ($new, $raw, $newname);
1636 if (!defined($ARGV[1])) {
1638 $newname = "original README data";
1639 $readmetype ne $project->{rmtype
} && $new ne "" and $raw = 1;
1640 } elsif ($ARGV[1] eq "-") {
1644 $newname = "contents of <STDIN>";
1645 } elsif (lc($ARGV[1]) eq "automatic" || lc($ARGV[1]) eq "auto") {
1647 } elsif (lc($ARGV[1]) eq "suppressed" || lc($ARGV[1]) eq "suppress") {
1648 $new = "<!-- suppress -->";
1652 die "missing filename for README\n" unless $fn ne "";
1653 die "no such file: \"$fn\"\n" unless -f
$fn && -r
$fn;
1654 open F
, '<', $fn or die "cannot open \"$fn\" for reading: $!\n";
1659 $newname = "contents of \"$fn\"";
1661 defined($new) or $new = '';
1662 my $origrmtype = $project->{rmtype
};
1663 $project->{rmtype
} = $readmetype;
1664 $project->{READMEDATA
} = to_utf8
($new, 1);
1665 $project->_cleanup_readme;
1666 if (length($project->{READMEDATA
}) > 8192) {
1667 die "readme greater than 8192 chars is too long (use --force to override)\n"
1669 warn "using readme greater than 8192 chars with --force\n" unless $quiet;
1672 my ($cnt, $err) = $project->_lint_readme(0);
1674 my $msg = "README: $cnt error";
1675 $msg .= "s" unless $cnt == 1;
1676 print STDERR
"$msg\n", "-" x
length($msg), "\n", $err
1677 unless $force && $quiet;
1678 exit(255) unless $force && $project->{rmtype
} eq 'HTML';
1679 warn $project->{name
} . ": using invalid raw HTML with --force\n" unless $quiet;
1680 $project->{README
} = $project->{READMEDATA
};
1683 if (defined($old) && $old eq $project->{READMEDATA
} && $readmetype eq $origrmtype && !$force) {
1684 warn $project->{name
}, ": skipping update of README to same value\n" unless $quiet;
1686 # Avoid touching anything other than README.html file
1687 $project->_property_fput("READMEDATA", $project->{READMEDATA
}, 1);
1688 $project->_property_fput("README", $project->{README
});
1689 $project->_property_fput("rmtype", $readmetype) if $readmetype ne $origrmtype;
1690 $project->_set_changed;
1691 my $desc = get_readme_desc
($project->{README
});
1693 $newname .= " ($desc)";
1697 warn $project->{name
}, ": README $readmetype format updated to $newname\n" unless $quiet;
1703 my ($proj, $newhead) = @_;
1704 my %okheads = map({($_ => 1)} $proj->get_heads);
1705 exists($okheads{$newhead});
1709 @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage
;
1710 my $project = get_project_harder
($ARGV[0]);
1711 if (@ARGV == 2 && !valid_head
($project, $ARGV[1])) {
1712 die "invalid head (try \"@{[basename($0)]} listheads $ARGV[0]\"): \"$ARGV[1]\"\n";
1714 my $old = $project->{HEAD
};
1716 print "$old\n" if defined($old);
1719 if (defined($old) && $old eq $ARGV[1]) {
1720 warn $project->{name
}, ": skipping update of HEAD symref to same value\n" unless $quiet;
1722 # Avoid touching anything other than the HEAD symref
1723 $project->set_HEAD($ARGV[1]);
1724 $project->_set_changed;
1725 warn $project->{name
}, ": HEAD symref updated to \"refs/heads/$ARGV[1]\"\n" unless $quiet;
1732 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1733 @ARGV == 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage
;
1734 my $project = get_project_harder
($ARGV[0]);
1735 my $projconfig = read_config_file_hash
($project->{path
}."/config");
1736 my $ghp = $Girocco::Config
::reporoot
."/_global/hooks";
1737 my $rghp = realpath
($ghp);
1738 my $lhp = $project->{path
}."/hooks";
1739 my $rlhp = realpath
($lhp);
1742 if (defined($projconfig) && defined($projconfig->{"core.hookspath"})) {
1743 $ahp = $projconfig->{"core.hookspath"};
1744 $rahp = realpath
($ahp);
1747 if (defined($rahp) && $rahp ne "") {
1748 if ($rahp eq $rghp) {
1749 my $nc = ($ahp eq $ghp ?
"" : " non-canonical");
1750 printf "%s \t(global%s)\n", $ahp, $nc;
1751 } elsif ($rahp eq $rlhp) {
1752 my $nc = ($ahp eq $lhp ?
"" : " non-canonical");
1753 printf "%s \t(local%s)\n", $ahp, $nc;
1754 } elsif ($rahp ne $ahp) {
1755 print "$ahp \t($rahp)\n";
1759 } elsif ($ahp ne "") {
1760 print "$ahp \t(non-existent)\n";
1765 if (lc($shp) eq "global") {
1767 } elsif (lc($shp) eq "local") {
1769 } elsif (substr($shp, 0, 2) eq "~/") {
1770 $shp = $ENV{"HOME"}.substr($shp,1);
1771 } elsif ($shp =~ m
,^~([a
-zA
-Z_
][a
-zA
-Z_0
-9]*)((?
:/.*)?
)$,) {
1773 my $hd = (getpwnam($1))[7];
1774 $shp = $hd . $sfx if defined($hd) && $hd ne "" && $hd ne "/" && -d
$hd;
1776 $shp ne "" && -d
$shp or die "no such directory: $ARGV[1]\n";
1777 my $rshp = realpath
($shp);
1778 defined($rshp) && $rshp ne "" or die "could not realpath: $ARGV[1]\n";
1779 $rshp =~ m
,^/[^/], or die "invalid hookspath: $rshp\n";
1780 die "refusing to switch from current non-global hookspath without --force\n"
1781 if !$force && defined($rahp) && $rahp ne "" && $rahp ne $rghp && $rshp ne $rahp;
1782 if (!$force && defined($rahp) && $rahp ne "") {
1783 if ($rshp eq $rahp && ($ahp eq $ghp || $ahp eq $lhp)) {
1784 warn $project->{name
}, ": skipping update of hookspath to same effective value\n" unless $quiet;
1788 $rshp = $ghp if $rshp eq $rghp;
1789 $rshp = $lhp if $rshp eq $rlhp;
1790 if ($rshp eq $ahp) {
1791 warn $project->{name
}, ": skipping update of hookspath to same value\n" unless $quiet;
1794 die "refusing to set neither local nor global hookspath without --force\n"
1795 if !$force && $rshp ne $ghp && $rshp ne $lhp;
1796 system($Girocco::Config
::git_bin
, '--git-dir='.$project->{path
},
1797 'config', "core.hookspath", $rshp);
1798 my $newval = '"'.$rshp.'"';
1799 $newval = "global" if $rshp eq $ghp;
1800 $newval = "local" if $rshp eq $lhp;
1801 warn $project->{name
}, ": hookspath set to $newval\n" unless $quiet;
1817 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1818 @ARGV == 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage
;
1819 my $project = get_project_harder
($ARGV[0]);
1820 if (!exists($boolfields{$ARGV[1]})) {
1821 die "invalid boolean field name: \"$ARGV[1]\" -- try \"help\"\n";
1823 if (@ARGV == 3 && $boolfields{$ARGV[1]} && !$project->{mirror
}) {
1824 die "invalid boolean field for non-mirror (use --force to accept): \"$ARGV[1]\"\n"
1826 warn "using mirror field on non-mirror with --force\n" unless $quiet;
1828 if (@ARGV == 3 && !valid_bool
($ARGV[2])) {
1829 die "invalid boolean value: \"$ARGV[2]\"\n";
1831 my $bool = clean_bool
($ARGV[2]);
1832 my $old = $project->{$ARGV[1]};
1834 print "$old\n" if defined($old);
1837 if (defined($old) && $old eq $bool) {
1838 warn $project->{name
}, ": skipping update of $ARGV[1] to same value\n" unless $quiet;
1840 # Avoid touching anything other than $ARGV[1] field
1841 $project->_property_fput($ARGV[1], $bool);
1842 warn $project->{name
}, ": $ARGV[1] updated to $bool\n" unless $quiet;
1847 sub cmd_setjsontype
{
1848 @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage
;
1849 my $project = get_project_harder
($ARGV[0]);
1852 my $jt = lc($ARGV[1]);
1853 index($jt, "/") >= 0 or $jt = "application/".$jt;
1854 $jt eq 'application/x-www-form-urlencoded' ||
1855 $jt eq 'application/json' or
1856 die "invalid jsontype value: \"$ARGV[1]\"\n";
1859 my $old = $project->{jsontype
};
1861 print "$old\n" if defined($old);
1864 if (defined($old) && $old eq $jsontype) {
1865 warn $project->{name
}, ": skipping update of jsontype to same value\n" unless $quiet;
1867 # Avoid touching anything other than jsontype field
1868 $project->_property_fput('jsontype', $jsontype);
1869 warn $project->{name
}, ": jsontype updated to $jsontype\n" unless $quiet;
1874 sub cmd_setjsonsecret
{
1875 @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage
;
1876 my $project = get_project_harder
($ARGV[0]);
1880 $js =~ s/^\s+//; $js =~ s/\s+$//;
1883 my $old = $project->{jsonsecret
};
1885 print "$old\n" if defined($old);
1888 if (defined($old) && $old eq $jsonsecret) {
1889 warn $project->{name
}, ": skipping update of jsonsecret to same value\n" unless $quiet;
1891 # Avoid touching anything other than jsonsecret field
1892 $project->_property_fput('jsonsecret', $jsonsecret);
1893 warn $project->{name
}, ": jsonsecret updated to \"$jsonsecret\"\n" unless $quiet;
1898 sub cmd_setautogchack
{
1899 @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage
;
1900 my $project = get_project_harder
($ARGV[0]);
1901 my $aghok = $Girocco::Config
::autogchack
&&
1902 ($project->{mirror
} || $Girocco::Config
::autogchack
ne "mirror");
1903 my $old = defined($project->{autogchack
}) ? clean_bool
($project->{autogchack
}) : "unset";
1905 print "$old\n" if $aghok;
1909 if (lc($ARGV[1]) eq "unset") {
1912 valid_bool
($ARGV[1]) or die "invalid boolean value: \"$ARGV[1]\"\n";
1913 $bool = clean_bool
($ARGV[1]);
1916 die "\$Girocco::Config::autogchack is false\n" unless $Girocco::Config
::autogchack
;
1917 die "\$Girocco::Config::autogchack is only enabled for mirrors\n";
1919 if ($old eq $bool) {
1920 warn $project->{name
}, ": autogchack value unchanged\n" unless $quiet;
1922 if ($bool eq "unset") {
1923 system($Girocco::Config
::git_bin
, '--git-dir='.$project->{path
},
1924 'config', '--unset', "girocco.autogchack");
1926 system($Girocco::Config
::git_bin
, '--git-dir='.$project->{path
},
1927 'config', '--bool', "girocco.autogchack", $bool);
1930 return system($Girocco::Config
::basedir
. "/jobd/maintain-auto-gc-hack.sh", $project->{name
}) == 0
1935 my ($url, $type) = @_;
1936 $type ne 'baseurl' and return valid_web_url
($url);
1937 valid_repo_url
($url) or return 0;
1938 if ($Girocco::Config
::restrict_mirror_hosts
) {
1939 my $mh = extract_url_hostname
($url);
1940 is_dns_hostname
($mh) or return 0;
1941 !is_our_hostname
($mh) or return 0;
1949 baseurl
=> ["url" , 1],
1950 homepage
=> ["hp" , 0],
1951 notifyjson
=> ["notifyjson", 0],
1957 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
1958 @ARGV == 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage
;
1959 my $project = get_project_harder
($ARGV[0]);
1960 if (!exists($urlfields{$ARGV[1]})) {
1961 die "invalid URL field name: \"$ARGV[1]\" -- try \"help\"\n";
1963 if (@ARGV == 3 && ${$urlfields{$ARGV[1]}}[1] && !$project->{mirror
}) {
1964 die "invalid URL field for non-mirror (use --force to accept): \"$ARGV[1]\"\n"
1966 warn "using mirror field on non-mirror with --force\n" unless $quiet;
1968 if (@ARGV == 3 && !valid_url
($ARGV[2], $ARGV[1])) {
1969 die "invalid URL (use --force to accept): \"$ARGV[2]\"\n"
1971 warn "using invalid URL with --force\n" unless $quiet;
1973 my $old = $project->{${$urlfields{$ARGV[1]}}[0]};
1975 print "$old\n" if defined($old);
1978 if (defined($old) && $old eq $ARGV[2]) {
1979 warn $project->{name
}, ": skipping update of $ARGV[1] to same value\n" unless $quiet;
1981 # Avoid touching anything other than $ARGV[1]'s field
1982 $project->_property_fput(${$urlfields{$ARGV[1]}}[0], $ARGV[2]);
1983 if ($ARGV[1] eq "baseurl") {
1984 $project->{url
} = $ARGV[2];
1985 $project->_set_bangagain;
1987 $project->_set_changed unless $ARGV[1] eq "notifyjson";
1988 warn $project->{name
}, ": $ARGV[1] updated to $ARGV[2]\n" unless $quiet;
2003 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
2004 @ARGV >= 3 || (@ARGV == 2 && !$force && !$setopt) or die_usage
;
2005 my $project = get_project_harder
(shift @ARGV);
2006 my $field = shift @ARGV;
2007 if (!exists($msgsfields{$field})) {
2008 die "invalid msgs field name: \"$field\" -- try \"help\"\n";
2010 if (@ARGV && !valid_addrlist
(@ARGV)) {
2011 die "invalid email address list (use --force to accept): \"".join(" ",@ARGV)."\"\n"
2013 warn "using invalid email address list with --force\n" unless $quiet;
2015 my $old = $project->{$field};
2017 printf "%s\n", clean_addrlist
($old, " ") if defined($old);
2020 my $newlist = clean_addrlist
(join(" ",@ARGV));
2021 if (defined($old) && $old eq $newlist) {
2022 warn $project->{name
}, ": skipping update of $field to same value\n" unless $quiet;
2024 # Avoid touching anything other than $field's field
2025 $project->_property_fput($field, $newlist);
2026 warn $project->{name
}, ": $field updated to \"$newlist\"\n" unless $quiet;
2033 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
2034 @ARGV >= 2 || (@ARGV == 1 && !$force && !$setopt) or die_usage
;
2035 my $project = get_project_harder
(shift @ARGV);
2036 my $projname = $project->{name
};
2037 !@ARGV || !$project->{mirror
} or die "cannot set users list for mirror project: \"$projname\"\n";
2040 eval {@newusers = validate_users
(join(" ", @ARGV), $force); 1;} or exit 255;
2041 die "refusing to set empty users list without --force\n" unless @newusers || $force;
2043 return 0 if !@ARGV && $project->{mirror
};
2044 my $oldusers = $project->{users
};
2045 if ($oldusers && ref($oldusers) eq "ARRAY") {
2046 $oldusers = join("\n", @
$oldusers);
2051 print "$oldusers\n" if $oldusers ne "";
2054 if ($oldusers eq join("\n", @newusers)) {
2055 warn "$projname: skipping update of users list to same value\n" unless $quiet;
2057 # Avoid touching anything other than the users list
2058 $project->{users
} = \
@newusers;
2059 $project->_update_users;
2060 warn "$projname: users list updated to \"@{[join(',',@newusers)]}\"\n" unless $quiet;
2068 owner
=> [\
&cmd_setowner
, 0],
2069 desc
=> [\
&cmd_setdesc
, 0],
2070 description
=> [\
&cmd_setdesc
, 0],
2071 readme
=> [\
&cmd_setreadme
, 0],
2072 head
=> [\
&cmd_sethead
, 0],
2073 HEAD
=> [\
&cmd_sethead
, 0],
2074 hooks
=> [\
&cmd_sethooks
, 0],
2075 hookspath
=> [\
&cmd_sethooks
, 0],
2076 cleanmirror
=> [\
&cmd_setbool
, 1],
2077 reverseorder
=> [\
&cmd_setbool
, 1],
2078 summaryonly
=> [\
&cmd_setbool
, 1],
2079 statusupdates
=> [\
&cmd_setbool
, 1],
2080 autogchack
=> [\
&cmd_setautogchack
, 0],
2081 baseurl
=> [\
&cmd_seturl
, 1],
2082 homepage
=> [\
&cmd_seturl
, 1],
2083 notifyjson
=> [\
&cmd_seturl
, 1],
2084 jsontype
=> [\
&cmd_setjsontype
, 0],
2085 jsonsecret
=> [\
&cmd_setjsonsecret
, 0],
2086 notifymail
=> [\
&cmd_setmsgs
, 1],
2087 notifytag
=> [\
&cmd_setmsgs
, 1],
2088 users
=> [\
&cmd_setusers
, 0],
2095 push(@newargs, shift) if @_ && $_[0] eq '--force';
2097 (($setopt && @_ >= 3) || @_ == 2) && exists($fieldnames{$field}) or die_usage
;
2098 push(@newargs, shift);
2099 shift unless ${$fieldnames{$field}}[1];
2101 diename
(($setopt ?
"set " : "get ") . $field);
2103 &{${$fieldnames{$field}}[0]}(@ARGV);
2118 create
=> \
&cmd_create
,
2119 adopt
=> \
&cmd_adopt
,
2120 remove
=> \
&cmd_remove
,
2121 trash
=> \
&cmd_remove
,
2122 delete => \
&cmd_remove
,
2123 prune
=> \
&cmd_prune
,
2125 verify
=> \
&cmd_verify
,
2127 listheads
=> \
&cmd_listheads
,
2128 listtags
=> \
&cmd_listtags
,
2129 listctags
=> \
&cmd_listtags
,
2130 deltags
=> \
&cmd_deltags
,
2131 delctags
=> \
&cmd_deltags
,
2132 addtags
=> \
&cmd_addtags
,
2133 addctags
=> \
&cmd_addtags
,
2134 chpass
=> \
&cmd_chpass
,
2135 checkpw
=> \
&cmd_checkpw
,
2137 update
=> \
&cmd_update
,
2138 remirror
=> \
&cmd_remirror
,
2139 setowner
=> \
&cmd_setowner
,
2140 setdesc
=> \
&cmd_setdesc
,
2141 setdescription
=> \
&cmd_setdesc
,
2142 setreadme
=> \
&cmd_setreadme
,
2143 sethead
=> \
&cmd_sethead
,
2144 sethooks
=> \
&cmd_sethooks
,
2145 sethookspath
=> \
&cmd_sethooks
,
2146 setbool
=> \
&cmd_setbool
,
2147 setboolean
=> \
&cmd_setbool
,
2148 setflag
=> \
&cmd_setbool
,
2149 setautogchack
=> \
&cmd_setautogchack
,
2150 seturl
=> \
&cmd_seturl
,
2151 setjsontype
=> \
&cmd_setjsontype
,
2152 setjsonsecret
=> \
&cmd_setjsonsecret
,
2153 setmsgs
=> \
&cmd_setmsgs
,
2154 setusers
=> \
&cmd_setusers
,
2160 BEGIN { %nopager = (
2161 # 1 => pager never allowed
2162 # -1 => pager defaults to off instead of on
2180 setdescription
=> -1,
2188 setautogchack
=> -1,
2191 setjsonsecret
=> -1,
2201 my $bn = basename
($0);
2202 setup_pager_stdout
($usepager);
2203 printf "%s version %s\n\n", $bn, $VERSION;
2204 if (defined($cmd) && $cmd ne '') {
2205 $cmd =~ s/^set(?=[a-zA-Z])//i;
2207 my ($lastmt, $incmd);
2208 foreach (split('\n', sprintf($help, $bn))) {
2209 $lastmt || $incmd or $lastmt = /^\s*$/, next;
2210 $incmd = 1 if $lastmt && /^\s*(?:\[?set\]?)?$cmd\s/;
2211 last if $incmd && /^\s*$/;
2212 $incmd and $cmdhelp .= $_ . "\n";
2215 print $cmdhelp and exit 0 if $cmdhelp;
2224 shift, $quiet=1, redo if @ARGV && $ARGV[0] =~ /^(?:-q|--quiet)$/i;
2225 shift, $usepager=1, redo if @ARGV && $ARGV[0] =~ /^(?:-p|--pager|--paginate)$/i;
2226 shift, $usepager=0, redo if @ARGV && $ARGV[0] =~ /^(?:--no-pager|--no-paginate)$/i;
2228 dohelp
($ARGV[1]) if !@ARGV || @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i;
2229 my $command = shift;
2232 if (!exists($commands{$command}) && exists($commands{"set".$command})) {
2234 $command = "set" . $command;
2236 exists($commands{$command}) or die "Unknown command \"$command\" -- try \"help\"\n";
2237 dohelp
($command) if @ARGV && ($ARGV[0] =~ /^(?:-h|-?-help)$/i ||
2238 $ARGV[0] =~ /^help$/i && !Girocco
::Project
::does_exist
("help",1));
2239 $nopager{$command} && $nopager{$command} > 0 and $usepager = 0;
2240 my $pgdfltoff = $nopager{$command} && $nopager{$command} < 0 ?
1 : 0;
2241 setup_pager_stdout
($usepager, $pgdfltoff);
2242 &{$commands{$command}}(@ARGV);