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

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