#!/usr/bin/perl
# $Id: unmime,v 1.4 2000/11/22 05:15:17 srivasta Exp $
#
#  Copyright (c) 1990-1993, Raphael Manfredi
#  
#  You may redistribute only under the terms of the Artistic License,
#  as specified in the README file that comes with the distribution.
#  You may reuse parts of this distribution only within the terms of
#  that same Artistic License; a copy of which may be found at the root
#  of the source tree for mailagent 3.0.
#
# Original Author: Eryq / eryq@rhine.gsfc.nasa.gov
#
# Integrated into mailagent and modified with Eryq's permission.
#
# $Log: unmime,v $
# Revision 1.4  2000/11/22 05:15:17  srivasta
# new version
#
# Revision 3.0.1.3  1998/03/31  15:31:34  ram
# patch59: new -x and -X options to cope with accentuated letters
# patch59: added removal of ugly ?iso-8859-1?Q escapes in subject
#
# Revision 3.0.1.2  1997/02/20  11:49:29  ram
# patch55: the -e un-escape was overzealous for uuencoded parts...
# patch55: made the filter die if an error occurs to prevent feedback
#
# Revision 3.0.1.1  1996/12/24  15:04:50  ram
# patch45: created
#

# Un-MIME regular message from stdin.
# Non-text version saved in directory ~/mail/MIME and proper indication is
# left in the dumped message. Text is otherwise dumped and deleted from there.
#
# Intended to be used with mailagent thanks to the following incantation rule:
#
# Mime-Version: /^\d/	{ SAVE +mime; FEED ~/mail/unmime; RESYNC; REJECT };
#
# Actually, that is just the basic idea. The real set of rules I use for
# this can be found in misc/mime/rules, in the mailagent distribution.
#
# WARNING: copy this script to ~/mail/unmime only when you're done with
# it since mailagent can pop up and use it anytime once the above is plugged.
#
# Options:
#   -e: pass the quoted-printable decoder over the message and that's it.
#	-x: translate chars not understood by some iso8859-1 fonts.
#	-X: translate all accents to non-accentuated letters (plain ASCII).

($me = $0) =~ s|.*/(.*)|$1|;

require "getopts.pl";
Getopts('exX');

$opt_x++ if $opt_X;		# -X implies -x

$TMPDIR = "$ENV{HOME}/var/tmp/MIME";

use MIME::Parser;

#------------------------------------------------------------
# dump_entity - idempotent routine for dumping an entity
#------------------------------------------------------------

sub dump_entity {
  my ($entity) = @_;
  my $IO;
  my $not_first_part = 0;
  
  # Print the header, converting accents if any
  my $head = $entity->head->original_text;
  $head =~ s/^(Subject:.*)/no_iso_markup($1)/me
    if $head =~ /^Subject:.*=\?iso-8859-1\?Q\?/mi;
  print $head, "\n";
  
  # Output the body:
  my @parts = $entity->parts;
  if (@parts) {			# multipart...
    my $i;
    foreach $i (0 .. $#parts) { # dump each part...
      dump_entity($parts[$i]);
    }
  } else {			# single part... 
    # Get MIME type, and display accordingly...
    my ($type, $subtype) = split('/', $entity->head->mime_type);
    #print STDERR "type - $type\n";
    
    my $body = $entity->bodyhandle;
    my $path = $body->path;
    if ($type =~ /^(text|message)$/ || -T $path) {	 # text: display it...
      if ($IO = $body->open("r")) {
	print "\n" if $not_first_part++;
	print to_ascii($_) while (defined($_ = $IO->getline));
	$IO->close;
	
	# If message is text/message, chances that we did the right
	# thing are extremely high. So unlink the message if lying on
	# the disk... -- RAM, 19/11/96

	unlink($path) or warn "$me: can't unlink $path: $!\n"
	  if defined $path && -f $path;
	
      } else {			# d'oh!
	die "$me: couldn't find/open '$file': $!";
      }
    } else {			# binary: just summarize it...
      my $size = ($path ? (-s $path) : '???');
      print ">>> This is a non-text message, $size bytes long.\n";
      print ">>> It is stored in ", ($path ? "'$path'" : 'core'),".\n\n";
    }
  }
  print "\n";
  
  1;
}

#------------------------------------------------------------
# smart_pack
#------------------------------------------------------------
sub smart_pack {
  my ($hexa) = @_;
  my $val = hex($hexa);
  return "=$hexa" if $val >= 128; # We're smart right there!
  return pack('C', $val);
}

#------------------------------------------------------------
# no_accent
#------------------------------------------------------------
sub no_accent {
  local ($_) = @_;
  tr/\xab\xbb\xe0\xe2\xe7\xe8\xe9\xea\xee\xef\xf4\xf9\xfb/""aaceeeiiouu/;
  return $_;
}

#------------------------------------------------------------
# to_ascii
#------------------------------------------------------------
sub to_ascii {
  my ($l) = @_;
  return $l unless $opt_x;	# Don't loose info unless -x or -X
  $l =~ tr/\x92/'/ if $opt_x;	# ';
  $l = no_accent($l) if $opt_X;
  return $l;
}

#------------------------------------------------------------
# to_txt -- combines =xx packing with no_accent()
#------------------------------------------------------------
sub to_txt {
  my ($l) = @_;
  $l =~ s/=([\da-fA-F]{2})/pack('C', hex($1))/ge;
  return no_accent($l);
}

#------------------------------------------------------------
# no_iso_markup -- removes ugly ?iso-8859-1?Q escapes
#------------------------------------------------------------
sub no_iso_markup {
  local ($_) = @_;
  s/^(.*?)=\?iso-8859-1\?Q\?(.*)\?=/$1 . to_txt($2)/ie;
  s/_/ /g;
  return $_;
}

#------------------------------------------------------------
# unquote_stdin
#------------------------------------------------------------
sub unquote_stdin {
  local $_;
  my $encoded = 0;
  my $in_header = 1;
  while (<STDIN>) {
    $in_header = 0 if /^\s*$/;
    
    # All Subject: line with accents to be "un-mimed" as well.
    s/^(Subject:.*)/no_iso_markup($1)/e 
      if $in_header && /^Subject:.*=\?iso-8859-1\?Q\?/i;
    
    # Avoid decoding inlined uuencoded/btoa stuff... since they might
    # accidentally bear valid =xx escapes... The leading \w character
    # is there in case the thing is shar'ed...
    # Likewise, all the lines longer than 60 chars and with no space
    # in them are treated as being encoded iff they begin with M.

    $encoded = 1 if /^\w?begin\s+\d+\s+\S+\s*$/ || /^\w?xbtoa Begin\s*$/;
    $encoded = 0 if /^\w?end\s*$/ || /^\w?xbtoa End/;
    
    if ($encoded || (length > 60 && !/ / && /^M/)) {
      print $_;
    } else {
      # Can't use decode_qp from MIME::QuotedPrint because we might not
      # face a real quoted-printable message...
      # Inline an alternate  version.
      
      s/\s+(\r?\n)/$1/g;	# Trailing white spaces
      s/^=\r?\n//;		# Soft line breaks
      s/([^=])=\r?\n/$1/;	# Soft line breaks, but not for trailing == 
      s/=([\da-fA-F]{2})/smart_pack($1)/ge;	# Hehe
      print to_ascii($_);
    }
  }
  return 1;	# OK
}

#------------------------------------------------------------
# main
#------------------------------------------------------------

sub main {
  return &unquote_stdin if $opt_e;
  
  # Create a new MIME parser:
  my $parser = new MIME::Parser;
  
  # Create and set the output directory:
  $parser->output_dir($TMPDIR);
  
  # Read the MIME message:
  $entity = $parser->read(\*STDIN) or
    die "$me: couldn't parse MIME stream";
  
  # Dump it out:
  dump_entity($entity);
}

exit(&main ? 0 : -1);

#------------------------------------------------------------
1;