package TTXMail;
#
# This module is a part of Trouble Ticket Express package
# http://www.troubleticketexpress.com
#
# COPYRIGHT: 2003-2005, United Web Coders
# http://www.unitedwebcoders.com
#
# $Revision: 189 $
# $Date: 2006-07-11 07:23:08 -0400 (Tue, 11 Jul 2006) $
#

$TTXMail::VERSION='2.22';
BEGIN {
  $TTXMail::REVISION = '$Revision: 189 $';
  if ($TTXMail::REVISION =~ /(\d+)/) {
    $TTXMail::REVISION = $1;
  }
};

use strict;
use TTXData;
use TTXMarkup;
my $hasb64 = 1;
$hasb64 = 0 unless eval "require MIME::Base64";

my $mailer;
my $smtphost;
my $usesmtp;

my $CRLF    = "\015\012";
my $doemailfix = 0;
# ====================================================================== charset
my $_charset;

sub charset {
  if ($_charset eq undef) {
    $_charset = TTXData::get('CONFIG')->get('charset') || 'ISO-8859-1';
  }
  return $_charset;
}

# ======================================================================= encode

sub encode {
  return $_[0] if $_[0] !~ /[^a-zA-Z0-9 ()[\]_!\/\\{}"';:?<>@#\$%&*\n\r.,-]/;
  return "=?".charset()."?B?".base64($_[0], "")."?=" if !$_[1];
  my $adr = $_[0];
  $adr =~ s/"[^"]*"//;
  $adr =~ s/^[^<]*<//g;
  $adr =~ s/>[^>]*$//g;
  $adr =~ s/^\s+//;
  $adr =~ s/\s+$//;
  my $name = $_[0];
  $name =~ s/<[^>]*>//g;
  $name =~ s/"//g;
  $name =~ s/[a-zA-Z0-9._-]+@[a-zA-Z0-9._-]+//g;
  $name =~ s/^\s+//;
  $name =~ s/\s+$//;
  $name =~ s/\s\s+/ /;
  $name = "=?".charset()."?B?".base64($name, "")."?=" if $name ne undef;
  $name =~ s/\r?\n\r?\s+/ /g;
  my $str;
  if ($name ne undef) {
    $str = "\"$name\" ";
  }
  $str .= "<$adr>";
  return $str;
}
# ========================================================================= smtp

sub smtp {
  if ($usesmtp eq undef) {
    if ($mailer ne undef && -x $mailer) {
      $usesmtp = 0;
    } else {
      $usesmtp = 1;
      unless (eval "require Net::SMTP") { $usesmtp = 0; }
    }
  }
  return $usesmtp;
}
# ===================================================================== sendmail

sub sendmail {
  my $cfg = TTXData::get('CONFIG');
  $doemailfix = $cfg->get('emailfix');
  if ($cfg->get('broadcast') ne undef) {
    $_[0]->{bcc} = $cfg->get('broadcast');
  }
  $mailer = $cfg->get('mailer');
  $smtphost = $cfg->get('smtp');
  my $html = $_[0]->{msg};
  my $msg = TTXMarkup::strip($html);
  srand($$);
  my $rnd;
  for(my $i = 0; $i < 20; $i++) { $rnd .= int rand 10; }
  my $boundary = "------------$rnd";
  my  $txtboundary = $boundary;

#  my $contenttype = "MIME-Version: 1.0\nContent-Type: text/plain; charset=\"".charset()."\"\nContent-Transfer-Encoding: quoted-printable";
  my  $contenttype = "MIME-Version: 1.0\nContent-Type: multipart/alternative;\n boundary=\"$boundary\"";
  my $datetag;
  if ($cfg->get('maildatetag')) {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time());
    $year += 1900;
    my @mabbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @wabbr = qw(Sun Mon Tue Wed Thu Fri Sat);
    $datetag = "Date: $wabbr[$wday], $mday $mabbr[$mon] $year ".
               sprintf("%02u:%02u:%02u", $hour, $min, $sec).
               " +0000\n";
  }
  if (!smtp()) {
    return 0 if !open(MAIL, "|$mailer -t");
    my $bcc = "Bcc: ".$_[0]->{bcc}."\n" if $_[0]->{bcc} ne undef;
    print MAIL "To: ".$_[0]->{to}."\nFrom: ".encode($_[0]->{from}, 1)."\n".$bcc.
               "Subject: ".encode($_[0]->{subject}, 0).
               "\n$datetag$contenttype\n\n".
               "This is a multi-part message in MIME format\n\n".
               "--$txtboundary\nContent-type: text/plain; charset=\"".charset()."\"\n".
               "Content-Transfer-Encoding: quoted-printable\n\n".
               quoteit($msg)."\n\n";
    print MAIL "\n\n--$txtboundary\nContent-type: text/html; charset=\"".charset()."\"\n".
                 "Content-Transfer-Encoding: base64\n\n";
    print MAIL base64(htmlpage($html));
    print MAIL "\n--$txtboundary--\n";
    close MAIL;
  } else {
    my $to = $_[0]->{to};
    $to =~ s/"[^"]*"//;
    $to =~ s/^[^<]*<//g;
    $to =~ s/>[^>]*$//g;
    $to =~ s/^\s+//;
    $to =~ s/\s+$//;
    my $from = $_[0]->{from};
    $from =~ s/"[^"]*"//;
    $from =~ s/^[^<]*<//g;
    $from =~ s/>[^>]*$//g;
    $from =~ s/^\s+//;
    $from =~ s/\s+$//;
    if ($cfg->get('smtptrace')) {
      # save original STDERR destination
      open SAVERR, ">&STDERR";
      # redirect STDERR handle to a file
      open STDERR, '>>'.$cfg->get('basedir').'/smtptrace.txt';
      my $oldfh = select STDERR; $| = 1; select($oldfh); # make unbuffered
    }
    my $s = Net::SMTP->new($smtphost, Debug => $cfg->get('smtptrace') ? 1:0);
    if ($s ne undef) {
      if ($cfg->get('smtplogin') ne undef) {
        my $trypop3 = 0;
        if ($s->can('auth')) {
          eval 'use Authen::SASL';
          if ($@ ne undef) {
            if ($cfg->get('smtptrace')) {
              warn $@;
              warn "No SASL";
              $trypop3 = 1;
            }
          } else {
            my $authcode;
            eval "\$authcode = \$s->auth(\$cfg->get('smtplogin'), \$cfg->get('smtppwd'));";
            if ($@ ne undef) {
              $trypop3 = 1;
              if ($cfg->get('smtptrace')) {
                warn $@;
              }
            } elsif (!$authcode) {
              $trypop3 = 1;
              if ($cfg->get('smtptrace')) {
                warn "auth(login, passwd) failed";
              }
            }
          }
        } else {
          $trypop3 = 1;
          if ($cfg->get('smtptrace')) {
              warn "No auth() method";
          }
        }
        if ($trypop3) {
          if ($cfg->get('smtptrace')) {
            warn 'Trying Net::POP3';
          }
          eval "use Net::POP3;";
          if ($@ ne undef) {
            if ($cfg->get('smtptrace')) {
              warn $@;
            }
          } else {
            my $pop = Net::POP3->new($smtphost);
            if (!$pop) { warn "Can't open connection to pop3 server: $!"; }
            elsif (!defined ($pop->login($cfg->get('smtplogin'), $cfg->get('smtppwd')))) {
              warn "Can't authenticate: $!";
            } else {
              my $messages = $pop->list();
              $pop->quit();
            }
          }
        }
      }
      $s->mail($from);
      if ($_[0]->{bcc} ne undef) {
        $s->to($to, $_[0]->{bcc});
      } else {
        $s->to($to);
      }
      $s->data();
      $s->datasend("To: ".$_[0]->{to}."\n");
      $s->datasend("From: ".encode($_[0]->{from}, 1)."\n");
      $s->datasend("Subject: ".encode($_[0]->{subject}, 0).
                   "\n$datetag$contenttype\n\nThis is a multi-part message in MIME format\n\n");
      $s->datasend(	"--$txtboundary\nContent-type: text/plain; charset=\"".charset()."\"\n".
                    "Content-Transfer-Encoding: quoted-printable\n\n".
	                quoteit($msg)."\n\n");
      $s->datasend("--$txtboundary\nContent-type: text/html; charset=\"".charset()."\"\n".
                   "Content-Transfer-Encoding: base64\n\n");
      $s->datasend(base64(htmlpage($html)));
      $s->datasend("\n--$txtboundary--\n\n");
      $s->dataend();
      $s->quit();
      if ($cfg->get('smtptrace')) {
        # restore original STDERR destination
        open STDERR, ">&SAVERR";
      }
    }
  }
  return 1;
}
# ====================================================================== quoteit

sub quoteit {
  my $in = shift;
  my $out;
  local $_;
  $in =~ s/\015?\012/\n/g;
  while (1) {
    $in =~ s/^(.*?(?:(?:\n)|\Z))//m;
    $_ = $1;
    (defined and length) or last;
    s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
    s/([ \t]+)$/join('', map { sprintf("=%02X", ord($_)) } split('', $1))/egm;
    my $brokenlines = "";
    $brokenlines .= "$1=\n"
    while s/(.*?^[^\n]{73} (?:
         [^=\n]{2} (?! [^=\n]{0,1} $)
         |[^=\n]    (?! [^=\n]{0,2} $)
         |          (?! [^=\n]{0,3} $)
         ))//xsm;
    $_ = "$brokenlines$_";
    if (length($_) < 74) {
      s/^\.$/=2E/g;
      s/^From /=46rom /g;
    }
    s/\015?\012/$CRLF/g;
    $out .= $_;
    (defined($in) and length($in)) or last;
  }
  $out =~ s/\015//g if $doemailfix;
  return $out;
}
# ======================================================================= base64

sub base64 {
  my $in = $_[0];
  my $out;
  my $eol = $_[1];
  $eol = "\n" unless defined $eol;
  while (1) {
    my ($buf, $b64);
    last unless length $in;
    $buf = substr($in, 0, 45);
    substr($in, 0, 45) = '';
    if ($hasb64) {
      $b64 = MIME::Base64::encode_base64($buf, $eol);
    } else {
      $b64 = _b64($buf, $eol);
    }
    $b64 =~ s/\015?\012/$CRLF/g;
    $b64 .= $CRLF if length $eol && $b64 !~ /$CRLF\Z/;
    $out .= $b64;
  }
  return $out;
}
# ========================================================================= _b64
sub _b64 {
  my $out = "";
  my $eol = $_[1];
  $eol = "\n" unless defined $eol;
  pos($_[0]) = 0;
  while ($_[0] =~ /(.{1,45})/gs) {
    $out .= substr(pack('u', $1), 1);
    chop($out);
  }
  $out =~ tr|` -_|AA-Za-z0-9+/|;
  my $padding = (3 - length($_[0]) % 3) % 3;
  $out =~ s/.{$padding}$/'=' x $padding/e if $padding;
  if (length $eol) {
    $out =~ s/(.{1,76})/$1$eol/g;
  }
  return $out;
}
# ===================================================================== htmlpage

sub htmlpage {
  my $pg = $_[0];
  $pg =~ s/\r//g;
  $pg =~ s/\n/<br \/>\n/g;
  $pg = TTXMarkup::html($pg);
  my $buff = <<EOT;
<html>
<head>
<style type="text/css">
.dummy {}
body, td {font-family: verdana,arial,helvetica,sans-serif;font-size: 10pt;color: #000000;}
</style>
</head>
<body>
$pg
</body>
</html>
EOT
  return $buff;
}
1;
#
