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

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