projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
catch bad SMTP settings before they error out sending mail, RT#83775
[freeside.git] / FS / FS / Misc.pm
diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm
index 9a43180..b787fb6 100644 (file)
--- a/FS/FS/Misc.pm
+++ b/FS/FS/Misc.pm
@@ -1,7 +1,7 @@
 package FS::Misc;
 
 use strict;
 package FS::Misc;
 
 use strict;
-use vars qw ( @ISA @EXPORT_OK $DEBUG );
+use vars qw ( @ISA @EXPORT_OK $DEBUG $DISABLE_ALL_NOTICES );
 use Exporter;
 use Carp;
 use Data::Dumper;
 use Exporter;
 use Carp;
 use Data::Dumper;
@@ -22,7 +22,6 @@ use Encode;
                  generate_ps generate_pdf do_print
                  csv_from_fixed
                  ocr_image
                  generate_ps generate_pdf do_print
                  csv_from_fixed
                  ocr_image
-                 bytes_substr
                  money_pretty
                );
 
                  money_pretty
                );
 
@@ -44,6 +43,32 @@ Miscellaneous subroutines.  This module contains miscellaneous subroutines
 called from multiple other modules.  These are not OO or necessarily related,
 but are collected here to eliminate code duplication.
 
 called from multiple other modules.  These are not OO or necessarily related,
 but are collected here to eliminate code duplication.
 
+=head1 DISABLE ALL NOTICES
+
+Set $FS::Misc::DISABLE_ALL_NOTICES to suppress:
+
+=over 4
+
+=item FS::cust_bill::send_csv
+
+=item FS::cust_bill::spool_csv
+
+=item FS::msg_template::email::send_prepared
+
+=item FS::Misc::send_email
+
+=item FS::Misc::do_print
+
+=item FS::Misc::send_fax
+
+=item FS::Template_Mixin::postal_mail_fsinc
+
+=back
+
+=cut
+
+$DISABLE_ALL_NOTICES = 0;
+
 =head1 SUBROUTINES
 
 =over 4
 =head1 SUBROUTINES
 
 =over 4
@@ -119,6 +144,12 @@ FS::UID->install_callback( sub {
 
 sub send_email {
   my(%options) = @_;
 
 sub send_email {
   my(%options) = @_;
+
+  if ( $DISABLE_ALL_NOTICES ) {
+    warn 'send_email() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
+    return;
+  }
+
   if ( $DEBUG ) {
     my %doptions = %options;
     $doptions{'body'} = '(full body not shown in debug)';
   if ( $DEBUG ) {
     my %doptions = %options;
     $doptions{'body'} = '(full body not shown in debug)';
@@ -157,7 +188,10 @@ sub send_email {
       unshift @mimeparts, { 
         'Type'        => ( $options{'content-type'} || 'text/plain' ),
         'Charset'     => 'UTF-8',
       unshift @mimeparts, { 
         'Type'        => ( $options{'content-type'} || 'text/plain' ),
         'Charset'     => 'UTF-8',
-        'Data'        => $options{'body'},
+        'Data'        => ( $options{'content-type'} =~ /^text\//
+                             ? Encode::encode_utf8( $options{'body'} )
+                             : $options{'body'}
+                         ),
         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Disposition' => 'inline',
       };
         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Disposition' => 'inline',
       };
@@ -166,7 +200,10 @@ sub send_email {
     
       @mimeargs = (
         'Type'     => ( $options{'content-type'} || 'text/plain' ),
     
       @mimeargs = (
         'Type'     => ( $options{'content-type'} || 'text/plain' ),
-        'Data'     => $options{'body'},
+        'Data'     => ( $options{'content-type'} =~ /^text\//
+                          ? Encode::encode_utf8( $options{'body'} )
+                          : $options{'body'}
+                      ),
         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Charset'  => 'UTF-8',
       );
         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Charset'  => 'UTF-8',
       );
@@ -243,9 +280,15 @@ sub send_email {
   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
   $smtp_opt{'port'} = $port;
 
   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
   $smtp_opt{'port'} = $port;
 
+  my $error = '';
   my $transport;
   if ( defined($enc) && $enc eq 'starttls' ) {
   my $transport;
   if ( defined($enc) && $enc eq 'starttls' ) {
-    $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
+    foreach (qw(username password)) {
+      $smtp_opt{$_} = $conf->config("smtp-$_");
+      $error = "SMTP settings misconfiguration: ".
+               "STARTTLS enabled in smtp-encryption but smtp-$_ missing"
+        if ! length($smtp_opt{$_});
+    }
     $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
   } else {
     if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
     $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
   } else {
     if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
@@ -256,25 +299,35 @@ sub send_email {
   }
   
   push @to, $options{bcc} if defined($options{bcc});
   }
   
   push @to, $options{bcc} if defined($options{bcc});
-  local $@; # just in case
-  eval { sendmail($message, { transport => $transport,
-                              from      => $from,
-                              to        => \@to }) };
-
-  my $error = '';
-  if(ref($@) and $@->isa('Email::Sender::Failure')) {
-    $error = $@->code.' ' if $@->code;
-    $error .= $@->message;
+  # fully unpack all addresses found in @to (including Bcc) to make the
+  # envelope list
+  my @env_to;
+  foreach my $dest (@to) {
+    push @env_to, map { $_->address } Email::Address->parse($dest);
   }
   }
-  else {
-    $error = $@;
+
+  unless ( length($error) ) {
+
+    local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
+    local $@; # just in case
+    eval { sendmail($message, { transport => $transport,
+                                from      => $from,
+                                to        => \@env_to }) };
+
+    if (ref($@) and $@->isa('Email::Sender::Failure')) {
+      $error = $@->code.' ' if $@->code;
+      $error .= $@->message;
+    } else {
+      $error = $@;
+    }
+
   }
 
   # Logging
   if ( $conf->exists('log_sent_mail') ) {
     my $cust_msg = FS::cust_msg->new({
         'env_from'  => $options{'from'},
   }
 
   # Logging
   if ( $conf->exists('log_sent_mail') ) {
     my $cust_msg = FS::cust_msg->new({
         'env_from'  => $options{'from'},
-        'env_to'    => join(', ', @to),
+        'env_to'    => join(', ', @env_to),
         'header'    => $message->header_as_string,
         'body'      => $message->body_as_string,
         '_date'     => $time,
         'header'    => $message->header_as_string,
         'body'      => $message->body_as_string,
         '_date'     => $time,
@@ -287,6 +340,7 @@ sub send_email {
     my $log_error = $cust_msg->insert;
     warn "Error logging message: $log_error\n" if $log_error; # at least warn
   }
     my $log_error = $cust_msg->insert;
     warn "Error logging message: $log_error\n" if $log_error; # at least warn
   }
+
   $error;
    
 }
   $error;
    
 }
@@ -370,7 +424,7 @@ sub generate_email {
     'Encoding'    => 'quoted-printable',
     'Charset'     => 'UTF-8',
     #'Encoding'    => '7bit',
     'Encoding'    => 'quoted-printable',
     'Charset'     => 'UTF-8',
     #'Encoding'    => '7bit',
-    'Data'        => $data,
+    'Data'        => Encode::encode_utf8($data),
     'Disposition' => 'inline',
   );
 
     'Disposition' => 'inline',
   );
 
@@ -391,7 +445,7 @@ sub generate_email {
                        '    </title>',
                        '  </head>',
                        '  <body bgcolor="#ffffff">',
                        '    </title>',
                        '  </head>',
                        '  <body bgcolor="#ffffff">',
-                       @html_data,
+                       ( map Encode::encode_utf8($_), @html_data ),
                        '  </body>',
                        '</html>',
                      ],
                        '  </body>',
                        '</html>',
                      ],
@@ -438,6 +492,11 @@ sub send_fax {
   die 'HylaFAX support has not been configured.'
     unless $conf->exists('hylafax');
 
   die 'HylaFAX support has not been configured.'
     unless $conf->exists('hylafax');
 
+  if ( $DISABLE_ALL_NOTICES ) {
+    warn 'send_fax() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
+    return;
+  }
+
   eval {
     require Fax::Hylafax::Client;
   };
   eval {
     require Fax::Hylafax::Client;
   };
@@ -719,6 +778,8 @@ sub generate_ps {
 
   my $papersize = $conf->config('papersize') || 'letter';
 
 
   my $papersize = $conf->config('papersize') || 'letter';
 
+  local($SIG{CHLD}) = sub {};
+
   system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
     or die "dvips failed";
 
   system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
     or die "dvips failed";
 
@@ -776,6 +837,8 @@ sub generate_pdf {
   #system('dvipdf', "$file.dvi", "$file.pdf" );
   my $papersize = $conf->config('papersize') || 'letter';
 
   #system('dvipdf', "$file.dvi", "$file.pdf" );
   my $papersize = $conf->config('papersize') || 'letter';
 
+  local($SIG{CHLD}) = sub {};
+
   system(
     "dvips -q -f $sfile.dvi -t $papersize ".
     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
   system(
     "dvips -q -f $sfile.dvi -t $papersize ".
     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
@@ -853,11 +916,17 @@ global value and agentnum).
 sub do_print {
   my( $data, %opt ) = @_;
 
 sub do_print {
   my( $data, %opt ) = @_;
 
+  if ( $DISABLE_ALL_NOTICES ) {
+    warn 'do_print() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
+    return;
+  }
+
   my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
               ? $opt{'lpr'}
               : $conf->config('lpr', $opt{'agentnum'} );
 
   my $outerr = '';
   my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
               ? $opt{'lpr'}
               : $conf->config('lpr', $opt{'agentnum'} );
 
   my $outerr = '';
+  local($SIG{CHLD}) = sub {};
   run3 $lpr, $data, \$outerr, \$outerr;
   if ( $? ) {
     $outerr = ": $outerr" if length($outerr);
   run3 $lpr, $data, \$outerr, \$outerr;
   if ( $? ) {
     $outerr = ": $outerr" if length($outerr);
@@ -947,6 +1016,8 @@ sub ocr_image {
   print $fh $logo_data;
   close $fh;
 
   print $fh $logo_data;
   close $fh;
 
+  local($SIG{CHLD}) = sub {};
+
   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
     or die "ocroscript recognize failed\n";
 
   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
     or die "ocroscript recognize failed\n";
 
@@ -962,23 +1033,26 @@ sub ocr_image {
 
 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
 
 
 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
 
+DEPRECATED
+  Use Unicode::Truncate truncate_egc instead
+
 A replacement for "substr" that counts raw bytes rather than logical 
 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
 rather than output them. Unlike real "substr", is not an lvalue.
 
 =cut
 
 A replacement for "substr" that counts raw bytes rather than logical 
 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
 rather than output them. Unlike real "substr", is not an lvalue.
 
 =cut
 
-sub bytes_substr {
-  my ($string, $offset, $length, $repl) = @_;
-  my $bytes = substr(
-    Encode::encode('utf8', $string),
-    $offset,
-    $length,
-    Encode::encode('utf8', $repl)
-  );
-  my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
-  return Encode::decode('utf8', $bytes, $chk);
-}
+# sub bytes_substr {
+#   my ($string, $offset, $length, $repl) = @_;
+#   my $bytes = substr(
+#     Encode::encode('utf8', $string),
+#     $offset,
+#     $length,
+#     Encode::encode('utf8', $repl)
+#   );
+#   my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
+#   return Encode::decode('utf8', $bytes, $chk);
+# }
 
 =item money_pretty
 
 
 =item money_pretty
 
Freeside billing, trouble ticketing, network monitoring and provisioning