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

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