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

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