+ my $ret=runsh $action, $topdir, $subdir,
+ $command, \@ARGV, sub {
+ my $sh=shift;
+ if ($quiet) {
+ my $output = qx/$sh 2>&1/;
+ my $ret = $?;
+ if ($ret != 0) {
+ print "$actionmsg\n";
+ print STDERR $output;
+ }
+ return $ret;
+ }
+ else {
+ system($sh);
+ }
+ };
+ if ($ret != 0) {
+ if (($? & 127) == 2) {
+ print STDERR "mr $action: interrupted\n";
+ return ABORT;
+ }
+ elsif ($? & 127) {
+ print STDERR "mr $action: received signal ".($? & 127)."\n";
+ return ABORT;
+ }
+ print STDERR "mr $action: failed ($ret)\n" if $verbose;
+ if ($ret >> 8 != 0) {
+ print STDERR "mr $action: command failed\n";
+ if (-e "$ENV{HOME}/.mrlog" && $action ne 'remember') {
+ # recreate original command line to
+ # remember, and avoid recursing
+ my @orig=@ARGV;
+ @ARGV=('-n', $action, @orig);
+ action("remember", $dir, $topdir, $subdir);
+ @ARGV=@orig;
+ }
+ }
+ elsif ($ret != 0) {
+ print STDERR "mr $action: command died ($ret)\n";
+ }
+ return FAILED;
+ }
+ else {
+ if ($is_checkout && ! -d $dir) {
+ print STDERR "mr $action: $dir missing after checkout\n";;
+ return FAILED;
+ }
+
+ my $ret=hook("post_$action", $topdir, $subdir);
+ return $ret if $ret != OK;
+
+ if (($is_checkout || $is_update)) {
+ my $ret=hook("fixups", $topdir, $subdir);
+ return $ret if $ret != OK;
+ }
+
+ return OK;
+ }
+ }
+}
+
+sub hook {
+ my ($hook, $topdir, $subdir) = @_;
+
+ my $command=$config{$topdir}{$subdir}{$hook};
+ return OK unless defined $command;
+ my $ret=runsh $hook, $topdir, $subdir, $command, [], sub {
+ my $sh=shift;
+ if ($quiet) {
+ my $output = qx/$sh 2>&1/;
+ my $ret = $?;
+ if ($ret != 0) {
+ print STDERR $output;
+ }
+ return $ret;
+ }
+ else {
+ system($sh);
+ }
+ };
+ if ($ret != 0) {
+ if (($? & 127) == 2) {
+ print STDERR "mr $hook: interrupted\n";
+ return ABORT;
+ }
+ elsif ($? & 127) {
+ print STDERR "mr $hook: received signal ".($? & 127)."\n";
+ return ABORT;
+ }
+ else {
+ return FAILED;
+ }
+ }
+
+ return OK;
+}
+
+# run actions on multiple repos, in parallel
+sub mrs {
+ my $action=shift;
+ my @repos=@_;
+
+ $| = 1;
+ my @active;
+ my @fhs;
+ my @out;
+ my $running=0;
+ while (@fhs or @repos) {
+ while ((!$jobs || $running < $jobs) && @repos) {
+ $running++;
+ my $repo = shift @repos;
+ pipe(my $outfh, CHILD_STDOUT);
+ pipe(my $errfh, CHILD_STDERR);
+ my $pid;
+ unless ($pid = fork) {
+ die "mr $action: cannot fork: $!" unless defined $pid;
+ open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
+ open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
+ close CHILD_STDOUT;
+ close CHILD_STDERR;
+ close $outfh;
+ close $errfh;
+ exit action($action, @$repo);
+ }
+ close CHILD_STDOUT;
+ close CHILD_STDERR;
+ push @active, [$pid, $repo];
+ push @fhs, [$outfh, $errfh];
+ push @out, ['', ''];
+ }
+ my ($rin, $rout) = ('','');
+ my $nfound;
+ foreach my $fh (@fhs) {
+ next unless defined $fh;
+ vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
+ vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
+ }
+ $nfound = select($rout=$rin, undef, undef, 1);
+ foreach my $channel (0, 1) {
+ foreach my $i (0..$#fhs) {
+ next unless defined $fhs[$i];
+ my $fh = $fhs[$i][$channel];
+ next unless defined $fh;
+ if (vec($rout, fileno($fh), 1) == 1) {
+ my $r = '';
+ if (sysread($fh, $r, 1024) == 0) {
+ close($fh);
+ $fhs[$i][$channel] = undef;
+ if (! defined $fhs[$i][0] &&
+ ! defined $fhs[$i][1]) {
+ waitpid($active[$i][0], 0);
+ print STDOUT $out[$i][0];
+ print STDERR $out[$i][1];
+ record($active[$i][1], $? >> 8);
+ splice(@fhs, $i, 1);
+ splice(@active, $i, 1);
+ splice(@out, $i, 1);
+ $running--;
+ }
+ }
+ $out[$i][$channel] .= $r;
+ }
+ }
+ }
+ }
+}
+
+sub record {
+ my $dir=shift()->[0];
+ my $ret=shift;
+
+ if ($ret == OK) {
+ push @ok, $dir;
+ print "\n" unless $quiet;
+ }
+ elsif ($ret == FAILED) {
+ if ($interactive) {
+ chdir($dir) unless $no_chdir;
+ print STDERR "mr: Starting interactive shell. Exit shell to continue.\n";
+ system((getpwuid($<))[8], "-i");
+ }
+ push @failed, $dir;
+ print "\n" unless $quiet;
+ }
+ elsif ($ret == SKIPPED) {
+ push @skipped, $dir;
+ }
+ elsif ($ret == ABORT) {
+ exit 1;
+ }
+ else {
+ die "unknown exit status $ret";
+ }
+}
+
+sub showstats {
+ my $action=shift;
+ if (! @ok && ! @failed && ! @skipped) {
+ die "mr $action: no repositories found to work on\n";
+ }
+ print "mr $action: finished (".join("; ",
+ showstat($#ok+1, "ok", "ok"),
+ showstat($#failed+1, "failed", "failed"),
+ showstat($#skipped+1, "skipped", "skipped"),
+ ).")\n" unless $quiet;
+ if ($stats) {
+ if (@skipped) {
+ print "mr $action: (skipped: ".join(" ", @skipped).")\n" unless $quiet;
+ }
+ if (@failed) {
+ print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
+ }
+ }
+}
+
+sub showstat {
+ my $count=shift;
+ my $singular=shift;
+ my $plural=shift;
+ if ($count) {
+ return "$count ".($count > 1 ? $plural : $singular);
+ }
+ return;
+}
+
+# an ordered list of repos
+sub repolist {
+ my @list;
+ foreach my $topdir (sort keys %config) {
+ foreach my $subdir (sort keys %{$config{$topdir}}) {
+ push @list, {
+ topdir => $topdir,
+ subdir => $subdir,
+ order => $config{$topdir}{$subdir}{order},
+ };
+ }
+ }
+ return sort {
+ $a->{order} <=> $b->{order}
+ ||
+ $a->{topdir} cmp $b->{topdir}
+ ||
+ $a->{subdir} cmp $b->{subdir}
+ } @list;
+}
+
+sub repodir {
+ my $repo=shift;
+ my $topdir=$repo->{topdir};
+ my $subdir=$repo->{subdir};
+ my $ret=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
+ $ret=~s/\/\.$//;
+ return $ret;
+}
+
+# Figure out which repos to act on. Returns a list of array refs
+# in the format:
+#
+# [ "$full_repo_path/", "$mr_config_path/", $section_header ]
+sub selectrepos {
+ my @repos;
+ foreach my $repo (repolist()) {
+ my $topdir=$repo->{topdir};
+ my $subdir=$repo->{subdir};
+
+ next if $subdir eq 'DEFAULT';
+ my $dir=repodir($repo);
+ my $d=$directory;
+ $dir.="/" unless $dir=~/\/$/;
+ $d.="/" unless $d=~/\/$/;
+ next if $dir ne $d && $dir !~ /^\Q$d\E/;
+ if (defined $max_depth) {
+ my @a=split('/', $dir);
+ my @b=split('/', $d);
+ do { } while (@a && @b && shift(@a) eq shift(@b));
+ next if @a > $max_depth || @b > $max_depth;
+ }
+ push @repos, [$dir, $topdir, $subdir];
+ }
+ if (! @repos) {
+ # fallback to find a leaf repo
+ foreach my $repo (reverse repolist()) {
+ my $topdir=$repo->{topdir};
+ my $subdir=$repo->{subdir};
+
+ next if $subdir eq 'DEFAULT';
+ my $dir=repodir($repo);
+ my $d=$directory;
+ $dir.="/" unless $dir=~/\/$/;
+ $d.="/" unless $d=~/\/$/;
+ if ($d=~/^\Q$dir\E/) {
+ push @repos, [$dir, $topdir, $subdir];
+ last;
+ }
+ }
+ $no_chdir=1;
+ }
+ return @repos;
+}
+
+sub expandenv {
+ my $val=shift;
+
+
+ if ($val=~/\$/) {
+ $val=`echo "$val"`;
+ chomp $val;
+ }
+
+ return $val;
+}
+
+my %trusted;
+sub is_trusted_config {
+ my $config=shift; # must be abs_pathed already
+
+ # We always trust ~/.mrconfig.
+ return 1 if $config eq abs_path("$ENV{HOME}/.mrconfig");
+
+ return 1 if $trust_all;
+
+ my $trustfile=$ENV{HOME}."/.mrtrust";
+
+ if (! %trusted) {
+ $trusted{"$ENV{HOME}/.mrconfig"}=1;
+ if (open (TRUST, "<", $trustfile)) {
+ while (<TRUST>) {
+ chomp;
+ s/^~\//$ENV{HOME}\//;
+ $trusted{abs_path($_)}=1;
+ }
+ close TRUST;
+ }
+ }
+
+ return $trusted{$config};
+}
+
+
+sub is_trusted_repo {
+ my $repo=shift;
+
+ # Tightly limit what is allowed in a repo name.
+ # No ../, no absolute paths, and no unusual filenames
+ # that might try to escape to the shell.
+ return $repo =~ /^[-_.+\/A-Za-z0-9]+$/ &&
+ $repo !~ /\.\./ && $repo !~ /^\//;
+}
+
+sub is_trusted_checkout {
+ my $command=shift;
+
+ # To determine if the command is safe, compare it with the
+ # *_trusted_checkout config settings. Those settings are
+ # templates for allowed commands, so make sure that each word
+ # of the command matches the corresponding word of the template.
+
+ my @words;
+ foreach my $word (split(' ', $command)) {
+ # strip quoting
+ if ($word=~/^'(.*)'$/) {
+ $word=$1;
+ }
+ elsif ($word=~/^"(.*)"$/) {
+ $word=$1;
+ }
+
+ push @words, $word;
+ }
+
+ foreach my $key (grep { /_trusted_checkout$/ }
+ keys %{$config{''}{DEFAULT}}) {
+ my @twords=split(' ', $config{''}{DEFAULT}{$key});
+ next if @words > @twords;
+
+ my $match=1;
+ my $url;
+ for (my $c=0; $c < @twords && $match; $c++) {
+ if ($twords[$c] eq '$url') {
+ # Match all the typical characters found in
+ # urls, plus @ which svn can use. Note
+ # that the "url" might also be a local
+ # directory.
+ $match=(
+ defined $words[$c] &&
+ $words[$c] =~ /^[-_.+:@\/A-Za-z0-9]+$/
+ );
+ $url=$words[$c];
+ }
+ elsif ($twords[$c] eq '$repo') {
+ # If a repo is not specified, assume it
+ # will be the last path component of the
+ # url, or something derived from it, and
+ # check that.
+ if (! defined $words[$c] && defined $url) {
+ ($words[$c])=$url=~/\/([^\/]+)\/?$/;
+ }
+
+ $match=(
+ defined $words[$c] &&
+ is_trusted_repo($words[$c])
+ );
+ }
+ elsif (defined $words[$c] && $words[$c]=~/^($twords[$c])$/) {
+ $match=1;
+ }
+ else {
+ $match=0;
+ }
+ }
+ return 1 if $match;
+ }
+
+ return 0;
+}
+
+my %loaded;
+sub loadconfig {
+ my $f=shift;
+ my $dir=shift;
+ my $bootstrap_url=shift;
+
+ my @toload;
+
+ my $in;
+ my $trusted;
+ if (ref $f eq 'GLOB') {
+ $dir="";
+ $in=$f;
+ $trusted=1;
+ }
+ else {
+ my $absf=abs_path($f);
+ if ($loaded{$absf}) {
+ return;
+ }
+ $loaded{$absf}=1;
+
+ $trusted=is_trusted_config($absf);
+
+ if (! defined $dir) {
+ ($dir)=$f=~/^(.*\/)[^\/]+$/;
+ if (! defined $dir) {
+ $dir=".";
+ }
+ }
+
+ $dir=abs_path($dir)."/";
+
+ if (! exists $configfiles{$dir}) {
+ $configfiles{$dir}=$f;
+ }
+
+ # copy in defaults from first parent
+ my $parent=$dir;
+ while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
+ if ($parent eq '/') {
+ $parent="";
+ }
+ if (exists $config{$parent} &&
+ exists $config{$parent}{DEFAULT}) {
+ $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
+ last;
+ }
+ }
+
+ if (! -e $f) {
+ return;
+ }
+
+ print "mr: loading config $f\n" if $verbose;
+ open($in, "<", $f) || die "mr: open $f: $!\n";
+ }
+ my @lines=<$in>;
+ close $in unless ref $f eq 'GLOB';
+
+ my $section;
+
+ # Keep track of the current line in the config file;
+ # when a file is included track the current line from the include.
+ my $lineno=0;
+ my $included=undef;
+
+ my $line;
+ my $nextline = sub {
+ if ($included) {
+ $included--;
+ }
+ else {
+ $included=undef;
+ $lineno++;
+ }
+ $line=shift @lines;
+ chomp $line;
+ return $line;
+ };
+ my $lineerror = sub {
+ my $msg=shift;
+ if (defined $included) {
+ die "mr: $msg at $f line $lineno, included line: $line\n";
+ }
+ else {
+ die "mr: $msg at $f line $lineno\n";
+ }
+ };
+ my $trusterror = sub {
+ my $msg=shift;
+ my ($err, $file, $lineno, $url)=@_;
+
+ if (defined $bootstrap_url) {
+ die "mr: $err in untrusted $bootstrap_url line $lineno\n".
+ "(To trust this url, --trust-all can be used; but please use caution;\n".
+ "this can allow arbitrary code execution!)\n";
+ }
+ else {
+ die "mr: $err in untrusted $file line $lineno\n".
+ "(To trust this file, list it in ~/.mrtrust.)\n";
+ }
+ };
+
+ while (@lines) {
+ $_=$nextline->();
+
+ if (! $trusted && /[[:cntrl:]]/) {
+ $trusterror->("illegal control character");
+ }
+
+ next if /^\s*\#/ || /^\s*$/;
+ if (/^\[([^\]]*)\]\s*$/) {
+ $section=$1;
+
+ if (! $trusted) {
+ if (! is_trusted_repo($section) ||
+ $section eq 'ALIAS' ||
+ $section eq 'DEFAULT') {
+ $trusterror->("illegal section \"[$section]\"");
+ }
+ }
+ $section=expandenv($section) if $trusted;
+ if ($section ne 'ALIAS' &&
+ ! exists $config{$dir}{$section} &&
+ exists $config{$dir}{DEFAULT}) {
+ # copy in defaults
+ $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
+ }
+ }
+ elsif (/^(\w+)\s*=\s*(.*)/) {
+ my $parameter=$1;
+ my $value=$2;
+
+ # continued value
+ while (@lines && $lines[0]=~/^\s(.+)/) {
+ $value.="\n$1";
+ chomp $value;
+ $nextline->();
+ }
+
+ if (! $trusted) {
+ # Untrusted files can only contain a few
+ # settings in specific known-safe formats.
+ if ($parameter eq 'checkout') {
+ if (! is_trusted_checkout($value)) {
+ $trusterror->("illegal checkout command \"$value\"");
+ }
+ }
+ elsif ($parameter eq 'order') {
+ # not interpreted as a command, so
+ # safe.
+ }
+ elsif ($value eq 'true' || $value eq 'false') {
+ # skip=true , deleted=true etc are
+ # safe.
+ }
+ else {
+ $trusterror->("illegal setting \"$parameter=$value\"");
+ }
+ }
+
+ if ($parameter eq "include") {
+ print "mr: including output of \"$value\"\n" if $verbose;
+ my @inc=`$value`;
+ if ($?) {
+ print STDERR "mr: include command exited nonzero ($?)\n";
+ }
+ $included += @inc;
+ unshift @lines, @inc;
+ next;
+ }
+
+ if (! defined $section) {
+ $lineerror->("parameter ($parameter) not in section");
+ }
+ if ($section eq 'ALIAS') {
+ $alias{$parameter}=$value;
+ }
+ elsif ($parameter eq 'lib' or $parameter =~ s/_append$//) {
+ $config{$dir}{$section}{$parameter}.="\n".$value."\n";
+ }
+ else {
+ $config{$dir}{$section}{$parameter}=$value;
+ if ($parameter =~ /.*_(.*)/) {
+ $knownactions{$1}=1;
+ }
+ else {
+ $knownactions{$parameter}=1;
+ }
+ if ($parameter eq 'chain' &&
+ length $dir && $section ne "DEFAULT") {
+ my $chaindir="$section";
+ if ($chaindir !~ m!^/!) {
+ $chaindir=$dir.$chaindir;
+ }
+ if (-e "$chaindir/.mrconfig") {
+ my $ret=system($value);
+ if ($ret != 0) {
+ if (($? & 127) == 2) {
+ print STDERR "mr: chain test interrupted\n";
+ exit 2;
+ }
+ elsif ($? & 127) {
+ print STDERR "mr: chain test received signal ".($? & 127)."\n";
+ }
+ }
+ else {
+ push @toload, ["$chaindir/.mrconfig", $chaindir];
+ }
+ }
+ }
+ }
+ }
+ else {
+ $lineerror->("parse error");
+ }
+ }
+
+ foreach my $c (@toload) {
+ loadconfig(@$c);
+ }
+}
+
+sub startingconfig {
+ %alias=%config=%configfiles=%knownactions=%loaded=();
+ my $datapos=tell(DATA);
+ loadconfig(\*DATA);
+ seek(DATA,$datapos,0); # rewind
+}
+
+sub modifyconfig {
+ my $f=shift;
+ # the section to modify or add
+ my $targetsection=shift;
+ # fields to change in the section
+ # To remove a field, set its value to "".
+ my %changefields=@_;
+
+ my @lines;
+ my @out;
+
+ if (-e $f) {
+ open(my $in, "<", $f) || die "mr: open $f: $!\n";
+ @lines=<$in>;
+ close $in;
+ }
+
+ my $formatfield=sub {
+ my $field=shift;
+ my @value=split(/\n/, shift);
+
+ return "$field = ".shift(@value)."\n".
+ join("", map { "\t$_\n" } @value);
+ };
+ my $addfields=sub {
+ my @blanks;
+ while ($out[$#out] =~ /^\s*$/) {
+ unshift @blanks, pop @out;
+ }
+ foreach my $field (sort keys %changefields) {
+ if (length $changefields{$field}) {
+ push @out, "$field = $changefields{$field}\n";
+ delete $changefields{$field};
+ }
+ }
+ push @out, @blanks;
+ };
+
+ my $section;
+ while (@lines) {
+ $_=shift(@lines);
+
+ if (/^\s*\#/ || /^\s*$/) {
+ push @out, $_;
+ }
+ elsif (/^\[([^\]]*)\]\s*$/) {
+ if (defined $section &&
+ $section eq $targetsection) {
+ $addfields->();
+ }
+
+ $section=expandenv($1);
+
+ push @out, $_;
+ }
+ elsif (/^(\w+)\s*=\s(.*)/) {
+ my $parameter=$1;
+ my $value=$2;
+
+ # continued value
+ while (@lines && $lines[0]=~/^\s(.+)/) {
+ shift(@lines);
+ $value.="\n$1";
+ chomp $value;
+ }
+
+ if ($section eq $targetsection) {
+ if (exists $changefields{$parameter}) {
+ if (length $changefields{$parameter}) {
+ $value=$changefields{$parameter};
+ }
+ delete $changefields{$parameter};
+ }
+ }
+
+ push @out, $formatfield->($parameter, $value);
+ }
+ }
+
+ if (defined $section &&
+ $section eq $targetsection) {
+ $addfields->();
+ }
+ elsif (%changefields) {
+ push @out, "\n[$targetsection]\n";
+ foreach my $field (sort keys %changefields) {
+ if (length $changefields{$field}) {
+ push @out, $formatfield->($field, $changefields{$field});
+ }
+ }
+ }
+
+ open(my $out, ">", $f) || die "mr: write $f: $!\n";
+ print $out @out;
+ close $out;
+}
+
+sub dispatch {
+ my $action=shift;
+
+ # actions that do not operate on all repos
+ if ($action eq 'help') {
+ help(@ARGV);
+ }
+ elsif ($action eq 'config') {
+ config(@ARGV);
+ }
+ elsif ($action eq 'register') {
+ register(@ARGV);
+ }
+ elsif ($action eq 'bootstrap') {
+ bootstrap();
+ }
+ elsif ($action eq 'remember' ||
+ $action eq 'offline' ||
+ $action eq 'online') {
+ my @repos=selectrepos;
+ action($action, @{$repos[0]}) if @repos;
+ exit 0;
+ }
+
+ if (!$jobs || $jobs > 1) {
+ mrs($action, selectrepos());
+ }
+ else {
+ foreach my $repo (selectrepos()) {
+ record($repo, action($action, @$repo));
+ }
+ }
+}
+
+sub help {
+ exec($config{''}{DEFAULT}{help}) || die "exec: $!";
+}
+
+sub config {
+ if (@_ < 2) {
+ die "mr config: not enough parameters\n";
+ }
+ my $section=shift;
+ if ($section=~/^\//) {
+ # try to convert to a path relative to the config file
+ my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
+ $dir=abs_path($dir);
+ $dir.="/" unless $dir=~/\/$/;
+ if ($section=~/^\Q$dir\E(.*)/) {
+ $section=$1;
+ }
+ }
+ my %changefields;
+ foreach (@_) {
+ if (/^([^=]+)=(.*)$/) {
+ $changefields{$1}=$2;
+ }
+ else {
+ my $found=0;
+ foreach my $topdir (sort keys %config) {
+ if (exists $config{$topdir}{$section} &&
+ exists $config{$topdir}{$section}{$_}) {
+ print $config{$topdir}{$section}{$_}."\n";
+ $found=1;
+ last if $section eq 'DEFAULT';
+ }
+ }
+ if (! $found) {
+ die "mr config: $section $_ not set\n";
+ }
+ }
+ }
+ modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
+ exit 0;
+}
+
+sub register {
+ if ($config_overridden) {
+ # Find the directory that the specified config file is
+ # located in.
+ ($directory)=abs_path($ENV{MR_CONFIG})=~/^(.*\/)[^\/]+$/;
+ }
+ else {
+ # Find the closest known mrconfig file to the current
+ # directory.
+ $directory.="/" unless $directory=~/\/$/;
+ my $foundconfig=0;
+ foreach my $topdir (reverse sort keys %config) {
+ next unless length $topdir;
+ if ($directory=~/^\Q$topdir\E/) {
+ $ENV{MR_CONFIG}=$configfiles{$topdir};
+ $directory=$topdir;
+ $foundconfig=1;
+ last;
+ }
+ }
+ if (! $foundconfig) {
+ $directory=""; # no config file, use builtin
+ }
+ }
+ if (@ARGV) {
+ my $subdir=shift @ARGV;
+ if (! chdir($subdir)) {
+ print STDERR "mr register: failed to chdir to $subdir: $!\n";
+ }
+ }
+
+ $ENV{MR_REPO}=getcwd();
+ my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
+ if (! defined $command) {
+ die "mr register: unknown repository type\n";
+ }
+
+ $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
+ $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
+ "my_action(){ $command\n }; my_action ".
+ join(" ", map { s/\\/\\\\/g; s/"/\"/g; '"'.$_.'"' } @ARGV);
+ print "mr register: running >>$command<<\n" if $verbose;
+ exec($command) || die "exec: $!";
+}
+
+sub bootstrap {
+ my $url=shift @ARGV;
+ my $dir=shift @ARGV || ".";
+
+ if (! defined $url || ! length $url) {
+ die "mr: bootstrap requires url\n";
+ }
+
+ # Download the config file to a temporary location.
+ eval q{use File::Temp};
+ die $@ if $@;
+ my $tmpconfig=File::Temp->new();
+ my @curlargs = ("curl", "-A", "mr", "-L", "-s", $url, "-o", $tmpconfig);
+ push(@curlargs, "-k") if $insecure;
+ my $curlstatus = system(@curlargs);
+ die "mr bootstrap: invalid SSL certificate for $url (consider -k)\n" if $curlstatus >> 8 == 60;
+ die "mr bootstrap: download of $url failed\n" if $curlstatus != 0;
+
+ if (! -e $dir) {
+ system("mkdir", "-p", $dir);
+ }
+ chdir($dir) || die "chdir $dir: $!";
+
+ # Special case to handle checkout of the "." repo, which
+ # would normally be skipped.
+ my $topdir=abs_path(".")."/";
+ my @repo=($topdir, $topdir, ".");
+ loadconfig($tmpconfig, $topdir, $url);
+ record(\@repo, action("checkout", @repo, 1))
+ if exists $config{$topdir}{"."}{"checkout"};
+
+ if (-e ".mrconfig") {
+ print STDERR "mr bootstrap: .mrconfig file already exists, not overwriting with $url\n";
+ }
+ else {
+ eval q{use File::Copy};
+ die $@ if $@;
+ move($tmpconfig, ".mrconfig") || die "rename: $!";
+ }
+
+ # Reload the config file (in case we got a different version)
+ # and checkout everything else.
+ startingconfig();
+ loadconfig(".mrconfig");
+ dispatch("checkout");
+ @skipped=grep { abs_path($_) ne abs_path($topdir) } @skipped;
+ showstats("bootstrap");
+ exitstats();
+}
+
+# alias expansion and command stemming
+sub expandaction {
+ my $action=shift;
+ if (exists $alias{$action}) {
+ $action=$alias{$action};
+ }
+ if (! exists $knownactions{$action}) {
+ my @matches = grep { /^\Q$action\E/ }
+ keys %knownactions, keys %alias;
+ if (@matches == 1) {
+ $action=$matches[0];
+ }
+ elsif (@matches == 0) {
+ die "mr: unknown action \"$action\" (known actions: ".
+ join(", ", sort keys %knownactions).")\n";
+ }
+ else {
+ die "mr: ambiguous action \"$action\" (matches: ".
+ join(", ", @matches).")\n";
+ }
+ }
+ return $action;
+}
+
+sub find_mrconfig {
+ my $dir=getcwd();
+ while (length $dir) {
+ if (-e "$dir/.mrconfig") {
+ return "$dir/.mrconfig";
+ }
+ $dir=~s/\/[^\/]*$//;
+ }
+ return "$ENV{HOME}/.mrconfig";
+}
+
+sub getopts {
+ my @saved=@ARGV;
+ Getopt::Long::Configure("bundling", "no_permute");
+ my $result=GetOptions(
+ "d|directory=s" => sub { $directory=abs_path($_[1]) },
+ "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
+ "p|path" => sub { }, # now default, ignore
+ "v|verbose" => \$verbose,
+ "q|quiet" => \$quiet,
+ "s|stats" => \$stats,
+ "k|insecure" => \$insecure,
+ "i|interactive" => \$interactive,
+ "n|no-recurse:i" => \$max_depth,
+ "j|jobs:i" => \$jobs,
+ "t|trust-all" => \$trust_all,
+ );
+ if (! $result || @ARGV < 1) {
+ die("Usage: mr [options] action [params ...]\n".
+ "(Use mr help for man page.)\n");
+ }
+
+ $ENV{MR_SWITCHES}="";
+ foreach my $option (@saved) {
+ last if $option eq $ARGV[0];
+ $ENV{MR_SWITCHES}.="$option ";
+ }
+}
+
+sub init {
+ $SIG{INT}=sub {
+ print STDERR "mr: interrupted\n";
+ exit 2;
+ };
+
+ # This can happen if it's run in a directory that was removed
+ # or other strangeness.
+ if (! defined $directory) {
+ die("mr: failed to determine working directory\n");
+ }
+ # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
+ # the config file might be a symlink to elsewhere, and the directory it's
+ # in is significant.
+ if ($ENV{MR_CONFIG} !~ /^\//) {
+ $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
+ }
+ # Try to set MR_PATH to the path to the program.
+ eval {
+ use FindBin qw($Bin $Script);
+ $ENV{MR_PATH}=$Bin."/".$Script;
+ };
+}
+
+sub exitstats {
+ if (@failed) {
+ exit 1;
+ }
+ else {
+ exit 0;
+ }
+}
+
+sub main {
+ getopts();
+ init();
+
+ startingconfig();
+ loadconfig("$ENV{HOME}/.mrconfig");
+ loadconfig($ENV{MR_CONFIG});
+ #use Data::Dumper; print Dumper(\%config);
+
+ my $action=expandaction(shift @ARGV);
+ dispatch($action);
+
+ showstats($action);
+ exitstats();
+}
+
+# Finally, some useful actions that mr knows about by default.
+# These can be overridden in ~/.mrconfig.
+__DATA__
+[ALIAS]
+co = checkout
+ci = commit
+ls = list
+
+[DEFAULT]
+order = 10
+lib =
+ error() {
+ echo "mr: $@" >&2
+ exit 1
+ }
+ warning() {
+ echo "mr (warning): $@" >&2
+ }
+ info() {
+ echo "mr: $@" >&2
+ }
+ hours_since() {
+ if [ -z "$1" ] || [ -z "$2" ]; then
+ error "mr: usage: hours_since action num"
+ fi
+ for dir in .git .svn .bzr CVS .hg _darcs _FOSSIL_; do
+ if [ -e "$MR_REPO/$dir" ]; then
+ flagfile="$MR_REPO/$dir/.mr_last$1"
+ break
+ fi
+ done
+ if [ -z "$flagfile" ]; then
+ error "cannot determine flag filename"
+ fi
+ delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
+ if [ "$delta" -lt "$2" ]; then
+ return 1
+ else
+ touch "$flagfile"
+ return 0
+ fi
+ }
+ is_bzr_checkout() {
+ LANG=C bzr info | egrep -q '^Checkout'
+ }
+ lazy() {
+ if [ "$MR_ACTION" = checkout ] || [ -d "$MR_REPO" ]; then
+ return 1
+ else
+ return 0
+ fi
+ }
+
+svn_test = test -d "$MR_REPO"/.svn
+git_test = test -d "$MR_REPO"/.git
+bzr_test = test -d "$MR_REPO"/.bzr
+cvs_test = test -d "$MR_REPO"/CVS
+hg_test = test -d "$MR_REPO"/.hg
+darcs_test = test -d "$MR_REPO"/_darcs
+fossil_test = test -f "$MR_REPO"/_FOSSIL_
+git_bare_test =
+ test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
+ test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
+ test "`GIT_CONFIG="$MR_REPO"/config git config --get core.bare`" = true
+
+svn_update = svn update "$@"
+git_update = git pull "$@"
+bzr_update =
+ if is_bzr_checkout; then
+ bzr update "$@"
+ else
+ bzr merge --pull "$@"
+ fi
+cvs_update = cvs update "$@"
+hg_update = hg pull "$@" && hg update "$@"
+darcs_update = darcs pull -a "$@"
+fossil_update = fossil pull "$@"
+
+svn_status = svn status "$@"
+git_status = git status -s "$@" || true
+bzr_status = bzr status --short "$@"
+cvs_status = cvs status "$@"
+hg_status = hg status "$@"
+darcs_status = darcs whatsnew -ls "$@" || true
+fossil_status = fossil changes "$@"
+
+svn_commit = svn commit "$@"
+git_commit = git commit -a "$@" && git push --all
+bzr_commit =
+ if is_bzr_checkout; then
+ bzr commit "$@"
+ else
+ bzr commit "$@" && bzr push
+ fi
+cvs_commit = cvs commit "$@"
+hg_commit = hg commit -m "$@" && hg push
+darcs_commit = darcs record -a -m "$@" && darcs push -a
+fossil_commit = fossil commit "$@"
+
+git_record = git commit -a "$@"
+bzr_record =
+ if is_bzr_checkout; then
+ bzr commit --local "$@"
+ else
+ bzr commit "$@"
+ fi
+hg_record = hg commit -m "$@"
+darcs_record = darcs record -a -m "$@"
+fossil_record = fossil commit "$@"
+
+svn_push = :
+git_push = git push "$@"
+bzr_push = bzr push "$@"
+cvs_push = :
+hg_push = hg push "$@"
+darcs_push = darcs push -a "$@"
+fossil_push = fossil push "$@"
+
+svn_diff = svn diff "$@"
+git_diff = git diff "$@"
+bzr_diff = bzr diff "$@"
+cvs_diff = cvs diff "$@"
+hg_diff = hg diff "$@"
+darcs_diff = darcs diff -u "$@"
+fossil_diff = fossil diff "$@"
+
+svn_log = svn log "$@"
+git_log = git log "$@"
+bzr_log = bzr log "$@"
+cvs_log = cvs log "$@"
+hg_log = hg log "$@"
+darcs_log = darcs changes "$@"
+git_bare_log = git log "$@"
+fossil_log = fossil timeline "$@"
+
+run = "$@"
+
+svn_register =
+ url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
+ if [ -z "$url" ]; then
+ error "cannot determine svn url"
+ fi
+ echo "Registering svn url: $url in $MR_CONFIG"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
+git_register =
+ url="`LC_ALL=C git config --get remote.origin.url`" || true
+ if [ -z "$url" ]; then
+ error "cannot determine git url"
+ fi
+ echo "Registering git url: $url in $MR_CONFIG"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
+bzr_register =
+ url="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
+ if [ -z "$url" ]; then
+ error "cannot determine bzr url"
+ fi
+ echo "Registering bzr url: $url in $MR_CONFIG"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr branch '$url' '$MR_REPO'"
+cvs_register =
+ repo=`cat CVS/Repository`
+ root=`cat CVS/Root`
+ if [ -z "$root" ]; then
+ error "cannot determine cvs root"
+ fi
+ echo "Registering cvs repository $repo at root $root"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
+hg_register =
+ url=`hg showconfig paths.default`
+ echo "Registering mercurial repo url: $url in $MR_CONFIG"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
+darcs_register =
+ url=`cat _darcs/prefs/defaultrepo`
+ echo "Registering darcs repository $url in $MR_CONFIG"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
+git_bare_register =
+ url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
+ if [ -z "$url" ]; then
+ error "cannot determine git url"
+ fi
+ echo "Registering git url: $url in $MR_CONFIG"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
+fossil_register =
+ url=`fossil remote-url`
+ repo=`fossil info | grep repository | sed -e 's/repository:*.//g' -e 's/ //g'`
+ echo "Registering fossil repository $url in $MR_CONFIG"
+ mr -c "$MR_CONFIG" config "`pwd`" checkout="mkdir -p '$MR_REPO' && cd '$MR_REPO' && fossil open '$repo'"
+
+svn_trusted_checkout = svn co $url $repo
+svn_alt_trusted_checkout = svn checkout $url $repo
+git_trusted_checkout = git clone $url $repo
+bzr_trusted_checkout = bzr checkout|clone|branch|get $url $repo
+# cvs: too hard
+hg_trusted_checkout = hg clone $url $repo
+darcs_trusted_checkout = darcs get $url $repo
+git_bare_trusted_checkout = git clone --bare $url $repo
+# fossil: messy to do
+
+
+help =
+ case `uname -s` in
+ SunOS)
+ SHOWMANFILE="man -f"
+ ;;
+ Darwin)
+ SHOWMANFILE="man"
+ ;;
+ *)
+ SHOWMANFILE="man -l"
+ ;;
+ esac
+ if [ ! -e "$MR_PATH" ]; then
+ error "cannot find program path"
+ fi
+ tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
+ trap "rm -f $tmp" exit
+ pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
+ $SHOWMANFILE "$tmp" || error "man failed"
+list = true
+config =
+bootstrap =
+
+online =
+ if [ -s ~/.mrlog ]; then
+ info "running offline commands"
+ mv -f ~/.mrlog ~/.mrlog.old
+ if ! sh -e ~/.mrlog.old; then
+ error "offline command failed; left in ~/.mrlog.old"
+ fi
+ rm -f ~/.mrlog.old
+ else
+ info "no offline commands to run"
+ fi
+offline =
+ umask 077
+ touch ~/.mrlog
+ info "offline mode enabled"
+remember =
+ info "remembering command: 'mr $@'"
+ command="mr -d '$(pwd)' $MR_SWITCHES"
+ for w in "$@"; do
+ command="$command '$w'"
+ done
+ if [ ! -e ~/.mrlog ] || ! grep -q -F "$command" ~/.mrlog; then
+ echo "$command" >> ~/.mrlog
+ fi
+
+ed = echo "A horse is a horse, of course, of course.."
+T = echo "I pity the fool."
+right = echo "Not found."
+
+# vim:sw=8:sts=0:ts=8:noet
+# Local variables:
+# indent-tabs-mode: t
+# cperl-indent-level: 8
+# End:
projects / code / myrepos.git / blobdiff