Remove use of IPC::Run3

The main use of IPC::Run3 was to be able to answer A(bort) in tsmretriever
if dsmc got into a mode where it wanted to ask a question.

IPC::Run3 also has a number of drawbacks, the most obvious one being that
it stores all output data in temporary files and thus only available after
the command has finished.

Using a standard pipe open we can detect an error condition and abort
by simply killing the dsmc process instead.

Fixes #15.

tsmarchiver.pl

@@ -19,7 +19,6 @@
 use warnings;
 use strict;
 
-use IPC::Run3;
 use POSIX qw(strftime);
 use File::Temp qw /tempfile/;
 use File::Basename;
@@ -130,13 +129,36 @@ INIT
 		"-description=ENDIT-$now","-filelist=$fn");
 	printlog "Executing: " . join(" ", @cmd) if($conf{debug});
 	my $execstart = time();
-	my ($out,$err);
-	if((run3 \@cmd, \undef, \$out, \$err) && $? ==0) { 
+
+	my $dsmcfh;
+	my @errmsgs;
+	my @out;
+	if(open($dsmcfh, "-|", @cmd)) {
+		while(<$dsmcfh>) {
+			chomp;
+
+			# Catch error messages, only printed on non-zero return
+			# code from dsmc
+			if(/^AN\w\d\d\d\d\w/) {
+				push @errmsgs, $_;
+				next;
+			}
+			# Save all output
+			push @out, $_;
+		}
+	}
+
+	if(!close($dsmcfh) && $!) {
+		warn "closing pipe from dsmc: $!";
+	}
+	if($? == 0) { 
 		my $duration = time()-$execstart;
 		$duration = 1 unless($duration);
 		my $stats = sprintf("%.2f MiB/s (%.2f files/s)", $usage*1024/$duration, scalar(@files)/$duration);
 		printlog "Archive operation successful, duration $duration seconds, average rate $stats";
-		printlog $out if $conf{'debug'};
+		if($conf{debug}) {
+			printlog "dsmc output: " . join("\n", @out);
+		}
 		# files migrated to tape without issue
 	} else {
 		# something went wrong. log and hope for better luck next time?
@@ -145,15 +167,20 @@ INIT
 			$msg .= "failed to execute: $!";
 		}
 		elsif ($? & 127) {
-			$msg .= sprintf "child died with signal %d, %s coredump",
+			$msg .= sprintf "dsmc died with signal %d, %s coredump",
 			       ($? & 127),  ($? & 128) ? 'with' : 'without';
 		}
 		else {
-			$msg .= sprintf "child exited with value %d\n", $? >> 8;
+			$msg .= sprintf "dsmc exited with value %d\n", $? >> 8;
 		}
 		printlog "$msg";
-		printlog "STDERR: $err";
-		printlog "STDOUT: $out";
+
+		foreach my $errmsg (@errmsgs) {
+			printlog "dsmc error message: $errmsg";
+		}
+		if($conf{verbose}) {
+			printlog "dsmc output: " . join("\n", @out);
+		}
 
 		# Avoid spinning on persistent errors.
 		sleep $conf{sleeptime};

tsmdeleter.pl

@@ -19,7 +19,6 @@
 use warnings;
 use strict;
 
-use IPC::Run3;
 use POSIX qw(strftime);
 use File::Temp qw /tempfile/;
 use File::Basename;
@@ -104,18 +103,49 @@ sub rundelete {
 	my @cmd = ('dsmc','delete','archive','-noprompt',
 		@dsmcopts,"-filelist=$filelist");
         printlog "Executing: " . join(" ", @cmd) if($conf{debug});
-	if((run3 \@cmd, \undef, \$out, \$err) && $? ==0) { 
-		# files removed from tape without issue
-	} else {
-		# ANS1345E - file already deleted
-		# or ANS1302E - all files already deleted
-		# Also ignore ANS1278W - irrelevant
-		my @outl = split /\n/m, $out;
-		my @errorcodes = grep (/^ANS/, @outl);
-		foreach my $error (@errorcodes) {
-			if($error =~ /^ANS1345E/ or $error =~ /^ANS1302E/ or $error =~ /^ANS1278W/ or $error =~ /^ANS1898I/) {
-				printlog "File already deleted:\n$error\n" if $conf{'verbose'};
-			} else {
+
+	my $dsmcfh;
+	my @errmsgs;
+	my @out;
+	if(open($dsmcfh, "-|", @cmd)) {
+		while(<$dsmcfh>) {
+			chomp;
+
+			# Catch error messages.
+			if(/^AN\w\d\d\d\d\w/) {
+				push @errmsgs, $_;
+				next;
+			}
+			# Save all output
+			push @out, $_;
+		}
+	}
+	if(!close($dsmcfh) && $!) {
+		warn "closing pipe from dsmc: $!";
+	}
+
+	if($? != 0) { 
+		# Some kind of problem occurred.
+
+		# Ignore known benign errors:
+		# - ANS1345E No objects on the server match object-name
+		# => file already deleted
+		# - ANS1302E No objects on server match query
+		# => all files already deleted
+		# - ANS1278W Virtual mount point 'filespace-name' is a file
+		#   system. It will be backed up as a file system.
+		# => irrelevant noise
+		# - ANS1898I ***** Processed count files *****
+		# => progress information
+
+		foreach (@errmsgs) {
+			if(/^ANS1278W/ or /^ANS1898I/) {
+				next;
+			}
+			elsif(/^ANS1345E/ or /^ANS1302E/) {
+				printlog "File already deleted: $_" if $conf{'verbose'};
+			}
+			else {
 				$reallybroken=1;
 			}
 		}
@@ -132,8 +162,9 @@ sub rundelete {
 				$msg .= sprintf "child exited with value %d\n", $? >> 8;
 			}
 			printlog "$msg";
-			printlog "STDERR: $err";
-			printlog "STDOUT: $out";
+			if($conf{verbose}) {
+				printlog "dsmc output: " . join("\n", @out);
+			}
 		}
 	}
 	return $reallybroken;

tsmretriever.pl

@@ -19,7 +19,6 @@
 use warnings;
 use strict;
 
-use IPC::Run3;
 use POSIX qw(strftime WNOHANG);
 use JSON;
 use File::Temp qw /tempfile/;
@@ -388,9 +387,47 @@ ()
 				my @cmd = ('dsmc','retrieve','-replace=no','-followsymbolic=yes',@dsmcopts, "-filelist=$listfile",$indir);
 				printlog "Executing: " . join(" ", @cmd) if($conf{debug});
 				my $execstart = time();
-				my ($in,$out,$err);
-				$in="A\n";
-				if((run3 \@cmd, \$in, \$out, \$err) && $? == 0) {
+				my @out;
+				my @errmsgs;
+				my $usractionreq = 0;
+				my $dsmcpid = open(my $dsmcfh, "-|", @cmd);
+				if($dsmcpid) {
+					while(<$dsmcfh>) {
+						chomp;
+
+						# Catch error messages, only
+						# printed on non-zero return
+						# code from dsmc
+						if(/^AN\w\d\d\d\d\w/) {
+							push @errmsgs, $_;
+						}
+
+						# Detect and save interactive
+						# messages as error messages
+						if(/^--- User Action is Required ---$/) {
+							$usractionreq = 1;
+						}
+						if($usractionreq) {
+							push @errmsgs, $_;
+						}
+
+						# Save all output for verbose
+						# output
+						push @out, $_;
+
+						if(/^Action\s+\[.*\]\s+:/) {
+							printlog "dsmc prompt detected, aborting";
+							kill("TERM", $dsmcpid);
+							last;
+						}
+
+					}
+
+				}
+				if(!close($dsmcfh) && $!) {
+					warn "closing pipe from dsmc: $!";
+				}
+				if($? == 0) {
 					my $duration = time()-$execstart;
 					$duration = 1 unless($duration);
 					my $sizestats = sprintf("%.2f GiB in %d files", $lfsize/(1024*1024*1024), $lfentries);
@@ -409,11 +446,16 @@ ()
 						$msg .= sprintf "child died with signal %d, %s coredump", ($? & 127),  ($? & 128) ? 'with' : 'without';
 					}
 					else {
-						$msg .= sprintf "child exited with value %d\n", $? >> 8;
+						$msg .= sprintf "child exited with value %d", $? >> 8;
 					}
 					printlog "$msg";
-					printlog "STDERR: $err";
-					printlog "STDOUT: $out";
+
+					foreach my $errmsg (@errmsgs) {
+						printlog "dsmc error message: $errmsg";
+					}
+					if($conf{verbose}) {
+						printlog "dsmc output: " . join("\n", @out);
+					}
 
 					# sleep to pace ourselves if these are
 					# persistent reoccurring failures