#!/usr/bin/perl
# tristan+perl@ethereal.net 27apr2004
# with plenty of stuff lifted from spamassassin
# see rfc2047

# in .procmailrc:
#   :0 fhw
#   * ^Subject: =\?.*\?B\?.*\?=
#   | $HOME/bin/fixsubj

use constant HAS_MIME_BASE64 => eval { require MIME::Base64; };
use MIME::QuotedPrint;

# Some base64 decoders will remove intermediate "=" characters, others
# will stop decoding on the first "=" character, this one translates "="
# characters to null.
sub base64_decode {
  local $_ = shift;

  s/\s+//g;
  if (HAS_MIME_BASE64 && (length($_) % 4 == 0) &&
      m|^(?:[A-Za-z0-9+/=]{2,}={0,2})$|s)
  {
    # only use MIME::Base64 when the XS and Perl are both correct and quiet
    s/(=+)(?!=*$)/'A' x length($1)/ge;
    return MIME::Base64::decode_base64($_);
  }
  tr|A-Za-z0-9+/=||cd;                  # remove non-base64 characters
  s/=+$//;                              # remove terminating padding
  tr|A-Za-z0-9+/=| -_`|;                # translate to uuencode
  s/.$// if (length($_) % 4 == 1);      # unpack cannot cope with extra byte

  my $length;
  my $out = '';
  while ($_) {
    $length = (length >= 84) ? 84 : length;
    $out .= unpack("u", chr(32 + $length * 3/4) . substr($_, 0, $length, ''));
  }

  return $out;
}

sub qp_or_plain {
  my ($cs, $text) = @_;
  # do nothing unless there's an 8-bit char
  return $text unless ($text =~ /[\x80-\xff]/);
  $text = '=?'.$cs.'?Q?'.encode_qp($text).'?=';
  $text =~ s/ /_/g;
  return $text;
}

sub b64_to_qp {
  my($header) = @_;
  return '' unless $header;
  $header =~ s/\n[ \t]+/\n /g;
  $header =~ s/\r?\n//g;
  return $header unless $header =~ /=\?/;
  $header =~ s/=\?([\w_-]+)\?[bB]\?(.*?)\?= ?/qp_or_plain($1, base64_decode($2))/ge;
  return $header;
}

while (<>) {
  if ($body) {
    print;
    next;
  }

  if (/^$/) {
    $body = 1;
  }

  if (/^Subject: (.*)/) {
    $subject = $1;
    next;
  } elsif ($subject && /^ /) {
    $subject .= "\n$_";
    next;
  } elsif ($subject) {
    print "Subject: ".b64_to_qp($subject)."\n";
    undef $subject;
  }

  print;
}