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

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