2021-12-30 12:05:56 +01:00
|
|
|
package Mod::MailTransport;
|
|
|
|
#
|
|
|
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
|
|
|
|
#
|
|
|
|
# new emailing module
|
|
|
|
#
|
|
|
|
#perl -cw src/Mod/MailTransport.pm
|
|
|
|
#use lib "/var/www/copri4/shareeapp-operator/src";
|
|
|
|
#
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
use POSIX;
|
|
|
|
use CGI ':standard';
|
|
|
|
use Email::MIME;
|
|
|
|
use IO::All;
|
|
|
|
use Email::Sender::Simple qw(sendmail);
|
|
|
|
use Net::SMTP;
|
|
|
|
use Try::Tiny;
|
|
|
|
use Config::General;
|
|
|
|
use Sys::Hostname;
|
|
|
|
my $hostname = hostname;
|
|
|
|
|
|
|
|
use Lib::Config;
|
|
|
|
use Mod::Basework;
|
|
|
|
use Mod::DBtank;
|
|
|
|
use Data::Dumper;
|
|
|
|
|
|
|
|
sub new {
|
|
|
|
my $class = shift;
|
|
|
|
my $self = {};
|
|
|
|
bless($self,$class);
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
|
|
|
my $q = new CGI;
|
|
|
|
my $cf = new Config;
|
|
|
|
my $bw = new Basework;
|
|
|
|
my $dbt = new DBtank;
|
|
|
|
|
|
|
|
my $mailx_file = "/var/www/copri4/shareeconf/mailx.cfg";
|
|
|
|
my $conf = Config::General->new($mailx_file);
|
|
|
|
my %mailxconf = $conf->getall;
|
|
|
|
|
|
|
|
sub send_mail(){
|
|
|
|
my $self = shift;
|
|
|
|
my $sendref = shift;
|
|
|
|
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
|
|
|
|
|
2022-01-12 09:27:23 +01:00
|
|
|
my $mail_from = $sendref->{mail_from} || $mailxconf{mailx_default}->{mail_from};
|
|
|
|
my $mail_to = $sendref->{mail_to} || $mailxconf{mailx_default}->{mail_to};
|
2021-12-30 12:05:56 +01:00
|
|
|
my $subject = $sendref->{subject} || "subject fails";
|
|
|
|
my $filename = $sendref->{filename} || "";
|
|
|
|
my $message = $sendref->{message} || "Failure, no message\n";
|
|
|
|
#If caller use utf8, message is encoded as utf-8
|
|
|
|
#$message = Encode::encode('utf-8', Encode::decode('iso-8859-1', $message));
|
|
|
|
|
|
|
|
#Special tink statisk, readdir with filename
|
|
|
|
#$filename like "2018-12"
|
|
|
|
my @files = ($filename);
|
|
|
|
|
|
|
|
#disabled because of zipping
|
|
|
|
#TODO, check what happens about Statistik-occubike_station_2019-1-konrad.csv
|
|
|
|
#Okay, send_mail breaks on verylong Statistik lines. CSV zipping is the solution
|
|
|
|
#@files = $lb->read_dirfiles("$dbt->{copri_conf}->{basedir}/csv",$filename,"file","") if($filename =~ /\d+-\d+/);
|
|
|
|
|
|
|
|
if($dbt->{copri_conf}->{stage} eq "test"){
|
2022-01-12 09:27:23 +01:00
|
|
|
$mail_to = $mailxconf{mailx_default}->{mail_to};
|
2021-12-30 12:05:56 +01:00
|
|
|
$subject .= " * offline Test *";
|
|
|
|
}
|
|
|
|
|
|
|
|
$bw->log("Trying send_mail:$0",$sendref,"");
|
|
|
|
|
|
|
|
|
|
|
|
if(ref($sendref) eq "HASH"){
|
|
|
|
|
2022-01-12 09:27:23 +01:00
|
|
|
$mailxconf{mailx_default}->{sasl_password} = Encode::encode('iso-8859-1', Encode::decode('utf-8', $mailxconf{mailx_default}->{sasl_password}));
|
2021-12-30 12:05:56 +01:00
|
|
|
my $transport = Email::Sender::Transport::SMTPS->new(
|
2022-01-12 09:27:23 +01:00
|
|
|
host => "$mailxconf{mailx_default}->{mail_gateway}",
|
2021-12-30 12:05:56 +01:00
|
|
|
ssl => 'ssl',
|
|
|
|
port => 465,
|
2022-01-12 09:27:23 +01:00
|
|
|
sasl_username => "$mailxconf{mailx_default}->{sasl_username}",
|
|
|
|
sasl_password => "$mailxconf{mailx_default}->{sasl_password}",
|
|
|
|
helo => "$mailxconf{mailx_default}->{mail_from}",
|
|
|
|
debug => 1,
|
2021-12-30 12:05:56 +01:00
|
|
|
);
|
|
|
|
|
|
|
|
|
|
|
|
#multipart message
|
|
|
|
#Email::MIME !!!
|
|
|
|
if(1==1){
|
|
|
|
my @parts = ();
|
|
|
|
|
|
|
|
my $parts_1 = (
|
|
|
|
Email::MIME->create(
|
|
|
|
attributes => {
|
|
|
|
content_type => "text/plain",
|
|
|
|
#disposition => "attachment",
|
|
|
|
encoding => "quoted-printable",
|
|
|
|
charset => "UTF-8",
|
|
|
|
},
|
|
|
|
body_str => "$sendref->{message}",
|
|
|
|
),
|
|
|
|
);
|
|
|
|
push(@parts,$parts_1);
|
|
|
|
|
|
|
|
|
|
|
|
foreach $filename (@files){
|
|
|
|
if($filename){
|
|
|
|
my $parts_0 = (
|
|
|
|
Email::MIME->create(
|
|
|
|
attributes => {
|
|
|
|
filename => "$filename",
|
|
|
|
#content_type => "application/pdf",
|
|
|
|
#content_type => "text/csv",
|
|
|
|
content_type => "application/octet-stream",
|
|
|
|
disposition => "attachment",
|
|
|
|
encoding => "quoted-printable",
|
|
|
|
name => "$filename",
|
|
|
|
},
|
|
|
|
body => io( "$dbt->{copri_conf}->{basedir}/csv/$filename" )->binary->all,
|
|
|
|
),
|
|
|
|
);
|
|
|
|
|
|
|
|
$bw->log("Attachment:$dbt->{copri_conf}->{basedir}/csv/$filename","","");
|
|
|
|
push(@parts,$parts_0);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
$message = Email::MIME->create(
|
|
|
|
header_str => [ From => "$mail_from",
|
|
|
|
To => "$mail_to",
|
|
|
|
Subject => "$subject", ],
|
|
|
|
parts => [ @parts ],
|
|
|
|
);
|
|
|
|
#$message->charset_set( 'UTF-8' );
|
|
|
|
print $message->as_string;
|
|
|
|
}#if not Email::Mime
|
|
|
|
else{
|
|
|
|
|
|
|
|
$message = Email::Simple->create(
|
|
|
|
header => [
|
|
|
|
From => "$mail_from",
|
|
|
|
To => "$mail_to",
|
|
|
|
Subject => "$subject",
|
|
|
|
],
|
|
|
|
body => "$sendref->{message}",
|
|
|
|
);
|
|
|
|
}
|
|
|
|
|
|
|
|
try {
|
|
|
|
sendmail($message, { transport => $transport });
|
|
|
|
} catch {
|
|
|
|
$bw->log("FAILURE send_mail:$0",$sendref,"");
|
|
|
|
warn "Error sending mail: $_";
|
|
|
|
};
|
|
|
|
}
|
|
|
|
$bw->log("Success send_mail","","");
|
|
|
|
|
|
|
|
|
|
|
|
}#end mail_send
|
|
|
|
|
|
|
|
1;
|