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

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