1###############################################################################
2# Mailer.pm                                                                   #
3# $Date: 12.02.14 $                                                           #
4###############################################################################
5# YaBB: Yet another Bulletin Board                                            #
6# Open-Source Community Software for Webmasters                               #
7# Version:        YaBB 2.6.11                                                 #
8# Packaged:       December 2, 2014                                            #
9# Distributed by: http://www.yabbforum.com                                    #
10# =========================================================================== #
11# Copyright (c) 2000-2014 YaBB (www.yabbforum.com) - All Rights Reserved.     #
12# Software by:  The YaBB Development Team                                     #
13#               with assistance from the YaBB community.                      #
14###############################################################################
15use CGI::Carp qw(fatalsToBrowser);
16use English '-no_match_vars';
17our $VERSION = '2.6.11';
18
19$mailerpmver = 'YaBB 2.6.11 $Revision: 1611 $';
20if ( $action eq 'detailedversion' ) { return 1; }
21
22$pre = q~style="padding:5px 40px; box-sizing:border-box; -moz-box-sizing:border-box; -webkit-box-sizing:border-box; display:block; white-space: pre-wrap; white-space: -moz-pre-wrap; white-space: -pre-wrap; white-space: -o-pre-wrap; word-wrap: break-word; width:100%; overflow-x:auto;"~;
23
24sub sendmail {
25    my ( $to, $subject, $message, $from, $mailcharset ) = @_;
26
27    # Do a FromHTML here for $to, and for $mbname
28    # Just in case has special chars like & in addresses
29    FromHTML($to);
30    FromHTML($mbname);
31
32# Change commas to HTML entity - ToHTML doesn't catch this
33# It's only a problem when sending emails, so no change to ToHTML.
34# Changed to dash -  misread in mail clients that use semi-colons as a delimiter
35    $mbname =~ s/,/-/igsm;
36
37    $charsetheader = $mailcharset ? $mailcharset : $yymycharset;
38
39    if ( !$from ) {
40        $from       = $webmaster_email;
41        $fromheader = qq~"$mbname" <$from>~;
42    }
43    else {
44        $fromheader = "$from";
45    }
46
47    if ( !$to ) {
48        $to       = $webmaster_email;
49        $toheader = "$mbname $smtp_txt{'555'} <$to>";
50    }
51    else {
52        $to =~ s/[ \t]+/, /gsm;
53        $toheader = $to;
54    }
55
56    $message =~ s/^\./../sm;
57    $message =~ s/[\r\n]/\n/gsm;
58
59    if ( $mailtype == 0 ) {
60        my $mailprogram = qq~$mailprog -t~;
61        open my $MAIL, q{|-}, $mailprogram or croak "$croak{'open'} MAIL";
62        @mailout =
63          ( $fromheader, $toheader, $subject, $message, $charsetheader );
64        tomail( $MAIL, \@mailout );
65        close $MAIL;    # or croak "$croak{'close'} MAIL";
66
67        return 1;
68    }
69    elsif ( $mailtype == 1 ) {
70        $smtp_to      = $to;
71        $smtp_from    = $from;
72        $smtp_message = qq~<pre $pre>$message</pre>~;
73        $smtp_subject = $subject;
74        $smtp_charset = $charsetheader;
75        require Sources::Smtp;
76        use_smtp();
77
78    }
79    elsif ( $mailtype == 2 || $mailtype == 3 ) {
80        my @arg = ( "$smtp_server", Hello => "$smtp_server", Timeout => 30 );
81        if ( $mailtype == 2 ) {
82            eval q^
83                use Net::SMTP;
84                push @arg, Debug => 0;
85                $smtp = Net::SMTP->new(@arg) || croak "Unable to create Net::SMTP object. Server: '$smtp_server'\n\n" . $OS_ERROR;
86            ^;
87        }
88        else {
89            eval q^
90                use Net::SMTP::TLS;
91                my $port = 25;
92                if ($smtp_server =~ s/:(\d+)$//sm) { $port = $1; }
93                push @arg, Port => $port;
94                if ($authuser) { push @arg, User => "$authuser" ;}
95                if ($authpass) { push @arg, Password => "$authpass" ;}
96                $smtp = Net::SMTP::TLS->new(@arg) || croak "Unable to create Net::SMTP::TLS object. Server: '$smtp_server', port '$port'\n\n" . $OS_ERROR;
97            ^;
98        }
99        if ($EVAL_ERROR) {
100            fatal_error( 'net_fatal',
101                "$error_txt{'error_verbose'}: $EVAL_ERROR" );
102        }
103
104        eval q^
105            $smtp->mail($from);
106            foreach (split /, /sm, $to) { $smtp->to($_); }
107            $smtp->data();
108            $smtp->datasend("To: $toheader\r\n");
109            $smtp->datasend("From: $fromheader\r\n");
110            $smtp->datasend("X-Mailer: YaBB Net::SMTP\r\n");
111            $smtp->datasend("Subject: $subject\r\n");
112            $smtp->datasend("Content-Type: text/html\; charset=$charsetheader\r\n");
113            $smtp->datasend("\r\n");
114            $smtp->datasend("<pre $pre>$message</pre>");
115            $smtp->dataend();
116            $smtp->quit();
117        ^;
118        if ($EVAL_ERROR) {
119            fatal_error( 'net_fatal',
120                "$error_txt{'error_verbose'}: $EVAL_ERROR" );
121        }
122        return 1;
123
124    }
125    elsif ( $mailtype == 4 ) {
126
127        # Dummy mail engine
128        fopen( MAIL, ">>$vardir/mail.log" );
129        print {MAIL} 'Mail sent at ' . scalar gmtime() . "\n"
130          or croak "$croak{'print'} mail";
131        print {MAIL} "To: $toheader\n"     or croak "$croak{'print'} mail";
132        print {MAIL} "From: $fromheader\n" or croak "$croak{'print'} mail";
133        print {MAIL} "X-Mailer: YaBB Sendmail\n"
134          or croak "$croak{'print'} mail";
135        print {MAIL} "Subject: $subject\n\n" or croak "$croak{'print'} mail";
136        $message =~ s/\r\n/\n/gsm;
137        print {MAIL} "<pre $pre>$message</pre>\n"         or croak "$croak{'print'} mail";
138        print {MAIL} "End of Message\n\n" or croak "$croak{'print'} mail";
139        fclose(MAIL);
140        return 1;
141    }
142    return;
143}
144
145# Before &sendmail is called, the message MUST be run through here.
146# First argument is the message
147# Second argument is a hashref to the replacements
148# Example:
149#  $message = qq~Hello, {yabb username}! The answer is {yabb answer}!~;
150#  $message = &template_email($message, {username => $username, answer => 42});
151# Result (with $username being the actual username):
152#  Hello, $username! The answer is 42!
153sub template_email {
154    my ( $message, $info ) = @_;
155    foreach my $key ( keys %{$info} ) {
156        $message =~ s/{yabb $key}/$info->{$key}/gsm;
157    }
158    $message =~ s/{yabb scripturl}/$scripturl/gsm;
159    $message =~ s/{yabb adminurl}/$adminurl/gsm;
160    $message =~ s/{yabb mbname}/$mbname/gsm;
161    return $message;
162}
163
164sub tomail {
165    my ( $MAIL, $mailout ) = @_;
166    my ( $fromheader, $toheader, $subject, $message, $charsetheader ) =
167      @{$mailout};
168    print {$MAIL} "To: $toheader\n"           or croak "$croak{'print'} mail";
169    print {$MAIL} "From: $fromheader\n"       or croak "$croak{'print'} mail";
170    print {$MAIL} "X-Mailer: YaBB Sendmail\n" or croak "$croak{'print'} mail";
171    print {$MAIL} "Subject: $subject\n"       or croak "$croak{'print'} mail";
172    print {$MAIL} "Content-Type: text/html\; charset=$charsetheader\n\n"
173      or croak "$croak{'print'} mail";
174    $message =~ s/\r\n/\n/gsm;
175    print {$MAIL} "<pre $pre>$message</pre>\n" or croak "$croak{'print'} mail";
176    return;
177}
178
1791;
180