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