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

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