]> 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:

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