home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / mailer.pl < prev    next >
Text File  |  2009-11-06  |  21KB  |  654 lines
  1. # FILE: mailer.pl
  2. # DESCRIPTION: Technical sending of e-mail messages
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### send_email_message
  20. ###
  21. ### Sends an e-mail message to one or more recipients, according to your
  22. ### e-mail configuration.
  23. ###
  24.  
  25. sub send_email_message {
  26.     my ($send_hashes, $text, $param_override, $debug, $override) = @_;
  27.     return 0 if $GLOBAL_OPTIONS->{capable} == 0 && ! defined $param_override;
  28.     my @s = ref $send_hashes eq "ARRAY" ? @{ $send_hashes } : ( $send_hashes );
  29.     return 0 if scalar(@s) == 0;
  30.     my $flag = ($GLOBAL_OPTIONS->{discus_taskman} && $GLOBAL_OPTIONS->{taskman_email});
  31.     $flag = 0 if $s[0]->{taskman};
  32.     if ($flag && ! $debug) {
  33.         foreach my $s (@s) {
  34.             $s->{taskman} = 1;
  35.             my @a = ($s, $text, $param_override, $debug);            
  36.             taskman_create_job("send_email_message", "mailer", \@a);
  37.         }
  38.         return 1;
  39.     }
  40.     my $par = defined $param_override ? $param_override : email_configuration_read();
  41.     $par = hash_merge($par, $override, 1) if defined $override && ref $override eq 'HASH';
  42.     my $frstr = $par->{fromname} ne "" ? join(" ", "\"$par->{fromname}\"", "<$par->{fromaddr}>") : $par->{fromaddr};
  43.     my $fradd = $par->{fromaddr};
  44.     $par->{input_stream} =~ s/\$FROMSTRG/$frstr/g;
  45.     $par->{input_stream} =~ s/\$FROMADDR/$fradd/g;
  46.     $par->{command_line} =~ s/\$FROMSTRG/$frstr/g;
  47.     $par->{command_line} =~ s/\$FROMADDR/$fradd/g;
  48.     return 0 if ! defined $par;
  49.     return net_smtp_send(\@s, $text, $par, $debug) if $par->{'net_SMTP'} == 1;
  50.     return mail_sendmail_send(\@s, $text, $par, $debug) if $par->{'net_SMTP'} == 2;
  51.     return raw_socket_send(\@s, $text, $par, $debug) if $par->{'net_SMTP'} == 3;
  52.     return bcc_standard_send(\@s, $text, $par, $debug) if $par->{'1message'} == 1;
  53.     return email_crontab_send(\@s, $text, $par, $debug) if $par->{'1message'} == 2;
  54.     return single_standard_send(\@s, $text, $par, $debug);
  55. }
  56.  
  57. ###
  58. ### net_smtp_send
  59. ###
  60. ### Sends e-mail message using the Net::SMTP module
  61. ###
  62.  
  63. sub net_smtp_send {
  64.     my ($send_hashes, $text, $par, $debug) = @_;
  65.     $par = email_configuration_read() if ! defined $par;
  66.     my ($smtp, $status) = 
  67.         eval '
  68.             use Net::SMTP;
  69.             my $status = 0;
  70.             my $smtp = undef;
  71.             if ($smtp = Net::SMTP->new($par->{"SMTP"}, Timeout => 15)) {
  72.                 $status = 1;
  73.             }
  74.             ($smtp, $status);
  75.         ';
  76.     if ($@) {
  77.         error_message("SMTP configuration error", "[0] Error executing Net::SMTP (error is: $@)!  Make sure Net::SMTP is installed on your server.") if $debug;
  78.         return 0;
  79.     }
  80.     if (!$status) {
  81.         error_message("SMTP connection error", "[1] Error connecting to $par->{'SMTP'}! Be sure you've given the correct name for the SMTP server, that the SMTP server is turned on, and that the SMTP server actually has SMTP service running on it!") if $debug;
  82.         return 0;
  83.     }
  84.     my $fr = "\"$par->{fromname}\"";
  85.     $fr .= " <$par->{fromaddr}>" if $par->{fromaddr};
  86.     $fr .= " <null\@null.null>" if ! $par->{fromaddr};
  87.     my $dataX = "X-Mailer: Discus";
  88.     $dataX .= " Pro" if $DCONF->{pro};
  89.     $dataX .= " <$DCONF->{html_url}>\n";
  90.     foreach my $r (@{ $send_hashes }) {
  91.         my $d = $dataX;
  92.         $d .= "Content-Type: text/html; charset=$DCONF->{mail_charset}\n" if $r->{html};
  93.         $d .= "Content-Type: text/plain; charset=$DCONF->{mail_charset}\n" if ! $r->{html};
  94.         if (!$smtp->mail($par->{fromaddr})) {
  95.             error_message("SMTP send error", "[2] Error sending data to $par->{'SMTP'}: " . $smtp->message()) if $debug;
  96.             return 0;
  97.         }
  98.         if (!$smtp->to($r->{to})) {
  99.             error_message("SMTP send error", "[3] Error sending data to [$r->{to}] $par->{'SMTP'}: " . $smtp->message()) if $debug;
  100.             return 0;
  101.         }
  102.         $smtp->data();
  103.         $smtp->datasend("To: $r->{to}\n");
  104.         $smtp->datasend("Subject: $r->{subject}\n");
  105.         $smtp->datasend("From: $fr\n") if $fr;
  106.         $smtp->datasend("$d");
  107.         $smtp->datasend("MIME-Version: 1.0\n");
  108.         if ($r->{html}) {
  109.             $smtp->datasend("Content-type: text/html; charset=$DCONF->{mail_charset}\n");
  110.         } else {
  111.             $smtp->datasend("Content-type: text/plain; charset=$DCONF->{mail_charset}\n");
  112.         }
  113.         $smtp->datasend("\n");
  114.         $smtp->datasend($text);
  115.         $smtp->dataend();
  116.         my $status_2 = $smtp->send();
  117.         if ($status_2) {
  118.             error_message("SMTP send error", "[4] Error sending data to $par->{'SMTP'}: " . $smtp->message()) if $debug;
  119.             return 0;
  120.         }
  121.     }
  122.     $smtp->quit();
  123.     return 1;
  124. }
  125.  
  126. ###
  127. ### mail_sendmail_send
  128. ###
  129. ### Sends e-mail message using the Mail::Sendmail module
  130. ###
  131.  
  132. sub mail_sendmail_send {
  133.     my ($send_hashes, $text, $par, $debug) = @_;
  134.     $par = email_configuration_read() if ! defined $par;
  135.     my $dataX = "X-Mailer: Discus";
  136.     $dataX .= " Pro" if $DCONF->{pro};
  137.     $dataX .= " <$DCONF->{html_url}>\n";
  138.     my $fr = $par->{fromname};
  139.     $fr .= " <$par->{fromaddr}>" if $par->{fromaddr};
  140.     foreach my $r (@{ $send_hashes }) {
  141.         my $mail = {
  142.             To => $r->{to},
  143.             From => $fr,
  144.             'X-Mailer' => $dataX,
  145.             Smtp => $par->{SMTP2},
  146.             Message => $text,
  147.             'Reply-to' => $fr,
  148.             Subject => $r->{subject},
  149.             'MIME-Version' => '1.0',
  150.         };
  151.         if ($r->{html}) {
  152.             $mail->{'Content-type'} = 'text/html; charset=$DCONF->{mail_charset}';
  153.         } else {
  154.             $mail->{'Content-type'} = 'text/plain; charset=$DCONF->{mail_charset}';
  155.         }
  156.         my ($status, $error, $log) = eval '
  157.             use Mail::Sendmail;
  158.             my $x = sendmail %{$mail};
  159.             my $err = $Mail::Sendmail::error;
  160.             my $log = $Mail::Sendmail::log;
  161.             ($x, $err, $log);
  162.         ';
  163.         if ($@) {
  164.             error_message("SMTP configuration error", "[0] Error executing Mail::Sendmail (error is: $@)!  Make sure Mail::Sendmail is installed on your server.") if $debug;
  165.             return 0;
  166.         }
  167.         if ($status) {
  168.             next;
  169.         } elsif ($debug) {
  170.             error_message("Mail::Sendmail Error", "<p><b>Error text:</b> $error</p><p><b>Log entry:</b> $log</p>");
  171.         }
  172.     }
  173.     return 1;
  174. }
  175.  
  176. ###
  177. ### email_guess_settings
  178. ###
  179. ### Guesses e-mail notification settings on a unix host
  180. ###
  181.  
  182. sub email_guess_settings {
  183.     return undef if $^O eq "MSWin32";
  184.     my @sp = ("/usr/bin", "/bin", "/usr/sbin", "/sbin", "/usr/local/bin", "/usr/local/sbin", "/usr/contrib/bin", "/usr/contrib/sbin", "/usr/lib", "/lib", "/etc", "/");
  185.     foreach my $p (@sp) {
  186.         if (-x "$p/sendmail") {
  187.             return {
  188.                 command_line =>             "| $p/sendmail -t",
  189.                 mail_program =>             "$p/sendmail",
  190.                 commandline =>                "-t",
  191.                 toaddress =>                1,
  192.                 toaddress_prefix =>            "To:",
  193.                 fromaddress =>                1,
  194.                 fromaddress_prefix =>         "From:",
  195.                 bccaddress =>                1,
  196.                 bccaddress_prefix =>         "Bcc:",
  197.                 subjectaddress =>            1,
  198.                 subjectaddress_prefix =>     "Subject:",
  199.                 replytoaddress =>            1,
  200.                 replytoaddress_prefix =>     "Reply-to:",
  201.                 useraddress =>                2,
  202.                 input_stream =>                escape("To: \$TO\n\From: \$FROM\nSubject: \$SUBJECT\nReply-to: \$REPLYTO\n"),
  203.                 is_guess =>                    1,
  204.             };
  205.         }
  206.     }
  207.     foreach my $p (@sp) {
  208.         if (-x "$p/mail") {
  209.             return {
  210.                 command_line =>             "| $p/mail -s '\$SUBJECT' -t '\$TO'",
  211.                 mail_program =>             "$p/mail",
  212.                 commandline =>                "-t",
  213.                 toaddress =>                0,
  214.                 fromaddress =>                2,
  215.                 fromaddress_switch =>         "-F",
  216.                 subjectaddress =>            0,
  217.                 subjectaddress_switch =>     "-s",
  218.                 is_guess =>                    1,
  219.             };
  220.         }
  221.     }
  222.     return undef;
  223. }
  224.  
  225. ###
  226. ### single_standard_send
  227. ###
  228. ### Sends individual messages to recipients via normal command-line mechanism
  229. ###
  230.  
  231. sub single_standard_send {
  232.     my ($send_hashes, $text, $par, $debug) = @_;
  233.     my ($command, $input) = email_get_parameters($par);
  234.     my $success = 0;
  235.     foreach my $r (@{ $send_hashes }) {
  236.         $r->{to} =~ s/\@\./\@/g;
  237.         next if $r->{to} !~ m|^([\w\+\-\.]+)\@([\w\+\-\.]+)$|;
  238.         my $command_temp = $command; $command_temp =~ s/\$TO/$r->{to}/g;
  239.         my $input_temp = $input; $input_temp =~ s/\$TO/$r->{to}/g;
  240.         $command_temp =~ s/\$SUBJECT/$r->{subject}/g;
  241.         $input_temp =~ s/\$SUBJECT/$r->{subject}/g;
  242.         $input_temp =~ s/\s+$//;
  243.         $input_temp .= "\n";
  244.         $input_temp .= "Content-type: text/html; charset=$DCONF->{mail_charset}\n" if $r->{html};
  245.         $input_temp .= "Content-type: text/plain; charset=$DCONF->{mail_charset}\n" if ! $r->{html};
  246.         $success += command_line_send($par, $command_temp, $input_temp, $text, $debug);
  247.     }
  248.     if (scalar(@{ $send_hashes })) {
  249.         return int($success / scalar(@{ $send_hashes }));
  250.     } else {
  251.         return 0;
  252.     }
  253. }
  254.  
  255. ###
  256. ### bcc_standard_send
  257. ###
  258. ### Sends one single message using BCC and command-line mechanism
  259. ###
  260.  
  261. sub bcc_standard_send {
  262.     my ($send_hashes, $text, $par, $debug) = @_;
  263.     my ($command, $input) = email_get_parameters($par);
  264.     my @bcc = ();
  265.     foreach my $r (@{ $send_hashes }) {
  266.         $r->{to} =~ s/\@\./\@/g;
  267.         next if $r->{to} !~ m|^([\w\+\-\.]+)\@([\w\+\-\.]+)$|;
  268.         push @bcc, $r->{to};
  269.     }
  270.     return 0 if scalar @bcc == 0;
  271.     my $bcc = join(",", @bcc);
  272.     my $command_temp = $command;
  273.     $command_temp =~ s/\$TO/$par->{chuckaddress}/g;
  274.     $command_temp =~ s/\$BCC/$bcc/g;
  275.     $command_temp =~ s/\$SUBJECT/$send_hashes->[0]->{subject}/g;
  276.     my $input_temp = $input;
  277.     $input_temp =~ s/\$TO/$par->{chuckaddress}/g;
  278.     $input_temp =~ s/\$BCC/$bcc/g;
  279.     $input_temp =~ s/\$SUBJECT/$send_hashes->[0]->{subject}/g;
  280.     $input_temp .= "\n";
  281.     return command_line_send($par, $command_temp, $input_temp, $text, $debug);    
  282. }
  283.  
  284. ###
  285. ### command_line_send
  286. ###
  287. ### Sends a message via the command line (technical guts)
  288. ###
  289.  
  290. sub command_line_send {
  291.     my ($par, $command, $input, $text, $debug) = @_;
  292.     my $tempfile = "";
  293.     if ($par->{'tempfile'} == 0) {
  294.         if (! open (MAIL, "$command")) {
  295.             log_error("mailer.pl", "command_line_send", "Could not open command $command: $!") if ! $debug;
  296.             error_message("Command Line Sending Error", "Could not open command $command: $!") if $debug;
  297.             return 0;
  298.         }
  299.     } else {
  300.         my $pid = $$;
  301.         my $timecache = time;
  302.         $pid =~ s/\D//g;
  303.         $tempfile = "$DCONF->{message_dir}/$timecache-$pid.tmp";
  304.         if (! open (MAIL, ">$tempfile")) {
  305.             log_error("mailer.pl", "command_line_send", "Could not open temporary file $tempfile: $!") if ! $debug;
  306.             error_message("Command Line Sending Error", "Could not open temporary file $tempfile: $!") if $debug;
  307.             return 0;
  308.         }
  309.     }
  310.     $input =~ s/\s+$/\n/;
  311.     print MAIL $input;
  312.     print MAIL "MIME-Version: 1.0\n";
  313.     print MAIL "\n";
  314.     print MAIL $text;
  315.     close (MAIL);
  316.     return 1 if $par->{'tempfile'} == 0;
  317.     my $command_temp = $command;
  318.     $command_temp =~ s/^\|\s*//;
  319.     my $mail_prog = $par->{'mail_program'};
  320.     my $cmdline = "";
  321.     if ($command_temp !~ m|\$TEMPFILE|) {
  322.         my $pr = quotemeta($mail_prog);
  323.         my $stuff = "";
  324.         if ($command_temp =~ m|$pr|) {
  325.             $stuff = $';
  326.             $command_temp = $mail_prog;
  327.         } else {
  328.             $stuff = "";
  329.         }
  330.         $cmdline = "$mail_prog \"$tempfile\" $stuff";
  331.     } else {
  332.         $cmdline = $command_temp;
  333.         $cmdline =~ s/\$TEMPFILE/$tempfile/g;
  334.     }
  335.     
  336.     if ($^O eq "MSWin32") {
  337.         $mail_prog =~ s%/%\\%g; $cmdline =~ s%/%\\%g; $cmdline =~ s/'/"/g; $cmdline =~ s/^\s*//;
  338.         my $cwd = "";
  339.         if ($mail_prog =~ m|(.*)\\|) { $cwd = $1; } else { $cwd = "."; }
  340.         return windows_process_send($mail_prog, $cmdline, $cwd, $debug);
  341.     } else {
  342.         if (system $cmdline) {
  343.             unlink ($tempfile);
  344.             log_error("mailer.pl", "command_line_send", "Send failed for [$cmdline] $!") if ! $debug;
  345.             error_message("Send Failed", "Failed to execute command '$cmdline': $!") if $debug;
  346.             return 0;
  347.         }
  348.     }
  349.     unlink ($tempfile);
  350.     return 1;    
  351. }
  352.  
  353. ###
  354. ### windows_process_send
  355. ###
  356. ### Sends an e-mail message with the Win32::Process module
  357. ###
  358.  
  359. sub windows_process_send {
  360.     my ($mail_prog, $cmdline, $cwd, $debug) = @_;
  361.     my $code = eval '
  362.         use Win32::Process;
  363.         use Win32;
  364.         my $ProcessObj = undef;
  365.         my $ExitCode = undef;
  366.         if (Win32::Process::Create($ProcessObj, "$mail_prog", "$cmdline", 0, DETACHED_PROCESS, $cwd)) {
  367.             $ProcessObj->Wait(INFINITE);
  368.             $ProcessObj->GetExitCode( $ExitCode );
  369.             $ExitCode;
  370.         } else {
  371.             error_message("Windows Process Creation Error", Win32::FormatMessage(Win32::GetLastError()) . "<P>Command line:<PRE>$cmdline</PRE><P>CWD:<PRE>$cwd</PRE>") if $debug;
  372.             log_error("mailer.pl", "windows_process_send", Win32::FormatMessage(Win32::GetLastError())) if ! $debug;
  373.             0;
  374.         }
  375.     ';
  376.     return $code;
  377. }
  378.  
  379. ###
  380. ### mailer_error
  381. ###
  382. ### Prints error to log or to screen depending on whether or not you are debugging
  383. ###
  384.  
  385. sub mailer_error {
  386.     my ($debug, $subroutine, $errortext, $sock) = @_;
  387.     if ($debug) {
  388.         close $sock if defined $sock;
  389.         error_message("Mail Error: $subroutine", $errortext, 0, 1);
  390.     } else {
  391.         log_error("mailer.pl", $subroutine, $errortext);
  392.     }
  393. }
  394.  
  395. ###
  396. ### raw_socket_send
  397. ###
  398. ### This should work on almost every platform; it requires only the very
  399. ### standard FileHandle module
  400. ###
  401.  
  402. sub raw_socket_send {
  403.     my ($send_hashes, $text, $par, $debug) = @_;
  404.     $par = email_configuration_read() if ! defined $par;
  405.     my $smtp = $par->{SMTP3};
  406.     my $smtp_sock = undef;
  407.     if ($smtp !~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) {
  408.         mailer_error($debug, "raw_socket_send", "SMTP server is invalid.");
  409.         return 0;
  410.     } else {
  411.         $smtp_sock = pack('C4',$1,$2,$3,$4);
  412.     }
  413.     my $proto = getprotobyname('tcp');
  414.     my $port = 25;
  415.     eval 'use Socket; use FileHandle;';
  416.     mailer_error($debug, "raw_socket_send", "(1) Socket/Filehandle module not implemented here: $@") if $@;
  417.     my $sock = eval ' FileHandle::new(); ';
  418.     mailer_error($debug, "raw_socket_send", "(2) Socket/Filehandle module not implemented here: $@") if $@;
  419.     if (! socket($sock, AF_INET(), SOCK_STREAM(), $proto)) {
  420.         mailer_error($debug, "raw_socket_send", "Socket Failed: $!");
  421.         return 0;
  422.     }
  423.     if (! connect($sock, pack('Sna4x8', AF_INET(), $port, $smtp_sock))) {
  424.         mailer_error($debug, "raw_socket_send", "Connect Failed to $smtp port $port: $!", $sock);
  425.         return 0;
  426.     }
  427.     my ($oldfh) = select($sock); $| = 1; select($oldfh);
  428.     $_ = <$sock>;
  429.     if (/^[45]/) {
  430.         close $sock;
  431.         mailer_error($debug, "raw_socket_send", "$smtp server not available: $!");
  432.         return 0;
  433.     }
  434.     print $sock "helo localhost\r\n";
  435.     $_ = <$sock>;
  436.     if (/^[45]/) {
  437.         close $sock;
  438.         mailer_error($debug, "raw_socket_send", "$smtp server error: $!");
  439.         return 0;
  440.     }
  441.     my $success = 0;
  442.     my $fr_addr = defined $par->{fromaddr} ? $par->{fromaddr} : "nobody\@localhost";
  443.     my $from = "$par->{fromname} <$fr_addr>";
  444.     my @txt = split(/\n/, $text);
  445.     foreach my $line (@txt) {
  446.         if ($line =~ /^\s*$/) {
  447.             $line = "\r\n";
  448.         } else {
  449.             $line = trim($line);
  450.             if ($line =~ /^\.+$/) {
  451.                 $line = "(.)\r\n";
  452.             } else {
  453.                 $line .= "\r\n";
  454.             }
  455.         }
  456.     }
  457.     my $dataX = "X-Mailer: Discus";
  458.     $dataX .= " Pro" if $DCONF->{pro};
  459.     $dataX .= " <$DCONF->{html_url}>";
  460.     foreach my $r (@{ $send_hashes }) {
  461.         $r->{to} =~ s/\@\./\@/g;
  462.         next if $r->{to} !~ m|^([\w\+\-\.]+)\@([\w\+\-\.]+)$|;
  463.         print $sock "mail from: $fr_addr\r\n";
  464.         $_ = <$sock>;
  465.         if (/^[45]/) {
  466.             mailer_error($debug, "raw_socket_send", "$smtp send error (mail from $fr_addr): $!", $sock);
  467.             next;
  468.         }
  469.         print $sock "rcpt to: $r->{to}\r\n";
  470.         $_ = <$sock>;
  471.         if (/^[45]/) {
  472.             mailer_error($debug, "raw_socket_send", "$smtp send error (rcpt to $r->{to}) (perhaps relaying denied?): $!", $sock);
  473.             next;
  474.         }
  475.         print $sock "data\r\n";
  476.         if (/^[45]/) {
  477.             mailer_error($debug, "raw_socket_send", "$smtp send error (would not accept data): $!", $sock);
  478.             next;
  479.         }
  480.         print $sock "To: $r->{to}\r\n";
  481.         print $sock "From: $from\r\n";
  482.         print $sock "Subject: $r->{subject}\r\n";
  483.         print $sock "Reply-to: $fr_addr\r\n";
  484.         print $sock "X-Mailer: $dataX\r\n";
  485.         print $sock "MIME-Version: 1.0\r\n";
  486.         if ($r->{html}) {
  487.             print $sock "Content-type: text/html; charset=$DCONF->{mail_charset}\r\n";
  488.         } else {
  489.             print $sock "Content-type: text/plain; charset=$DCONF->{mail_charset}\r\n";
  490.         }
  491.         print $sock "\r\n";
  492.         print $sock @txt;
  493.         print $sock "\r\n.\r\n";
  494.         if (/^[45]/) {
  495.             mailer_error($debug, "raw_socket_send", "Text send to $r->{to} failed: $!", $sock);
  496.             next;
  497.         }
  498.         $success++;
  499.     }
  500.     print $sock "quit\r\n";
  501.     $_ = <$sock>;
  502.     close $sock;
  503.     if (scalar(@{ $send_hashes })) {
  504.         return int($success / scalar(@{ $send_hashes }));
  505.     } else {
  506.         return 0;
  507.     }
  508. }
  509.  
  510.  
  511. ###
  512. ### email_get_parameters
  513. ###
  514. ### Gets input stream and command line for sending
  515. ###
  516.  
  517. sub email_get_parameters {
  518.     my ($par) = @_;
  519.     my $command = $par->{'command_line'};
  520.     my $input = $par->{'input_stream'};
  521.     $command =~ s/\$REPLYTO/$par->{fromaddr}/g;
  522.     $input =~ s/\$REPLYTO/$par->{fromaddr}/g;
  523.     $input .= "X-Mailer: Discus $PARAMS->{release}.$PARAMS->{revision}";
  524.     $input .= " Pro" if $DCONF->{pro};
  525.     $input .= " <$DCONF->{html_url}>\n";
  526.     return ($command, $input);
  527. }
  528.  
  529. ###
  530. ### email_crontab_send
  531. ###
  532. ### Sends a message with "cron-based" sending mechanism
  533. ###
  534.  
  535. sub email_crontab_send {
  536.     my ($send_hashes, $text, $par, $debug) = @_;
  537.     my $filename = join("", time, $$, $ENV{'REMOTE_ADDR'}); $filename =~ s/\D//g;
  538.     my ($command, $input) = email_get_parameters($par);
  539.     while (-r "$DCONF->{admin_dir}/mailqueue/$filename-1.txt") {
  540.         $filename .= int(rand(10));
  541.     }
  542.     my $file = "$DCONF->{admin_dir}/mailqueue/$filename";
  543.     my $ctr = 0;
  544.     foreach my $r (@{ $send_hashes }) {
  545.         $ctr++;
  546.         $r->{to} =~ s/\@\./\@/g;
  547.         my $command_temp = $command;
  548.         $command_temp =~ s/\$TO/$r->{to}/g;
  549.         $command_temp =~ s/\$SUBJECT/$r->{subject}/g;
  550.         my $input_temp = $input;
  551.         $input_temp =~ s/\$TO/$r->{to}/g;
  552.         $input_temp =~ s/\$SUBJECT/$r->{subject}/g;
  553.         $input_temp =~ s/\s+$/\n/;
  554.         $input_temp .= "MIME-Version: 1.0\n";
  555.         $input_temp .= "Content-type: text/html; charset=$DCONF->{mail_charset}\n" if $r->{html};
  556.         $input_temp .= "Content-type: text/plain; charset=$DCONF->{mail_charset}\n" if ! $r->{html};
  557.         $input_temp .= "\n";
  558.         open (FILE, "> $file-$ctr.txt") || error_message("Mail Send Error", "Could not open mail queue for writing!");
  559.         print FILE "$command_temp\n";
  560.         print FILE $input_temp;
  561.         print FILE $text;
  562.         print FILE "<==============>|$r->{user}|", crypt($r->{pass}, "cookie"), "|<==============>\n" if ($r->{user} ne "" && $par->{'reply_email'});
  563.         close (FILE);
  564.         chmod (oct($DCONF->{perms0666}), "$file-$ctr.txt");
  565.     }
  566.     return 1;
  567. }
  568.  
  569. ###
  570. ### email_configuration_read
  571. ###
  572. ### Reads e-mail configuration from email.txt file
  573. ###
  574.  
  575. sub email_configuration_read {
  576.     my $k = $_[0];
  577.     my $o = defined $k ? $k : readfile("$DCONF->{admin_dir}/email.txt", "email_configuration_read", { create => 1, zero_ok => 1, no_lock => 1, no_unlock => 1 });
  578.     return undef if ! defined $o;
  579.     undef my $result;
  580.     foreach my $line (@{$o}) {
  581.         if ($line =~ m|^(\w+)=(.*)|) {
  582.             my ($o, $t) = ($1, $2);
  583.             $t =~ s/\r//g; $t = unescape($t) if $t =~ /^[\w\+\%]+$/;
  584.             $result->{$o} = $t;
  585.         }
  586.     }
  587.     return $result;
  588. }
  589.  
  590. ###
  591. ### email_configuration_save
  592. ###
  593. ### Writes e-mail configuration into email.txt file
  594. ###
  595.  
  596. sub email_configuration_save {
  597.     my ($s, $infile) = @_;
  598.     my $f = defined $infile ? $infile : readfile("$DCONF->{admin_dir}/email.txt", "email_configuration_read", { create => 1, zero_ok => 1, no_unlock => 1 });
  599.     my $r = {};
  600.     foreach my $l (@{ $f }) {
  601.         if ($l =~ m|^(\w+)=(.*)|) {
  602.             my ($o, $t) = ($1, $2);
  603.             $t =~ s/\r//g;
  604.             $t = unescape($t) if $t !~ /\s/;
  605.             $r->{$o} = $t;
  606.         }
  607.     }
  608.     hash_merge($r, $s, 1);
  609.     my @o = sort map { join("", join("=", $_, escape($r->{$_})), "\n") } keys(%{ $r });
  610.     return defined $infile ? \@o : writefile("$DCONF->{admin_dir}/email.txt", \@o, "email_configuration_save", { no_lock => 1 });
  611. }
  612.  
  613. ###
  614. ### construct_command_line_string
  615. ###
  616. ### Constructs a command line and an input stream
  617. ###
  618.  
  619. sub construct_command_line_string {
  620.     my ($Q) = @_;
  621.     my @z = (
  622.         { id => 'to',        x => '$TO' },
  623.         { id => 'from',        x => '$FROMSTRG' },
  624.         { id => 'user',        x => '$FROMADDR' },
  625.         { id => 'subject',    x => '$SUBJECT' },
  626.         { id => 'bcc',        x => '$BCC' },
  627.         { id => 'replyto',    x => '$FROMADDR' },
  628.     );
  629.     my @cl = ();
  630.     my @is = ();
  631.     foreach my $z (@z) {
  632.         next if $z->{id} eq "bcc" && $Q->{'1message'} != 1;
  633.         my $I = join("", $z->{id}, "address");
  634.         my $L1 = $Q->{lineformat} == 1 ? join(trim(join(" ", $Q->{join("_", $I, "prefix")}, $z->{x})), "'", "'") : trim(join(" ", $Q->{join("_", $I, "prefix")}, join($z->{x}, "'", "'")));
  635.         my $L2 = trim(join(" ", $Q->{join("_", $I, "prefix")}, $z->{x}));
  636.         my $L3 = trim(join("", $Q->{join("_", $I, "prefix")}, $z->{x}));
  637.         if ($Q->{join("_", $I, "prefix")} !~ /\S/ && $Q->{$I} == 0) {
  638.             push @cl, $L3;
  639.         } elsif ($Q->{$I} == 0) {
  640.             push @cl, trim($L1);
  641.         } elsif ($Q->{$I} == 1) {
  642.             push @is, $L2;
  643.         }
  644.     }
  645.     unshift @cl, $Q->{commandline} if $Q->{commandline} ne "";
  646.     push @cl, $Q->{commandlineend} if $Q->{commandlineend} ne "";
  647.     unshift @cl, $Q->{mail_program};
  648.     my $cl = join(" ", '|', @cl);
  649.     my $is = join("\n", @is); $is .= "\n";
  650.     return ($cl, $is);
  651. }
  652.  
  653. 1;
  654.