as well as look for a F<.mrconfig> file in the current directory, or in one
of its parent directories.
+=item -f
+
+=item --force
+
+Force mr to act on repositories that would normally be skipped due to their
+configuration.
+
=item -v
=item --verbose
Another way to use skip is for a lazy checkout. This makes mr skip
operating on a repo unless it already exists. To enable the
-repo, you have to explicitly check it out (using "mr -d foo checkout").
+repo, you have to explicitly check it out (using "mr --force -d foo checkout").
[foo]
checkout = ...
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.
+
=back
=head1 UNTRUSTED MRCONFIG FILES
my $verbose=0;
my $quiet=0;
my $stats=0;
+my $force=0;
my $insecure=0;
my $interactive=0;
my $max_depth;
my $trust_all=0;
my $directory=getcwd();
+my $HOME_MR_CONFIG = "$ENV{HOME}/.mrconfig";
$ENV{MR_CONFIG}=find_mrconfig();
# globals :-(
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);
+}
+
+my %perl_cache;
+sub perl {
+ my $id=shift;
+ my $s=shift;
+ if ($s =~ m/^perl:\s+(.*)/s) {
+ return $perl_cache{$1} if exists $perl_cache{$1};
+ my $sub=eval "sub {$1}";
+ if (! defined $sub) {
+ print STDERR "mr: bad perl code in $id: $@\n";
+ }
+ return $perl_cache{$1} = $sub;
+ }
+ return undef;
+}
+
my %vcs;
sub vcs_test {
my ($action, $dir, $topdir, $subdir) = @_;
return $vcs{$dir};
}
- my $test="set -e\n";
+ my $test="";
+ my %perltest;
foreach my $vcs_test (
sort {
length $a <=> length $b
||
$a cmp $b
} grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
- 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";
+ my ($vcs)=$vcs_test =~ /(.*)_test/;
+ my $p=perl($vcs_test, $config{$topdir}{$subdir}{$vcs_test});
+ if (defined $p) {
+ $perltest{$vcs}=$p;
+ }
+ else {
+ $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 ($vcs=~/\n/s) {
- $vcs=~s/\n/, /g;
- print STDERR "mr $action: found multiple possible repository types ($vcs) for ".fulldir($topdir, $subdir)."\n";
+
+ my @vcs;
+ foreach my $vcs (keys %perltest) {
+ if ($perltest{$vcs}->()) {
+ push @vcs, $vcs;
+ }
+ }
+
+ push @vcs, split(/\n/,
+ runsh("vcs test", $topdir, $subdir, $test, [], sub {
+ my $sh=shift;
+ my $ret=`$sh`;
+ return $ret;
+ })) if length $test;
+ if (@vcs > 1) {
+ print STDERR "mr $action: found multiple possible repository types (@vcs) for ".fulldir($topdir, $subdir)."\n";
return undef;
}
- if (! length $vcs) {
+ if (! @vcs) {
return $vcs{$dir}=undef;
}
else {
- return $vcs{$dir}=$vcs;
+ return $vcs{$dir}=$vcs[0];
}
}
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/);
$ENV{MR_ACTION}=$action;
foreach my $testname ("skip", "deleted") {
+ next if $force && $testname eq "skip";
+
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";
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 $config eq abs_path($HOME_MR_CONFIG);
return 1 if $trust_all;
my $trustfile=$ENV{HOME}."/.mrtrust";
if (! %trusted) {
- $trusted{"$ENV{HOME}/.mrconfig"}=1;
+ $trusted{$HOME_MR_CONFIG}=1;
if (open (TRUST, "<", $trustfile)) {
while (<TRUST>) {
chomp;
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\"");
}
}
}
$dir=~s/\/[^\/]*$//;
}
- return "$ENV{HOME}/.mrconfig";
+ return $HOME_MR_CONFIG;
}
sub getopts {
"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
+ "f|force" => \$force,
"v|verbose" => \$verbose,
"q|quiet" => \$quiet,
"s|stats" => \$stats,
init();
startingconfig();
- loadconfig("$ENV{HOME}/.mrconfig");
+ loadconfig($HOME_MR_CONFIG);
loadconfig($ENV{MR_CONFIG});
#use Data::Dumper; print Dumper(\%config);
LANG=C bzr info | egrep -q '^Checkout'
}
lazy() {
- if [ "$MR_ACTION" = checkout ] || [ -d "$MR_REPO" ]; then
+ if [ -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_test = perl: -d "$ENV{MR_REPO}/.svn"
+git_test = perl: -d "$ENV{MR_REPO}/.git"
+bzr_test = perl: -d "$ENV{MR_REPO}/.bzr"
+cvs_test = perl: -d "$ENV{MR_REPO}/CVS"
+hg_test = perl: -d "$ENV{MR_REPO}/.hg"
+darcs_test = perl: -d "$ENV{MR_REPO}/_darcs"
+fossil_test = perl: -f "$ENV{MR_REPO}/_FOSSIL_"
+git_bare_test = perl:
+ -d "$ENV{MR_REPO}/refs/heads" && -d "$ENV{MR_REPO}/refs/tags" &&
+ -d "$ENV{MR_REPO}/objects" && -f "$ENV{MR_REPO}/config" &&
+ `GIT_CONFIG="$ENV{MR_REPO}"/config git config --get core.bare` =~ /true/
svn_update = svn update "$@"
git_update = git pull "$@"
projects / code / myrepos.git / blobdiff