#!/usr/local/bin/perl
# readNeXT -- Read the ASCII parts of NeXT mail
#	Brian Katzung  2 March 1994
#
# This software is provided on a strictly as-is basis.
# Use it at your own risk.
#

eval "exec perl -S $0 $*"
  if $isAShell;

#
# Command paths
#
$arch = `/home/katzung/env/bin/_arch`;
chop($arch);
$rtftxt = "/home/katzung/env/$arch/bin/rtftxt";
$tar = '/usr/bin/tar';
$uudecode = '/usr/bin/uudecode';
$zcat = '/usr/ucb/zcat';

$tmp = '/usr/tmp';
$scratchDirectory = "$tmp/rna.$$";

$true = 1;
$false = 0;
$myName = 'readNeXT';

$sep = "\n----------\n";
$end = "\n------------\n";

@trapSignals = ('HUP', 'INT', 'QUIT', 'TERM');

######################################################################
# Clean up temporary files on interrupt
sub cleanup
{
	foreach $signal (@trapSignals)
	{
		$SIG{$signal} = 'IGNORE';
	}
	chdir($tmp);
	system(('/bin/rm', '-rf', $scratchDirectory)) if
	  $scratchDirectory ne '' && -d $scratchDirectory;
	exit($_[0]);
}

######################################################################
# Return true if a file contains characters other than 7-bit ASCII
sub isBin
{
	local($file) = $_[0];
	local(*FILE);
	local($data);

	if (!open(FILE, "<$file"))
	{
		warn "$myName:  Cannot open \"$file\"";
		&cleanup(1);
	}
	read(FILE, $data, 8192);
	close(FILE);
	$data =~ /[\200-\377]/;
}

######################################################################
# Flush stdout
sub flush
{
	$| = 1;
	print "";
	$| = 0;
}

######################################################################
# Repackage a NeXT Attachment as individual, uuencoded attachments
sub repackageAttachment
{
	local($file);
	local(@attachments);
	local(*UUDECODE);
	local(*DOT);
	local(*FILE);
	local($terminate);

	#
	# Create a scratch directory in which to work
	#
	die "$myName:  Unable to create scratch directory:  $scratchDirectory"
	  if mkdir($scratchDirectory, 0700) != 1;
	if (!chdir($scratchDirectory))
	{
		warn "$myName:  Unable to change to directory:  " .
		  $scratchDirectory;
		&cleanup(1);
	}

	#
	# Feed the attachment to uudecode for decoding.
	#
	if (!open(UUDECODE, "|$uudecode"))
	{
		warn "$myName:  Unable to pipe to uudecode";
		&cleanup(1);
	}
	print UUDECODE "begin 0600 .$$.tar.Z\n";
	while (<>)
	{
		print UUDECODE $_;
		last if /^end/;
	}
	close(UUDECODE);

	#
	# Decompress the attachment and extract the contents of
	# the tar archive.
	#
	if (system("$zcat .$$.tar.Z | $tar xf -") != 0)
	{
		warn "$myName:  Attempt to decode NeXT attachment failed";
		&cleanup(1);
	}
	unlink(".$$.tar.Z");

	if (!opendir(DOT, '.'))
	{
		warn "$myName:  Unable to read directory:  $scratchDirectory";
		&cleanup(1);
	}

	#
	# Convert the RTF body text to flat ASCII and insert it
	# into the output.
	#
	&flush;
	system(($rtftxt, 'index.rtf'));

	#
	# Process each file, inserting ASCII ones into the output.
	#
	$terminate = $false;
	foreach $file (grep(-f, readdir(DOT)))
	{
		next if ($file eq 'index.rtf') ||
		  (&isBin($file) && $file !~ /.rtf$/);
		$terminate = $true;
		if ($file =~ /.rtf$/)
		{
			print $sep . "Comments: Attachment \"$file\"\n\n";
			&flush;
			system(($rtftxt, $file));
		}
		elsif (open(FILE, "<$file"))
		{
			print $sep . "Comments: Attachment \"$file\"\n\n";
			print while (<FILE>);
			close(FILE);
		}
		else
		{
			print $sep . "Comments: Attachment \"$file\" " .
			  "is unreadable\n\n";
		}
	}
	closedir(DOT);
	print $end if $terminate == $true;

	if (!chdir($tmp))
	{
		warn "$myName:  Unable to change to directory:  $tmp";
		&cleanup(1);
	}
	system(('/bin/rm', '-rf', $scratchDirectory));
}

######################################################################
# Main program

#
# Catch signals for cleanup
#
foreach $signal (@trapSignals)
{
	$SIG{$signal} = 'cleanup' if $SIG{$signal} ne 'IGNORE';
}

#
# Scan the header for a NeXT Attachment indicator.
#
$hasNeXTAttachment = $false;
while (<>)
{
	if ($_ =~ /^next-attachment:/i)
	{
		#
		# Note the fact that the body contains a NeXT attachment,
		# but don't keep the header since we are going to split
		# the attachment into it's component pieces.
		#
		$hasNeXTAttachment = $true;
	}
	else
	{
		print;
		last if $_ eq "\n";		# End of headers
	}
}

if ($hasNeXTAttachment == $false)
{
	#
	# If there are no NeXT Attachments, just copy the input to the output.
	#
	print while (<>);
}
else
{
	#
	# Copy the input to the output, looking for the start of NeXT
	# attachments and repackaging them as we go.
	#
	while (<>)
	{
		if ($_ =~ /^begin [0-7]+/)
		{
			&repackageAttachment;
		}
		else
		{
			print;
		}
	}
}

&cleanup(0);