summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Master/tlpkg/dev/dev.sys_redir.README16
-rw-r--r--Master/tlpkg/dev/dev.sys_redir.pl119
-rw-r--r--TODO3
3 files changed, 138 insertions, 0 deletions
diff --git a/Master/tlpkg/dev/dev.sys_redir.README b/Master/tlpkg/dev/dev.sys_redir.README
new file mode 100644
index 00000000000..860d859a458
--- /dev/null
+++ b/Master/tlpkg/dev/dev.sys_redir.README
@@ -0,0 +1,16 @@
+Replacement for system('foo <bar >bar') without using a shell.
+Would solve quoting problems once and for all.
+
+includes a test routine with a few tests, lacking tests for stderr redirection
+right now
+
+needs to be tested on windows too!
+
+Ideas for running tests (Unix):
+
+# echo abc > Cin; echo 123 >> Cin
+perl redir.pl # interactive, just keep typing 'y' <ENTER>
+yes | perl redir.pl
+yes | perl redir.pl >Pout 2>Perr
+yes | perl redir.pl >Pcomb 2>&1
+
diff --git a/Master/tlpkg/dev/dev.sys_redir.pl b/Master/tlpkg/dev/dev.sys_redir.pl
new file mode 100644
index 00000000000..fd3960b67b2
--- /dev/null
+++ b/Master/tlpkg/dev/dev.sys_redir.pl
@@ -0,0 +1,119 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+# flush an output stream
+# argument: a filehandle reference
+sub flush {
+ my ($fh) = @_;
+
+ my $prev_fh = select($fh);
+ my $prev_autoflush = $|;
+ $| = 1; # force a flush and turn on autoflush
+ $| = $prev_autoflush; # restore the previous autoflush status for this fh
+ select($prev_fh);
+}
+
+# run a command with (optional) redirections, without a shell
+#
+# arguments: input filename, output filename, error filename
+# (undef for a filename means no redirection)
+# return value: exit status from the child
+#
+# usage:
+# my $status = sys_redir('foo.tar.xz', 'foo.tar', 'undef', 'xzdec', '-q')
+# equivalent to
+# system('xzdec -q <foo.tar.xz >foo.tar');
+# my $status = $? >> 8;
+# execpt it never runs a shell and does some additional error checking
+sub sys_redir {
+ my $in = shift;
+ my $out = shift;
+ my $err = shift;
+
+ # description for error messages
+ my $desc = "@_";
+ $desc .= " <$in" if defined $in;
+ $desc .= " <$out" if defined $out;
+ $desc .= " <$err" if defined $err;
+
+ # log what we're about to do
+ ddebug("Preparing to run: $desc\n");
+
+ # flush stdout and stderr for tydiness
+ flush \*STDOUT;
+ flush \*STDERR;
+
+ # duplicate file handles
+ open(my $stdin, '<&', \*STDIN) || die "$desc: failed to dup stdin: $!\n";
+ open(my $stdout, '>&', \*STDOUT) || die "$desc: failed to dup stdout: $!\n";
+ open(my $stderr, '>&', \*STDERR) || die "$desc: failed to dup stderr: $!\n";
+
+ # possibly tweak the file handles
+ if (defined $in) {
+ open(STDIN, '<', $in) || die "$desc: failed to read from $in: $!\n";
+ }
+ if (defined $out) {
+ open(STDOUT, '>', $out) || die "$desc: failed to write to $out: $!\n"
+ }
+ if (defined $err) {
+ open(STDERR, '>', $err) || die "$desc: failed to write to $err: $!\n"
+ }
+
+ # run the command
+ system { $_[0] } @_;
+
+ # check common errors and get actual exit value
+ # (taken from perldoc -f system)
+ my $ret;
+ if ($? == -1) {
+ die "failed to execute $desc: $!\n";
+ } elsif ($? & 127) {
+ die sprintf("child $desc died with signal %d, %s coredump\n",
+ ($? & 127), ($? & 128) ? 'with' : 'without');
+ } else {
+ $ret = $? >> 8;
+ }
+
+ # flush stdout and stderr again for tydiness
+ flush \*STDOUT;
+ flush \*STDERR;
+
+ # restore handles
+ open(STDIN, '<&', $stdin) || die "$desc: failed to restore stdin: $!\n";
+ open(STDOUT, '>&', $stdout) || die "$desc: failed to restore stdout: $!\n";
+ open(STDERR, '>&', $stderr) || die "$desc: failed to restore stderr: $!\n";
+
+ # log the return value
+ ddebug("Child '$desc' returned: $ret\n")
+
+ # done
+ return $ret;
+}
+
+my $i;
+
+sub test {
+ $i++;
+ print STDERR "\n";
+ print "\n===> BEGIN $i <===\n";
+ print "$i Child expects input, please type something\n" if !defined $_[0];
+ print "$i Unflushed sdtout from parent"; # no \n
+ print STDERR "$i Unflushed sdterr from parent"; # no \n
+ my $status = sys_redir @_;
+ print "$i Parent writing to stdout (please type something)\n";
+ print "$i Parent reading from stdin: ", scalar <>;
+ warn "$i Parent writing to stderr\n";
+}
+
+test('Cin', 'Cout1', undef, 'perl', '-ne',
+ 'print "C in-out1 $_"; warn "W in-out1\n"');
+test('Cin', undef, undef, 'perl', '-ne',
+ 'print "C in- $_"; warn "W in-\n"');
+test(undef, 'Cout2', undef, 'perl', '-e',
+ 'print "C -out2 ", scalar <>; warn "W -out2\n"');
+test(undef, undef, undef, 'perl', '-e',
+ 'print "C - ", scalar <>; warn "W -\n"');
+
+# vim: ts=2 sw=2 et
diff --git a/TODO b/TODO
index 7fbc40794ed..5da38385d94 100644
--- a/TODO
+++ b/TODO
@@ -111,6 +111,9 @@ dvips and all: snprintf
release directory (tldev, 2008) instead of hardwiring. Then update
doc/packages.txt.
+- tlmgr & installer: stop using system(foo <bar >baz)
+to avoid shell quoting problems, see dev/dev.sys_redir.pl
+
infra: texmf/xindy not reported by check-file-coverage though not in tlp's
MAYBE TODO (needs discussion)