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

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