1# -*- indent-tabs-mode: nil; -*- 2# vim:ft=perl:et:sw=4 3# $Id$ 4 5# Sympa - SYsteme de Multi-Postage Automatique 6# 7# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel 8# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 9# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites 10# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER 11# Copyright 2018, 2020 The Sympa Community. See the AUTHORS.md 12# file at the top-level directory of this distribution and at 13# <https://github.com/sympa-community/sympa.git>. 14# 15# This program is free software; you can redistribute it and/or modify 16# it under the terms of the GNU General Public License as published by 17# the Free Software Foundation; either version 2 of the License, or 18# (at your option) any later version. 19# 20# This program is distributed in the hope that it will be useful, 21# but WITHOUT ANY WARRANTY; without even the implied warranty of 22# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23# GNU General Public License for more details. 24# 25# You should have received a copy of the GNU General Public License 26# along with this program. If not, see <http://www.gnu.org/licenses/>. 27 28package Sympa::Message::Template; 29 30use strict; 31use warnings; 32use DateTime; 33use Encode qw(); 34use MIME::EncWords; 35 36use Sympa; 37use Conf; 38use Sympa::Constants; 39use Sympa::Language; 40use Sympa::Log; 41use Sympa::Spool; 42use Sympa::Template; 43use Sympa::Tools::Data; 44use Sympa::Tools::Password; 45use Sympa::Tools::SMIME; 46use Sympa::Tools::Text; 47use Sympa::User; 48 49use base qw(Sympa::Message); 50 51my $language = Sympa::Language->instance; 52my $log = Sympa::Log->instance; 53 54# Old names: (part of) mail::mail_file(), mail::parse_tt2_messageasstring(), 55# List::send_file(), List::send_global_file(). 56sub new { 57 my $class = shift; 58 my %options = @_; 59 60 my $that = $options{context}; 61 my $tpl = $options{template}; 62 my $who = $options{rcpt}; 63 my $context = $options{data} || {}; 64 65 die 'Parameter $tpl is not defined' 66 unless defined $tpl and length $tpl; 67 68 my ($list, $family, $robot_id, $domain); 69 if (ref $that eq 'Sympa::List') { 70 $robot_id = $that->{'domain'}; 71 $list = $that; 72 $domain = $that->{'domain'}; 73 } elsif (ref $that eq 'Sympa::Family') { 74 $robot_id = $that->{'domain'}; 75 $family = $that; 76 $domain = $that->{'domain'}; 77 } elsif ($that and $that ne '*') { 78 $robot_id = $that; 79 $domain = Conf::get_robot_conf($that, 'domain'); 80 } else { 81 $robot_id = '*'; 82 $domain = $Conf::Conf{'domain'}; 83 } 84 85 my $data = Sympa::Tools::Data::dup_var($context); 86 87 ## Any recipients 88 if (not $who or (ref $who and !@$who)) { 89 $log->syslog('err', 'No recipient for sending %s', $tpl); 90 return undef; 91 } 92 93 ## Unless multiple recipients 94 unless (ref $who) { 95 unless ($data->{'user'}) { 96 $data->{'user'} = Sympa::User->new($who); 97 } 98 99 if ($list) { 100 # FIXME: Don't overwrite date & update_date. Format datetime on 101 # the template. 102 my $subscriber = 103 Sympa::Tools::Data::dup_var($list->get_list_member($who)); 104 if ($subscriber) { 105 $data->{'subscriber'}{'date'} = 106 $language->gettext_strftime("%d %b %Y", 107 localtime($subscriber->{'date'})); 108 $data->{'subscriber'}{'update_date'} = 109 $language->gettext_strftime("%d %b %Y", 110 localtime($subscriber->{'update_date'})); 111 if ($subscriber->{'bounce'}) { 112 $subscriber->{'bounce'} =~ 113 /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/; 114 115 $data->{'subscriber'}{'first_bounce'} = 116 $language->gettext_strftime("%d %b %Y", localtime $1); 117 } 118 } 119 } 120 } 121 122 # Lang 123 $language->push_lang( 124 $data->{'lang'}, 125 $data->{'user'}{'lang'}, 126 ($list ? $list->{'admin'}{'lang'} : undef), 127 Conf::get_robot_conf($robot_id, 'lang'), 'en' 128 ); 129 $data->{'lang'} = $language->get_lang; 130 $language->pop_lang; 131 132 if ($list) { 133 # Trying to use custom_vars 134 if (defined $list->{'admin'}{'custom_vars'}) { 135 $data->{'custom_vars'} = {}; 136 foreach my $var (@{$list->{'admin'}{'custom_vars'}}) { 137 $data->{'custom_vars'}{$var->{'name'}} = $var->{'value'}; 138 } 139 } 140 } 141 142 foreach my $p ( 143 'email', 'gecos', 'listmaster', 'wwsympa_url', 144 'title', 'listmaster_email' 145 ) { 146 $data->{'conf'}{$p} = Conf::get_robot_conf($robot_id, $p); 147 } 148 $data->{'domain'} = $domain; 149 $data->{'conf'}{'version'} = Sympa::Constants::VERSION(); 150 $data->{'sender'} ||= $who; 151 152 # Compat.: Deprecated attributes of Robot. 153 $data->{'conf'}{'sympa'} = Sympa::get_address($robot_id); 154 $data->{'conf'}{'request'} = Sympa::get_address($robot_id, 'owner'); 155 # No longer used. 156 $data->{'robot_domain'} = $domain; 157 # Compat. < 6.2.32 158 $data->{'conf'}{'host'} = $domain; 159 160 if ($list) { 161 $data->{'list'}{'lang'} = $list->{'admin'}{'lang'}; 162 $data->{'list'}{'name'} = $list->{'name'}; 163 $data->{'list'}{'subject'} = $list->{'admin'}{'subject'}; 164 $data->{'list'}{'owner'} = [$list->get_admins('owner')]; 165 $data->{'list'}{'dir'} = $list->{'dir'}; #FIXME: Required? 166 $data->{'list'}{'family'} = {name => $list->get_family->{'name'}} 167 if $list->get_family; 168 # Compat. < 6.2.32 169 $data->{'list'}{'domain'} = $list->{'domain'}; 170 $data->{'list'}{'host'} = $list->{'domain'}; 171 } elsif ($family) { 172 $data->{family} = {name => $family->{'name'},}; 173 } 174 175 # Sign mode 176 my $smime_sign = Sympa::Tools::SMIME::find_keys($that, 'sign'); 177 178 if ($list) { 179 # if the list have it's private_key and cert sign the message 180 # . used only for the welcome message, could be useful in other case? 181 # . a list should have several certificates and use if possible a 182 # certificate issued by the same CA as the recipient CA if it exists 183 if ($smime_sign) { 184 $data->{'fromlist'} = Sympa::get_address($list); 185 $data->{'replyto'} = Sympa::get_address($list, 'owner'); 186 } else { 187 $data->{'fromlist'} = Sympa::get_address($list, 'owner'); 188 } 189 } 190 $data->{'boundary'} = '----------=_' . Sympa::unique_message_id($robot_id) 191 unless $data->{'boundary'}; 192 193 my $self = $class->_new_from_template($that, $tpl . '.tt2', 194 $who, $data, %options); 195 return undef unless $self; 196 197 # Shelve S/MIME signing. 198 $self->{shelved}{smime_sign} = 1 199 if $smime_sign; 200 # Shelve DKIM signing. 201 if (Conf::get_robot_conf($robot_id, 'dkim_feature') eq 'on') { 202 my $dkim_add_signature_to = 203 Conf::get_robot_conf($robot_id, 'dkim_add_signature_to'); 204 if ($list and $dkim_add_signature_to =~ /list/ 205 or not $list and $dkim_add_signature_to =~ /robot/) { 206 $self->{shelved}{dkim_sign} = 1; 207 } 208 } 209 210 # Set default envelope sender. 211 if (exists $options{envelope_sender}) { 212 $self->{envelope_sender} = $options{envelope_sender}; 213 } elsif ($list) { 214 $self->{envelope_sender} = Sympa::get_address($list, 'return_path'); 215 } else { 216 $self->{envelope_sender} = Sympa::get_address($robot_id, 'owner'); 217 } 218 219 # Set default delivery date. 220 $self->{date} = (exists $options{date}) ? $options{date} : time; 221 222 # Set priority if specified. 223 $self->{priority} = $options{priority} 224 if exists $options{priority}; 225 226 # Shelve tracking if speficied. 227 $self->{shelved}{tracking} = $options{tracking} 228 if exists $options{tracking}; 229 230 # Assign unique ID and log it. 231 my $marshalled = 232 Sympa::Spool::marshal_metadata($self, '%s@%s.%ld.%ld,%d', 233 [qw(localpart domainpart date PID RAND)]); 234 $self->{messagekey} = $marshalled; 235 236 return $self; 237} 238 239#TODO: This would be merged in new() because used only by it. 240sub _new_from_template { 241 $log->syslog('debug2', '(%s, %s, %s, %s, %s)', @_); 242 my $class = shift; 243 my $that = shift || '*'; 244 my $filename = shift; 245 my $rcpt = shift; 246 my $data = shift; 247 my %options = @_; 248 249 my ($list, $family, $robot_id); 250 if (ref $that eq 'Sympa::List') { 251 $list = $that; 252 $robot_id = $list->{'domain'}; 253 } elsif (ref $that eq 'Sympa::Family') { 254 $family = $that; 255 $robot_id = $family->{'domain'}; 256 } elsif ($that and $that ne '*') { 257 $robot_id = $that; 258 } else { 259 $robot_id = '*'; 260 } 261 262 my $message_as_string; 263 my %header_ok; # hash containing no missing headers 264 my $existing_headers = 0; # the message already contains headers 265 266 ## We may receive a list of recipients 267 die sprintf 'Wrong type of reference for $rcpt: %s', ref $rcpt 268 if ref $rcpt and ref $rcpt ne 'ARRAY'; 269 270 ## Charset for encoding 271 $data->{'charset'} ||= Conf::lang2charset($data->{'lang'}); 272 273 # Template file parsing 274 # If context is List, add list directory and list archives to get the 275 # 'info' file and last message. 276 my $template = Sympa::Template->new( 277 $that, 278 subdir => 'mail_tt2', 279 lang => $data->{'lang'}, 280 include_path => 281 ($list ? [$list->{'dir'}, $list->{'dir'} . '/archives'] : []) 282 ); 283 unless ($template->parse($data, $filename, \$message_as_string)) { 284 $log->syslog( 285 'err', 'Can\'t parse template %s: %s', 286 $filename, $template->{last_error} 287 ); 288 return undef; 289 } 290 291 # Does the message include headers ? 292 if ($data->{'headers'}) { 293 foreach my $field (keys %{$data->{'headers'}}) { 294 $field =~ tr/A-Z/a-z/; 295 $header_ok{$field} = 1; 296 } 297 } 298 299 foreach my $line (split /\n/, $message_as_string) { 300 last if ($line =~ /^\s*$/); 301 if ($line =~ /^[\w-]+:\s*/) { 302 ## A header field 303 $existing_headers = 1; 304 } elsif ($existing_headers and $line =~ /^\s/) { 305 ## Following of a header field 306 next; 307 } else { 308 last; 309 } 310 311 foreach my $header ( 312 qw(message-id date to from subject reply-to 313 mime-version content-type content-transfer-encoding) 314 ) { 315 if ($line =~ /^$header\s*:/i) { 316 $header_ok{$header} = 1; 317 last; 318 } 319 } 320 } 321 322 ## ADD MISSING HEADERS 323 my $headers = ""; 324 325 unless ($header_ok{'message-id'}) { 326 $headers .= 327 sprintf("Message-Id: %s\n", Sympa::unique_message_id($robot_id)); 328 } 329 330 unless ($header_ok{'date'}) { 331 # Format current time. 332 # If setting local timezone fails, fallback to UTC. 333 my $date = 334 (eval { DateTime->now(time_zone => 'local') } || DateTime->now) 335 ->strftime('%a, %{day} %b %Y %H:%M:%S %z'); 336 $headers .= sprintf "Date: %s\n", $date; 337 } 338 339 unless ($header_ok{'to'}) { 340 my $to; 341 # Currently, bare e-mail address is assumed. Complex ones such as 342 # "phrase" <email> won't be allowed. 343 if (ref($rcpt)) { 344 if ($data->{'to'}) { 345 $to = $data->{'to'}; 346 } else { 347 $to = join(",\n ", @{$rcpt}); 348 } 349 } else { 350 $to = $rcpt; 351 } 352 $headers .= "To: $to\n"; 353 } 354 unless ($header_ok{'from'}) { 355 unless (defined $data->{'from'}) { 356 # DSN should not have command address <sympa> to prevent looping 357 # by dumb auto-responder (including Sympa command robot itself). 358 my $sympa = 359 ( exists $options{envelope_sender} 360 and defined $options{envelope_sender} 361 and $options{envelope_sender} eq '<>') 362 ? Sympa::get_address($robot_id, 'owner') # sympa-request 363 : Sympa::get_address($robot_id); 364 $headers .= sprintf "From: %s\n", 365 Sympa::Tools::Text::addrencode($sympa, 366 Conf::get_robot_conf($robot_id, 'gecos'), 367 $data->{'charset'}); 368 } elsif ($data->{'from'} eq 'sympa' 369 or $data->{'from'} eq $data->{'conf'}{'sympa'}) { 370 #XXX NOTREACHED: $data->{'from'} was obsoleted. 371 $headers .= 'From: ' 372 . Sympa::Tools::Text::addrencode( 373 $data->{'conf'}{'sympa'}, 374 $data->{'conf'}{'gecos'}, 375 $data->{'charset'} 376 ) . "\n"; 377 } else { 378 #XXX NOTREACHED: $data->{'from'} was obsoleted. 379 $headers .= "From: " 380 . MIME::EncWords::encode_mimewords( 381 Encode::decode('utf8', $data->{'from'}), 382 'Encoding' => 'A', 383 'Charset' => $data->{'charset'}, 384 'Field' => 'From' 385 ) . "\n"; 386 } 387 } 388 unless ($header_ok{'subject'}) { 389 $headers .= "Subject: " 390 . MIME::EncWords::encode_mimewords( 391 Encode::decode('utf8', $data->{'subject'}), 392 'Encoding' => 'A', 393 'Charset' => $data->{'charset'}, 394 'Field' => 'Subject' 395 ) . "\n"; 396 } 397 unless ($header_ok{'reply-to'}) { 398 $headers .= "Reply-to: " 399 . MIME::EncWords::encode_mimewords( 400 Encode::decode('utf8', $data->{'replyto'}), 401 'Encoding' => 'A', 402 'Charset' => $data->{'charset'}, 403 'Field' => 'Reply-to' 404 ) 405 . "\n" 406 if ($data->{'replyto'}); 407 } 408 if ($data->{'headers'}) { 409 foreach my $field (keys %{$data->{'headers'}}) { 410 $headers .= 411 $field . ': ' 412 . MIME::EncWords::encode_mimewords( 413 Encode::decode('utf8', $data->{'headers'}{$field}), 414 'Encoding' => 'A', 415 'Charset' => $data->{'charset'}, 416 'Field' => $field 417 ) . "\n"; 418 } 419 } 420 unless ($header_ok{'mime-version'}) { 421 $headers .= "MIME-Version: 1.0\n"; 422 } 423 unless ($header_ok{'content-type'}) { 424 $headers .= 425 "Content-Type: text/plain; charset=" . $data->{'charset'} . "\n"; 426 } 427 unless ($header_ok{'content-transfer-encoding'}) { 428 $headers .= "Content-Transfer-Encoding: 8bit\n"; 429 } 430 431 # Determine what value the Auto-Submitted header field should take. 432 # See RFC 3834. The header field can have one of the following keywords: 433 # "auto-generated", "auto-replied". 434 # The header should not be set when WWSympa sends a command to sympa.pl 435 # through its spool. 436 # n.b. The keyword "auto-forwarded" was abandoned. 437 unless ($data->{'not_auto_submitted'} || $header_ok{'auto_submitted'}) { 438 ## Default value is 'auto-generated' 439 my $header_value = $data->{'auto_submitted'} || 'auto-generated'; 440 $headers .= "Auto-Submitted: $header_value\n"; 441 } 442 443 unless ($existing_headers) { 444 $headers .= "\n"; 445 } 446 447 # All these data provide mail attachments in service messages. 448 my @msgs = (); 449 if (ref($data->{'msg_list'}) eq 'ARRAY') { 450 @msgs = 451 map { $_->{'msg'} || $_->{'full_msg'} } @{$data->{'msg_list'}}; 452 } elsif ($data->{'spool'}) { 453 @msgs = @{$data->{'spool'}}; 454 } elsif ($data->{'msg'}) { 455 push @msgs, $data->{'msg'}; 456 } elsif ($data->{'msg_path'} and open IN, '<' . $data->{'msg_path'}) { 457 push @msgs, join('', <IN>); 458 close IN; 459 } elsif ($data->{'file'} and open IN, '<' . $data->{'file'}) { 460 push @msgs, join('', <IN>); 461 close IN; 462 } 463 464 my $self = 465 $class->SUPER::new($headers . $message_as_string, context => $that); 466 return undef unless $self; 467 468 unless ($self->reformat_utf8_message(\@msgs, $data->{'charset'})) { 469 $log->syslog('err', 'Failed to reformat message'); 470 } 471 472 return $self; 473} 474 475# Methods compatible to Sympa::Spool. 476 477sub next { 478 my $self = shift; 479 480 return if delete $self->{_done_next}; 481 $self->{_done_next} = 1; 482 return ($self, 1); 483} 484 485use constant quarantine => 1; 486use constant remove => 1; 487 4881; 489__END__ 490 491=encoding utf-8 492 493=head1 NAME 494 495Sympa::Message::Template - Mail message generated from template 496 497=head1 SYNOPSIS 498 499 use Sympa::Message::Template; 500 my $message = Sympa::Message::Template->new( 501 context => $list, template => "name", rcpt => [$email], data => {}); 502 503=head1 DESCRIPTION 504 505=head2 Methods 506 507=over 508 509=item new ( context =E<gt> $that, template =E<gt> $filename, 510rcpt =E<gt> $rcpt, [ data =E<gt> $data ], [ options... ] ) 511 512I<Constructor>. 513Creates L<Sympa::Message> object from template. 514 515Parameters: 516 517=over 518 519=item context =E<gt> $that 520 521Content: Sympa::List, robot or '*'. 522 523=item template =E<gt> $filename 524 525Template filename (without extension). 526 527=item rcpt =E<gt> $rcpt 528 529Scalar or arrayref: SMTP "RCPT TO:" field. 530 531If it is a scalar, tries to retrieve information of the user 532(See also L<Sympa::User>. 533 534=item data =E<gt> $data 535 536Hashref used to parse template, with keys: 537 538=over 539 540=item return_path 541 542SMTP "MAIL FROM:" field if sent by SMTP (see L<Sympa::Mailer>), 543"Return-Path:" field if sent by spool. 544 545Note: This parameter was OBSOLETED. Currently, {envelope_sender} attribute of 546object is taken from the context. 547 548=item to 549 550"To:" header field 551 552=item lang 553 554Language tag used for parsing template. 555See also L<Sympa::Language>. 556 557=item from 558 559"From:" field if not a full msg 560 561Note: 562This parameter was OBSOLETED. 563The "From:" field will be filled in by "sympa" address if it is not found. 564 565=item subject 566 567"Subject:" field if not a full msg 568 569=item replyto 570 571"Reply-To:" field if not a full msg 572 573=item body 574 575Body message if $filename is C<''>. 576 577Note: This feature has been deprecated. 578 579=item headers 580 581Additional headers, hashref with keys are field names. 582 583=back 584 585=back 586 587Below are optional parameters. 588 589=over 590 591=item date =E<gt> $time 592 593Delivery time of message. 594By default current time will be used. 595 596=item envelope_sender =E<gt> $email 597 598Forces setting envelope sender. 599C<'E<lt>E<gt>'> may be used for null envelope sender. 600 601=item priority =E<gt> $priority 602 603Forces setting priority if specified. 604 605=item tracking =E<gt> $feature 606 607Forces tracking if specified. 608 609=back 610 611Returns: 612 613New L<Sympa::Message> instance, or C<undef> if something went wrong. 614 615=back 616 617=head1 SEE ALSO 618 619L<Sympa::Message>, L<Sympa::Template>. 620 621=head1 HISTORY 622 623L<Sympa::Message/"new_from_template"> appeared on Sympa 6.2. 624 625It was renamed to L<Sympa::Message::Template/"new"> on Sympa 6.2.13. 626 627=cut 628