When looking for a command to run for a given action, mr first looks for
a parameter with the same name as the action. If that is not found, it
looks for a parameter named "VCS_action" (substituting in the name of the
-version control system and the action). The name of the version control
-system is itself determined by running each defined "VCS_test" action,
-until one succeeds.
+version control system and the action).
Internally, mr has settings for "git_update", "svn_update", etc. To change
the action that is performed for a given version control system, you can
to the existing value of the parameter. In this way, actions
can be constructed accumulatively.
+=item VCS_test
+
+The name of the version control system is itself determined by
+running each defined "VCS_test" action, until one succeeds.
+
+=item VCS_dir_test
+
+This is a more optimised way to test for the version control system.
+Each "VCS_dir_test" action is run once, and can output lines consisting
+of the name of a VCS, and a directory to look for in the top of a repo
+to detect that VCS.
+
=back
=head1 UNTRUSTED MRCONFIG FILES
main();
+sub shellquote {
+ my $i=shift;
+ $i=~s/'/'"'"'/g;
+ return "'$i'";
+}
+
+# Runs a shell command using a supplied function.
+# The lib will be included in the shell command line, and any params
+# will be available in the shell as $1, $2, etc.
+my $lastlib;
+sub runsh {
+ my ($action, $topdir, $subdir, $command, $params, $runner) = @_;
+
+ # optimisation: avoid running the shell for true and false
+ if ($command =~ /^\s*true\s*$/) {
+ $?=0;
+ return 0;
+ }
+ elsif ($command =~ /^\s*false\s*$/) {
+ $?=0;
+ return 1;
+ }
+
+ my $quotedparams=join(" ", (map { shellquote($_) } @$params));
+ my $lib=exists $config{$topdir}{$subdir}{lib} ?
+ $config{$topdir}{$subdir}{lib}."\n" : "";
+ if ($verbose && (! defined $lastlib || $lastlib ne $lib)) {
+ print "mr library now: >>$lib<<\n";
+ $lastlib=$lib;
+ }
+ my $shellcode="set -e;".$lib.
+ "my_sh(){ $command\n }; my_sh $quotedparams";
+ print "mr $action: running $action >>$command<<\n" if $verbose;
+ $runner->($shellcode);
+}
+
+sub runshpipe {
+ runsh @_, sub {
+ my $sh=shift;
+ my $ret=`$sh`;
+ chomp $ret;
+ return $ret;
+ };
+}
+
my %vcs;
+my %vcs_dir_test;
sub vcs_test {
my ($action, $dir, $topdir, $subdir) = @_;
return $vcs{$dir};
}
- my $test="set -e\n";
+ my $test="";
+ my $dir_test="";
foreach my $vcs_test (
sort {
length $a <=> length $b
||
$a cmp $b
} grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
- my ($vcs)=$vcs_test=~/(.*)_test/;
+ if ($vcs_test =~ /(.*)_dir_test/) {
+ my $vcs=$1;
+ if (! defined $vcs_dir_test{$vcs}) {
+ $dir_test.=$config{$topdir}{$subdir}{$vcs_test}."\n";
+ }
+ next;
+ }
+ my $vcs=$vcs_test =~ /(.*)_test/;
$test="my_$vcs_test() {\n$config{$topdir}{$subdir}{$vcs_test}\n}\n".$test;
$test.="if my_$vcs_test; then echo $vcs; fi\n";
}
- $test=$config{$topdir}{$subdir}{lib}."\n".$test
- if exists $config{$topdir}{$subdir}{lib};
-
- print "mr $action: running vcs test >>$test<<\n" if $verbose;
- my $vcs=`$test`;
- chomp $vcs;
+
+ if (length $dir_test) {
+ runsh "vcs dir test", $topdir, $subdir, $dir_test, [], sub {
+ my $sh=shift;
+ foreach my $line (`$sh`) {
+ chomp $line;
+ my ($vcs, $dir)=split(" ", $line);
+ $vcs_dir_test{$vcs}=$dir;
+ }
+ }
+ }
+
+ foreach my $vcs (keys %vcs_dir_test) {
+ if (-d "$ENV{MR_REPO}/$vcs_dir_test{$vcs}") {
+ return $vcs{$dir}=$vcs;
+ }
+ }
+
+ my $vcs=runshpipe "vcs test", $topdir, $subdir, $test, [];
if ($vcs=~/\n/s) {
$vcs=~s/\n/, /g;
print STDERR "mr $action: found multiple possible repository types ($vcs) for ".fulldir($topdir, $subdir)."\n";
my $fulldir=fulldir($topdir, $subdir);
$ENV{MR_CONFIG}=$configfiles{$topdir};
- my $lib=exists $config{$topdir}{$subdir}{lib} ?
- $config{$topdir}{$subdir}{lib}."\n" : "";
my $is_checkout=($action eq 'checkout');
my $is_update=($action =~ /update/);
my $testcommand=findcommand($testname, $dir, $topdir, $subdir, $is_checkout);
if (defined $testcommand) {
- my $test="set -e;".$lib.
- "my_action(){ $testcommand\n }; my_action '$action'";
- print "mr $action: running $testname test >>$test<<\n" if $verbose;
- my $ret=system($test);
+ my $ret=runsh "$testname test", $topdir, $subdir,
+ $testcommand, [$action],
+ sub { system(shift()) };
if ($ret != 0) {
if (($? & 127) == 2) {
print STDERR "mr $action: interrupted\n";
my $hookret=hook("pre_$action", $topdir, $subdir);
return $hookret if $hookret != OK;
- $command="set -e; ".$lib.
- "my_action(){ $command\n }; my_action ".
- join(" ", map { s/\\/\\\\/g; s/"/\"/g; '"'.$_.'"' } @ARGV);
- print "mr $action: running >>$command<<\n" if $verbose;
- my $ret;
- if ($quiet) {
- my $output = qx/$command 2>&1/;
- $ret = $?;
- if ($ret != 0) {
- print "$actionmsg\n";
- print STDERR $output;
- }
- }
- else {
- $ret=system($command);
- }
+ 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";
my $command=$config{$topdir}{$subdir}{$hook};
return OK unless defined $command;
- my $lib=exists $config{$topdir}{$subdir}{lib} ?
- $config{$topdir}{$subdir}{lib}."\n" : "";
- my $shell="set -e;".$lib.
- "my_hook(){ $command\n }; my_hook";
- print "mr $hook: running >>$shell<<\n" if $verbose;
- my $ret;
- if ($quiet) {
- my $output = qx/$shell 2>&1/;
- $ret = $?;
- if ($ret != 0) {
- print STDERR $output;
- }
- }
- else {
- $ret=system($shell);
- }
+ 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 0;
}
-sub trusterror {
- my ($err, $file, $line, $url)=@_;
-
- if (defined $url) {
- die "$err in untrusted $url line $line\n".
- "(To trust this url, --trust-all can be used; but please use caution;\n".
- "this can allow arbitrary code execution!)\n";
- }
- else {
- die "$err in untrusted $file line $line\n".
- "(To trust this file, list it in ~/.mrtrust.)\n";
- }
-}
-
my %loaded;
sub loadconfig {
my $f=shift;
# Keep track of the current line in the config file;
# when a file is included track the current line from the include.
- my $line=0;
+ my $lineno=0;
my $included=undef;
- my $includeline=0;
+
+ my $line;
my $nextline = sub {
if ($included) {
- $includeline++;
$included--;
}
else {
$included=undef;
- $includeline=0;
- $line++;
+ $lineno++;
}
- my $l=shift @lines;
- chomp $l;
- return $l
+ $line=shift @lines;
+ chomp $line;
+ return $line;
};
my $lineerror = sub {
my $msg=shift;
if (defined $included) {
- die "mr: $f line $line include line $includeline: $msg\n";
+ 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: $f line $line: $msg\n";
+ die "mr: $err in untrusted $file line $lineno\n".
+ "(To trust this file, list it in ~/.mrtrust.)\n";
}
};
$_=$nextline->();
if (! $trusted && /[[:cntrl:]]/) {
- trusterror("mr: illegal control character", $f, $line, $bootstrap_url);
+ $trusterror->("illegal control character");
}
next if /^\s*\#/ || /^\s*$/;
if (! is_trusted_repo($section) ||
$section eq 'ALIAS' ||
$section eq 'DEFAULT') {
- trusterror("mr: illegal section \"[$section]\"", $f, $line, $bootstrap_url)
+ $trusterror->("illegal section \"[$section]\"");
}
}
$section=expandenv($section) if $trusted;
# settings in specific known-safe formats.
if ($parameter eq 'checkout') {
if (! is_trusted_checkout($value)) {
- trusterror("mr: illegal checkout command \"$value\"", $f, $line, $bootstrap_url);
+ $trusterror->("illegal checkout command \"$value\"");
}
}
elsif ($parameter eq 'order') {
# safe.
}
else {
- trusterror("mr: illegal setting \"$parameter=$value\"", $f, $line, $bootstrap_url);
+ $trusterror->("illegal setting \"$parameter=$value\"");
}
}
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
+svn_dir_test = echo svn .svn
+git_dir_test = echo git .git
+bzr_dir_test = echo bzr .bzr
+cvs_dir_test = echo cvs CVS
+hg_dir_test = echo hg .hg
+darcs_dir_test = echo darcs _darcs
fossil_test = test -f "$MR_REPO"/_FOSSIL_
git_bare_test =
test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
projects / code / myrepos.git / blobdiff