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