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

Ignore nonzero exit status of hg pull, which can happen when there were no changes...
[code/myrepos.git] / mr
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 mr - a Multiple Repository management tool
6
7 =head1 SYNOPSIS
8
9 B<mr> [options] checkout
10
11 B<mr> [options] update
12
13 B<mr> [options] status
14
15 B<mr> [options] commit [-m "message"]
16
17 B<mr> [options] record [-m "message"]
18
19 B<mr> [options] push
20
21 B<mr> [options] diff
22
23 B<mr> [options] log
24
25 B<mr> [options] run command [param ...]
26
27 B<mr> [options] bootstrap url [directory]
28
29 B<mr> [options] register [repository]
30
31 B<mr> [options] config section ["parameter=[value]" ...]
32
33 B<mr> [options] action [params ...]
34
35 B<mr> [options] [online|offline]
36
37 B<mr> [options] remember action [params ...]
38
39 =head1 DESCRIPTION
40
41 B<mr> is a Multiple Repository management tool. It can checkout, update, or
42 perform other actions on a set of repositories as if they were one combined
43 repository. It supports any combination of subversion, git, cvs, mercurial,
44 bzr, darcs, fossil and veracity repositories, and support for other version
45 control systems can easily be added.
46
47 B<mr> cds into and operates on all registered repositories at or below your
48 working directory. Or, if you are in a subdirectory of a repository that
49 contains no other registered repositories, it will stay in that directory,
50 and work on only that repository,
51
52 B<mr> is configured by .mrconfig files, which list the repositories. It
53 starts by reading the .mrconfig file in your home directory, and this can
54 in turn chain load .mrconfig files from repositories. It also automatically
55 looks for a .mrconfig file in the current directory, or in one of its
56 parent directories.
57
58 These predefined commands should be fairly familiar to users of any version
59 control system:
60
61 =over 4
62
63 =item checkout (or co)
64
65 Checks out any repositories that are not already checked out.
66
67 =item update
68
69 Updates each repository from its configured remote repository.
70
71 If a repository isn't checked out yet, it will first check it out.
72
73 =item status
74
75 Displays a status report for each repository, showing what
76 uncommitted changes are present in the repository.
77
78 =item commit (or ci)
79
80 Commits changes to each repository. (By default, changes are pushed to the
81 remote repository too, when using distributed systems like git. If you
82 don't like this default, you can change it in your .mrconfig, or use record
83 instead.)
84
85 The optional -m parameter allows specifying a commit message.
86
87 =item record
88
89 Records changes to the local repository, but does not push them to the
90 remote repository. Only supported for distributed version control systems.
91
92 The optional -m parameter allows specifying a commit message.
93
94 =item push
95
96 Pushes committed local changes to the remote repository. A no-op for
97 centralized version control systems.
98
99 =item diff
100
101 Show a diff of uncommitted changes.
102
103 =item log
104
105 Show the commit log.
106
107 =item run command [param ...]
108
109 Runs the specified command in each repository.
110
111 =back
112
113 These commands are also available:
114
115 =over 4
116
117 =item bootstrap url [directory]
118
119 Causes mr to download the url, and use it as a .mrconfig file
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, 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 =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 $force=0;
534 my $insecure=0;
535 my $interactive=0;
536 my $max_depth;
537 my $no_chdir=0;
538 my $jobs=1;
539 my $trust_all=0;
540 my $directory=getcwd();
541
542 my $HOME_MR_CONFIG = "$ENV{HOME}/.mrconfig";
543 $ENV{MR_CONFIG}=find_mrconfig();
544
545 # globals :-(
546 my %config;
547 my %configfiles;
548 my %knownactions;
549 my %alias;
550 my (@ok, @failed, @skipped);
551
552 main();
553
554 sub shellquote {
555         my $i=shift;
556         $i=~s/'/'"'"'/g;
557         return "'$i'";
558 }
559
560 # Runs a shell command using a supplied function.
561 # The lib will be included in the shell command line, and any params
562 # will be available in the shell as $1, $2, etc.
563 my $lastlib;
564 sub runsh {
565         my ($action, $topdir, $subdir, $command, $params, $runner) = @_;
566
567         # optimisation: avoid running the shell for true and false
568         if ($command =~ /^\s*true\s*$/) {
569                 $?=0;
570                 return 0;
571         }
572         elsif ($command =~ /^\s*false\s*$/) {
573                 $?=0;
574                 return 1;
575         }
576         
577         my $quotedparams=join(" ", (map { shellquote($_) } @$params));
578         my $lib=exists $config{$topdir}{$subdir}{lib} ?
579                        $config{$topdir}{$subdir}{lib}."\n" : "";
580         if ($verbose && (! defined $lastlib || $lastlib ne $lib)) {
581                 print "mr library now: >>$lib<<\n";
582                 $lastlib=$lib;
583         }
584         my $shellcode="set -e;".$lib.
585                 "my_sh(){ $command\n }; my_sh $quotedparams";
586         print "mr $action: running $action >>$command<<\n" if $verbose;
587         $runner->($shellcode);
588 }
589
590 my %perl_cache;
591 sub perl {
592         my $id=shift;
593         my $s=shift;
594         if ($s =~ m/^perl:\s+(.*)/s) {
595                 return $perl_cache{$1} if exists $perl_cache{$1};
596                 my $sub=eval "sub {$1}";
597                 if (! defined $sub) {
598                         print STDERR "mr: bad perl code in $id: $@\n";
599                 }
600                 return $perl_cache{$1} = $sub;
601         }
602         return undef;
603 }
604
605 my %vcs;
606 sub vcs_test {
607         my ($action, $dir, $topdir, $subdir) = @_;
608
609         if (exists $vcs{$dir}) {
610                 return $vcs{$dir};
611         }
612
613         my $test="";
614         my %perltest;
615         foreach my $vcs_test (
616                         sort {
617                                 length $a <=> length $b 
618                                           ||
619                                        $a cmp $b
620                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
621                 my ($vcs)=$vcs_test =~ /(.*)_test/;
622                 my $p=perl($vcs_test, $config{$topdir}{$subdir}{$vcs_test});
623                 if (defined $p) {
624                         $perltest{$vcs}=$p;
625                 }
626                 else {
627                         $test="my_$vcs_test() {\n$config{$topdir}{$subdir}{$vcs_test}\n}\n".$test;
628                         $test.="if my_$vcs_test; then echo $vcs; fi\n";
629                 }
630         }
631
632         my @vcs;
633         foreach my $vcs (keys %perltest) {
634                 if ($perltest{$vcs}->()) {
635                         push @vcs, $vcs;
636                 }
637         }
638
639         push @vcs, split(/\n/,
640                 runsh("vcs test", $topdir, $subdir, $test, [], sub {
641                         my $sh=shift;
642                         my $ret=`$sh`;
643                         return $ret;
644                 })) if length $test;
645         if (@vcs > 1) {
646                 print STDERR "mr $action: found multiple possible repository types (@vcs) for ".fulldir($topdir, $subdir)."\n";
647                 return undef;
648         }
649         if (! @vcs) {
650                 return $vcs{$dir}=undef;
651         }
652         else {
653                 return $vcs{$dir}=$vcs[0];
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         my $checkout_dir;
688
689         $ENV{MR_CONFIG}=$configfiles{$topdir};
690         my $is_checkout=($action eq 'checkout');
691         my $is_update=($action =~ /update/);
692
693         ($ENV{MR_REPO}=$dir) =~ s!/$!!;
694         $ENV{MR_ACTION}=$action;
695         
696         foreach my $testname ("skip", "deleted") {
697                 next if $force && $testname eq "skip";
698
699                 my $testcommand=findcommand($testname, $dir, $topdir, $subdir, $is_checkout);
700
701                 if (defined $testcommand) {
702                         my $ret=runsh "$testname test", $topdir, $subdir,
703                                 $testcommand, [$action],
704                                 sub { system(shift()) };
705                         if ($ret != 0) {
706                                 if (($? & 127) == 2) {
707                                         print STDERR "mr $action: interrupted\n";
708                                         return ABORT;
709                                 }
710                                 elsif ($? & 127) {
711                                         print STDERR "mr $action: $testname test received signal ".($? & 127)."\n";
712                                         return ABORT;
713                                 }
714                         }
715                         if ($ret >> 8 == 0) {
716                                 if ($testname eq "deleted") {
717                                         if (-d $dir) {
718                                                 print STDERR "mr error: $dir should be deleted yet still exists\n";
719                                                 return FAILED;
720                                         }
721                                 }
722                                 print "mr $action: skip $dir skipped\n" if $verbose;
723                                 return SKIPPED;
724                         }
725                 }
726         }
727
728         if ($is_checkout) {
729                 $checkout_dir=$dir;
730                 if (! $force_checkout) {
731                         if (-d $dir) {
732                                 print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
733                                 return SKIPPED;
734                         }
735         
736                         $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
737                 }
738         }
739         elsif ($is_update) {
740                 if (! -d $dir) {
741                         return action("checkout", $dir, $topdir, $subdir);
742                 }
743         }
744
745         my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
746
747         if ($is_checkout && ! -d $dir) {
748                 print "mr $action: creating parent directory $dir\n" if $verbose;
749                 system("mkdir", "-p", $dir);
750         }
751
752         if (! $no_chdir && ! chdir($dir)) {
753                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
754                 return FAILED;
755         }
756         elsif (! defined $command) {
757                 my $vcs=vcs_test(@_);
758                 if (! defined $vcs) {
759                         print STDERR "mr $action: unknown repository type and no defined $action command for $fulldir\n";
760                         return FAILED;
761                 }
762                 else {
763                         print STDERR "mr $action: no defined action for $vcs repository $fulldir, skipping\n";
764                         return SKIPPED;
765                 }
766         }
767         else {
768                 my $actionmsg;
769                 if (! $no_chdir) {
770                         $actionmsg="mr $action: $fulldir";
771                 }
772                 else {
773                         my $s=$directory;
774                         $s=~s/^\Q$fulldir\E\/?//;
775                         $actionmsg="mr $action: $fulldir (in subdir $s)";
776                 }
777                 print "$actionmsg\n" unless $quiet;
778
779                 my $hookret=hook("pre_$action", $topdir, $subdir);
780                 return $hookret if $hookret != OK;
781
782                 my $ret=runsh $action, $topdir, $subdir,
783                         $command, \@ARGV, sub {
784                                 my $sh=shift;
785                                 if ($quiet) {
786                                         my $output = qx/$sh 2>&1/;
787                                         my $ret = $?;
788                                         if ($ret != 0) {
789                                                 print "$actionmsg\n";
790                                                 print STDERR $output;
791                                         }
792                                         return $ret;
793                                 }
794                                 else {
795                                         system($sh);
796                                 }
797                         };
798                 if ($ret != 0) {
799                         if (($? & 127) == 2) {
800                                 print STDERR "mr $action: interrupted\n";
801                                 return ABORT;
802                         }
803                         elsif ($? & 127) {
804                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
805                                 return ABORT;
806                         }
807                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
808                         if ($ret >> 8 != 0) {
809                                 print STDERR "mr $action: command failed\n";
810                                 if (-e "$ENV{HOME}/.mrlog" && $action ne 'remember') {
811                                         # recreate original command line to
812                                         # remember, and avoid recursing
813                                         my @orig=@ARGV;
814                                         @ARGV=('-n', $action, @orig);
815                                         action("remember", $dir, $topdir, $subdir);
816                                         @ARGV=@orig;
817                                 }
818                         }
819                         elsif ($ret != 0) {
820                                 print STDERR "mr $action: command died ($ret)\n";
821                         }
822                         return FAILED;
823                 }
824                 else {
825                         if ($is_checkout && ! -d $dir) {
826                                 print STDERR "mr $action: $dir missing after checkout\n";;
827                                 return FAILED;
828                         }
829
830                         my $ret=hook("post_$action", $topdir, $subdir);
831                         return $ret if $ret != OK;
832                         
833                         if ($is_checkout || $is_update) {
834                                 if ($is_checkout && ! $no_chdir) {
835                                         if (! chdir($checkout_dir)) {
836                                                 print STDERR "mr $action: failed to chdir to $checkout_dir: $!\n";
837                                                 return FAILED;
838                                         }
839                                 }
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($HOME_MR_CONFIG);
1106
1107         return 1 if $trust_all;
1108
1109         my $trustfile=$ENV{HOME}."/.mrtrust";
1110
1111         if (! %trusted) {
1112                 $trusted{$HOME_MR_CONFIG}=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         
1296                 if (defined $bootstrap_url) {
1297                         die "mr: $msg in untrusted $bootstrap_url line $lineno\n".
1298                                 "(To trust this url, --trust-all can be used; but please use caution;\n".
1299                                 "this can allow arbitrary code execution!)\n";
1300                 }
1301                 else {
1302                         die "mr: $msg in untrusted $f line $lineno\n".
1303                                 "(To trust this file, list it in ~/.mrtrust.)\n";
1304                 }
1305         };
1306
1307         while (@lines) {
1308                 $_=$nextline->();
1309
1310                 if (! $trusted && /[[:cntrl:]]/) {
1311                         $trusterror->("illegal control character");
1312                 }
1313
1314                 next if /^\s*\#/ || /^\s*$/;
1315                 if (/^\[([^\]]*)\]\s*$/) {
1316                         $section=$1;
1317
1318                         if (! $trusted) {
1319                                 if (! is_trusted_repo($section) ||
1320                                     $section eq 'ALIAS' ||
1321                                     $section eq 'DEFAULT') {
1322                                         $trusterror->("illegal section \"[$section]\"");
1323                                 }
1324                         }
1325                         $section=expandenv($section) if $trusted;
1326                         if ($section ne 'ALIAS' &&
1327                             ! exists $config{$dir}{$section} &&
1328                             exists $config{$dir}{DEFAULT}) {
1329                                 # copy in defaults
1330                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
1331                         }
1332                 }
1333                 elsif (/^(\w+)\s*=\s*(.*)/) {
1334                         my $parameter=$1;
1335                         my $value=$2;
1336
1337                         # continued value
1338                         while (@lines && $lines[0]=~/^\s(.+)/) {
1339                                 $value.="\n$1";
1340                                 chomp $value;
1341                                 $nextline->();
1342                         }
1343
1344                         if (! $trusted) {
1345                                 # Untrusted files can only contain a few
1346                                 # settings in specific known-safe formats.
1347                                 if ($parameter eq 'checkout') {
1348                                         if (! is_trusted_checkout($value)) {
1349                                                 $trusterror->("illegal checkout command \"$value\"");
1350                                         }
1351                                 }
1352                                 elsif ($parameter eq 'order') {
1353                                         # not interpreted as a command, so
1354                                         # safe.
1355                                 }
1356                                 elsif ($value eq 'true' || $value eq 'false') {
1357                                         # skip=true , deleted=true etc are
1358                                         # safe.
1359                                 }
1360                                 else {
1361                                         $trusterror->("illegal setting \"$parameter=$value\"");
1362                                 }
1363                         }
1364
1365                         if ($parameter eq "include") {
1366                                 print "mr: including output of \"$value\"\n" if $verbose;
1367                                 my @inc=`$value`;
1368                                 if ($?) {
1369                                         print STDERR "mr: include command exited nonzero ($?)\n";
1370                                 }
1371                                 $included += @inc;
1372                                 unshift @lines, @inc;
1373                                 next;
1374                         }
1375
1376                         if (! defined $section) {
1377                                 $lineerror->("parameter ($parameter) not in section");
1378                         }
1379                         if ($section eq 'ALIAS') {
1380                                 $alias{$parameter}=$value;
1381                         }
1382                         elsif ($parameter eq 'lib' or $parameter =~ s/_append$//) {
1383                                 $config{$dir}{$section}{$parameter}.="\n".$value."\n";
1384                         }
1385                         else {
1386                                 $config{$dir}{$section}{$parameter}=$value;
1387                                 if ($parameter =~ /.*_(.*)/) {
1388                                         $knownactions{$1}=1;
1389                                 }
1390                                 else {
1391                                         $knownactions{$parameter}=1;
1392                                 }
1393                                 if ($parameter eq 'chain' &&
1394                                     length $dir && $section ne "DEFAULT") {
1395                                         my $chaindir="$section";
1396                                         if ($chaindir !~ m!^/!) {
1397                                                 $chaindir=$dir.$chaindir;
1398                                         }
1399                                         if (-e "$chaindir/.mrconfig") {
1400                                                 my $ret=system($value);
1401                                                 if ($ret != 0) {
1402                                                         if (($? & 127) == 2) {
1403                                                                 print STDERR "mr: chain test interrupted\n";
1404                                                                 exit 2;
1405                                                         }
1406                                                         elsif ($? & 127) {
1407                                                                 print STDERR "mr: chain test received signal ".($? & 127)."\n";
1408                                                         }
1409                                                 }
1410                                                 else {
1411                                                         push @toload, ["$chaindir/.mrconfig", $chaindir];
1412                                                 }
1413                                         }
1414                                 }
1415                         }
1416                 }
1417                 else {
1418                         $lineerror->("parse error");
1419                 }
1420         }
1421
1422         foreach my $c (@toload) {
1423                 loadconfig(@$c);
1424         }
1425 }
1426
1427 sub startingconfig {
1428         %alias=%config=%configfiles=%knownactions=%loaded=();
1429         my $datapos=tell(DATA);
1430         loadconfig(\*DATA);
1431         seek(DATA,$datapos,0); # rewind
1432 }
1433
1434 sub modifyconfig {
1435         my $f=shift;
1436         # the section to modify or add
1437         my $targetsection=shift;
1438         # fields to change in the section
1439         # To remove a field, set its value to "".
1440         my %changefields=@_;
1441
1442         my @lines;
1443         my @out;
1444
1445         if (-e $f) {
1446                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
1447                 @lines=<$in>;
1448                 close $in;
1449         }
1450
1451         my $formatfield=sub {
1452                 my $field=shift;
1453                 my @value=split(/\n/, shift);
1454
1455                 return "$field = ".shift(@value)."\n".
1456                         join("", map { "\t$_\n" } @value);
1457         };
1458         my $addfields=sub {
1459                 my @blanks;
1460                 while ($out[$#out] =~ /^\s*$/) {
1461                         unshift @blanks, pop @out;
1462                 }
1463                 foreach my $field (sort keys %changefields) {
1464                         if (length $changefields{$field}) {
1465                                 push @out, "$field = $changefields{$field}\n";
1466                                 delete $changefields{$field};
1467                         }
1468                 }
1469                 push @out, @blanks;
1470         };
1471
1472         my $section;
1473         while (@lines) {
1474                 $_=shift(@lines);
1475
1476                 if (/^\s*\#/ || /^\s*$/) {
1477                         push @out, $_;
1478                 }
1479                 elsif (/^\[([^\]]*)\]\s*$/) {
1480                         if (defined $section && 
1481                             $section eq $targetsection) {
1482                                 $addfields->();
1483                         }
1484
1485                         $section=expandenv($1);
1486
1487                         push @out, $_;
1488                 }
1489                 elsif (/^(\w+)\s*=\s(.*)/) {
1490                         my $parameter=$1;
1491                         my $value=$2;
1492
1493                         # continued value
1494                         while (@lines && $lines[0]=~/^\s(.+)/) {
1495                                 shift(@lines);
1496                                 $value.="\n$1";
1497                                 chomp $value;
1498                         }
1499
1500                         if ($section eq $targetsection) {
1501                                 if (exists $changefields{$parameter}) {
1502                                         if (length $changefields{$parameter}) {
1503                                                 $value=$changefields{$parameter};
1504                                         }
1505                                         delete $changefields{$parameter};
1506                                 }
1507                         }
1508
1509                         push @out, $formatfield->($parameter, $value);
1510                 }
1511         }
1512
1513         if (defined $section && 
1514             $section eq $targetsection) {
1515                 $addfields->();
1516         }
1517         elsif (%changefields) {
1518                 push @out, "\n[$targetsection]\n";
1519                 foreach my $field (sort keys %changefields) {
1520                         if (length $changefields{$field}) {
1521                                 push @out, $formatfield->($field, $changefields{$field});
1522                         }
1523                 }
1524         }
1525
1526         open(my $out, ">", $f) || die "mr: write $f: $!\n";
1527         print $out @out;
1528         close $out;     
1529 }
1530
1531 sub dispatch {
1532         my $action=shift;
1533
1534         # actions that do not operate on all repos
1535         if ($action eq 'help') {
1536                 help(@ARGV);
1537         }
1538         elsif ($action eq 'config') {
1539                 config(@ARGV);
1540         }
1541         elsif ($action eq 'register') {
1542                 register(@ARGV);
1543         }
1544         elsif ($action eq 'bootstrap') {
1545                 bootstrap();
1546         }
1547         elsif ($action eq 'remember' ||
1548                $action eq 'offline' ||
1549                $action eq 'online') {
1550                 my @repos=selectrepos;
1551                 action($action, @{$repos[0]}) if @repos;
1552                 exit 0;
1553         }
1554
1555         if (!$jobs || $jobs > 1) {
1556                 mrs($action, selectrepos());
1557         }
1558         else {
1559                 foreach my $repo (selectrepos()) {
1560                         record($repo, action($action, @$repo));
1561                 }
1562         }
1563 }
1564
1565 sub help {
1566         exec($config{''}{DEFAULT}{help}) || die "exec: $!";
1567 }
1568
1569 sub config {
1570         if (@_ < 2) {
1571                 die "mr config: not enough parameters\n";
1572         }
1573         my $section=shift;
1574         if ($section=~/^\//) {
1575                 # try to convert to a path relative to the config file
1576                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
1577                 $dir=abs_path($dir);
1578                 $dir.="/" unless $dir=~/\/$/;
1579                 if ($section=~/^\Q$dir\E(.*)/) {
1580                         $section=$1;
1581                 }
1582         }
1583         my %changefields;
1584         foreach (@_) {
1585                 if (/^([^=]+)=(.*)$/) {
1586                         $changefields{$1}=$2;
1587                 }
1588                 else {
1589                         my $found=0;
1590                         foreach my $topdir (sort keys %config) {
1591                                 if (exists $config{$topdir}{$section} &&
1592                                     exists $config{$topdir}{$section}{$_}) {
1593                                         print $config{$topdir}{$section}{$_}."\n";
1594                                         $found=1;
1595                                         last if $section eq 'DEFAULT';
1596                                 }
1597                         }
1598                         if (! $found) {
1599                                 die "mr config: $section $_ not set\n";
1600                         }
1601                 }
1602         }
1603         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
1604         exit 0;
1605 }
1606
1607 sub register {
1608         if ($config_overridden) {
1609                 # Find the directory that the specified config file is
1610                 # located in.
1611                 ($directory)=abs_path($ENV{MR_CONFIG})=~/^(.*\/)[^\/]+$/;
1612         }
1613         else {
1614                 # Find the closest known mrconfig file to the current
1615                 # directory.
1616                 $directory.="/" unless $directory=~/\/$/;
1617                 my $foundconfig=0;
1618                 foreach my $topdir (reverse sort keys %config) {
1619                         next unless length $topdir;
1620                         if ($directory=~/^\Q$topdir\E/) {
1621                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1622                                 $directory=$topdir;
1623                                 $foundconfig=1;
1624                                 last;
1625                         }
1626                 }
1627                 if (! $foundconfig) {
1628                         $directory=""; # no config file, use builtin
1629                 }
1630         }
1631         if (@ARGV) {
1632                 my $subdir=shift @ARGV;
1633                 if (! chdir($subdir)) {
1634                         print STDERR "mr register: failed to chdir to $subdir: $!\n";
1635                 }
1636         }
1637
1638         $ENV{MR_REPO}=getcwd();
1639         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
1640         if (! defined $command) {
1641                 die "mr register: unknown repository type\n";
1642         }
1643
1644         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1645         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1646                 "my_action(){ $command\n }; my_action ".
1647                 join(" ", map { s/\\/\\\\/g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1648         print "mr register: running >>$command<<\n" if $verbose;
1649         exec($command) || die "exec: $!";
1650 }
1651
1652 sub bootstrap {
1653         my $url=shift @ARGV;
1654         my $dir=shift @ARGV || ".";
1655         
1656         if (! defined $url || ! length $url) {
1657                 die "mr: bootstrap requires url\n";
1658         }
1659         
1660         # Download the config file to a temporary location.
1661         eval q{use File::Temp};
1662         die $@ if $@;
1663         my $tmpconfig=File::Temp->new();
1664         my @curlargs = ("curl", "-A", "mr", "-L", "-s", $url, "-o", $tmpconfig);
1665         push(@curlargs, "-k") if $insecure;
1666         my $curlstatus = system(@curlargs);
1667         die "mr bootstrap: invalid SSL certificate for $url (consider -k)\n" if $curlstatus >> 8 == 60;
1668         die "mr bootstrap: download of $url failed\n" if $curlstatus != 0;
1669
1670         if (! -e $dir) {
1671                 system("mkdir", "-p", $dir);
1672         }
1673         chdir($dir) || die "chdir $dir: $!";
1674
1675         # Special case to handle checkout of the "." repo, which 
1676         # would normally be skipped.
1677         my $topdir=abs_path(".")."/";
1678         my @repo=($topdir, $topdir, ".");
1679         loadconfig($tmpconfig, $topdir, $url);
1680         record(\@repo, action("checkout", @repo, 1))
1681                 if exists $config{$topdir}{"."}{"checkout"};
1682
1683         if (-e ".mrconfig") {
1684                 print STDERR "mr bootstrap: .mrconfig file already exists, not overwriting with $url\n";
1685         }
1686         else {
1687                 eval q{use File::Copy};
1688                 die $@ if $@;
1689                 move($tmpconfig, ".mrconfig") || die "rename: $!";
1690         }
1691
1692         # Reload the config file (in case we got a different version)
1693         # and checkout everything else.
1694         startingconfig();
1695         loadconfig(".mrconfig");
1696         dispatch("checkout");
1697         @skipped=grep { abs_path($_) ne abs_path($topdir) } @skipped;
1698         showstats("bootstrap");
1699         exitstats();
1700 }
1701
1702 # alias expansion and command stemming
1703 sub expandaction {
1704         my $action=shift;
1705         if (exists $alias{$action}) {
1706                 $action=$alias{$action};
1707         }
1708         if (! exists $knownactions{$action}) {
1709                 my @matches = grep { /^\Q$action\E/ }
1710                         keys %knownactions, keys %alias;
1711                 if (@matches == 1) {
1712                         $action=$matches[0];
1713                 }
1714                 elsif (@matches == 0) {
1715                         die "mr: unknown action \"$action\" (known actions: ".
1716                                 join(", ", sort keys %knownactions).")\n";
1717                 }
1718                 else {
1719                         die "mr: ambiguous action \"$action\" (matches: ".
1720                                 join(", ", @matches).")\n";
1721                 }
1722         }
1723         return $action;
1724 }
1725
1726 sub find_mrconfig {
1727         my $dir=getcwd();
1728         while (length $dir) {
1729                 if (-e "$dir/.mrconfig") {
1730                         return "$dir/.mrconfig";
1731                 }
1732                 $dir=~s/\/[^\/]*$//;
1733         }
1734         return $HOME_MR_CONFIG;
1735 }
1736
1737 sub getopts {
1738         my @saved=@ARGV;
1739         Getopt::Long::Configure("bundling", "no_permute");
1740         my $result=GetOptions(
1741                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1742                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1743                 "p|path" => sub { }, # now default, ignore
1744                 "f|force" => \$force,
1745                 "v|verbose" => \$verbose,
1746                 "q|quiet" => \$quiet,
1747                 "s|stats" => \$stats,
1748                 "k|insecure" => \$insecure,
1749                 "i|interactive" => \$interactive,
1750                 "n|no-recurse:i" => \$max_depth,
1751                 "j|jobs:i" => \$jobs,
1752                 "t|trust-all" => \$trust_all,
1753         );
1754         if (! $result || @ARGV < 1) {
1755                 die("Usage: mr [options] action [params ...]\n".
1756                     "(Use mr help for man page.)\n");
1757         }
1758         
1759         $ENV{MR_SWITCHES}="";
1760         foreach my $option (@saved) {
1761                 last if $option eq $ARGV[0];
1762                 $ENV{MR_SWITCHES}.="$option ";
1763         }
1764 }
1765
1766 sub init {
1767         $SIG{INT}=sub {
1768                 print STDERR "mr: interrupted\n";
1769                 exit 2;
1770         };
1771         
1772         # This can happen if it's run in a directory that was removed
1773         # or other strangeness.
1774         if (! defined $directory) {
1775                 die("mr: failed to determine working directory\n");
1776         }
1777         # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
1778         # the config file might be a symlink to elsewhere, and the directory it's
1779         # in is significant.
1780         if ($ENV{MR_CONFIG} !~ /^\//) {
1781                 $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
1782         }
1783         # Try to set MR_PATH to the path to the program.
1784         eval {
1785                 use FindBin qw($Bin $Script);
1786                 $ENV{MR_PATH}=$Bin."/".$Script;
1787         };
1788 }
1789         
1790 sub exitstats {
1791         if (@failed) {
1792                 exit 1;
1793         }
1794         else {
1795                 exit 0;
1796         }
1797 }
1798
1799 sub main {
1800         getopts();
1801         init();
1802
1803         startingconfig();
1804         loadconfig($HOME_MR_CONFIG);
1805         loadconfig($ENV{MR_CONFIG});
1806         #use Data::Dumper; print Dumper(\%config);
1807         
1808         my $action=expandaction(shift @ARGV);
1809         dispatch($action);
1810
1811         showstats($action);
1812         exitstats();
1813 }
1814
1815 # Finally, some useful actions that mr knows about by default.
1816 # These can be overridden in ~/.mrconfig.
1817 __DATA__
1818 [ALIAS]
1819 co = checkout
1820 ci = commit
1821 ls = list
1822
1823 [DEFAULT]
1824 order = 10
1825 lib =
1826         error() {
1827                 echo "mr: $@" >&2
1828                 exit 1
1829         }
1830         warning() {
1831                 echo "mr (warning): $@" >&2
1832         }
1833         info() {
1834                 echo "mr: $@" >&2
1835         }
1836         hours_since() {
1837                 if [ -z "$1" ] || [ -z "$2" ]; then
1838                         error "mr: usage: hours_since action num"
1839                 fi
1840                 for dir in .git .svn .bzr CVS .hg _darcs _FOSSIL_; do
1841                         if [ -e "$MR_REPO/$dir" ]; then
1842                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1843                                 break
1844                         fi
1845                 done
1846                 if [ -z "$flagfile" ]; then
1847                         error "cannot determine flag filename"
1848                 fi
1849                 delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
1850                 if [ "$delta" -lt "$2" ]; then
1851                         return 1
1852                 else
1853                         touch "$flagfile"
1854                         return 0
1855                 fi
1856         }
1857         is_bzr_checkout() {
1858                 LANG=C bzr info | egrep -q '^Checkout'
1859         }
1860         lazy() {
1861                 if [ -d "$MR_REPO" ]; then
1862                         return 1
1863                 else
1864                         return 0
1865                 fi
1866         }
1867
1868 svn_test = perl: -d "$ENV{MR_REPO}/.svn"
1869 git_test = perl: -d "$ENV{MR_REPO}/.git"
1870 bzr_test = perl: -d "$ENV{MR_REPO}/.bzr"
1871 cvs_test = perl: -d "$ENV{MR_REPO}/CVS"
1872 hg_test  = perl: -d "$ENV{MR_REPO}/.hg"
1873 darcs_test = perl: -d "$ENV{MR_REPO}/_darcs"
1874 fossil_test = perl: -f "$ENV{MR_REPO}/_FOSSIL_"
1875 git_bare_test = perl: 
1876         -d "$ENV{MR_REPO}/refs/heads" && -d "$ENV{MR_REPO}/refs/tags" &&
1877         -d "$ENV{MR_REPO}/objects" && -f "$ENV{MR_REPO}/config" &&
1878         `GIT_CONFIG="$ENV{MR_REPO}"/config git config --get core.bare` =~ /true/
1879 vcsh_test = perl:
1880         -d "$ENV{MR_REPO}/refs/heads" && -d "$ENV{MR_REPO}/refs/tags" &&
1881         -d "$ENV{MR_REPO}/objects" && -f "$ENV{MR_REPO}/config" &&
1882         `GIT_CONFIG="$ENV{MR_REPO}"/config git config --get vcsh.vcsh` =~ /true/
1883 veracity_test  = perl: -d "$ENV{MR_REPO}/.sgdrawer"
1884
1885 svn_update = svn update "$@"
1886 git_update = git pull "$@"
1887 bzr_update = 
1888         if is_bzr_checkout; then
1889                 bzr update "$@"
1890         else
1891                 bzr merge --pull "$@"
1892         fi
1893 cvs_update = cvs update "$@"
1894 hg_update  = hg pull "$@"; hg update "$@"
1895 darcs_update = darcs pull -a "$@"
1896 fossil_update = fossil pull "$@"
1897 vcsh_update = vcsh run "$MR_REPO" git pull "$@"
1898 veracity_update = vv pull "$@" && vv update "$@"
1899
1900 svn_status = svn status "$@"
1901 git_status = git status -s "$@" || true
1902 bzr_status = bzr status --short "$@"
1903 cvs_status = cvs status "$@"
1904 hg_status  = hg status "$@"
1905 darcs_status = darcs whatsnew -ls "$@" || true
1906 fossil_status = fossil changes "$@"
1907 vcsh_status = cd $(vcsh run "$MR_REPO" git config --get core.worktree); vcsh run "$MR_REPO" git status -s "$@" || true
1908 veracity_status = vv status "$@"
1909
1910 svn_commit = svn commit "$@"
1911 git_commit = git commit -a "$@" && git push --all
1912 bzr_commit = 
1913         if is_bzr_checkout; then
1914                 bzr commit "$@"
1915         else
1916                 bzr commit "$@" && bzr push
1917         fi
1918 cvs_commit = cvs commit "$@"
1919 hg_commit  = hg commit -m "$@" && hg push
1920 darcs_commit = darcs record -a -m "$@" && darcs push -a
1921 fossil_commit = fossil commit "$@"
1922 vcsh_commit = vcsh run "$MR_REPO" git commit -a "$@" && vcsh run "$MR_REPO" git push --all
1923 veracity_commit = vv commit -m "@" && vv push
1924
1925 git_record = git commit -a "$@"
1926 bzr_record =
1927         if is_bzr_checkout; then
1928                 bzr commit --local "$@"
1929         else
1930                 bzr commit "$@"
1931         fi
1932 hg_record  = hg commit -m "$@"
1933 darcs_record = darcs record -a -m "$@"
1934 fossil_record = fossil commit "$@"
1935 vcsh_record = vcsh run "$MR_REPO" git commit -a "$@"
1936 veracity_record = vv commit -m "@"
1937
1938 svn_push = :
1939 git_push = git push "$@"
1940 bzr_push = bzr push "$@"
1941 cvs_push = :
1942 hg_push = hg push "$@"
1943 darcs_push = darcs push -a "$@"
1944 fossil_push = fossil push "$@"
1945 vcsh_push = vcsh run "$MR_REPO" git push "$@"
1946 veracity_push = vv push "$@"
1947
1948 svn_diff = svn diff "$@"
1949 git_diff = git diff "$@"
1950 bzr_diff = bzr diff "$@"
1951 cvs_diff = cvs diff "$@"
1952 hg_diff  = hg diff "$@"
1953 darcs_diff = darcs diff -u "$@"
1954 fossil_diff = fossil diff "$@"
1955 vcsh_diff = vcsh run "$MR_REPO" git diff "$@"
1956 veracity_diff = vv diff "$@"
1957
1958 svn_log = svn log "$@"
1959 git_log = git log "$@"
1960 bzr_log = bzr log "$@"
1961 cvs_log = cvs log "$@"
1962 hg_log  = hg log "$@"
1963 darcs_log = darcs changes "$@"
1964 git_bare_log = git log "$@"
1965 fossil_log = fossil timeline "$@"
1966 vcsh_log = vcsh run "$MR_REPO" git log "$@"
1967 veracity_log = vv log "$@"
1968
1969 run = "$@"
1970
1971 svn_register =
1972         url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
1973         if [ -z "$url" ]; then
1974                 error "cannot determine svn url"
1975         fi
1976         echo "Registering svn url: $url in $MR_CONFIG"
1977         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1978 git_register = 
1979         url="`LC_ALL=C git config --get remote.origin.url`" || true
1980         if [ -z "$url" ]; then
1981                 error "cannot determine git url"
1982         fi
1983         echo "Registering git url: $url in $MR_CONFIG"
1984         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1985 bzr_register =
1986         url="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
1987         if [ -z "$url" ]; then
1988                 error "cannot determine bzr url"
1989         fi
1990         echo "Registering bzr url: $url in $MR_CONFIG"
1991         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr branch '$url' '$MR_REPO'"
1992 cvs_register =
1993         repo=`cat CVS/Repository`
1994         root=`cat CVS/Root`
1995         if [ -z "$root" ]; then
1996                 error "cannot determine cvs root"
1997                 fi
1998         echo "Registering cvs repository $repo at root $root"
1999         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
2000 hg_register = 
2001         url=`hg showconfig paths.default`
2002         echo "Registering mercurial repo url: $url in $MR_CONFIG"
2003         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
2004 darcs_register = 
2005         url=`cat _darcs/prefs/defaultrepo`
2006         echo "Registering darcs repository $url in $MR_CONFIG"
2007         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
2008 git_bare_register = 
2009         url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
2010         if [ -z "$url" ]; then
2011                 error "cannot determine git url"
2012         fi
2013         echo "Registering git url: $url in $MR_CONFIG"
2014         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
2015 vcsh_register =
2016         url="`LC_ALL=C vcsh run "$MR_REPO" git config --get remote.origin.url`" || true
2017         if [ -z "$url" ]; then
2018                 error "cannot determine git url"
2019         fi
2020         echo "Registering git url: $url in $MR_CONFIG"
2021         mr -c "$MR_CONFIG" config "`pwd`" checkout="vcsh clone '$url' '$MR_REPO'"
2022 fossil_register =
2023         url=`fossil remote-url`
2024         repo=`fossil info | grep repository | sed -e 's/repository:*.//g' -e 's/ //g'`
2025         echo "Registering fossil repository $url in $MR_CONFIG"
2026         mr -c "$MR_CONFIG" config "`pwd`" checkout="mkdir -p '$MR_REPO' && cd '$MR_REPO' && fossil open '$repo'"
2027 veracity_register =
2028         url=`vv config | grep sync_targets | sed -e 's/sync_targets:*.//g' -e 's/ //g'`
2029         repo=`vv repo info | grep repository | sed -e 's/Current repository:*.//g' -e 's/ //g'`
2030         echo "Registering veracity repository $url in $MR_CONFIG"
2031         mr -c "$MR_CONFIG" config "`pwd`" checkout="mkdir -p '$MR_REPO' && cd '$MR_REPO' && vv checkout '$repo'"
2032
2033 svn_trusted_checkout = svn co $url $repo
2034 svn_alt_trusted_checkout = svn checkout $url $repo
2035 git_trusted_checkout = git clone $url $repo
2036 bzr_trusted_checkout = bzr checkout|clone|branch|get $url $repo
2037 # cvs: too hard
2038 hg_trusted_checkout = hg clone $url $repo
2039 darcs_trusted_checkout = darcs get $url $repo
2040 git_bare_trusted_checkout = git clone --bare $url $repo
2041 vcsh_trusted_checkout = vcsh run "$MR_REPO" git clone $url $repo
2042 # fossil: messy to do
2043 veracity_trusted_checkout = vv clone $url $repo
2044
2045
2046 help =
2047         case `uname -s` in
2048                 SunOS)
2049                 SHOWMANFILE="man -f"
2050                 ;;
2051                 Darwin)
2052                 SHOWMANFILE="man"
2053                 ;;
2054                 *)
2055                 SHOWMANFILE="man -l"
2056                 ;;
2057         esac
2058         if [ ! -e "$MR_PATH" ]; then
2059                 error "cannot find program path"
2060         fi
2061         tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
2062         trap "rm -f $tmp" exit
2063         pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
2064         $SHOWMANFILE "$tmp" || error "man failed"
2065 list = true
2066 config = 
2067 bootstrap = 
2068
2069 online =
2070         if [ -s ~/.mrlog ]; then
2071                 info "running offline commands"
2072                 mv -f ~/.mrlog ~/.mrlog.old
2073                 if ! sh -e ~/.mrlog.old; then
2074                         error "offline command failed; left in ~/.mrlog.old"
2075                 fi
2076                 rm -f ~/.mrlog.old
2077         else
2078                 info "no offline commands to run"
2079         fi
2080 offline =
2081         umask 077
2082         touch ~/.mrlog
2083         info "offline mode enabled"
2084 remember =
2085         info "remembering command: 'mr $@'"
2086         command="mr -d '$(pwd)' $MR_SWITCHES"
2087         for w in "$@"; do
2088                 command="$command '$w'"
2089         done
2090         if [ ! -e ~/.mrlog ] || ! grep -q -F "$command" ~/.mrlog; then
2091                 echo "$command" >> ~/.mrlog
2092         fi
2093
2094 ed = echo "A horse is a horse, of course, of course.."
2095 T = echo "I pity the fool."
2096 right = echo "Not found."
2097
2098 # vim:sw=8:sts=0:ts=8:noet
2099 # Local variables:
2100 # indent-tabs-mode: t
2101 # cperl-indent-level: 8
2102 # End: