#!/usr/bin/perl
# 
# pip
# 
# Wrapper for silly programs that insist on reading from / writing to
# files instead of using stdin and stdout.
# 
# Usage:
# 
# pip [-i|-o]... PROG ARGS...
# 
# where '-i' or '-o' means input or output.  The ARGS should contain
# one or more arguments beginning with '-'; the first occurrence will
# be replaced by a filename used as stdin or stdout.  If the argument
# has extra characters after the '-', these will be used as the
# extension for the filename generated.  Any further '-i' or '-o'
# arguments will be processed in the same way.  Without these flags,
# the command is run as-is without substitution.
# 
# For example:
# 
# pip -i netscape -
# 
# will read a file from standard input, and give it to netscape to
# display.  The final commandline might be 'netscape /tmp/pip123.tmp'.
# 
# pip -o ppmtogif in.gif -
# 
# will run ppmtogif with the input file 'in.gif' and output filename
# something like '/tmp/pip124.tmp'.  Whatever it outputs will then be
# printed to stdout.  (In the case of ppmtogif, this script is not
# necessary, but you get the idea.)
# 
# pip -i -o ppmtogif - -
# 
# will get a file from stdin, run it through ppmtogif, and print the
# results to stdout.  (Putting the switches the other way round will
# not work.)
# 
# If the program you're running uses filename extensions to decide
# what to do (such as the C compiler which does different things with
# files ending in '.c' and '.cc'), then you can make pip generate a
# filename with the desired extension, for example:
# 
# pip -i cc -.c
# 
# which will feed the C compiler with a file ending in '.c'.  This
# works for filename extensions beginning with a dot; an argument
# like '-x' will not be substituted.  Similarly for DOSish programs
# which insist that their output should have a certain extension, you
# can use something like '-.arc' as the placeholder for -o.
# 
# Note that in all these cases, you must wait for all input to be
# consumed, or all output to be produced, before it feeds through.
# You don't get smooth, gradual piping.  (This could be done using
# named pipes instead of plain files, but that would be harder.)
# 
# We also handle 'bunched' arguments, eg '-io'.
# 
# I have never used CP/M, but vaguely remember a command called 'pip'
# which was probably nothing like this.
# 
# BUGS
# 
# Because we unlink leftover temporary files before exiting, and we
# exit as soon as we finish waiting for the command to exit, any
# command which puts itself into the background before opening its
# input files (eg emacs under Windows) will not work.
# 
# This program is in the public domain.  Use at your own risk.
# <http://www.doc.ic.ac.uk/~epa98/work/apps/pip/>.
# 
# Version 0.2.2
# 
# -- Ed Avis, epa98@doc.ic.ac.uk, 2001-01-22
# 

use strict;
use IO::Handle;
sub tmpnam();

if (@ARGV < 1) {
    print STDERR "usage: $0 [-i|-o]... PROG ARGS...\n";
    exit(1);
}

# Split the arguments into flags, and the rest.
my $flags = '';
my @rest = ();

# Get the flags into a big lump.
while (my $arg = shift @ARGV) {
    if ($arg =~ /^-(.*)/) {
	local $_ = $1;
	if (tr/io//c) {
	    die "bad flag $_, expected -i or -o";
	}
	elsif ($_ eq '') {
	    die "argument '-' must come after name of program to run";
	}
	else {
	    $flags .= $_;
	}
    }
    else {
	# Not a flag, push it back and finish.
	unshift @ARGV, $arg;
	last;
    }
}

@rest = @ARGV;
die "no program specified, usage: $0 [-i|-o]... PROG ARGS..."
    if @rest == 0;

my ($prog, @args) = @rest;
my @tmpfiles = ();
my @infiles = ();
my @outfiles = ();
my %type = ();

# Go through all the flags, substituting filenames for '-'
# arguments.
# 
my $flag;
foreach $flag (split(//, $flags)) {
    my $found = 0;
    my $n;
    foreach $n (0 .. $#args) {
	if ($args[$n] =~ /^-(.*)/) {
	    my $ext = $1;
	    next if ($ext ne '' and $ext !~ /^\./);
	    my $tmpfile = tmpnam() . $ext;
	    push @tmpfiles, $tmpfile;
	    if ($flag eq 'i') {
		push @infiles, $tmpfile;
	    }
	    elsif ($flag eq 'o') {
		push @outfiles, $tmpfile;
	    }
	    else { die }

	    $args[$n] = $tmpfile;
	    $found = 1;
	    last;
	}
    }
    die "no '-' argument found for flag $flag" if not $found;
}

# Get stdin if necessary.  Each input file gets the same data.
if (@infiles) {
    my @handles = ();
    foreach (@infiles) {
	my $fh = new IO::Handle;
	open ($fh, ">$_") or die "can't write to $_: $!";
	push @handles, $fh;
    }
    
    while (<STDIN>) {
	my $handle;
	foreach $handle (@handles) {
	    print $handle $_;
	}
    }
  
    foreach (@handles) {
	close $_;
    }
}

# Run the program.
system($prog, @args);

# Remove input files.
foreach (@infiles) {
    (not -e $_) or unlink or die "cannot unlink $_: $!";
}

# Print output if necessary, and remove files.
my $outfile;
foreach $outfile (@outfiles) {
    unless (open (OUTFILE, $outfile)) {
	if ($! =~ /^No such file or directory/
	    and $outfile !~ m!\.[^/]*$!)
        {
	    # Sometimes DOSish programs add an extension to the output
	    # filename without being asked.  Sniff around and see if
	    # we can find any evidence of this.
	    # 
	    if (-e $outfile) {
		die "open() said $outfile doesn't exist, but it does";
	    }
	    my @poss = <$outfile.*>;
	    if (@poss == 0) {
		# Nope, nothing.
		die "cannot open $outfile: $!";
	    }
	    elsif (@poss == 1) {
		# It looks like the program has indeed created an
		# output file with a silly name.
		# 
		my $o = $poss[0];
		$o =~ /^$outfile(\..*)$/ or die;
		my $ext = $1;
		warn <<END;
$prog has created the file '$o' instead of '$outfile'.  Perhaps you
should have given the output placeholder as '-$1' instead of '-'?
END
                open (OUTFILE, $o) or die "cannot open $o: $!";
		$outfile = $o;
	    }
	    else {
		my $s = "$prog did not create $outfile, "
		  . "but it did create: " . join(', ', @poss) . "\n"
		    . "I can't handle this sort of thing, giving up";
		die $s;
	    }
	}
	else {
	    die "cannot open $outfile: $!";
	}
    }
                
    while (<OUTFILE>) {
	print;
    }
    close OUTFILE;
    unlink $outfile or die "cannot unlink $outfile: $!";
}


# tmpnam()
# 
# Return a name for a temporary file.  I would use the tmpnam()
# included with Perl's POSIX module, but some programs from MS-DOS
# backgrounds truncate any leafname with more than eight characters
# before the dot.
# 
# Now POSIX::tmpnam() is insecure, because an attacker might guess the
# filename it will pick and use a symlink attack.  But I'm not sure
# whether this version suffers from the same problem, since it creates
# an 0700 directory.  Actually, it does, because it will use an
# existing directory with the right name rather than insisting on
# creating its own.  So this routine is insecure, don't use it.  I
# will fix this sometime.
# 
sub tmpnam() {
    die 'usage: tmpnam()' if @_;

    # Max. tries to think of a filename before giving up.  The number
    # of digits in $MAX_TRIES-1 is the max. number of characters in
    # the leafname.
    # 
    my $MAX_TRIES = 1000;
    
    use vars '$tmpdir'; # Global var. for temp directory
    $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || $ENV{TEMP} || '/tmp';
    die "bad temp directory $tmpdir" if not -d $tmpdir;

    # Because of the limited length, we might not be able to put our
    # PID into the leafname, so to 'guarantee' uniqueness we make a
    # directory under $tmpdir corresponding to our PID.
    # 
    (-d "$tmpdir/$$")
      or mkdir "$tmpdir/$$", 0700
	or die "cannot mkdir $tmpdir/$$: $!";

    # Pick an unused filename in this directory.  Race condition here
    # if you have two threads with the same PID.
    # 
    for (my $n = 0; $n < $MAX_TRIES; $n++) {
	my $try = "$tmpdir/$$/$n";
	next if -e $try or <$try.*>;
	return $try;
    }
    die "$tmpdir/$$ is full up";
}
# And here's some code to clear up the mess tmpnam() leaves behind.
END {
    (not defined $tmpdir)
      or (not -e "$tmpdir/$$")
	or (rmdir "$tmpdir/$$")
	  or warn "cannot rmdir $tmpdir/$$: $!";
}
