X-Git-Url: https://git.madduck.net/code/myrepos.git/blobdiff_plain/09afd4d8b287a7401451541a93343987db979db8..16632d827f322c0767ee67056df7eab90cad016a:/mr

diff --git a/mr b/mr
index ba0cf0a..bcab403 100755
--- a/mr
+++ b/mr
@@ -212,6 +212,13 @@ Use the specified mrconfig file. The default is to use both F<~/.mrconfig>
 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
@@ -367,7 +374,7 @@ been at least 12 hours since the last update.
  
 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 = ...
@@ -417,12 +424,11 @@ to keep track of and remember to delete old repositories.
 
 The "lib" parameter can specify some shell code that will be run
 before each command, this can be a useful way to define shell
-functions for other commands to use.  Unlike most other parameters,
-this can be specified multiple times, in which case the chunks of
-shell code are accumulatively concatenated together.  This is
-particularly useful because it allows the user to build a library of
-shell functions defined in the [DEFAULT] section scattered across
-various mr modules (files referenced by an C<include> directive).
+functions for other commands to use. 
+
+Unlike most other parameters, this can be specified multiple times, in
+which case the chunks of shell code are accumulatively concatenated
+together.
 
 =item fixups
 
@@ -431,31 +437,37 @@ is checked out, or updated. This provides an easy way to do things
 like permissions fixups, or other tweaks to the repository content,
 whenever the repository is changed.
 
-=item pre_ and post_
-
-If a "pre_action" parameter is set, its command is run before mr performs the
-specified action. Similarly, "post_action" parameters are run after mr
-successfully performs the specified action. For example, "pre_commit" is
-run before committing; "post_update" is run after updating.
-
-=back
+=item VCS_action
 
 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
 override these VCS specific actions. To add a new version control system,
 you can just add VCS specific actions for it.
 
-As with the C<lib> parameter, if a parameter is suffixed with
-C<_append>, its value is concatenated to the existing value of the
-parameter for that config block, rather than overwriting it.  In this
-way, actions such as C<fixup> can be constructed accumulatively.
+=item pre_ and post_
+
+If a "pre_action" parameter is set, its command is run before mr performs the
+specified action. Similarly, "post_action" parameters are run after mr
+successfully performs the specified action. For example, "pre_commit" is
+run before committing; "post_update" is run after updating.
+
+=item _append
+
+Any parameter can be suffixed with C<_append>, to add an additional value
+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
 
@@ -518,6 +530,7 @@ my $config_overridden=0;
 my $verbose=0;
 my $quiet=0;
 my $stats=0;
+my $force=0;
 my $insecure=0;
 my $interactive=0;
 my $max_depth;
@@ -526,6 +539,7 @@ my $jobs=1;
 my $trust_all=0;
 my $directory=getcwd();
 
+my $HOME_MR_CONFIG = "$ENV{HOME}/.mrconfig";
 $ENV{MR_CONFIG}=find_mrconfig();
 
 # globals :-(
@@ -537,6 +551,57 @@ my (@ok, @failed, @skipped);
 
 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) = @_;
@@ -545,33 +610,47 @@ sub vcs_test {
 		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];
 	}
 }
 	
@@ -607,8 +686,6 @@ sub action {
 	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/);
 
@@ -616,13 +693,14 @@ sub action {
 	$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";
@@ -699,22 +777,22 @@ sub action {
 		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";
@@ -765,22 +843,20 @@ sub hook {
 
 	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";
@@ -1018,14 +1094,14 @@ 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 $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;
@@ -1117,20 +1193,6 @@ sub is_trusted_checkout {
 	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;
@@ -1195,30 +1257,42 @@ sub loadconfig {
 
 	# 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;
+	
+		if (defined $bootstrap_url) {
+			die "mr: $msg 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: $msg in untrusted $f line $lineno\n".
+				"(To trust this file, list it in ~/.mrtrust.)\n";
 		}
 	};
 
@@ -1226,7 +1300,7 @@ sub loadconfig {
 		$_=$nextline->();
 
 		if (! $trusted && /[[:cntrl:]]/) {
-			trusterror("mr: illegal control character", $f, $line, $bootstrap_url);
+			$trusterror->("illegal control character");
 		}
 
 		next if /^\s*\#/ || /^\s*$/;
@@ -1237,7 +1311,7 @@ sub loadconfig {
 				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;
@@ -1264,7 +1338,7 @@ sub loadconfig {
 				# 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') {
@@ -1276,7 +1350,7 @@ sub loadconfig {
 					# safe.
 				}
 				else {
-					trusterror("mr: illegal setting \"$parameter=$value\"", $f, $line, $bootstrap_url);
+					$trusterror->("illegal setting \"$parameter=$value\"");
 				}
 			}
 
@@ -1649,7 +1723,7 @@ sub find_mrconfig {
 		}
 		$dir=~s/\/[^\/]*$//;
 	}
-	return "$ENV{HOME}/.mrconfig";
+	return $HOME_MR_CONFIG;
 }
 
 sub getopts {
@@ -1659,6 +1733,7 @@ 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,
@@ -1718,7 +1793,7 @@ sub main {
 	init();
 
 	startingconfig();
-	loadconfig("$ENV{HOME}/.mrconfig");
+	loadconfig($HOME_MR_CONFIG);
 	loadconfig($ENV{MR_CONFIG});
 	#use Data::Dumper; print Dumper(\%config);
 	
@@ -1775,24 +1850,24 @@ lib =
 		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 "$@"