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

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