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