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

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