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

Update suggests for git-core to git transition.
[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] diff
20
21 B<mr> [options] log
22
23 B<mr> [options] bootstrap url [directory]
24
25 B<mr> [options] register [repository]
26
27 B<mr> [options] config section ["parameter=[value]" ...]
28
29 B<mr> [options] action [params ...]
30
31 B<mr> [options] [online|offline]
32
33 B<mr> [options] remember action [params ...]
34
35 =head1 DESCRIPTION
36
37 B<mr> is a Multiple Repository management tool. It can checkout, update, or
38 perform other actions on a set of repositories as if they were one combined
39 repository. It supports any combination of subversion, git, cvs, mercurial,
40 bzr and darcs repositories, and support for other revision control systems can
41 easily be added.
42
43 B<mr> cds into and operates on all registered repositories at or below your
44 working directory. Or, if you are in a subdirectory of a repository that
45 contains no other registered repositories, it will stay in that directory,
46 and work on only that repository,
47
48 B<mr> is configured by .mrconfig files, which list the repositories. It
49 starts by reading the .mrconfig file in your home directory, and this can
50 in turn chain load .mrconfig files from repositories.
51
52 These predefined commands should be fairly familiar to users of any revision
53 control system:
54
55 =over 4
56
57 =item checkout (or co)
58
59 Checks out any repositories that are not already checked out.
60
61 =item update
62
63 Updates each repository from its configured remote repository.
64
65 If a repository isn't checked out yet, it will first check it out.
66
67 =item status
68
69 Displays a status report for each repository, showing what
70 uncommitted changes are present in the repository.
71
72 =item commit (or ci)
73
74 Commits changes to each repository. (By default, changes are pushed to the
75 remote repository too, when using distributed systems like git. If you
76 don't like this default, you can change it in your .mrconfig, or use record
77 instead.)
78
79 The optional -m parameter allows specifying a commit message.
80
81 =item record
82
83 Records changes to the local repository, but does not push them to the
84 remote repository. Only supported for distributed revision control systems.
85
86 The optional -m parameter allows specifying a commit message.
87
88 =item push
89
90 Pushes committed local changes to the remote repository. A no-op for
91 centralized revision control systems.
92
93 =item diff
94
95 Show a diff of uncommitted changes.
96
97 =item log
98
99 Show the commit log.
100
101 =back
102
103 These commands are also available:
104
105 =over 4
106
107 =item bootstrap url [directory]
108
109 Causes mr to download the url, and use it as a .mrconfig file
110 to checkout the repositories listed in it, into the specified directory.
111
112 The directory will be created if it does not exist. If no directory is
113 specified, the current directory will be used.
114
115 If the .mrconfig file includes a repository named ".", that
116 is checked out into the top of the specified directory.
117
118 =item list (or ls)
119
120 List the repositories that mr will act on.
121
122 =item register
123
124 Register an existing repository in a mrconfig file. By default, the
125 repository in the current directory is registered, or you can specify a
126 directory to register.
127
128 The mrconfig file that is modified is chosen by either the -c option, or by
129 looking for the closest known one at or below the current directory.
130
131 =item config
132
133 Adds, modifies, removes, or prints a value from a mrconfig file. The next
134 parameter is the name of the section the value is in. To add or modify
135 values, use one or more instances of "parameter=value". Use "parameter=" to
136 remove a parameter. Use just "parameter" to get the value of a parameter.
137
138 For example, to add (or edit) a repository in src/foo:
139
140   mr config src/foo checkout="svn co svn://example.com/foo/trunk foo"
141
142 To show the command that mr uses to update the repository in src/foo:
143
144   mr config src/foo update
145
146 To see the built-in library of shell functions contained in mr:
147
148   mr config DEFAULT lib
149
150 The ~/.mrconfig file is used by default. To use a different config file,
151 use the -c option.
152
153 =item offline
154
155 Advises mr that it is in offline mode. Any commands that fail in
156 offline mode will be remembered, and retried when mr is told it's online.
157
158 =item online
159
160 Advices mr that it is in online mode again. Commands that failed while in
161 offline mode will be re-run.
162
163 =item remember
164
165 Remember a command, to be run later when mr re-enters online mode. This
166 implicitly puts mr into offline mode. The command can be any regular mr
167 command. This is useful when you know that a command will fail due to being
168 offline, and so don't want to run it right now at all, but just remember
169 to run it when you go back online.
170
171 =item help
172
173 Displays this help.
174
175 =back
176
177 Actions can be abbreviated to any unambiguous substring, so
178 "mr st" is equivalent to "mr status", and "mr up" is equivalent to "mr
179 update"
180
181 Additional parameters can be passed to most commands, and are passed on
182 unchanged to the underlying revision control system. This is mostly useful
183 if the repositories mr will act on all use the same revision control
184 system.
185
186 =head1 OPTIONS
187
188 =over 4
189
190 =item -d directory
191
192 =item --directory directory
193
194 Specifies the topmost directory that B<mr> should work in. The default is
195 the current working directory.
196
197 =item -c mrconfig
198
199 =item --config mrconfig
200
201 Use the specified mrconfig file. The default is B<~/.mrconfig>
202
203 =item -p
204
205 =item --path
206
207 Search in the current directory, and its parent directories and use
208 the first B<.mrconfig> found, instead of the default B<~/.mrconfig>.
209
210 =item -v
211
212 =item --verbose
213
214 Be verbose.
215
216 =item -q
217
218 =item --quiet
219
220 Be quiet.
221
222 =item -k
223
224 =item --insecure
225
226 Accept untrusted SSL certificates when bootstrapping.
227
228 =item -s
229
230 =item --stats
231
232 Expand the statistics line displayed at the end to include information
233 about exactly which repositories failed and were skipped, if any.
234
235 =item -i
236
237 =item --interactive
238
239 Interactive mode. If a repository fails to be processed, a subshell will be
240 started which you can use to resolve or investigate the problem. Exit the
241 subshell to continue the mr run.
242
243 =item -n [number]
244
245 =item --no-recurse [number]
246
247 If no number if specified, just operate on the repository for the current
248 directory, do not recurse into deeper repositories.
249
250 If a number is specified, will recurse into repositories at most that many
251 subdirectories deep. For example, with -n 2 it would recurse into ./src/foo,
252 but not ./src/packages/bar.
253
254 =item -j [number]
255
256 =item --jobs [number]
257
258 Run the specified number of jobs in parallel, or an unlimited number of jobs
259 with no number specified. This can greatly speed up operations such as updates.
260 It is not recommended for interactive operations.
261
262 Note that running more than 10 jobs at a time is likely to run afoul of
263 ssh connection limits. Running between 3 and 5 jobs at a time will yield
264 a good speedup in updates without loading the machine too much.
265
266 =item -t
267
268 =item --trust-all
269
270 Trust all mrconfig files even if they are not listed in ~/.mrtrust.
271 Use with caution.
272
273 =back
274
275 =head1 "MRCONFIG FILES"
276
277 Here is an example .mrconfig file:
278
279   [src]
280   checkout = svn co svn://svn.example.com/src/trunk src
281   chain = true
282
283   [src/linux-2.6]
284   checkout = git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git &&
285         cd linux-2.6 &&
286         git checkout -b mybranch origin/master
287
288 The .mrconfig file uses a variant of the INI file format. Lines starting with
289 "#" are comments. Values can be continued to the following line by
290 indenting the line with whitespace.
291
292 The "DEFAULT" section allows setting default values for the sections that
293 come after it.
294
295 The "ALIAS" section allows adding aliases for actions. Each parameter
296 is an alias, and its value is the action to use.
297
298 All other sections add repositories. The section header specifies the
299 directory where the repository is located. This is relative to the directory
300 that contains the mrconfig file, but you can also choose to use absolute
301 paths. (Note that you can use environment variables in section names; they
302 will be passed through the shell for expansion. For example, 
303 "[$HOSTNAME]", or "[${HOSTNAME}foo]")
304
305 Within a section, each parameter defines a shell command to run to handle a
306 given action. mr contains default handlers for "update", "status",
307 "commit", and other standard actions. Normally you only need to specify what
308 to do for "checkout".
309
310 Note that these shell commands are run in a "set -e" shell
311 environment, where any additional parameters you pass are available in
312 "$@". The "checkout" command is run in the parent of the repository
313 directory, since the repository isn't checked out yet. All other commands
314 are run inside the repository, though not necessarily at the top of it.
315
316 The "MR_REPO" environment variable is set to the path to the top of the
317 repository. (For the "register" action, "MR_REPO" is instead set to the 
318 basename of the directory that should be created when checking the
319 repository out.)
320
321 The "MR_CONFIG" environment variable is set to the .mrconfig file
322 that defines the repo being acted on, or, if the repo is not yet in a config
323 file, the .mrconfig file that should be modified to register the repo.
324
325 A few parameters have special meanings:
326
327 =over 4
328
329 =item skip
330
331 If the "skip" parameter is set and its command returns true, then B<mr>
332 will skip acting on that repository. The command is passed the action
333 name in $1.
334
335 Here are two examples. The first skips the repo unless
336 mr is run by joey. The second uses the hours_since function
337 (included in mr's built-in library) to skip updating the repo unless it's
338 been at least 12 hours since the last update.
339
340   skip = test `whoami` != joey
341   skip = [ "$1" = update ] && ! hours_since "$1" 12
342
343 =item order
344
345 The "order" parameter can be used to override the default ordering of
346 repositories. The default order value is 10. Use smaller values to make
347 repositories be processed earlier, and larger values to make repositories
348 be processed later.
349
350 Note that if a repository is located in a subdirectory of another
351 repository, ordering it to be processed earlier is not recommended.
352
353 =item chain
354
355 If the "chain" parameter is set and its command returns true, then B<mr>
356 will try to load a .mrconfig file from the root of the repository.
357
358 =item include
359
360 If the "include" parameter is set, its command is ran, and should output
361 additional mrconfig file content. The content is included as if it were
362 part of the including file.
363
364 Unlike all other parameters, this parameter does not need to be placed
365 within a section.
366
367 =item lib
368
369 The "lib" parameter can specify some shell code that will be run before each
370 command, this can be a useful way to define shell functions for other commands
371 to use.
372
373 =back
374
375 When looking for a command to run for a given action, mr first looks for
376 a parameter with the same name as the action. If that is not found, it
377 looks for a parameter named "rcs_action" (substituting in the name of the
378 revision control system and the action). The name of the revision control
379 system is itself determined by running each defined "rcs_test" action,
380 until one succeeds.
381
382 Internally, mr has settings for "git_update", "svn_update", etc. To change
383 the action that is performed for a given revision control system, you can
384 override these rcs specific actions. To add a new revision control system,
385 you can just add rcs specific actions for it.
386
387 The ~/.mrlog file contains commands that mr has remembered to run later,
388 due to being offline. You can delete or edit this file to remove commands,
389 or even to add other commands for 'mr online' to run. If the file is
390 present, mr assumes it is in offline mode.
391
392 =head1 "UNTRUSTED MRCONFIG FILES"
393
394 Since mrconfig files can contain arbitrary shell commands, they can do
395 anything. This flexability is good, but it also allows a malicious mrconfig
396 file to delete your whole home directory. Such a file might be contained
397 inside a repository that your main ~/.mrconfig checks out and chains to. To
398 avoid worries about evil commands in a mrconfig file, mr
399 has the ability to read mrconfig files in untrusted mode. Such files are
400 limited to running only known safe commands (like "git clone") in a
401 carefully checked manner.
402
403 By default, mr trusts all mrconfig files. (This default will change in a
404 future release!) But if you have a ~/.mrtrust file, mr will only trust
405 mrconfig files that are listed within it. (One file per line.) All other
406 files will be treated as untrusted.
407
408 =head1 EXTENSIONS
409
410 mr can be extended to support things such as unison and git-svn. Some
411 files providing such extensions are available in /usr/share/mr/. See
412 the documentation in the files for details about using them.
413
414 =head1 AUTHOR
415
416 Copyright 2007-2009 Joey Hess <joey@kitenet.net>
417
418 Licensed under the GNU GPL version 2 or higher.
419
420 http://kitenet.net/~joey/code/mr/
421
422 =cut
423
424 use warnings;
425 use strict;
426 use Getopt::Long;
427 use Cwd qw(getcwd abs_path);
428
429 # things that can happen when mr runs a command
430 use constant {
431         OK => 0,
432         FAILED => 1,
433         SKIPPED => 2,
434         ABORT => 3,
435 };
436
437 # configurables
438 my $config_overridden=0;
439 my $verbose=0;
440 my $quiet=0;
441 my $stats=0;
442 my $insecure=0;
443 my $interactive=0;
444 my $max_depth;
445 my $no_chdir=0;
446 my $jobs=1;
447 my $trust_all=0;
448 my $directory=getcwd();
449 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
450
451 # globals :-(
452 my %config;
453 my %configfiles;
454 my %knownactions;
455 my %alias;
456 my (@ok, @failed, @skipped);
457
458 main();
459
460 my %rcs;
461 sub rcs_test {
462         my ($action, $dir, $topdir, $subdir) = @_;
463
464         if (exists $rcs{$dir}) {
465                 return $rcs{$dir};
466         }
467
468         my $test="set -e\n";
469         foreach my $rcs_test (
470                         sort {
471                                 length $a <=> length $b 
472                                           ||
473                                        $a cmp $b
474                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
475                 my ($rcs)=$rcs_test=~/(.*)_test/;
476                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
477                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
478         }
479         $test=$config{$topdir}{$subdir}{lib}."\n".$test
480                 if exists $config{$topdir}{$subdir}{lib};
481         
482         print "mr $action: running rcs test >>$test<<\n" if $verbose;
483         my $rcs=`$test`;
484         chomp $rcs;
485         if ($rcs=~/\n/s) {
486                 $rcs=~s/\n/, /g;
487                 print STDERR "mr $action: found multiple possible repository types ($rcs) for $topdir$subdir\n";
488                 return undef;
489         }
490         if (! length $rcs) {
491                 return $rcs{$dir}=undef;
492         }
493         else {
494                 return $rcs{$dir}=$rcs;
495         }
496 }
497         
498 sub findcommand {
499         my ($action, $dir, $topdir, $subdir, $is_checkout) = @_;
500         
501         if (exists $config{$topdir}{$subdir}{$action}) {
502                 return $config{$topdir}{$subdir}{$action};
503         }
504
505         if ($is_checkout) {
506                 return undef;
507         }
508
509         my $rcs=rcs_test(@_);
510
511         if (defined $rcs && 
512             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
513                 return $config{$topdir}{$subdir}{$rcs."_".$action};
514         }
515         else {
516                 return undef;
517         }
518 }
519
520 sub action {
521         my ($action, $dir, $topdir, $subdir, $force_checkout) = @_;
522         
523         $ENV{MR_CONFIG}=$configfiles{$topdir};
524         my $lib=exists $config{$topdir}{$subdir}{lib} ?
525                        $config{$topdir}{$subdir}{lib}."\n" : "";
526         my $is_checkout=($action eq 'checkout');
527
528         $ENV{MR_REPO}=$dir;
529
530         if ($is_checkout) {
531                 if (! $force_checkout) {
532                         if (-d $dir) {
533                                 print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
534                                 return SKIPPED;
535                         }
536         
537                         $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
538                 }
539         }
540         elsif ($action =~ /update/) {
541                 if (! -d $dir) {
542                         return action("checkout", $dir, $topdir, $subdir);
543                 }
544         }
545
546         my $skiptest=findcommand("skip", $dir, $topdir, $subdir, $is_checkout);
547         my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
548
549         if (defined $skiptest) {
550                 my $test="set -e;".$lib.
551                         "my_action(){ $skiptest\n }; my_action '$action'";
552                 print "mr $action: running skip test >>$test<<\n" if $verbose;
553                 my $ret=system($test);
554                 if ($ret != 0) {
555                         if (($? & 127) == 2) {
556                                 print STDERR "mr $action: interrupted\n";
557                                 return ABORT;
558                         }
559                         elsif ($? & 127) {
560                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
561                                 return ABORT;
562                         }
563                 }
564                 if ($ret >> 8 == 0) {
565                         print "mr $action: $dir skipped per config file\n" if $verbose;
566                         return SKIPPED;
567                 }
568         }
569
570         if ($is_checkout && ! -d $dir) {
571                 print "mr $action: creating parent directory $dir\n" if $verbose;
572                 system("mkdir", "-p", $dir);
573         }
574
575         if (! $no_chdir && ! chdir($dir)) {
576                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
577                 return FAILED;
578         }
579         elsif (! defined $command) {
580                 my $rcs=rcs_test(@_);
581                 if (! defined $rcs) {
582                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
583                         return FAILED;
584                 }
585                 else {
586                         print STDERR "mr $action: no defined action for $rcs repository $topdir$subdir, skipping\n";
587                         return SKIPPED;
588                 }
589         }
590         else {
591                 if (! $no_chdir) {
592                         print "mr $action: $topdir$subdir\n" unless $quiet;
593                 }
594                 else {
595                         my $s=$directory;
596                         $s=~s/^\Q$topdir$subdir\E\/?//;
597                         print "mr $action: $topdir$subdir (in subdir $s)\n" unless $quiet;
598                 }
599                 $command="set -e; ".$lib.
600                         "my_action(){ $command\n }; my_action ".
601                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
602                 print "mr $action: running >>$command<<\n" if $verbose;
603                 my $ret=system($command);
604                 if ($ret != 0) {
605                         if (($? & 127) == 2) {
606                                 print STDERR "mr $action: interrupted\n";
607                                 return ABORT;
608                         }
609                         elsif ($? & 127) {
610                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
611                                 return ABORT;
612                         }
613                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
614                         if ($ret >> 8 != 0) {
615                                 print STDERR "mr $action: command failed\n";
616                                 if (-e "$ENV{HOME}/.mrlog" && $action ne 'remember') {
617                                         # recreate original command line to
618                                         # remember, and avoid recursing
619                                         my @orig=@ARGV;
620                                         @ARGV=('-n', $action, @orig);
621                                         action("remember", $dir, $topdir, $subdir);
622                                         @ARGV=@orig;
623                                 }
624                         }
625                         elsif ($ret != 0) {
626                                 print STDERR "mr $action: command died ($ret)\n";
627                         }
628                         return FAILED;
629                 }
630                 else {
631                         if ($action eq 'checkout' && ! -d $dir) {
632                                 print STDERR "mr $action: $dir missing after checkout\n";;
633                                 return FAILED;
634                         }
635
636                         return OK;
637                 }
638         }
639 }
640
641 # run actions on multiple repos, in parallel
642 sub mrs {
643         my $action=shift;
644         my @repos=@_;
645
646         $| = 1;
647         my @active;
648         my @fhs;
649         my @out;
650         my $running=0;
651         while (@fhs or @repos) {
652                 while ((!$jobs || $running < $jobs) && @repos) {
653                         $running++;
654                         my $repo = shift @repos;
655                         pipe(my $outfh, CHILD_STDOUT);
656                         pipe(my $errfh, CHILD_STDERR);
657                         my $pid;
658                         unless ($pid = fork) {
659                                 die "mr $action: cannot fork: $!" unless defined $pid;
660                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
661                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
662                                 close CHILD_STDOUT;
663                                 close CHILD_STDERR;
664                                 close $outfh;
665                                 close $errfh;
666                                 exit action($action, @$repo);
667                         }
668                         close CHILD_STDOUT;
669                         close CHILD_STDERR;
670                         push @active, [$pid, $repo];
671                         push @fhs, [$outfh, $errfh];
672                         push @out, ['',     ''];
673                 }
674                 my ($rin, $rout) = ('','');
675                 my $nfound;
676                 foreach my $fh (@fhs) {
677                         next unless defined $fh;
678                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
679                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
680                 }
681                 $nfound = select($rout=$rin, undef, undef, 1);
682                 foreach my $channel (0, 1) {
683                         foreach my $i (0..$#fhs) {
684                                 next unless defined $fhs[$i];
685                                 my $fh = $fhs[$i][$channel];
686                                 next unless defined $fh;
687                                 if (vec($rout, fileno($fh), 1) == 1) {
688                                         my $r = '';
689                                         if (sysread($fh, $r, 1024) == 0) {
690                                                 close($fh);
691                                                 $fhs[$i][$channel] = undef;
692                                                 if (! defined $fhs[$i][0] &&
693                                                     ! defined $fhs[$i][1]) {
694                                                         waitpid($active[$i][0], 0);
695                                                         print STDOUT $out[$i][0];
696                                                         print STDERR $out[$i][1];
697                                                         record($active[$i][1], $? >> 8);
698                                                         splice(@fhs, $i, 1);
699                                                         splice(@active, $i, 1);
700                                                         splice(@out, $i, 1);
701                                                         $running--;
702                                                 }
703                                         }
704                                         $out[$i][$channel] .= $r;
705                                 }
706                         }
707                 }
708         }
709 }
710
711 sub record {
712         my $dir=shift()->[0];
713         my $ret=shift;
714
715         if ($ret == OK) {
716                 push @ok, $dir;
717                 print "\n" unless $quiet;
718         }
719         elsif ($ret == FAILED) {
720                 if ($interactive) {
721                         chdir($dir) unless $no_chdir;
722                         print STDERR "mr: Starting interactive shell. Exit shell to continue.\n";
723                         system((getpwuid($<))[8], "-i");
724                 }
725                 push @failed, $dir;
726                 print "\n" unless $quiet;
727         }
728         elsif ($ret == SKIPPED) {
729                 push @skipped, $dir;
730         }
731         elsif ($ret == ABORT) {
732                 exit 1;
733         }
734         else {
735                 die "unknown exit status $ret";
736         }
737 }
738
739 sub showstats {
740         my $action=shift;
741         if (! @ok && ! @failed && ! @skipped) {
742                 die "mr $action: no repositories found to work on\n";
743         }
744         print "mr $action: finished (".join("; ",
745                 showstat($#ok+1, "ok", "ok"),
746                 showstat($#failed+1, "failed", "failed"),
747                 showstat($#skipped+1, "skipped", "skipped"),
748         ).")\n" unless $quiet;
749         if ($stats) {
750                 if (@skipped) {
751                         print "mr $action: (skipped: ".join(" ", @skipped).")\n" unless $quiet;
752                 }
753                 if (@failed) {
754                         print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
755                 }
756         }
757 }
758
759 sub showstat {
760         my $count=shift;
761         my $singular=shift;
762         my $plural=shift;
763         if ($count) {
764                 return "$count ".($count > 1 ? $plural : $singular);
765         }
766         return;
767 }
768
769 # an ordered list of repos
770 sub repolist {
771         my @list;
772         foreach my $topdir (sort keys %config) {
773                 foreach my $subdir (sort keys %{$config{$topdir}}) {
774                         push @list, {
775                                 topdir => $topdir,
776                                 subdir => $subdir,
777                                 order => $config{$topdir}{$subdir}{order},
778                         };
779                 }
780         }
781         return sort {
782                 $a->{order}  <=> $b->{order}
783                              ||
784                 $a->{topdir} cmp $b->{topdir}
785                              ||
786                 $a->{subdir} cmp $b->{subdir}
787         } @list;
788 }
789
790 sub repodir {
791         my $repo=shift;
792         my $topdir=$repo->{topdir};
793         my $subdir=$repo->{subdir};
794         my $ret=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
795         $ret=~s/\/\.$//;
796         return $ret;
797 }
798
799 # figure out which repos to act on
800 sub selectrepos {
801         my @repos;
802         foreach my $repo (repolist()) {
803                 my $topdir=$repo->{topdir};
804                 my $subdir=$repo->{subdir};
805
806                 next if $subdir eq 'DEFAULT';
807                 my $dir=repodir($repo);
808                 my $d=$directory;
809                 $dir.="/" unless $dir=~/\/$/;
810                 $d.="/" unless $d=~/\/$/;
811                 next if $dir ne $d && $dir !~ /^\Q$d\E/;
812                 if (defined $max_depth) {
813                         my @a=split('/', $dir);
814                         my @b=split('/', $d);
815                         do { } while (@a && @b && shift(@a) eq shift(@b));
816                         next if @a > $max_depth || @b > $max_depth;
817                 }
818                 push @repos, [$dir, $topdir, $subdir];
819         }
820         if (! @repos) {
821                 # fallback to find a leaf repo
822                 foreach my $repo (reverse repolist()) {
823                         my $topdir=$repo->{topdir};
824                         my $subdir=$repo->{subdir};
825                         
826                         next if $subdir eq 'DEFAULT';
827                         my $dir=repodir($repo);
828                         my $d=$directory;
829                         $dir.="/" unless $dir=~/\/$/;
830                         $d.="/" unless $d=~/\/$/;
831                         if ($d=~/^\Q$dir\E/) {
832                                 push @repos, [$dir, $topdir, $subdir];
833                                 last;
834                         }
835                 }
836                 $no_chdir=1;
837         }
838         return @repos;
839 }
840
841 sub expandenv {
842         my $val=shift;
843         
844
845         if ($val=~/\$/) {
846                 $val=`echo "$val"`;
847                 chomp $val;
848         }
849         
850         return $val;
851 }
852
853 my %trusted;
854 sub is_trusted_config {
855         my $config=shift; # must be abs_pathed already
856
857         # We always trust ~/.mrconfig.
858         return 1 if $config eq abs_path("$ENV{HOME}/.mrconfig");
859
860         return 1 if $trust_all;
861
862         my $trustfile=$ENV{HOME}."/.mrtrust";
863
864         if (! -e $trustfile) {
865                 print "mr: Assuming $config is trusted.\n";
866                 print "mr: For better security, you are encouraged to create ~/.mrtrust\n";
867                 print "mr: and list all trusted mrconfig files in it.\n";
868                 return 1;
869         }
870
871         if (! %trusted) {
872                 $trusted{"$ENV{HOME}/.mrconfig"}=1;
873                 open (TRUST, "<", $trustfile) || die "$trustfile: $!";
874                 while (<TRUST>) {
875                         chomp;
876                         s/^~\//$ENV{HOME}\//;
877                         $trusted{abs_path($_)}=1;
878                 }
879                 close TRUST;
880         }
881
882         return $trusted{$config};
883 }
884
885
886 sub is_trusted_repo {
887         my $repo=shift;
888         
889         # Tightly limit what is allowed in a repo name.
890         # No ../, no absolute paths, and no unusual filenames
891         # that might try to escape to the shell.
892         return $repo =~ /^[-_.+\/A-Za-z0-9]+$/ &&
893                $repo !~ /\.\./ && $repo !~ /^\//;
894 }
895
896 sub is_trusted_checkout {
897         my $command=shift;
898         
899         # To determine if the command is safe, compare it with the
900         # *_trusted_checkout config settings. Those settings are
901         # templates for allowed commands, so make sure that each word
902         # of the command matches the corresponding word of the template.
903         
904         my @words;
905         foreach my $word (split(' ', $command)) {
906                 # strip quoting
907                 if ($word=~/^'(.*)'$/) {
908                         $word=$1;
909                 }
910                 elsif ($word=~/^"(.*)"$/) {
911                         $word=$1;
912                 }
913
914                 push @words, $word;
915         }
916
917         foreach my $key (grep { /_trusted_checkout$/ }
918                          keys %{$config{''}{DEFAULT}}) {
919                 my @twords=split(' ', $config{''}{DEFAULT}{$key});
920                 next if @words > @twords;
921
922                 my $match=1;
923                 my $url;
924                 for (my $c=0; $c < @twords && $match; $c++) {
925                         if ($twords[$c] eq '$url') {
926                                 # Match all the typical characters found in
927                                 # urls, plus @ which svn can use. Note
928                                 # that the "url" might also be a local
929                                 # directory.
930                                 $match=(
931                                         defined $words[$c] &&
932                                         $words[$c] =~ /^[-_.+:@\/A-Za-z0-9]+$/
933                                 );
934                                 $url=$words[$c];
935                         }
936                         elsif ($twords[$c] eq '$repo') {
937                                 # If a repo is not specified, assume it
938                                 # will be the last path component of the
939                                 # url, or something derived from it, and
940                                 # check that.
941                                 if (! defined $words[$c] && defined $url) {
942                                         ($words[$c])=$url=~/\/([^\/]+)\/?$/;
943                                 }
944
945                                 $match=(
946                                         defined $words[$c] &&
947                                         is_trusted_repo($words[$c])
948                                 );
949                         }
950                         elsif (defined $words[$c] && $twords[$c] eq $words[$c]) {
951                                 $match=1;
952                         }
953                         else {
954                                 $match=0;
955                         }
956                 }
957                 return 1 if $match;
958         }
959
960         return 0;
961 }
962
963 my %loaded;
964 sub loadconfig {
965         my $f=shift;
966         my $dir=shift;
967
968         my @toload;
969
970         my $in;
971         my $trusted;
972         if (ref $f eq 'GLOB') {
973                 $dir="";
974                 $in=$f;
975                 $trusted=1;
976         }
977         else {
978                 if (! -e $f) {
979                         return;
980                 }
981
982                 my $absf=abs_path($f);
983                 if ($loaded{$absf}) {
984                         return;
985                 }
986                 $loaded{$absf}=1;
987
988                 $trusted=is_trusted_config($absf);
989
990                 if (! defined $dir) {
991                         ($dir)=$f=~/^(.*\/)[^\/]+$/;
992                         if (! defined $dir) {
993                                 $dir=".";
994                         }
995                 }
996
997                 $dir=abs_path($dir)."/";
998                 
999                 if (! exists $configfiles{$dir}) {
1000                         $configfiles{$dir}=$f;
1001                 }
1002
1003                 # copy in defaults from first parent
1004                 my $parent=$dir;
1005                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
1006                         if ($parent eq '/') {
1007                                 $parent="";
1008                         }
1009                         if (exists $config{$parent} &&
1010                             exists $config{$parent}{DEFAULT}) {
1011                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
1012                                 last;
1013                         }
1014                 }
1015                 
1016                 print "mr: loading config $f\n" if $verbose;
1017                 open($in, "<", $f) || die "mr: open $f: $!\n";
1018         }
1019         my @lines=<$in>;
1020         close $in unless ref $f eq 'GLOB';
1021
1022         my $section;
1023         my $line=0;
1024         while (@lines) {
1025                 $_=shift @lines;
1026                 $line++;
1027                 chomp;
1028                 next if /^\s*\#/ || /^\s*$/;
1029                 if (/^\[([^\]]*)\]\s*$/) {
1030                         $section=$1;
1031
1032                         if (! $trusted) {
1033                                 if (! is_trusted_repo($section) ||
1034                                     $section eq 'ALIAS' ||
1035                                     $section eq 'DEFAULT') {
1036                                         die "mr: illegal section \"[$section]\" in untrusted $f line $line\n";
1037                                 }
1038                         }
1039                         $section=expandenv($section) if $trusted;
1040                         if ($section ne 'ALIAS' &&
1041                             ! exists $config{$dir}{$section} &&
1042                             exists $config{$dir}{DEFAULT}) {
1043                                 # copy in defaults
1044                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
1045                         }
1046                 }
1047                 elsif (/^(\w+)\s*=\s*(.*)/) {
1048                         my $parameter=$1;
1049                         my $value=$2;
1050
1051                         # continued value
1052                         while (@lines && $lines[0]=~/^\s(.+)/) {
1053                                 shift(@lines);
1054                                 $line++;
1055                                 $value.="\n$1";
1056                                 chomp $value;
1057                         }
1058
1059                         if (! $trusted) {
1060                                 # Untrusted files can only contain checkout
1061                                 # parameters.
1062                                 if ($parameter ne 'checkout') {
1063                                         die "mr: illegal setting \"$parameter=$value\" in untrusted $f line $line\n";
1064                                 }
1065                                 if (! is_trusted_checkout($value)) {
1066                                         die "mr: illegal checkout command \"$value\" in untrusted $f line $line\n";
1067                                 }
1068                         }
1069
1070                         if ($parameter eq "include") {
1071                                 print "mr: including output of \"$value\"\n" if $verbose;
1072                                 unshift @lines, `$value`;
1073                                 if ($?) {
1074                                         print STDERR "mr: include command exited nonzero ($?)\n";
1075                                 }
1076                                 next;
1077                         }
1078
1079                         if (! defined $section) {
1080                                 die "$f line $.: parameter ($parameter) not in section\n";
1081                         }
1082                         if ($section eq 'ALIAS') {
1083                                 $alias{$parameter}=$value;
1084                         }
1085                         elsif ($parameter eq 'lib') {
1086                                 $config{$dir}{$section}{lib}.=$value."\n";
1087                         }
1088                         else {
1089                                 $config{$dir}{$section}{$parameter}=$value;
1090                                 if ($parameter =~ /.*_(.*)/) {
1091                                         $knownactions{$1}=1;
1092                                 }
1093                                 else {
1094                                         $knownactions{$parameter}=1;
1095                                 }
1096                                 if ($parameter eq 'chain' &&
1097                                     length $dir && $section ne "DEFAULT" &&
1098                                     -e $dir.$section."/.mrconfig") {
1099                                         my $ret=system($value);
1100                                         if ($ret != 0) {
1101                                                 if (($? & 127) == 2) {
1102                                                         print STDERR "mr: chain test interrupted\n";
1103                                                         exit 2;
1104                                                 }
1105                                                 elsif ($? & 127) {
1106                                                         print STDERR "mr: chain test received signal ".($? & 127)."\n";
1107                                                 }
1108                                         }
1109                                         else {
1110                                                 push @toload, $dir.$section."/.mrconfig";
1111                                         }
1112                                 }
1113                         }
1114                 }
1115                 else {
1116                         die "$f line $line: parse error\n";
1117                 }
1118         }
1119
1120         foreach (@toload) {
1121                 loadconfig($_);
1122         }
1123 }
1124
1125 sub startingconfig {
1126         %alias=%config=%configfiles=%knownactions=%loaded=();
1127         my $datapos=tell(DATA);
1128         loadconfig(\*DATA);
1129         seek(DATA,$datapos,0); # rewind
1130 }
1131
1132 sub modifyconfig {
1133         my $f=shift;
1134         # the section to modify or add
1135         my $targetsection=shift;
1136         # fields to change in the section
1137         # To remove a field, set its value to "".
1138         my %changefields=@_;
1139
1140         my @lines;
1141         my @out;
1142
1143         if (-e $f) {
1144                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
1145                 @lines=<$in>;
1146                 close $in;
1147         }
1148
1149         my $formatfield=sub {
1150                 my $field=shift;
1151                 my @value=split(/\n/, shift);
1152
1153                 return "$field = ".shift(@value)."\n".
1154                         join("", map { "\t$_\n" } @value);
1155         };
1156         my $addfields=sub {
1157                 my @blanks;
1158                 while ($out[$#out] =~ /^\s*$/) {
1159                         unshift @blanks, pop @out;
1160                 }
1161                 foreach my $field (sort keys %changefields) {
1162                         if (length $changefields{$field}) {
1163                                 push @out, "$field = $changefields{$field}\n";
1164                                 delete $changefields{$field};
1165                         }
1166                 }
1167                 push @out, @blanks;
1168         };
1169
1170         my $section;
1171         while (@lines) {
1172                 $_=shift(@lines);
1173
1174                 if (/^\s*\#/ || /^\s*$/) {
1175                         push @out, $_;
1176                 }
1177                 elsif (/^\[([^\]]*)\]\s*$/) {
1178                         if (defined $section && 
1179                             $section eq $targetsection) {
1180                                 $addfields->();
1181                         }
1182
1183                         $section=expandenv($1);
1184
1185                         push @out, $_;
1186                 }
1187                 elsif (/^(\w+)\s*=\s(.*)/) {
1188                         my $parameter=$1;
1189                         my $value=$2;
1190
1191                         # continued value
1192                         while (@lines && $lines[0]=~/^\s(.+)/) {
1193                                 shift(@lines);
1194                                 $value.="\n$1";
1195                                 chomp $value;
1196                         }
1197
1198                         if ($section eq $targetsection) {
1199                                 if (exists $changefields{$parameter}) {
1200                                         if (length $changefields{$parameter}) {
1201                                                 $value=$changefields{$parameter};
1202                                         }
1203                                         delete $changefields{$parameter};
1204                                 }
1205                         }
1206
1207                         push @out, $formatfield->($parameter, $value);
1208                 }
1209         }
1210
1211         if (defined $section && 
1212             $section eq $targetsection) {
1213                 $addfields->();
1214         }
1215         elsif (%changefields) {
1216                 push @out, "\n[$targetsection]\n";
1217                 foreach my $field (sort keys %changefields) {
1218                         if (length $changefields{$field}) {
1219                                 push @out, $formatfield->($field, $changefields{$field});
1220                         }
1221                 }
1222         }
1223
1224         open(my $out, ">", $f) || die "mr: write $f: $!\n";
1225         print $out @out;
1226         close $out;     
1227 }
1228
1229 sub dispatch {
1230         my $action=shift;
1231
1232         # actions that do not operate on all repos
1233         if ($action eq 'help') {
1234                 help(@ARGV);
1235         }
1236         elsif ($action eq 'config') {
1237                 config(@ARGV);
1238         }
1239         elsif ($action eq 'register') {
1240                 register(@ARGV);
1241         }
1242         elsif ($action eq 'bootstrap') {
1243                 bootstrap();
1244         }
1245         elsif ($action eq 'remember' ||
1246                $action eq 'offline' ||
1247                $action eq 'online') {
1248                 my @repos=selectrepos;
1249                 action($action, @{$repos[0]}) if @repos;
1250                 exit 0;
1251         }
1252
1253         if (!$jobs || $jobs > 1) {
1254                 mrs($action, selectrepos());
1255         }
1256         else {
1257                 foreach my $repo (selectrepos()) {
1258                         record($repo, action($action, @$repo));
1259                 }
1260         }
1261 }
1262
1263 sub help {
1264         exec($config{''}{DEFAULT}{help}) || die "exec: $!";
1265 }
1266
1267 sub config {
1268         if (@_ < 2) {
1269                 die "mr config: not enough parameters\n";
1270         }
1271         my $section=shift;
1272         if ($section=~/^\//) {
1273                 # try to convert to a path relative to the config file
1274                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
1275                 $dir=abs_path($dir);
1276                 $dir.="/" unless $dir=~/\/$/;
1277                 if ($section=~/^\Q$dir\E(.*)/) {
1278                         $section=$1;
1279                 }
1280         }
1281         my %changefields;
1282         foreach (@_) {
1283                 if (/^([^=]+)=(.*)$/) {
1284                         $changefields{$1}=$2;
1285                 }
1286                 else {
1287                         my $found=0;
1288                         foreach my $topdir (sort keys %config) {
1289                                 if (exists $config{$topdir}{$section} &&
1290                                     exists $config{$topdir}{$section}{$_}) {
1291                                         print $config{$topdir}{$section}{$_}."\n";
1292                                         $found=1;
1293                                         last if $section eq 'DEFAULT';
1294                                 }
1295                         }
1296                         if (! $found) {
1297                                 die "mr config: $section $_ not set\n";
1298                         }
1299                 }
1300         }
1301         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
1302         exit 0;
1303 }
1304
1305 sub register {
1306         if ($config_overridden) {
1307                 # Find the directory that the specified config file is
1308                 # located in.
1309                 ($directory)=abs_path($ENV{MR_CONFIG})=~/^(.*\/)[^\/]+$/;
1310         }
1311         else {
1312                 # Find the closest known mrconfig file to the current
1313                 # directory.
1314                 $directory.="/" unless $directory=~/\/$/;
1315                 my $foundconfig=0;
1316                 foreach my $topdir (reverse sort keys %config) {
1317                         next unless length $topdir;
1318                         if ($directory=~/^\Q$topdir\E/) {
1319                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1320                                 $directory=$topdir;
1321                                 $foundconfig=1;
1322                                 last;
1323                         }
1324                 }
1325                 if (! $foundconfig) {
1326                         $directory=""; # no config file, use builtin
1327                 }
1328         }
1329         if (@ARGV) {
1330                 my $subdir=shift @ARGV;
1331                 if (! chdir($subdir)) {
1332                         print STDERR "mr register: failed to chdir to $subdir: $!\n";
1333                 }
1334         }
1335
1336         $ENV{MR_REPO}=getcwd();
1337         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
1338         if (! defined $command) {
1339                 die "mr register: unknown repository type\n";
1340         }
1341
1342         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1343         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1344                 "my_action(){ $command\n }; my_action ".
1345                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1346         print "mr register: running >>$command<<\n" if $verbose;
1347         exec($command) || die "exec: $!";
1348 }
1349
1350 sub bootstrap {
1351         my $url=shift @ARGV;
1352         my $dir=shift @ARGV || ".";
1353         
1354         if (! defined $url || ! length $url) {
1355                 die "mr: bootstrap requires url\n";
1356         }
1357         
1358         # Download the config file to a temporary location.
1359         eval q{use File::Temp};
1360         die $@ if $@;
1361         my $tmpconfig=File::Temp->new();
1362         my @curlargs = ("curl", "-A", "mr", "-L", "-s", $url, "-o", $tmpconfig);
1363         push(@curlargs, "-k") if $insecure;
1364         my $curlstatus = system(@curlargs);
1365         die "mr bootstrap: invalid SSL certificate for $url (consider -k)\n" if $curlstatus >> 8 == 60;
1366         die "mr bootstrap: download of $url failed\n" if $curlstatus != 0;
1367
1368         if (! -e $dir) {
1369                 system("mkdir", "-p", $dir);
1370         }
1371         chdir($dir) || die "chdir $dir: $!";
1372
1373         # Special case to handle checkout of the "." repo, which 
1374         # would normally be skipped.
1375         my $topdir=abs_path(".")."/";
1376         my @repo=($topdir, $topdir, ".");
1377         loadconfig($tmpconfig, $topdir);
1378         record(\@repo, action("checkout", @repo, 1))
1379                 if exists $config{$topdir}{"."}{"checkout"};
1380
1381         if (-e ".mrconfig") {
1382                 print STDERR "mr bootstrap: .mrconfig file already exists, not overwriting with $url\n";
1383         }
1384         else {
1385                 eval q{use File::Copy};
1386                 die $@ if $@;
1387                 move($tmpconfig, ".mrconfig") || die "rename: $!";
1388         }
1389
1390         # Reload the config file (in case we got a different version)
1391         # and checkout everything else.
1392         startingconfig();
1393         loadconfig(".mrconfig");
1394         dispatch("checkout");
1395         @skipped=grep { abs_path($_) ne abs_path($topdir) } @skipped;
1396         showstats("bootstrap");
1397         exitstats();
1398 }
1399
1400 # alias expansion and command stemming
1401 sub expandaction {
1402         my $action=shift;
1403         if (exists $alias{$action}) {
1404                 $action=$alias{$action};
1405         }
1406         if (! exists $knownactions{$action}) {
1407                 my @matches = grep { /^\Q$action\E/ }
1408                         keys %knownactions, keys %alias;
1409                 if (@matches == 1) {
1410                         $action=$matches[0];
1411                 }
1412                 elsif (@matches == 0) {
1413                         die "mr: unknown action \"$action\" (known actions: ".
1414                                 join(", ", sort keys %knownactions).")\n";
1415                 }
1416                 else {
1417                         die "mr: ambiguous action \"$action\" (matches: ".
1418                                 join(", ", @matches).")\n";
1419                 }
1420         }
1421         return $action;
1422 }
1423
1424 sub find_nearest_mrconfig {
1425         my $dir=getcwd();
1426         while (length $dir) {
1427                 if (-e "$dir/.mrconfig") {
1428                         return "$dir/.mrconfig";
1429                 }
1430                 $dir=~s/\/[^\/]*$//;
1431         }
1432         die "no .mrconfig found in path\n";
1433 }
1434
1435 sub getopts {
1436         my @saved=@ARGV;
1437         Getopt::Long::Configure("bundling", "no_permute");
1438         my $result=GetOptions(
1439                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1440                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1441                 "p|path" => sub { $ENV{MR_CONFIG}=find_nearest_mrconfig(); $config_overridden=1 },
1442                 "v|verbose" => \$verbose,
1443                 "q|quiet" => \$quiet,
1444                 "s|stats" => \$stats,
1445                 "k|insecure" => \$insecure,
1446                 "i|interactive" => \$interactive,
1447                 "n|no-recurse:i" => \$max_depth,
1448                 "j|jobs:i" => \$jobs,
1449                 "t|trust-all" => \$trust_all,
1450         );
1451         if (! $result || @ARGV < 1) {
1452                 die("Usage: mr [options] action [params ...]\n".
1453                     "(Use mr help for man page.)\n");
1454         }
1455         
1456         $ENV{MR_SWITCHES}="";
1457         foreach my $option (@saved) {
1458                 last if $option eq $ARGV[0];
1459                 $ENV{MR_SWITCHES}.="$option ";
1460         }
1461 }
1462
1463 sub init {
1464         $SIG{INT}=sub {
1465                 print STDERR "mr: interrupted\n";
1466                 exit 2;
1467         };
1468         
1469         # This can happen if it's run in a directory that was removed
1470         # or other strangeness.
1471         if (! defined $directory) {
1472                 die("mr: failed to determine working directory\n");
1473         }
1474         # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
1475         # the config file might be a symlink to elsewhere, and the directory it's
1476         # in is significant.
1477         if ($ENV{MR_CONFIG} !~ /^\//) {
1478                 $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
1479         }
1480         # Try to set MR_PATH to the path to the program.
1481         eval {
1482                 use FindBin qw($Bin $Script);
1483                 $ENV{MR_PATH}=$Bin."/".$Script;
1484         };
1485 }
1486         
1487 sub exitstats {
1488         if (@failed) {
1489                 exit 1;
1490         }
1491         elsif (! @ok && @skipped) {
1492                 exit 1;
1493         }
1494         else {
1495                 exit 0;
1496         }
1497 }
1498
1499 sub main {
1500         getopts();
1501         init();
1502
1503         startingconfig();
1504         loadconfig($ENV{MR_CONFIG});
1505         #use Data::Dumper; print Dumper(\%config);
1506         
1507         my $action=expandaction(shift @ARGV);
1508         dispatch($action);
1509
1510         showstats($action);
1511         exitstats();
1512 }
1513
1514 # Finally, some useful actions that mr knows about by default.
1515 # These can be overridden in ~/.mrconfig.
1516 __DATA__
1517 [ALIAS]
1518 co = checkout
1519 ci = commit
1520 ls = list
1521
1522 [DEFAULT]
1523 order = 10
1524 lib =
1525         error() {
1526                 echo "mr: $@" >&2
1527                 exit 1
1528         }
1529         warning() {
1530                 echo "mr (warning): $@" >&2
1531         }
1532         info() {
1533                 echo "mr: $@" >&2
1534         }
1535         hours_since() {
1536                 if [ -z "$1" ] || [ -z "$2" ]; then
1537                         error "mr: usage: hours_since action num"
1538                 fi
1539                 for dir in .git .svn .bzr CVS .hg _darcs; do
1540                         if [ -e "$MR_REPO/$dir" ]; then
1541                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1542                                 break
1543                         fi
1544                 done
1545                 if [ -z "$flagfile" ]; then
1546                         error "cannot determine flag filename"
1547                 fi
1548                 delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
1549                 if [ "$delta" -lt "$2" ]; then
1550                         return 1
1551                 else
1552                         touch "$flagfile"
1553                         return 0
1554                 fi
1555         }
1556
1557 svn_test = test -d "$MR_REPO"/.svn
1558 git_test = test -d "$MR_REPO"/.git
1559 bzr_test = test -d "$MR_REPO"/.bzr
1560 cvs_test = test -d "$MR_REPO"/CVS
1561 hg_test  = test -d "$MR_REPO"/.hg
1562 darcs_test = test -d "$MR_REPO"/_darcs
1563 git_bare_test =
1564         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1565         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1566         test "`GIT_CONFIG="$MR_REPO"/config git config --get core.bare`" = true
1567
1568 svn_update = svn update "$@"
1569 git_update = git pull "$@"
1570 bzr_update = bzr merge --pull "$@"
1571 cvs_update = cvs update "$@"
1572 hg_update  = hg pull "$@" && hg update "$@"
1573 darcs_update = darcs pull -a "$@"
1574
1575 svn_status = svn status "$@"
1576 git_status = git status "$@" || true
1577 bzr_status = bzr status "$@"
1578 cvs_status = cvs status "$@"
1579 hg_status  = hg status "$@"
1580 darcs_status = darcs whatsnew -ls "$@" || true
1581
1582 svn_commit = svn commit "$@"
1583 git_commit = git commit -a "$@" && git push --all
1584 bzr_commit = bzr commit "$@" && bzr push
1585 cvs_commit = cvs commit "$@"
1586 hg_commit  = hg commit -m "$@" && hg push
1587 darcs_commit = darcs record -a -m "$@" && darcs push -a
1588
1589 git_record = git commit -a "$@"
1590 bzr_record = bzr commit "$@"
1591 hg_record  = hg commit -m "$@"
1592 darcs_record = darcs record -a -m "$@"
1593
1594 svn_push = :
1595 git_push = git push "$@"
1596 bzr_push = bzr push "$@"
1597 cvs_push = :
1598 hg_push = hg push "$@"
1599 darcs_push = darcs push -a "$@"
1600
1601 svn_diff = svn diff "$@"
1602 git_diff = git diff "$@"
1603 bzr_diff = bzr diff "$@"
1604 cvs_diff = cvs diff "$@"
1605 hg_diff  = hg diff "$@"
1606 darcs_diff = darcs diff -u "$@"
1607
1608 svn_log = svn log "$@"
1609 git_log = git log "$@"
1610 bzr_log = bzr log "$@"
1611 cvs_log = cvs log "$@"
1612 hg_log  = hg log "$@"
1613 darcs_log = darcs changes "$@"
1614 git_bare_log = git log "$@"
1615
1616 svn_register =
1617         url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
1618         if [ -z "$url" ]; then
1619                 error "cannot determine svn url"
1620         fi
1621         echo "Registering svn url: $url in $MR_CONFIG"
1622         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1623 git_register = 
1624         url="`LC_ALL=C git config --get remote.origin.url`" || true
1625         if [ -z "$url" ]; then
1626                 error "cannot determine git url"
1627         fi
1628         echo "Registering git url: $url in $MR_CONFIG"
1629         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1630 bzr_register =
1631         url="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
1632         if [ -z "$url" ]; then
1633                 error "cannot determine bzr url"
1634         fi
1635         echo "Registering bzr url: $url in $MR_CONFIG"
1636         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'"
1637 cvs_register =
1638         repo=`cat CVS/Repository`
1639         root=`cat CVS/Root`
1640         if [ -z "$root" ]; then
1641                 error "cannot determine cvs root"
1642                 fi
1643         echo "Registering cvs repository $repo at root $root"
1644         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1645 hg_register = 
1646         url=`hg showconfig paths.default`
1647         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1648         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
1649 darcs_register = 
1650         url=`cat _darcs/prefs/defaultrepo`
1651         echo "Registering darcs repository $url in $MR_CONFIG"
1652         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
1653 git_bare_register = 
1654         url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
1655         if [ -z "$url" ]; then
1656                 error "cannot determine git url"
1657         fi
1658         echo "Registering git url: $url in $MR_CONFIG"
1659         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1660
1661 svn_trusted_checkout = svn co $url $repo
1662 svn_alt_trusted_checkout = svn checkout $url $repo
1663 git_trusted_checkout = git clone $url $repo
1664 bzr_trusted_checkout = bzr clone $url $repo
1665 # cvs: too hard
1666 hg_trusted_checkout = hg clone $url $repo
1667 darcs_trusted_checkout = darcs get $url $repo
1668 git_bare_trusted_checkout = git clone --bare $url $repo
1669
1670
1671 help =
1672         case `uname -s` in
1673                 SunOS)
1674                 SHOWMANFILE="man -f"
1675                 ;;
1676                 Darwin)
1677                 SHOWMANFILE="man"
1678                 ;;
1679                 *)
1680                 SHOWMANFILE="man -l"
1681                 ;;
1682         esac
1683         if [ ! -e "$MR_PATH" ]; then
1684                 error "cannot find program path"
1685         fi
1686         tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
1687         trap "rm -f $tmp" exit
1688         pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
1689         $SHOWMANFILE "$tmp" || error "man failed"
1690 list = true
1691 config = 
1692 bootstrap = 
1693
1694 online =
1695         if [ -s ~/.mrlog ]; then
1696                 info "running offline commands"
1697                 mv -f ~/.mrlog ~/.mrlog.old
1698                 if ! sh -e ~/.mrlog.old; then
1699                         error "offline command failed; left in ~/.mrlog.old"
1700                 fi
1701                 rm -f ~/.mrlog.old
1702         else
1703                 info "no offline commands to run"
1704         fi
1705 offline =
1706         umask 077
1707         touch ~/.mrlog
1708         info "offline mode enabled"
1709 remember =
1710         info "remembering command: 'mr $@'"
1711         command="mr -d '$(pwd)' $MR_SWITCHES"
1712         for w in "$@"; do
1713                 command="$command '$w'"
1714         done
1715         if [ ! -e ~/.mrlog ] || ! grep -q -F "$command" ~/.mrlog; then
1716                 echo "$command" >> ~/.mrlog
1717         fi
1718
1719 ed = echo "A horse is a horse, of course, of course.."
1720 T = echo "I pity the fool."
1721 right = echo "Not found."
1722
1723 # vim:sw=8:sts=0:ts=8:noet