]> git.madduck.net Git - code/myrepos.git/blob - mr

madduck's git repository

Every one of the projects in this repository is available at the canonical URL git://git.madduck.net/madduck/pub/<projectpath> — see each project's metadata for the exact URL.

All patches and comments are welcome. Please squash your changes to logical commits before using git-format-patch and git-send-email to patches@git.madduck.net. If you'd read over the Git project's submission guidelines and adhered to them, I'd be especially grateful.

SSH access, as well as push access can be individually arranged.

If you use my repositories frequently, consider adding the following snippet to ~/.gitconfig and using the third clone URL listed for each project:

[url "git://git.madduck.net/madduck/"]
  insteadOf = madduck:

make veracity commit push
[code/myrepos.git] / mr
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 mr - a Multiple Repository management tool
6
7 =head1 SYNOPSIS
8
9 B<mr> [options] checkout
10
11 B<mr> [options] update
12
13 B<mr> [options] status
14
15 B<mr> [options] commit [-m "message"]
16
17 B<mr> [options] record [-m "message"]
18
19 B<mr> [options] push
20
21 B<mr> [options] diff
22
23 B<mr> [options] log
24
25 B<mr> [options] run command [param ...]
26
27 B<mr> [options] bootstrap url [directory]
28
29 B<mr> [options] register [repository]
30
31 B<mr> [options] config section ["parameter=[value]" ...]
32
33 B<mr> [options] action [params ...]
34
35 B<mr> [options] [online|offline]
36
37 B<mr> [options] remember action [params ...]
38
39 =head1 DESCRIPTION
40
41 B<mr> is a Multiple Repository management tool. It can checkout, update, or
42 perform other actions on a set of repositories as if they were one combined
43 repository. It supports any combination of subversion, git, cvs, mercurial,
44 bzr, darcs, fossil and veracity repositories, and support for other version
45 control systems can easily be added.
46
47 B<mr> cds into and operates on all registered repositories at or below your
48 working directory. Or, if you are in a subdirectory of a repository that
49 contains no other registered repositories, it will stay in that directory,
50 and work on only that repository,
51
52 B<mr> is configured by .mrconfig files, which list the repositories. It
53 starts by reading the .mrconfig file in your home directory, and this can
54 in turn chain load .mrconfig files from repositories. It also automatically
55 looks for a .mrconfig file in the current directory, or in one of its
56 parent directories.
57
58 These predefined commands should be fairly familiar to users of any version
59 control system:
60
61 =over 4
62
63 =item checkout (or co)
64
65 Checks out any repositories that are not already checked out.
66
67 =item update
68
69 Updates each repository from its configured remote repository.
70
71 If a repository isn't checked out yet, it will first check it out.
72
73 =item status
74
75 Displays a status report for each repository, showing what
76 uncommitted changes are present in the repository.
77
78 =item commit (or ci)
79
80 Commits changes to each repository. (By default, changes are pushed to the
81 remote repository too, when using distributed systems like git. If you
82 don't like this default, you can change it in your .mrconfig, or use record
83 instead.)
84
85 The optional -m parameter allows specifying a commit message.
86
87 =item record
88
89 Records changes to the local repository, but does not push them to the
90 remote repository. Only supported for distributed version control systems.
91
92 The optional -m parameter allows specifying a commit message.
93
94 =item push
95
96 Pushes committed local changes to the remote repository. A no-op for
97 centralized version control systems.
98
99 =item diff
100
101 Show a diff of uncommitted changes.
102
103 =item log
104
105 Show the commit log.
106
107 =item run command [param ...]
108
109 Runs the specified command in each repository.
110
111 =back
112
113 These commands are also available:
114
115 =over 4
116
117 =item bootstrap url [directory]
118
119 Causes mr to download the url, and use it as a .mrconfig file
120 to checkout the repositories listed in it, into the specified directory.
121
122 The directory will be created if it does not exist. If no directory is
123 specified, the current directory will be used.
124
125 If the .mrconfig file includes a repository named ".", that
126 is checked out into the top of the specified directory.
127
128 =item list (or ls)
129
130 List the repositories that mr will act on.
131
132 =item register
133
134 Register an existing repository in a mrconfig file. By default, the
135 repository in the current directory is registered, or you can specify a
136 directory to register.
137
138 The mrconfig file that is modified is chosen by either the -c option, or by
139 looking for the closest known one at or in a parent of the current directory.
140
141 =item config
142
143 Adds, modifies, removes, or prints a value from a mrconfig file. The next
144 parameter is the name of the section the value is in. To add or modify
145 values, use one or more instances of "parameter=value". Use "parameter=" to
146 remove a parameter. Use just "parameter" to get the value of a parameter.
147
148 For example, to add (or edit) a repository in src/foo:
149
150   mr config src/foo checkout="svn co svn://example.com/foo/trunk foo"
151
152 To show the command that mr uses to update the repository in src/foo:
153
154   mr config src/foo update
155
156 To see the built-in library of shell functions contained in mr:
157
158   mr config DEFAULT lib
159
160 The mrconfig file that is used is chosen by either the -c option, or by
161 looking for the closest known one at or in a parent of the current directory.
162
163 =item offline
164
165 Advises mr that it is in offline mode. Any commands that fail in
166 offline mode will be remembered, and retried when mr is told it's online.
167
168 =item online
169
170 Advices mr that it is in online mode again. Commands that failed while in
171 offline mode will be re-run.
172
173 =item remember
174
175 Remember a command, to be run later when mr re-enters online mode. This
176 implicitly puts mr into offline mode. The command can be any regular mr
177 command. This is useful when you know that a command will fail due to being
178 offline, and so don't want to run it right now at all, but just remember
179 to run it when you go back online.
180
181 =item help
182
183 Displays this help.
184
185 =back
186
187 Actions can be abbreviated to any unambiguous substring, so
188 "mr st" is equivalent to "mr status", and "mr up" is equivalent to "mr
189 update"
190
191 Additional parameters can be passed to most commands, and are passed on
192 unchanged to the underlying version control system. This is mostly useful
193 if the repositories mr will act on all use the same version control
194 system.
195
196 =head1 OPTIONS
197
198 =over 4
199
200 =item -d directory
201
202 =item --directory directory
203
204 Specifies the topmost directory that B<mr> should work in. The default is
205 the current working directory.
206
207 =item -c mrconfig
208
209 =item --config mrconfig
210
211 Use the specified mrconfig file. The default is to use both F<~/.mrconfig>
212 as well as look for a F<.mrconfig> file in the current directory, or in one
213 of its parent directories.
214
215 =item -f
216
217 =item --force
218
219 Force mr to act on repositories that would normally be skipped due to their
220 configuration.
221
222 =item -v
223
224 =item --verbose
225
226 Be verbose.
227
228 =item -q
229
230 =item --quiet
231
232 Be quiet. This suppresses mr's usual output, as well as any output from
233 commands that are run (including stderr output). If a command fails,
234 the output will be shown.
235
236 =item -k
237
238 =item --insecure
239
240 Accept untrusted SSL certificates when bootstrapping.
241
242 =item -s
243
244 =item --stats
245
246 Expand the statistics line displayed at the end to include information
247 about exactly which repositories failed and were skipped, if any.
248
249 =item -i
250
251 =item --interactive
252
253 Interactive mode. If a repository fails to be processed, a subshell will be
254 started which you can use to resolve or investigate the problem. Exit the
255 subshell to continue the mr run.
256
257 =item -n [number]
258
259 =item --no-recurse [number]
260
261 If no number if specified, just operate on the repository for the current
262 directory, do not recurse into deeper repositories.
263
264 If a number is specified, will recurse into repositories at most that many
265 subdirectories deep. For example, with -n 2 it would recurse into ./src/foo,
266 but not ./src/packages/bar.
267
268 =item -j [number]
269
270 =item --jobs [number]
271
272 Run the specified number of jobs in parallel, or an unlimited number of jobs
273 with no number specified. This can greatly speed up operations such as updates.
274 It is not recommended for interactive operations.
275
276 Note that running more than 10 jobs at a time is likely to run afoul of
277 ssh connection limits. Running between 3 and 5 jobs at a time will yield
278 a good speedup in updates without loading the machine too much.
279
280 =item -t
281
282 =item --trust-all
283
284 Trust all mrconfig files even if they are not listed in F<~/.mrtrust>.
285 Use with caution.
286
287 =item -p
288
289 =item --path
290
291 This obsolete flag is ignored.
292
293 =back
294
295 =head1 MRCONFIG FILES
296
297 Here is an example F<.mrconfig> file:
298
299   [src]
300   checkout = svn checkout svn://svn.example.com/src/trunk src
301   chain = true
302
303   [src/linux-2.6]
304   checkout = git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git &&
305         cd linux-2.6 &&
306         git checkout -b mybranch origin/master
307
308 The F<.mrconfig> file uses a variant of the INI file format. Lines
309 starting with "#" are comments. Values can be continued to the
310 following line by indenting the line with whitespace.
311
312 The C<DEFAULT> section allows setting default values for the sections that
313 come after it.
314
315 The C<ALIAS> section allows adding aliases for actions. Each parameter
316 is an alias, and its value is the action to use.
317
318 All other sections add repositories. The section header specifies the
319 directory where the repository is located. This is relative to the directory
320 that contains the mrconfig file, but you can also choose to use absolute
321 paths. (Note that you can use environment variables in section names; they
322 will be passed through the shell for expansion. For example, 
323 C<[$HOSTNAME]>, or C<[${HOSTNAME}foo]>).
324
325 Within a section, each parameter defines a shell command to run to handle a
326 given action. mr contains default handlers for "update", "status",
327 "commit", and other standard actions.
328
329 Normally you only need to specify what to do for "checkout". Here you
330 specify the command to run in order to create a checkout of the repository.
331 The command will be run in the parent directory, and must create the
332 repository's directory. So use C<git clone>, C<svn checkout>, C<bzr branch>
333 or C<bzr checkout> (for a bound branch), etc.
334
335 Note that these shell commands are run in a C<set -e> shell
336 environment, where any additional parameters you pass are available in
337 C<$@>. All commands other than "checkout" are run inside the repository,
338 though not necessarily at the top of it.
339
340 The C<MR_REPO> environment variable is set to the path to the top of the
341 repository. (For the "register" action, "MR_REPO" is instead set to the 
342 basename of the directory that should be created when checking the
343 repository out.)
344
345 The C<MR_CONFIG> environment variable is set to the .mrconfig file
346 that defines the repo being acted on, or, if the repo is not yet in a config
347 file, the F<.mrconfig> file that should be modified to register the repo.
348
349 The C<MR_ACTION> environment variable is set to the command being run
350 (update, checkout, etc).
351
352 A few parameters have special meanings:
353
354 =over 4
355
356 =item skip
357
358 If the "skip" parameter is set and its command returns true, then B<mr>
359 will skip acting on that repository. The command is passed the action
360 name in C<$1>.
361
362 Here are two examples. The first skips the repo unless
363 mr is run by joey. The second uses the hours_since function
364 (included in mr's built-in library) to skip updating the repo unless it's
365 been at least 12 hours since the last update.
366
367   [mystuff]
368   checkout = ...
369   skip = test `whoami` != joey
370
371   [linux]
372   checkout = ...
373   skip = [ "$1" = update ] && ! hours_since "$1" 12
374  
375 Another way to use skip is for a lazy checkout. This makes mr skip
376 operating on a repo unless it already exists. To enable the 
377 repo, you have to explicitly check it out (using "mr --force -d foo checkout").
378
379   [foo]
380   checkout = ...
381   skip = lazy
382
383 =item order
384
385 The "order" parameter can be used to override the default ordering of
386 repositories. The default order value is 10. Use smaller values to make
387 repositories be processed earlier, and larger values to make repositories
388 be processed later.
389
390 Note that if a repository is located in a subdirectory of another
391 repository, ordering it to be processed earlier is not recommended.
392
393 =item chain
394
395 If the "chain" parameter is set and its command returns true, then B<mr>
396 will try to load a F<.mrconfig> file from the root of the repository.
397
398 =item include
399
400 If the "include" parameter is set, its command is ran, and should output
401 additional mrconfig file content. The content is included as if it were
402 part of the including file.
403
404 Unlike all other parameters, this parameter does not need to be placed
405 within a section.
406
407 B<mr> ships several libraries that can be included to add support for
408 additional version control type things (unison, git-svn, vcsh, git-fake-bare,
409 git-subtree). To include them all, you could use:
410
411   include = cat /usr/share/mr/*
412
413 See the individual files for details.
414
415 =item deleted
416
417 If the "deleted" parameter is set and its command returns true, then
418 B<mr> will treat the repository as deleted. It won't ever actually delete
419 the repository, but it will warn if it sees the repository's directory.
420 This is useful when one mrconfig file is shared among multiple machines,
421 to keep track of and remember to delete old repositories.
422
423 =item lib
424
425 The "lib" parameter can specify some shell code that will be run
426 before each command, this can be a useful way to define shell
427 functions for other commands to use. 
428
429 Unlike most other parameters, this can be specified multiple times, in
430 which case the chunks of shell code are accumulatively concatenated
431 together.
432
433 =item fixups
434
435 If the "fixups" parameter is set, its command is run whenever a repository
436 is checked out, or updated. This provides an easy way to do things
437 like permissions fixups, or other tweaks to the repository content,
438 whenever the repository is changed.
439
440 =item VCS_action
441
442 When looking for a command to run for a given action, mr first looks for
443 a parameter with the same name as the action. If that is not found, it
444 looks for a parameter named "VCS_action" (substituting in the name of the
445 version control system and the action).
446
447 Internally, mr has settings for "git_update", "svn_update", etc. To change
448 the action that is performed for a given version control system, you can
449 override these VCS specific actions. To add a new version control system,
450 you can just add VCS specific actions for it.
451
452 =item pre_ and post_
453
454 If a "pre_action" parameter is set, its command is run before mr performs the
455 specified action. Similarly, "post_action" parameters are run after mr
456 successfully performs the specified action. For example, "pre_commit" is
457 run before committing; "post_update" is run after updating.
458
459 =item _append
460
461 Any parameter can be suffixed with C<_append>, to add an additional value
462 to the existing value of the parameter. In this way, actions 
463 can be constructed accumulatively.
464
465 =item VCS_test
466
467 The name of the version control system is itself determined by
468 running each defined "VCS_test" action, until one succeeds.
469
470 =back
471
472 =head1 UNTRUSTED MRCONFIG FILES
473
474 Since mrconfig files can contain arbitrary shell commands, they can do
475 anything. This flexibility is good, but it also allows a malicious mrconfig
476 file to delete your whole home directory. Such a file might be contained
477 inside a repository that your main F<~/.mrconfig> checks out. To
478 avoid worries about evil commands in a mrconfig file, mr defaults to
479 reading all mrconfig files other than the main F<~/.mrconfig> in untrusted
480 mode. In untrusted mode, mrconfig files are limited to running only known
481 safe commands (like "git clone") in a carefully checked manner.
482
483 To configure mr to trust other mrconfig files, list them in F<~/.mrtrust>.
484 One mrconfig file should be listed per line. Either the full pathname
485 should be listed, or the pathname can start with F<~/> to specify a file
486 relative to your home directory.
487
488 =head1 OFFLINE LOG FILE
489
490 The F<~/.mrlog> file contains commands that mr has remembered to run later,
491 due to being offline. You can delete or edit this file to remove commands,
492 or even to add other commands for 'mr online' to run. If the file is
493 present, mr assumes it is in offline mode.
494
495 =head1 EXTENSIONS
496
497 mr can be extended to support things such as unison and git-svn. Some
498 files providing such extensions are available in F</usr/share/mr/>. See
499 the documentation in the files for details about using them.
500
501 =head1 EXIT STATUS
502
503 mr returns nonzero if a command failed in any of the repositories.
504
505 =head1 AUTHOR
506
507 Copyright 2007-2011 Joey Hess <joey@kitenet.net>
508
509 Licensed under the GNU GPL version 2 or higher.
510
511 http://kitenet.net/~joey/code/mr/
512
513 =cut
514
515 use warnings;
516 use strict;
517 use Getopt::Long;
518 use Cwd qw(getcwd abs_path);
519
520 # things that can happen when mr runs a command
521 use constant {
522         OK => 0,
523         FAILED => 1,
524         SKIPPED => 2,
525         ABORT => 3,
526 };
527
528 # configurables
529 my $config_overridden=0;
530 my $verbose=0;
531 my $quiet=0;
532 my $stats=0;
533 my $force=0;
534 my $insecure=0;
535 my $interactive=0;
536 my $max_depth;
537 my $no_chdir=0;
538 my $jobs=1;
539 my $trust_all=0;
540 my $directory=getcwd();
541
542 my $HOME_MR_CONFIG = "$ENV{HOME}/.mrconfig";
543 $ENV{MR_CONFIG}=find_mrconfig();
544
545 # globals :-(
546 my %config;
547 my %configfiles;
548 my %knownactions;
549 my %alias;
550 my (@ok, @failed, @skipped);
551
552 main();
553
554 sub shellquote {
555         my $i=shift;
556         $i=~s/'/'"'"'/g;
557         return "'$i'";
558 }
559
560 # Runs a shell command using a supplied function.
561 # The lib will be included in the shell command line, and any params
562 # will be available in the shell as $1, $2, etc.
563 my $lastlib;
564 sub runsh {
565         my ($action, $topdir, $subdir, $command, $params, $runner) = @_;
566
567         # optimisation: avoid running the shell for true and false
568         if ($command =~ /^\s*true\s*$/) {
569                 $?=0;
570                 return 0;
571         }
572         elsif ($command =~ /^\s*false\s*$/) {
573                 $?=0;
574                 return 1;
575         }
576         
577         my $quotedparams=join(" ", (map { shellquote($_) } @$params));
578         my $lib=exists $config{$topdir}{$subdir}{lib} ?
579                        $config{$topdir}{$subdir}{lib}."\n" : "";
580         if ($verbose && (! defined $lastlib || $lastlib ne $lib)) {
581                 print "mr library now: >>$lib<<\n";
582                 $lastlib=$lib;
583         }
584         my $shellcode="set -e;".$lib.
585                 "my_sh(){ $command\n }; my_sh $quotedparams";
586         print "mr $action: running $action >>$command<<\n" if $verbose;
587         $runner->($shellcode);
588 }
589
590 my %perl_cache;
591 sub perl {
592         my $id=shift;
593         my $s=shift;
594         if ($s =~ m/^perl:\s+(.*)/s) {
595                 return $perl_cache{$1} if exists $perl_cache{$1};
596                 my $sub=eval "sub {$1}";
597                 if (! defined $sub) {
598                         print STDERR "mr: bad perl code in $id: $@\n";
599                 }
600                 return $perl_cache{$1} = $sub;
601         }
602         return undef;
603 }
604
605 my %vcs;
606 sub vcs_test {
607         my ($action, $dir, $topdir, $subdir) = @_;
608
609         if (exists $vcs{$dir}) {
610                 return $vcs{$dir};
611         }
612
613         my $test="";
614         my %perltest;
615         foreach my $vcs_test (
616                         sort {
617                                 length $a <=> length $b 
618                                           ||
619                                        $a cmp $b
620                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
621                 my ($vcs)=$vcs_test =~ /(.*)_test/;
622                 my $p=perl($vcs_test, $config{$topdir}{$subdir}{$vcs_test});
623                 if (defined $p) {
624                         $perltest{$vcs}=$p;
625                 }
626                 else {
627                         $test="my_$vcs_test() {\n$config{$topdir}{$subdir}{$vcs_test}\n}\n".$test;
628                         $test.="if my_$vcs_test; then echo $vcs; fi\n";
629                 }
630         }
631
632         my @vcs;
633         foreach my $vcs (keys %perltest) {
634                 if ($perltest{$vcs}->()) {
635                         push @vcs, $vcs;
636                 }
637         }
638
639         push @vcs, split(/\n/,
640                 runsh("vcs test", $topdir, $subdir, $test, [], sub {
641                         my $sh=shift;
642                         my $ret=`$sh`;
643                         return $ret;
644                 })) if length $test;
645         if (@vcs > 1) {
646                 print STDERR "mr $action: found multiple possible repository types (@vcs) for ".fulldir($topdir, $subdir)."\n";
647                 return undef;
648         }
649         if (! @vcs) {
650                 return $vcs{$dir}=undef;
651         }
652         else {
653                 return $vcs{$dir}=$vcs[0];
654         }
655 }
656         
657 sub findcommand {
658         my ($action, $dir, $topdir, $subdir, $is_checkout) = @_;
659         
660         if (exists $config{$topdir}{$subdir}{$action}) {
661                 return $config{$topdir}{$subdir}{$action};
662         }
663
664         if ($is_checkout) {
665                 return undef;
666         }
667
668         my $vcs=vcs_test(@_);
669
670         if (defined $vcs && 
671             exists $config{$topdir}{$subdir}{$vcs."_".$action}) {
672                 return $config{$topdir}{$subdir}{$vcs."_".$action};
673         }
674         else {
675                 return undef;
676         }
677 }
678
679 sub fulldir {
680         my ($topdir, $subdir) = @_;
681         return $subdir =~ /^\// ? $subdir : $topdir.$subdir;
682 }
683
684 sub action {
685         my ($action, $dir, $topdir, $subdir, $force_checkout) = @_;
686         my $fulldir=fulldir($topdir, $subdir);
687
688         $ENV{MR_CONFIG}=$configfiles{$topdir};
689         my $is_checkout=($action eq 'checkout');
690         my $is_update=($action =~ /update/);
691
692         ($ENV{MR_REPO}=$dir) =~ s!/$!!;
693         $ENV{MR_ACTION}=$action;
694         
695         foreach my $testname ("skip", "deleted") {
696                 next if $force && $testname eq "skip";
697
698                 my $testcommand=findcommand($testname, $dir, $topdir, $subdir, $is_checkout);
699
700                 if (defined $testcommand) {
701                         my $ret=runsh "$testname test", $topdir, $subdir,
702                                 $testcommand, [$action],
703                                 sub { system(shift()) };
704                         if ($ret != 0) {
705                                 if (($? & 127) == 2) {
706                                         print STDERR "mr $action: interrupted\n";
707                                         return ABORT;
708                                 }
709                                 elsif ($? & 127) {
710                                         print STDERR "mr $action: $testname test received signal ".($? & 127)."\n";
711                                         return ABORT;
712                                 }
713                         }
714                         if ($ret >> 8 == 0) {
715                                 if ($testname eq "deleted") {
716                                         if (-d $dir) {
717                                                 print STDERR "mr error: $dir should be deleted yet still exists\n";
718                                                 return FAILED;
719                                         }
720                                 }
721                                 print "mr $action: skip $dir skipped\n" if $verbose;
722                                 return SKIPPED;
723                         }
724                 }
725         }
726
727         if ($is_checkout) {
728                 if (! $force_checkout) {
729                         if (-d $dir) {
730                                 print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
731                                 return SKIPPED;
732                         }
733         
734                         $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
735                 }
736         }
737         elsif ($is_update) {
738                 if (! -d $dir) {
739                         return action("checkout", $dir, $topdir, $subdir);
740                 }
741         }
742
743         my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
744
745         if ($is_checkout && ! -d $dir) {
746                 print "mr $action: creating parent directory $dir\n" if $verbose;
747                 system("mkdir", "-p", $dir);
748         }
749
750         if (! $no_chdir && ! chdir($dir)) {
751                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
752                 return FAILED;
753         }
754         elsif (! defined $command) {
755                 my $vcs=vcs_test(@_);
756                 if (! defined $vcs) {
757                         print STDERR "mr $action: unknown repository type and no defined $action command for $fulldir\n";
758                         return FAILED;
759                 }
760                 else {
761                         print STDERR "mr $action: no defined action for $vcs repository $fulldir, skipping\n";
762                         return SKIPPED;
763                 }
764         }
765         else {
766                 my $actionmsg;
767                 if (! $no_chdir) {
768                         $actionmsg="mr $action: $fulldir";
769                 }
770                 else {
771                         my $s=$directory;
772                         $s=~s/^\Q$fulldir\E\/?//;
773                         $actionmsg="mr $action: $fulldir (in subdir $s)";
774                 }
775                 print "$actionmsg\n" unless $quiet;
776
777                 my $hookret=hook("pre_$action", $topdir, $subdir);
778                 return $hookret if $hookret != OK;
779
780                 my $ret=runsh $action, $topdir, $subdir,
781                         $command, \@ARGV, sub {
782                                 my $sh=shift;
783                                 if ($quiet) {
784                                         my $output = qx/$sh 2>&1/;
785                                         my $ret = $?;
786                                         if ($ret != 0) {
787                                                 print "$actionmsg\n";
788                                                 print STDERR $output;
789                                         }
790                                         return $ret;
791                                 }
792                                 else {
793                                         system($sh);
794                                 }
795                         };
796                 if ($ret != 0) {
797                         if (($? & 127) == 2) {
798                                 print STDERR "mr $action: interrupted\n";
799                                 return ABORT;
800                         }
801                         elsif ($? & 127) {
802                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
803                                 return ABORT;
804                         }
805                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
806                         if ($ret >> 8 != 0) {
807                                 print STDERR "mr $action: command failed\n";
808                                 if (-e "$ENV{HOME}/.mrlog" && $action ne 'remember') {
809                                         # recreate original command line to
810                                         # remember, and avoid recursing
811                                         my @orig=@ARGV;
812                                         @ARGV=('-n', $action, @orig);
813                                         action("remember", $dir, $topdir, $subdir);
814                                         @ARGV=@orig;
815                                 }
816                         }
817                         elsif ($ret != 0) {
818                                 print STDERR "mr $action: command died ($ret)\n";
819                         }
820                         return FAILED;
821                 }
822                 else {
823                         if ($is_checkout && ! -d $dir) {
824                                 print STDERR "mr $action: $dir missing after checkout\n";;
825                                 return FAILED;
826                         }
827
828                         my $ret=hook("post_$action", $topdir, $subdir);
829                         return $ret if $ret != OK;
830                         
831                         if (($is_checkout || $is_update)) {
832                                 my $ret=hook("fixups", $topdir, $subdir);
833                                 return $ret if $ret != OK;
834                         }
835                         
836                         return OK;
837                 }
838         }
839 }
840
841 sub hook {
842         my ($hook, $topdir, $subdir) = @_;
843
844         my $command=$config{$topdir}{$subdir}{$hook};
845         return OK unless defined $command;
846         my $ret=runsh $hook, $topdir, $subdir, $command, [], sub {
847                         my $sh=shift;
848                         if ($quiet) {
849                                 my $output = qx/$sh 2>&1/;
850                                 my $ret = $?;
851                                 if ($ret != 0) {
852                                         print STDERR $output;
853                                 }
854                                 return $ret;
855                         }
856                         else {
857                                 system($sh);
858                         }
859                 };
860         if ($ret != 0) {
861                 if (($? & 127) == 2) {
862                         print STDERR "mr $hook: interrupted\n";
863                         return ABORT;
864                 }
865                 elsif ($? & 127) {
866                         print STDERR "mr $hook: received signal ".($? & 127)."\n";
867                         return ABORT;
868                 }
869                 else {
870                         return FAILED;
871                 }
872         }
873
874         return OK;
875 }
876
877 # run actions on multiple repos, in parallel
878 sub mrs {
879         my $action=shift;
880         my @repos=@_;
881
882         $| = 1;
883         my @active;
884         my @fhs;
885         my @out;
886         my $running=0;
887         while (@fhs or @repos) {
888                 while ((!$jobs || $running < $jobs) && @repos) {
889                         $running++;
890                         my $repo = shift @repos;
891                         pipe(my $outfh, CHILD_STDOUT);
892                         pipe(my $errfh, CHILD_STDERR);
893                         my $pid;
894                         unless ($pid = fork) {
895                                 die "mr $action: cannot fork: $!" unless defined $pid;
896                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
897                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
898                                 close CHILD_STDOUT;
899                                 close CHILD_STDERR;
900                                 close $outfh;
901                                 close $errfh;
902                                 exit action($action, @$repo);
903                         }
904                         close CHILD_STDOUT;
905                         close CHILD_STDERR;
906                         push @active, [$pid, $repo];
907                         push @fhs, [$outfh, $errfh];
908                         push @out, ['',     ''];
909                 }
910                 my ($rin, $rout) = ('','');
911                 my $nfound;
912                 foreach my $fh (@fhs) {
913                         next unless defined $fh;
914                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
915                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
916                 }
917                 $nfound = select($rout=$rin, undef, undef, 1);
918                 foreach my $channel (0, 1) {
919                         foreach my $i (0..$#fhs) {
920                                 next unless defined $fhs[$i];
921                                 my $fh = $fhs[$i][$channel];
922                                 next unless defined $fh;
923                                 if (vec($rout, fileno($fh), 1) == 1) {
924                                         my $r = '';
925                                         if (sysread($fh, $r, 1024) == 0) {
926                                                 close($fh);
927                                                 $fhs[$i][$channel] = undef;
928                                                 if (! defined $fhs[$i][0] &&
929                                                     ! defined $fhs[$i][1]) {
930                                                         waitpid($active[$i][0], 0);
931                                                         print STDOUT $out[$i][0];
932                                                         print STDERR $out[$i][1];
933                                                         record($active[$i][1], $? >> 8);
934                                                         splice(@fhs, $i, 1);
935                                                         splice(@active, $i, 1);
936                                                         splice(@out, $i, 1);
937                                                         $running--;
938                                                 }
939                                         }
940                                         $out[$i][$channel] .= $r;
941                                 }
942                         }
943                 }
944         }
945 }
946
947 sub record {
948         my $dir=shift()->[0];
949         my $ret=shift;
950
951         if ($ret == OK) {
952                 push @ok, $dir;
953                 print "\n" unless $quiet;
954         }
955         elsif ($ret == FAILED) {
956                 if ($interactive) {
957                         chdir($dir) unless $no_chdir;
958                         print STDERR "mr: Starting interactive shell. Exit shell to continue.\n";
959                         system((getpwuid($<))[8], "-i");
960                 }
961                 push @failed, $dir;
962                 print "\n" unless $quiet;
963         }
964         elsif ($ret == SKIPPED) {
965                 push @skipped, $dir;
966         }
967         elsif ($ret == ABORT) {
968                 exit 1;
969         }
970         else {
971                 die "unknown exit status $ret";
972         }
973 }
974
975 sub showstats {
976         my $action=shift;
977         if (! @ok && ! @failed && ! @skipped) {
978                 die "mr $action: no repositories found to work on\n";
979         }
980         print "mr $action: finished (".join("; ",
981                 showstat($#ok+1, "ok", "ok"),
982                 showstat($#failed+1, "failed", "failed"),
983                 showstat($#skipped+1, "skipped", "skipped"),
984         ).")\n" unless $quiet;
985         if ($stats) {
986                 if (@skipped) {
987                         print "mr $action: (skipped: ".join(" ", @skipped).")\n" unless $quiet;
988                 }
989                 if (@failed) {
990                         print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
991                 }
992         }
993 }
994
995 sub showstat {
996         my $count=shift;
997         my $singular=shift;
998         my $plural=shift;
999         if ($count) {
1000                 return "$count ".($count > 1 ? $plural : $singular);
1001         }
1002         return;
1003 }
1004
1005 # an ordered list of repos
1006 sub repolist {
1007         my @list;
1008         foreach my $topdir (sort keys %config) {
1009                 foreach my $subdir (sort keys %{$config{$topdir}}) {
1010                         push @list, {
1011                                 topdir => $topdir,
1012                                 subdir => $subdir,
1013                                 order => $config{$topdir}{$subdir}{order},
1014                         };
1015                 }
1016         }
1017         return sort {
1018                 $a->{order}  <=> $b->{order}
1019                              ||
1020                 $a->{topdir} cmp $b->{topdir}
1021                              ||
1022                 $a->{subdir} cmp $b->{subdir}
1023         } @list;
1024 }
1025
1026 sub repodir {
1027         my $repo=shift;
1028         my $topdir=$repo->{topdir};
1029         my $subdir=$repo->{subdir};
1030         my $ret=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
1031         $ret=~s/\/\.$//;
1032         return $ret;
1033 }
1034
1035 # Figure out which repos to act on.  Returns a list of array refs
1036 # in the format:
1037 #
1038 #   [ "$full_repo_path/", "$mr_config_path/", $section_header ]
1039 sub selectrepos {
1040         my @repos;
1041         foreach my $repo (repolist()) {
1042                 my $topdir=$repo->{topdir};
1043                 my $subdir=$repo->{subdir};
1044
1045                 next if $subdir eq 'DEFAULT';
1046                 my $dir=repodir($repo);
1047                 my $d=$directory;
1048                 $dir.="/" unless $dir=~/\/$/;
1049                 $d.="/" unless $d=~/\/$/;
1050                 next if $dir ne $d && $dir !~ /^\Q$d\E/;
1051                 if (defined $max_depth) {
1052                         my @a=split('/', $dir);
1053                         my @b=split('/', $d);
1054                         do { } while (@a && @b && shift(@a) eq shift(@b));
1055                         next if @a > $max_depth || @b > $max_depth;
1056                 }
1057                 push @repos, [$dir, $topdir, $subdir];
1058         }
1059         if (! @repos) {
1060                 # fallback to find a leaf repo
1061                 foreach my $repo (reverse repolist()) {
1062                         my $topdir=$repo->{topdir};
1063                         my $subdir=$repo->{subdir};
1064                         
1065                         next if $subdir eq 'DEFAULT';
1066                         my $dir=repodir($repo);
1067                         my $d=$directory;
1068                         $dir.="/" unless $dir=~/\/$/;
1069                         $d.="/" unless $d=~/\/$/;
1070                         if ($d=~/^\Q$dir\E/) {
1071                                 push @repos, [$dir, $topdir, $subdir];
1072                                 last;
1073                         }
1074                 }
1075                 $no_chdir=1;
1076         }
1077         return @repos;
1078 }
1079
1080 sub expandenv {
1081         my $val=shift;
1082         
1083
1084         if ($val=~/\$/) {
1085                 $val=`echo "$val"`;
1086                 chomp $val;
1087         }
1088         
1089         return $val;
1090 }
1091
1092 my %trusted;
1093 sub is_trusted_config {
1094         my $config=shift; # must be abs_pathed already
1095
1096         # We always trust ~/.mrconfig.
1097         return 1 if $config eq abs_path($HOME_MR_CONFIG);
1098
1099         return 1 if $trust_all;
1100
1101         my $trustfile=$ENV{HOME}."/.mrtrust";
1102
1103         if (! %trusted) {
1104                 $trusted{$HOME_MR_CONFIG}=1;
1105                 if (open (TRUST, "<", $trustfile)) {
1106                         while (<TRUST>) {
1107                                 chomp;
1108                                 s/^~\//$ENV{HOME}\//;
1109                                 $trusted{abs_path($_)}=1;
1110                         }
1111                         close TRUST;
1112                 }
1113         }
1114
1115         return $trusted{$config};
1116 }
1117
1118
1119 sub is_trusted_repo {
1120         my $repo=shift;
1121         
1122         # Tightly limit what is allowed in a repo name.
1123         # No ../, no absolute paths, and no unusual filenames
1124         # that might try to escape to the shell.
1125         return $repo =~ /^[-_.+\/A-Za-z0-9]+$/ &&
1126                $repo !~ /\.\./ && $repo !~ /^\//;
1127 }
1128
1129 sub is_trusted_checkout {
1130         my $command=shift;
1131         
1132         # To determine if the command is safe, compare it with the
1133         # *_trusted_checkout config settings. Those settings are
1134         # templates for allowed commands, so make sure that each word
1135         # of the command matches the corresponding word of the template.
1136         
1137         my @words;
1138         foreach my $word (split(' ', $command)) {
1139                 # strip quoting
1140                 if ($word=~/^'(.*)'$/) {
1141                         $word=$1;
1142                 }
1143                 elsif ($word=~/^"(.*)"$/) {
1144                         $word=$1;
1145                 }
1146
1147                 push @words, $word;
1148         }
1149
1150         foreach my $key (grep { /_trusted_checkout$/ }
1151                          keys %{$config{''}{DEFAULT}}) {
1152                 my @twords=split(' ', $config{''}{DEFAULT}{$key});
1153                 next if @words > @twords;
1154
1155                 my $match=1;
1156                 my $url;
1157                 for (my $c=0; $c < @twords && $match; $c++) {
1158                         if ($twords[$c] eq '$url') {
1159                                 # Match all the typical characters found in
1160                                 # urls, plus @ which svn can use. Note
1161                                 # that the "url" might also be a local
1162                                 # directory.
1163                                 $match=(
1164                                         defined $words[$c] &&
1165                                         $words[$c] =~ /^[-_.+:@\/A-Za-z0-9]+$/
1166                                 );
1167                                 $url=$words[$c];
1168                         }
1169                         elsif ($twords[$c] eq '$repo') {
1170                                 # If a repo is not specified, assume it
1171                                 # will be the last path component of the
1172                                 # url, or something derived from it, and
1173                                 # check that.
1174                                 if (! defined $words[$c] && defined $url) {
1175                                         ($words[$c])=$url=~/\/([^\/]+)\/?$/;
1176                                 }
1177
1178                                 $match=(
1179                                         defined $words[$c] &&
1180                                         is_trusted_repo($words[$c])
1181                                 );
1182                         }
1183                         elsif (defined $words[$c] && $words[$c]=~/^($twords[$c])$/) {
1184                                 $match=1;
1185                         }
1186                         else {
1187                                 $match=0;
1188                         }
1189                 }
1190                 return 1 if $match;
1191         }
1192
1193         return 0;
1194 }
1195
1196 my %loaded;
1197 sub loadconfig {
1198         my $f=shift;
1199         my $dir=shift;
1200         my $bootstrap_url=shift;
1201
1202         my @toload;
1203
1204         my $in;
1205         my $trusted;
1206         if (ref $f eq 'GLOB') {
1207                 $dir="";
1208                 $in=$f;
1209                 $trusted=1;
1210         }
1211         else {
1212                 my $absf=abs_path($f);
1213                 if ($loaded{$absf}) {
1214                         return;
1215                 }
1216                 $loaded{$absf}=1;
1217
1218                 $trusted=is_trusted_config($absf);
1219
1220                 if (! defined $dir) {
1221                         ($dir)=$f=~/^(.*\/)[^\/]+$/;
1222                         if (! defined $dir) {
1223                                 $dir=".";
1224                         }
1225                 }
1226
1227                 $dir=abs_path($dir)."/";
1228                 
1229                 if (! exists $configfiles{$dir}) {
1230                         $configfiles{$dir}=$f;
1231                 }
1232
1233                 # copy in defaults from first parent
1234                 my $parent=$dir;
1235                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
1236                         if ($parent eq '/') {
1237                                 $parent="";
1238                         }
1239                         if (exists $config{$parent} &&
1240                             exists $config{$parent}{DEFAULT}) {
1241                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
1242                                 last;
1243                         }
1244                 }
1245                 
1246                 if (! -e $f) {
1247                         return;
1248                 }
1249
1250                 print "mr: loading config $f\n" if $verbose;
1251                 open($in, "<", $f) || die "mr: open $f: $!\n";
1252         }
1253         my @lines=<$in>;
1254         close $in unless ref $f eq 'GLOB';
1255
1256         my $section;
1257
1258         # Keep track of the current line in the config file;
1259         # when a file is included track the current line from the include.
1260         my $lineno=0;
1261         my $included=undef;
1262
1263         my $line;
1264         my $nextline = sub {
1265                 if ($included) {
1266                         $included--;
1267                 }
1268                 else {
1269                         $included=undef;
1270                         $lineno++;
1271                 }
1272                 $line=shift @lines;
1273                 chomp $line;
1274                 return $line;
1275         };
1276         my $lineerror = sub {
1277                 my $msg=shift;
1278                 if (defined $included) {
1279                         die "mr: $msg at $f line $lineno, included line: $line\n";
1280                 }
1281                 else {
1282                         die "mr: $msg at $f line $lineno\n";
1283                 }
1284         };
1285         my $trusterror = sub {
1286                 my $msg=shift;
1287         
1288                 if (defined $bootstrap_url) {
1289                         die "mr: $msg in untrusted $bootstrap_url line $lineno\n".
1290                                 "(To trust this url, --trust-all can be used; but please use caution;\n".
1291                                 "this can allow arbitrary code execution!)\n";
1292                 }
1293                 else {
1294                         die "mr: $msg in untrusted $f line $lineno\n".
1295                                 "(To trust this file, list it in ~/.mrtrust.)\n";
1296                 }
1297         };
1298
1299         while (@lines) {
1300                 $_=$nextline->();
1301
1302                 if (! $trusted && /[[:cntrl:]]/) {
1303                         $trusterror->("illegal control character");
1304                 }
1305
1306                 next if /^\s*\#/ || /^\s*$/;
1307                 if (/^\[([^\]]*)\]\s*$/) {
1308                         $section=$1;
1309
1310                         if (! $trusted) {
1311                                 if (! is_trusted_repo($section) ||
1312                                     $section eq 'ALIAS' ||
1313                                     $section eq 'DEFAULT') {
1314                                         $trusterror->("illegal section \"[$section]\"");
1315                                 }
1316                         }
1317                         $section=expandenv($section) if $trusted;
1318                         if ($section ne 'ALIAS' &&
1319                             ! exists $config{$dir}{$section} &&
1320                             exists $config{$dir}{DEFAULT}) {
1321                                 # copy in defaults
1322                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
1323                         }
1324                 }
1325                 elsif (/^(\w+)\s*=\s*(.*)/) {
1326                         my $parameter=$1;
1327                         my $value=$2;
1328
1329                         # continued value
1330                         while (@lines && $lines[0]=~/^\s(.+)/) {
1331                                 $value.="\n$1";
1332                                 chomp $value;
1333                                 $nextline->();
1334                         }
1335
1336                         if (! $trusted) {
1337                                 # Untrusted files can only contain a few
1338                                 # settings in specific known-safe formats.
1339                                 if ($parameter eq 'checkout') {
1340                                         if (! is_trusted_checkout($value)) {
1341                                                 $trusterror->("illegal checkout command \"$value\"");
1342                                         }
1343                                 }
1344                                 elsif ($parameter eq 'order') {
1345                                         # not interpreted as a command, so
1346                                         # safe.
1347                                 }
1348                                 elsif ($value eq 'true' || $value eq 'false') {
1349                                         # skip=true , deleted=true etc are
1350                                         # safe.
1351                                 }
1352                                 else {
1353                                         $trusterror->("illegal setting \"$parameter=$value\"");
1354                                 }
1355                         }
1356
1357                         if ($parameter eq "include") {
1358                                 print "mr: including output of \"$value\"\n" if $verbose;
1359                                 my @inc=`$value`;
1360                                 if ($?) {
1361                                         print STDERR "mr: include command exited nonzero ($?)\n";
1362                                 }
1363                                 $included += @inc;
1364                                 unshift @lines, @inc;
1365                                 next;
1366                         }
1367
1368                         if (! defined $section) {
1369                                 $lineerror->("parameter ($parameter) not in section");
1370                         }
1371                         if ($section eq 'ALIAS') {
1372                                 $alias{$parameter}=$value;
1373                         }
1374                         elsif ($parameter eq 'lib' or $parameter =~ s/_append$//) {
1375                                 $config{$dir}{$section}{$parameter}.="\n".$value."\n";
1376                         }
1377                         else {
1378                                 $config{$dir}{$section}{$parameter}=$value;
1379                                 if ($parameter =~ /.*_(.*)/) {
1380                                         $knownactions{$1}=1;
1381                                 }
1382                                 else {
1383                                         $knownactions{$parameter}=1;
1384                                 }
1385                                 if ($parameter eq 'chain' &&
1386                                     length $dir && $section ne "DEFAULT") {
1387                                         my $chaindir="$section";
1388                                         if ($chaindir !~ m!^/!) {
1389                                                 $chaindir=$dir.$chaindir;
1390                                         }
1391                                         if (-e "$chaindir/.mrconfig") {
1392                                                 my $ret=system($value);
1393                                                 if ($ret != 0) {
1394                                                         if (($? & 127) == 2) {
1395                                                                 print STDERR "mr: chain test interrupted\n";
1396                                                                 exit 2;
1397                                                         }
1398                                                         elsif ($? & 127) {
1399                                                                 print STDERR "mr: chain test received signal ".($? & 127)."\n";
1400                                                         }
1401                                                 }
1402                                                 else {
1403                                                         push @toload, ["$chaindir/.mrconfig", $chaindir];
1404                                                 }
1405                                         }
1406                                 }
1407                         }
1408                 }
1409                 else {
1410                         $lineerror->("parse error");
1411                 }
1412         }
1413
1414         foreach my $c (@toload) {
1415                 loadconfig(@$c);
1416         }
1417 }
1418
1419 sub startingconfig {
1420         %alias=%config=%configfiles=%knownactions=%loaded=();
1421         my $datapos=tell(DATA);
1422         loadconfig(\*DATA);
1423         seek(DATA,$datapos,0); # rewind
1424 }
1425
1426 sub modifyconfig {
1427         my $f=shift;
1428         # the section to modify or add
1429         my $targetsection=shift;
1430         # fields to change in the section
1431         # To remove a field, set its value to "".
1432         my %changefields=@_;
1433
1434         my @lines;
1435         my @out;
1436
1437         if (-e $f) {
1438                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
1439                 @lines=<$in>;
1440                 close $in;
1441         }
1442
1443         my $formatfield=sub {
1444                 my $field=shift;
1445                 my @value=split(/\n/, shift);
1446
1447                 return "$field = ".shift(@value)."\n".
1448                         join("", map { "\t$_\n" } @value);
1449         };
1450         my $addfields=sub {
1451                 my @blanks;
1452                 while ($out[$#out] =~ /^\s*$/) {
1453                         unshift @blanks, pop @out;
1454                 }
1455                 foreach my $field (sort keys %changefields) {
1456                         if (length $changefields{$field}) {
1457                                 push @out, "$field = $changefields{$field}\n";
1458                                 delete $changefields{$field};
1459                         }
1460                 }
1461                 push @out, @blanks;
1462         };
1463
1464         my $section;
1465         while (@lines) {
1466                 $_=shift(@lines);
1467
1468                 if (/^\s*\#/ || /^\s*$/) {
1469                         push @out, $_;
1470                 }
1471                 elsif (/^\[([^\]]*)\]\s*$/) {
1472                         if (defined $section && 
1473                             $section eq $targetsection) {
1474                                 $addfields->();
1475                         }
1476
1477                         $section=expandenv($1);
1478
1479                         push @out, $_;
1480                 }
1481                 elsif (/^(\w+)\s*=\s(.*)/) {
1482                         my $parameter=$1;
1483                         my $value=$2;
1484
1485                         # continued value
1486                         while (@lines && $lines[0]=~/^\s(.+)/) {
1487                                 shift(@lines);
1488                                 $value.="\n$1";
1489                                 chomp $value;
1490                         }
1491
1492                         if ($section eq $targetsection) {
1493                                 if (exists $changefields{$parameter}) {
1494                                         if (length $changefields{$parameter}) {
1495                                                 $value=$changefields{$parameter};
1496                                         }
1497                                         delete $changefields{$parameter};
1498                                 }
1499                         }
1500
1501                         push @out, $formatfield->($parameter, $value);
1502                 }
1503         }
1504
1505         if (defined $section && 
1506             $section eq $targetsection) {
1507                 $addfields->();
1508         }
1509         elsif (%changefields) {
1510                 push @out, "\n[$targetsection]\n";
1511                 foreach my $field (sort keys %changefields) {
1512                         if (length $changefields{$field}) {
1513                                 push @out, $formatfield->($field, $changefields{$field});
1514                         }
1515                 }
1516         }
1517
1518         open(my $out, ">", $f) || die "mr: write $f: $!\n";
1519         print $out @out;
1520         close $out;     
1521 }
1522
1523 sub dispatch {
1524         my $action=shift;
1525
1526         # actions that do not operate on all repos
1527         if ($action eq 'help') {
1528                 help(@ARGV);
1529         }
1530         elsif ($action eq 'config') {
1531                 config(@ARGV);
1532         }
1533         elsif ($action eq 'register') {
1534                 register(@ARGV);
1535         }
1536         elsif ($action eq 'bootstrap') {
1537                 bootstrap();
1538         }
1539         elsif ($action eq 'remember' ||
1540                $action eq 'offline' ||
1541                $action eq 'online') {
1542                 my @repos=selectrepos;
1543                 action($action, @{$repos[0]}) if @repos;
1544                 exit 0;
1545         }
1546
1547         if (!$jobs || $jobs > 1) {
1548                 mrs($action, selectrepos());
1549         }
1550         else {
1551                 foreach my $repo (selectrepos()) {
1552                         record($repo, action($action, @$repo));
1553                 }
1554         }
1555 }
1556
1557 sub help {
1558         exec($config{''}{DEFAULT}{help}) || die "exec: $!";
1559 }
1560
1561 sub config {
1562         if (@_ < 2) {
1563                 die "mr config: not enough parameters\n";
1564         }
1565         my $section=shift;
1566         if ($section=~/^\//) {
1567                 # try to convert to a path relative to the config file
1568                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
1569                 $dir=abs_path($dir);
1570                 $dir.="/" unless $dir=~/\/$/;
1571                 if ($section=~/^\Q$dir\E(.*)/) {
1572                         $section=$1;
1573                 }
1574         }
1575         my %changefields;
1576         foreach (@_) {
1577                 if (/^([^=]+)=(.*)$/) {
1578                         $changefields{$1}=$2;
1579                 }
1580                 else {
1581                         my $found=0;
1582                         foreach my $topdir (sort keys %config) {
1583                                 if (exists $config{$topdir}{$section} &&
1584                                     exists $config{$topdir}{$section}{$_}) {
1585                                         print $config{$topdir}{$section}{$_}."\n";
1586                                         $found=1;
1587                                         last if $section eq 'DEFAULT';
1588                                 }
1589                         }
1590                         if (! $found) {
1591                                 die "mr config: $section $_ not set\n";
1592                         }
1593                 }
1594         }
1595         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
1596         exit 0;
1597 }
1598
1599 sub register {
1600         if ($config_overridden) {
1601                 # Find the directory that the specified config file is
1602                 # located in.
1603                 ($directory)=abs_path($ENV{MR_CONFIG})=~/^(.*\/)[^\/]+$/;
1604         }
1605         else {
1606                 # Find the closest known mrconfig file to the current
1607                 # directory.
1608                 $directory.="/" unless $directory=~/\/$/;
1609                 my $foundconfig=0;
1610                 foreach my $topdir (reverse sort keys %config) {
1611                         next unless length $topdir;
1612                         if ($directory=~/^\Q$topdir\E/) {
1613                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1614                                 $directory=$topdir;
1615                                 $foundconfig=1;
1616                                 last;
1617                         }
1618                 }
1619                 if (! $foundconfig) {
1620                         $directory=""; # no config file, use builtin
1621                 }
1622         }
1623         if (@ARGV) {
1624                 my $subdir=shift @ARGV;
1625                 if (! chdir($subdir)) {
1626                         print STDERR "mr register: failed to chdir to $subdir: $!\n";
1627                 }
1628         }
1629
1630         $ENV{MR_REPO}=getcwd();
1631         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
1632         if (! defined $command) {
1633                 die "mr register: unknown repository type\n";
1634         }
1635
1636         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1637         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1638                 "my_action(){ $command\n }; my_action ".
1639                 join(" ", map { s/\\/\\\\/g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1640         print "mr register: running >>$command<<\n" if $verbose;
1641         exec($command) || die "exec: $!";
1642 }
1643
1644 sub bootstrap {
1645         my $url=shift @ARGV;
1646         my $dir=shift @ARGV || ".";
1647         
1648         if (! defined $url || ! length $url) {
1649                 die "mr: bootstrap requires url\n";
1650         }
1651         
1652         # Download the config file to a temporary location.
1653         eval q{use File::Temp};
1654         die $@ if $@;
1655         my $tmpconfig=File::Temp->new();
1656         my @curlargs = ("curl", "-A", "mr", "-L", "-s", $url, "-o", $tmpconfig);
1657         push(@curlargs, "-k") if $insecure;
1658         my $curlstatus = system(@curlargs);
1659         die "mr bootstrap: invalid SSL certificate for $url (consider -k)\n" if $curlstatus >> 8 == 60;
1660         die "mr bootstrap: download of $url failed\n" if $curlstatus != 0;
1661
1662         if (! -e $dir) {
1663                 system("mkdir", "-p", $dir);
1664         }
1665         chdir($dir) || die "chdir $dir: $!";
1666
1667         # Special case to handle checkout of the "." repo, which 
1668         # would normally be skipped.
1669         my $topdir=abs_path(".")."/";
1670         my @repo=($topdir, $topdir, ".");
1671         loadconfig($tmpconfig, $topdir, $url);
1672         record(\@repo, action("checkout", @repo, 1))
1673                 if exists $config{$topdir}{"."}{"checkout"};
1674
1675         if (-e ".mrconfig") {
1676                 print STDERR "mr bootstrap: .mrconfig file already exists, not overwriting with $url\n";
1677         }
1678         else {
1679                 eval q{use File::Copy};
1680                 die $@ if $@;
1681                 move($tmpconfig, ".mrconfig") || die "rename: $!";
1682         }
1683
1684         # Reload the config file (in case we got a different version)
1685         # and checkout everything else.
1686         startingconfig();
1687         loadconfig(".mrconfig");
1688         dispatch("checkout");
1689         @skipped=grep { abs_path($_) ne abs_path($topdir) } @skipped;
1690         showstats("bootstrap");
1691         exitstats();
1692 }
1693
1694 # alias expansion and command stemming
1695 sub expandaction {
1696         my $action=shift;
1697         if (exists $alias{$action}) {
1698                 $action=$alias{$action};
1699         }
1700         if (! exists $knownactions{$action}) {
1701                 my @matches = grep { /^\Q$action\E/ }
1702                         keys %knownactions, keys %alias;
1703                 if (@matches == 1) {
1704                         $action=$matches[0];
1705                 }
1706                 elsif (@matches == 0) {
1707                         die "mr: unknown action \"$action\" (known actions: ".
1708                                 join(", ", sort keys %knownactions).")\n";
1709                 }
1710                 else {
1711                         die "mr: ambiguous action \"$action\" (matches: ".
1712                                 join(", ", @matches).")\n";
1713                 }
1714         }
1715         return $action;
1716 }
1717
1718 sub find_mrconfig {
1719         my $dir=getcwd();
1720         while (length $dir) {
1721                 if (-e "$dir/.mrconfig") {
1722                         return "$dir/.mrconfig";
1723                 }
1724                 $dir=~s/\/[^\/]*$//;
1725         }
1726         return $HOME_MR_CONFIG;
1727 }
1728
1729 sub getopts {
1730         my @saved=@ARGV;
1731         Getopt::Long::Configure("bundling", "no_permute");
1732         my $result=GetOptions(
1733                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1734                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1735                 "p|path" => sub { }, # now default, ignore
1736                 "f|force" => \$force,
1737                 "v|verbose" => \$verbose,
1738                 "q|quiet" => \$quiet,
1739                 "s|stats" => \$stats,
1740                 "k|insecure" => \$insecure,
1741                 "i|interactive" => \$interactive,
1742                 "n|no-recurse:i" => \$max_depth,
1743                 "j|jobs:i" => \$jobs,
1744                 "t|trust-all" => \$trust_all,
1745         );
1746         if (! $result || @ARGV < 1) {
1747                 die("Usage: mr [options] action [params ...]\n".
1748                     "(Use mr help for man page.)\n");
1749         }
1750         
1751         $ENV{MR_SWITCHES}="";
1752         foreach my $option (@saved) {
1753                 last if $option eq $ARGV[0];
1754                 $ENV{MR_SWITCHES}.="$option ";
1755         }
1756 }
1757
1758 sub init {
1759         $SIG{INT}=sub {
1760                 print STDERR "mr: interrupted\n";
1761                 exit 2;
1762         };
1763         
1764         # This can happen if it's run in a directory that was removed
1765         # or other strangeness.
1766         if (! defined $directory) {
1767                 die("mr: failed to determine working directory\n");
1768         }
1769         # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
1770         # the config file might be a symlink to elsewhere, and the directory it's
1771         # in is significant.
1772         if ($ENV{MR_CONFIG} !~ /^\//) {
1773                 $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
1774         }
1775         # Try to set MR_PATH to the path to the program.
1776         eval {
1777                 use FindBin qw($Bin $Script);
1778                 $ENV{MR_PATH}=$Bin."/".$Script;
1779         };
1780 }
1781         
1782 sub exitstats {
1783         if (@failed) {
1784                 exit 1;
1785         }
1786         else {
1787                 exit 0;
1788         }
1789 }
1790
1791 sub main {
1792         getopts();
1793         init();
1794
1795         startingconfig();
1796         loadconfig($HOME_MR_CONFIG);
1797         loadconfig($ENV{MR_CONFIG});
1798         #use Data::Dumper; print Dumper(\%config);
1799         
1800         my $action=expandaction(shift @ARGV);
1801         dispatch($action);
1802
1803         showstats($action);
1804         exitstats();
1805 }
1806
1807 # Finally, some useful actions that mr knows about by default.
1808 # These can be overridden in ~/.mrconfig.
1809 __DATA__
1810 [ALIAS]
1811 co = checkout
1812 ci = commit
1813 ls = list
1814
1815 [DEFAULT]
1816 order = 10
1817 lib =
1818         error() {
1819                 echo "mr: $@" >&2
1820                 exit 1
1821         }
1822         warning() {
1823                 echo "mr (warning): $@" >&2
1824         }
1825         info() {
1826                 echo "mr: $@" >&2
1827         }
1828         hours_since() {
1829                 if [ -z "$1" ] || [ -z "$2" ]; then
1830                         error "mr: usage: hours_since action num"
1831                 fi
1832                 for dir in .git .svn .bzr CVS .hg _darcs _FOSSIL_; do
1833                         if [ -e "$MR_REPO/$dir" ]; then
1834                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1835                                 break
1836                         fi
1837                 done
1838                 if [ -z "$flagfile" ]; then
1839                         error "cannot determine flag filename"
1840                 fi
1841                 delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
1842                 if [ "$delta" -lt "$2" ]; then
1843                         return 1
1844                 else
1845                         touch "$flagfile"
1846                         return 0
1847                 fi
1848         }
1849         is_bzr_checkout() {
1850                 LANG=C bzr info | egrep -q '^Checkout'
1851         }
1852         lazy() {
1853                 if [ -d "$MR_REPO" ]; then
1854                         return 1
1855                 else
1856                         return 0
1857                 fi
1858         }
1859
1860 svn_test = perl: -d "$ENV{MR_REPO}/.svn"
1861 git_test = perl: -d "$ENV{MR_REPO}/.git"
1862 bzr_test = perl: -d "$ENV{MR_REPO}/.bzr"
1863 cvs_test = perl: -d "$ENV{MR_REPO}/CVS"
1864 hg_test  = perl: -d "$ENV{MR_REPO}/.hg"
1865 darcs_test = perl: -d "$ENV{MR_REPO}/_darcs"
1866 fossil_test = perl: -f "$ENV{MR_REPO}/_FOSSIL_"
1867 git_bare_test = perl: 
1868         -d "$ENV{MR_REPO}/refs/heads" && -d "$ENV{MR_REPO}/refs/tags" &&
1869         -d "$ENV{MR_REPO}/objects" && -f "$ENV{MR_REPO}/config" &&
1870         `GIT_CONFIG="$ENV{MR_REPO}"/config git config --get core.bare` =~ /true/
1871 veracity_test  = perl: -d "$ENV{MR_REPO}/.sgdrawer"
1872
1873 svn_update = svn update "$@"
1874 git_update = git pull "$@"
1875 bzr_update = 
1876         if is_bzr_checkout; then
1877                 bzr update "$@"
1878         else
1879                 bzr merge --pull "$@"
1880         fi
1881 cvs_update = cvs update "$@"
1882 hg_update  = hg pull "$@" && hg update "$@"
1883 darcs_update = darcs pull -a "$@"
1884 fossil_update = fossil pull "$@"
1885 veracity_update = vv pull "$@" && vv update "$@"
1886
1887 svn_status = svn status "$@"
1888 git_status = git status -s "$@" || true
1889 bzr_status = bzr status --short "$@"
1890 cvs_status = cvs status "$@"
1891 hg_status  = hg status "$@"
1892 darcs_status = darcs whatsnew -ls "$@" || true
1893 fossil_status = fossil changes "$@"
1894 veracity_status = vv status "$@"
1895
1896 svn_commit = svn commit "$@"
1897 git_commit = git commit -a "$@" && git push --all
1898 bzr_commit = 
1899         if is_bzr_checkout; then
1900                 bzr commit "$@"
1901         else
1902                 bzr commit "$@" && bzr push
1903         fi
1904 cvs_commit = cvs commit "$@"
1905 hg_commit  = hg commit -m "$@" && hg push
1906 darcs_commit = darcs record -a -m "$@" && darcs push -a
1907 fossil_commit = fossil commit "$@"
1908 veracity_commit = vv commit -m "@" && vv push
1909
1910 git_record = git commit -a "$@"
1911 bzr_record =
1912         if is_bzr_checkout; then
1913                 bzr commit --local "$@"
1914         else
1915                 bzr commit "$@"
1916         fi
1917 hg_record  = hg commit -m "$@"
1918 darcs_record = darcs record -a -m "$@"
1919 fossil_record = fossil commit "$@"
1920 veracity_record = vv commit -m "@"
1921
1922 svn_push = :
1923 git_push = git push "$@"
1924 bzr_push = bzr push "$@"
1925 cvs_push = :
1926 hg_push = hg push "$@"
1927 darcs_push = darcs push -a "$@"
1928 fossil_push = fossil push "$@"
1929 veracity_push = vv push "$@"
1930
1931 svn_diff = svn diff "$@"
1932 git_diff = git diff "$@"
1933 bzr_diff = bzr diff "$@"
1934 cvs_diff = cvs diff "$@"
1935 hg_diff  = hg diff "$@"
1936 darcs_diff = darcs diff -u "$@"
1937 fossil_diff = fossil diff "$@"
1938 veracity_diff = vv diff "$@"
1939
1940 svn_log = svn log "$@"
1941 git_log = git log "$@"
1942 bzr_log = bzr log "$@"
1943 cvs_log = cvs log "$@"
1944 hg_log  = hg log "$@"
1945 darcs_log = darcs changes "$@"
1946 git_bare_log = git log "$@"
1947 fossil_log = fossil timeline "$@"
1948 veracity_log = vv log "$@"
1949
1950 run = "$@"
1951
1952 svn_register =
1953         url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
1954         if [ -z "$url" ]; then
1955                 error "cannot determine svn url"
1956         fi
1957         echo "Registering svn url: $url in $MR_CONFIG"
1958         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1959 git_register = 
1960         url="`LC_ALL=C git config --get remote.origin.url`" || true
1961         if [ -z "$url" ]; then
1962                 error "cannot determine git url"
1963         fi
1964         echo "Registering git url: $url in $MR_CONFIG"
1965         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1966 bzr_register =
1967         url="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
1968         if [ -z "$url" ]; then
1969                 error "cannot determine bzr url"
1970         fi
1971         echo "Registering bzr url: $url in $MR_CONFIG"
1972         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr branch '$url' '$MR_REPO'"
1973 cvs_register =
1974         repo=`cat CVS/Repository`
1975         root=`cat CVS/Root`
1976         if [ -z "$root" ]; then
1977                 error "cannot determine cvs root"
1978                 fi
1979         echo "Registering cvs repository $repo at root $root"
1980         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1981 hg_register = 
1982         url=`hg showconfig paths.default`
1983         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1984         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
1985 darcs_register = 
1986         url=`cat _darcs/prefs/defaultrepo`
1987         echo "Registering darcs repository $url in $MR_CONFIG"
1988         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
1989 git_bare_register = 
1990         url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
1991         if [ -z "$url" ]; then
1992                 error "cannot determine git url"
1993         fi
1994         echo "Registering git url: $url in $MR_CONFIG"
1995         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1996 fossil_register =
1997         url=`fossil remote-url`
1998         repo=`fossil info | grep repository | sed -e 's/repository:*.//g' -e 's/ //g'`
1999         echo "Registering fossil repository $url in $MR_CONFIG"
2000         mr -c "$MR_CONFIG" config "`pwd`" checkout="mkdir -p '$MR_REPO' && cd '$MR_REPO' && fossil open '$repo'"
2001 veracity_register =
2002         url=`vv config | grep sync_targets | sed -e 's/sync_targets:*.//g' -e 's/ //g'`
2003         repo=`vv repo info | grep repository | sed -e 's/Current repository:*.//g' -e 's/ //g'`
2004         echo "Registering veracity repository $url in $MR_CONFIG"
2005         mr -c "$MR_CONFIG" config "`pwd`" checkout="mkdir -p '$MR_REPO' && cd '$MR_REPO' && vv checkout '$repo'"
2006
2007 svn_trusted_checkout = svn co $url $repo
2008 svn_alt_trusted_checkout = svn checkout $url $repo
2009 git_trusted_checkout = git clone $url $repo
2010 bzr_trusted_checkout = bzr checkout|clone|branch|get $url $repo
2011 # cvs: too hard
2012 hg_trusted_checkout = hg clone $url $repo
2013 darcs_trusted_checkout = darcs get $url $repo
2014 git_bare_trusted_checkout = git clone --bare $url $repo
2015 # fossil: messy to do
2016 veracity_trusted_checkout = vv clone $url $repo
2017
2018
2019 help =
2020         case `uname -s` in
2021                 SunOS)
2022                 SHOWMANFILE="man -f"
2023                 ;;
2024                 Darwin)
2025                 SHOWMANFILE="man"
2026                 ;;
2027                 *)
2028                 SHOWMANFILE="man -l"
2029                 ;;
2030         esac
2031         if [ ! -e "$MR_PATH" ]; then
2032                 error "cannot find program path"
2033         fi
2034         tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
2035         trap "rm -f $tmp" exit
2036         pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
2037         $SHOWMANFILE "$tmp" || error "man failed"
2038 list = true
2039 config = 
2040 bootstrap = 
2041
2042 online =
2043         if [ -s ~/.mrlog ]; then
2044                 info "running offline commands"
2045                 mv -f ~/.mrlog ~/.mrlog.old
2046                 if ! sh -e ~/.mrlog.old; then
2047                         error "offline command failed; left in ~/.mrlog.old"
2048                 fi
2049                 rm -f ~/.mrlog.old
2050         else
2051                 info "no offline commands to run"
2052         fi
2053 offline =
2054         umask 077
2055         touch ~/.mrlog
2056         info "offline mode enabled"
2057 remember =
2058         info "remembering command: 'mr $@'"
2059         command="mr -d '$(pwd)' $MR_SWITCHES"
2060         for w in "$@"; do
2061                 command="$command '$w'"
2062         done
2063         if [ ! -e ~/.mrlog ] || ! grep -q -F "$command" ~/.mrlog; then
2064                 echo "$command" >> ~/.mrlog
2065         fi
2066
2067 ed = echo "A horse is a horse, of course, of course.."
2068 T = echo "I pity the fool."
2069 right = echo "Not found."
2070
2071 # vim:sw=8:sts=0:ts=8:noet
2072 # Local variables:
2073 # indent-tabs-mode: t
2074 # cperl-indent-level: 8
2075 # End: