[dw-free] move cgi-bin/lj*.pl files into proper modules (in cgi-bin/LJ)
[commit: http://hg.dwscoalition.org/dw-free/rev/88b20bf4dc78]
http://bugs.dwscoalition.org/show_bug.cgi?id=1726
Move ljmail.pl to LJ/Sendmail.pm
Patch by
kareila.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=1726
Move ljmail.pl to LJ/Sendmail.pm
Patch by
![[personal profile]](https://www.dreamwidth.org/img/silk/identity/user.png)
Files modified:
- bin/worker/paidstatus
- bin/worker/support-notify
- cgi-bin/DW/Worker/DistributeInvites.pm
- cgi-bin/LJ/Cmdbuffer.pm
- cgi-bin/LJ/Sendmail.pm
- cgi-bin/ljlib.pl
- cgi-bin/ljmail.pl
- cgi-bin/modperl_subs.pl
-------------------------------------------------------------------------------- diff -r 2d35bfea266d -r 88b20bf4dc78 bin/worker/paidstatus --- a/bin/worker/paidstatus Tue Oct 18 18:19:19 2011 +0800 +++ b/bin/worker/paidstatus Tue Oct 18 18:30:10 2011 +0800 @@ -21,7 +21,7 @@ use Time::HiRes qw/ gettimeofday tv_interval /; require 'ljlib.pl'; -require 'ljmail.pl'; +use LJ::Sendmail; use LJ::Lang; use DW::Shop; use DW::Shop::Cart; diff -r 2d35bfea266d -r 88b20bf4dc78 bin/worker/support-notify --- a/bin/worker/support-notify Tue Oct 18 18:19:19 2011 +0800 +++ b/bin/worker/support-notify Tue Oct 18 18:30:10 2011 +0800 @@ -16,7 +16,7 @@ use lib "$ENV{LJHOME}/cgi-bin"; require 'ljlib.pl'; use LJ::Support; -require "ljmail.pl"; +use LJ::Sendmail; use LJ::Worker::TheSchwartz; diff -r 2d35bfea266d -r 88b20bf4dc78 cgi-bin/DW/Worker/DistributeInvites.pm --- a/cgi-bin/DW/Worker/DistributeInvites.pm Tue Oct 18 18:19:19 2011 +0800 +++ b/cgi-bin/DW/Worker/DistributeInvites.pm Tue Oct 18 18:30:10 2011 +0800 @@ -28,7 +28,7 @@ use LJ::Lang; use LJ::Sysban; -BEGIN { require "ljmail.pl"; } +BEGIN { use LJ::Sendmail; } sub schwartz_capabilities { return ('DW::Worker::DistributeInvites'); } diff -r 2d35bfea266d -r 88b20bf4dc78 cgi-bin/LJ/Cmdbuffer.pm --- a/cgi-bin/LJ/Cmdbuffer.pm Tue Oct 18 18:19:19 2011 +0800 +++ b/cgi-bin/LJ/Cmdbuffer.pm Tue Oct 18 18:30:10 2011 +0800 @@ -19,7 +19,7 @@ use lib "$LJ::HOME/cgi-bin"; require "ljlib.pl"; -require "ljmail.pl"; +use LJ::Sendmail; package LJ::Cmdbuffer; diff -r 2d35bfea266d -r 88b20bf4dc78 cgi-bin/LJ/Sendmail.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cgi-bin/LJ/Sendmail.pm Tue Oct 18 18:30:10 2011 +0800 @@ -0,0 +1,239 @@ +#!/usr/bin/perl +# +# This code was forked from the LiveJournal project owned and operated +# by Live Journal, Inc. The code has been modified and expanded by +# Dreamwidth Studios, LLC. These files were originally licensed under +# the terms of the license supplied by Live Journal, Inc, which can +# currently be found at: +# +# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt +# +# In accordance with the original license, this code and all its +# modifications are provided under the GNU General Public License. +# A copy of that license can be found in the LICENSE file included as +# part of this distribution. + + +use strict; + +use lib "$LJ::HOME/cgi-bin"; +require "ljlib.pl"; + +package LJ; + +use Text::Wrap (); +use Time::HiRes qw( gettimeofday tv_interval ); +use Encode qw( encode from_to ); +use MIME::Base64 qw( encode_base64 ); +use IO::Socket::INET; +use MIME::Lite; +use Mail::Address; +use MIME::Words qw( encode_mimeword ); + +my $done_init = 0; +sub init { + return if $done_init++; + if ($LJ::SMTP_SERVER) { + # determine how we're going to send mail + $LJ::OPTMOD_NETSMTP = eval "use Net::SMTP (); 1;"; + die "Net::SMTP not installed\n" unless $LJ::OPTMOD_NETSMTP; + MIME::Lite->send('smtp', $LJ::SMTP_SERVER, Timeout => 10); + } else { + MIME::Lite->send('sendmail', $LJ::SENDMAIL); + } +} + + +# <LJFUNC> +# name: LJ::send_mail +# des: Sends email. Character set will only be used if message is not ASCII. +# args: opt, async_caller +# des-opt: Hashref of arguments. Required: to, from, subject, body. +# Optional: toname, fromname, cc, bcc, charset, wrap, html. +# All text must be in UTF-8 (without UTF flag, as usual in LJ code). +# Body and subject are converted to recipient-user mail encoding. +# Subject line is encoded according to RFC 2047. +# Warning: opt can be a MIME::Lite ref instead, in which +# case it is sent as-is. +# </LJFUNC> +sub send_mail +{ + my $opt = shift; + my $async_caller = shift; + + init(); + + my $msg = $opt; + + # did they pass a MIME::Lite object already? + unless (ref $msg eq 'MIME::Lite') { + + my $clean_name = sub { + my ($name, $email) = @_; + return $email unless $name; + $name =~ s/[\n\t\"<>]//g; + return $name ? "\"$name\" <$email>" : $email; + }; + + my $body = $opt->{'wrap'} ? Text::Wrap::wrap('','',$opt->{'body'}) : $opt->{'body'}; + my $subject = $opt->{'subject'}; + my $fromname = $opt->{'fromname'}; + + # if it's not ascii, add a charset header to either what we were explictly told + # it is (for instance, if the caller transcoded it), or else we assume it's utf-8. + # Note: explicit us-ascii default charset suggested by RFC2854 sec 6. + $opt->{'charset'} ||= "utf-8"; + my $charset; + if (!LJ::is_ascii($subject) + || !LJ::is_ascii($body) + || ($opt->{html} && !LJ::is_ascii($opt->{html})) + || !LJ::is_ascii($fromname)) { + $charset = $opt->{'charset'}; + } else { + $charset = 'us-ascii'; + } + + # Don't convert from us-ascii and utf-8 charsets. + unless (($charset =~ m/us-ascii/i) || ($charset =~ m/^utf-8$/i)) { + from_to($body, "utf-8", $charset); + # Convert also html-part if we has it. + if ($opt->{html}) { + from_to($opt->{html}, "utf-8", $charset); + } + } + + from_to($subject, "utf-8", $charset) unless $charset =~ m/^utf-8$/i; + if (!LJ::is_ascii($subject)) { + $subject = MIME::Words::encode_mimeword($subject, 'B', $charset); + } + + from_to($fromname, "utf-8", $charset) unless $charset =~ m/^utf-8$/i; + if (!LJ::is_ascii($fromname)) { + $fromname = MIME::Words::encode_mimeword($fromname, 'B', $charset); + } + $fromname = $clean_name->($fromname, $opt->{'from'}); + + if ($opt->{html}) { + # do multipart, with plain and HTML parts + + $msg = new MIME::Lite ('From' => $fromname, + 'To' => $clean_name->($opt->{'toname'}, $opt->{'to'}), + 'Cc' => $opt->{'cc'}, + 'Bcc' => $opt->{'bcc'}, + 'Subject' => $subject, + 'Type' => 'multipart/alternative'); + + # add the plaintext version + my $plain = $msg->attach( + 'Type' => 'text/plain', + 'Data' => "$body\n", + 'Encoding' => 'quoted-printable', + ); + $plain->attr("content-type.charset" => $charset); + + # add the html version + my $html = $msg->attach( + 'Type' => 'text/html', + 'Data' => $opt->{html}, + 'Encoding' => 'quoted-printable', + ); + $html->attr("content-type.charset" => $charset); + + } else { + # no html version, do simple email + $msg = new MIME::Lite ('From' => $fromname, + 'To' => $clean_name->($opt->{'toname'}, $opt->{'to'}), + 'Cc' => $opt->{'cc'}, + 'Bcc' => $opt->{'bcc'}, + 'Subject' => $subject, + 'Type' => 'text/plain', + 'Data' => $body); + + $msg->attr("content-type.charset" => $charset); + } + + if ($opt->{headers}) { + while (my ($tag, $value) = each %{$opt->{headers}}) { + $msg->add($tag, $value); + } + } + } + + # at this point $msg is a MIME::Lite + + # note that we sent an email + LJ::note_recent_action(undef, $msg->attr('content-type') =~ /plain/i ? 'email_send_text' : 'email_send_html'); + + my $enqueue = sub { + my $starttime = [gettimeofday()]; + my $sclient = LJ::theschwartz() or die "Misconfiguration in mail. Can't go into TheSchwartz."; + my ($env_from) = map { $_->address } Mail::Address->parse($msg->get('From')); + my @rcpts; + push @rcpts, map { $_->address } Mail::Address->parse($msg->get($_)) foreach (qw(To Cc Bcc)); + my $host; + if (@rcpts == 1) { + $rcpts[0] =~ /(.+)@(.+)$/; + $host = lc($2) . '@' . lc($1); # we store it reversed in database + } + my $job = TheSchwartz::Job->new(funcname => "TheSchwartz::Worker::SendEmail", + arg => { + env_from => $env_from, + rcpts => \@rcpts, + data => $msg->as_string, + }, + coalesce => $host, + ); + my $h = $sclient->insert($job); + + LJ::blocking_report( 'the_schwartz', 'send_mail', + tv_interval($starttime)); + + return $h ? 1 : 0; + }; + + if ($LJ::MAIL_TO_THESCHWARTZ || ($LJ::MAIL_SOMETIMES_TO_THESCHWARTZ && $LJ::MAIL_SOMETIMES_TO_THESCHWARTZ->($msg))) { + return $enqueue->(); + } + + return $enqueue->() if $LJ::ASYNC_MAIL && ! $async_caller; + + my $starttime = [gettimeofday()]; + my $rv; + if ($LJ::DMTP_SERVER) { + my $host = $LJ::DMTP_SERVER; + unless ($host =~ /:/) { + $host .= ":7005"; + } + # DMTP (Danga Mail Transfer Protocol) + $LJ::DMTP_SOCK ||= IO::Socket::INET->new(PeerAddr => $host, + Proto => 'tcp'); + if ($LJ::DMTP_SOCK) { + my $as = $msg->as_string; + my $len = length($as); + my $env = $opt->{'from'}; + $LJ::DMTP_SOCK->print("Content-Length: $len\r\n" . + "Envelope-Sender: $env\r\n\r\n$as"); + my $ok = $LJ::DMTP_SOCK->getline; + $rv = ($ok =~ /^OK/); + } + } else { + # SMTP or sendmail case + $rv = eval { $msg->send && 1; }; + } + my $notes = sprintf( "Direct mail send to %s %s: %s", + $msg->get('to'), + $rv ? "succeeded" : "failed", + $msg->get('subject') ); + + unless ($async_caller) { + LJ::blocking_report( $LJ::SMTP_SERVER || $LJ::SENDMAIL, 'send_mail', + tv_interval($starttime), $notes ); + } + + return 1 if $rv; + return 0 if $@ =~ /no data in this part/; # encoding conversion error higher + return $enqueue->() unless $opt->{'no_buffer'}; + return 0; +} + +1; diff -r 2d35bfea266d -r 88b20bf4dc78 cgi-bin/ljlib.pl --- a/cgi-bin/ljlib.pl Tue Oct 18 18:19:19 2011 +0800 +++ b/cgi-bin/ljlib.pl Tue Oct 18 18:30:10 2011 +0800 @@ -2096,7 +2096,7 @@ our $AUTOLOAD; sub AUTOLOAD { if ($AUTOLOAD eq "LJ::send_mail") { - require "ljmail.pl"; + eval "use LJ::Sendmail;"; goto &$AUTOLOAD; } Carp::croak("Undefined subroutine: $AUTOLOAD"); diff -r 2d35bfea266d -r 88b20bf4dc78 cgi-bin/ljmail.pl --- a/cgi-bin/ljmail.pl Tue Oct 18 18:19:19 2011 +0800 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,239 +0,0 @@ -#!/usr/bin/perl -# -# This code was forked from the LiveJournal project owned and operated -# by Live Journal, Inc. The code has been modified and expanded by -# Dreamwidth Studios, LLC. These files were originally licensed under -# the terms of the license supplied by Live Journal, Inc, which can -# currently be found at: -# -# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt -# -# In accordance with the original license, this code and all its -# modifications are provided under the GNU General Public License. -# A copy of that license can be found in the LICENSE file included as -# part of this distribution. - - -use strict; - -use lib "$LJ::HOME/cgi-bin"; -require "ljlib.pl"; - -package LJ; - -use Text::Wrap (); -use Time::HiRes qw( gettimeofday tv_interval ); -use Encode qw( encode from_to ); -use MIME::Base64 qw( encode_base64 ); -use IO::Socket::INET; -use MIME::Lite; -use Mail::Address; -use MIME::Words qw( encode_mimeword ); - -my $done_init = 0; -sub init { - return if $done_init++; - if ($LJ::SMTP_SERVER) { - # determine how we're going to send mail - $LJ::OPTMOD_NETSMTP = eval "use Net::SMTP (); 1;"; - die "Net::SMTP not installed\n" unless $LJ::OPTMOD_NETSMTP; - MIME::Lite->send('smtp', $LJ::SMTP_SERVER, Timeout => 10); - } else { - MIME::Lite->send('sendmail', $LJ::SENDMAIL); - } -} - - -# <LJFUNC> -# name: LJ::send_mail -# des: Sends email. Character set will only be used if message is not ASCII. -# args: opt, async_caller -# des-opt: Hashref of arguments. Required: to, from, subject, body. -# Optional: toname, fromname, cc, bcc, charset, wrap, html. -# All text must be in UTF-8 (without UTF flag, as usual in LJ code). -# Body and subject are converted to recipient-user mail encoding. -# Subject line is encoded according to RFC 2047. -# Warning: opt can be a MIME::Lite ref instead, in which -# case it is sent as-is. -# </LJFUNC> -sub send_mail -{ - my $opt = shift; - my $async_caller = shift; - - init(); - - my $msg = $opt; - - # did they pass a MIME::Lite object already? - unless (ref $msg eq 'MIME::Lite') { - - my $clean_name = sub { - my ($name, $email) = @_; - return $email unless $name; - $name =~ s/[\n\t\"<>]//g; - return $name ? "\"$name\" <$email>" : $email; - }; - - my $body = $opt->{'wrap'} ? Text::Wrap::wrap('','',$opt->{'body'}) : $opt->{'body'}; - my $subject = $opt->{'subject'}; - my $fromname = $opt->{'fromname'}; - - # if it's not ascii, add a charset header to either what we were explictly told - # it is (for instance, if the caller transcoded it), or else we assume it's utf-8. - # Note: explicit us-ascii default charset suggested by RFC2854 sec 6. - $opt->{'charset'} ||= "utf-8"; - my $charset; - if (!LJ::is_ascii($subject) - || !LJ::is_ascii($body) - || ($opt->{html} && !LJ::is_ascii($opt->{html})) - || !LJ::is_ascii($fromname)) { - $charset = $opt->{'charset'}; - } else { - $charset = 'us-ascii'; - } - - # Don't convert from us-ascii and utf-8 charsets. - unless (($charset =~ m/us-ascii/i) || ($charset =~ m/^utf-8$/i)) { - from_to($body, "utf-8", $charset); - # Convert also html-part if we has it. - if ($opt->{html}) { - from_to($opt->{html}, "utf-8", $charset); - } - } - - from_to($subject, "utf-8", $charset) unless $charset =~ m/^utf-8$/i; - if (!LJ::is_ascii($subject)) { - $subject = MIME::Words::encode_mimeword($subject, 'B', $charset); - } - - from_to($fromname, "utf-8", $charset) unless $charset =~ m/^utf-8$/i; - if (!LJ::is_ascii($fromname)) { - $fromname = MIME::Words::encode_mimeword($fromname, 'B', $charset); - } - $fromname = $clean_name->($fromname, $opt->{'from'}); - - if ($opt->{html}) { - # do multipart, with plain and HTML parts - - $msg = new MIME::Lite ('From' => $fromname, - 'To' => $clean_name->($opt->{'toname'}, $opt->{'to'}), - 'Cc' => $opt->{'cc'}, - 'Bcc' => $opt->{'bcc'}, - 'Subject' => $subject, - 'Type' => 'multipart/alternative'); - - # add the plaintext version - my $plain = $msg->attach( - 'Type' => 'text/plain', - 'Data' => "$body\n", - 'Encoding' => 'quoted-printable', - ); - $plain->attr("content-type.charset" => $charset); - - # add the html version - my $html = $msg->attach( - 'Type' => 'text/html', - 'Data' => $opt->{html}, - 'Encoding' => 'quoted-printable', - ); - $html->attr("content-type.charset" => $charset); - - } else { - # no html version, do simple email - $msg = new MIME::Lite ('From' => $fromname, - 'To' => $clean_name->($opt->{'toname'}, $opt->{'to'}), - 'Cc' => $opt->{'cc'}, - 'Bcc' => $opt->{'bcc'}, - 'Subject' => $subject, - 'Type' => 'text/plain', - 'Data' => $body); - - $msg->attr("content-type.charset" => $charset); - } - - if ($opt->{headers}) { - while (my ($tag, $value) = each %{$opt->{headers}}) { - $msg->add($tag, $value); - } - } - } - - # at this point $msg is a MIME::Lite - - # note that we sent an email - LJ::note_recent_action(undef, $msg->attr('content-type') =~ /plain/i ? 'email_send_text' : 'email_send_html'); - - my $enqueue = sub { - my $starttime = [gettimeofday()]; - my $sclient = LJ::theschwartz() or die "Misconfiguration in mail. Can't go into TheSchwartz."; - my ($env_from) = map { $_->address } Mail::Address->parse($msg->get('From')); - my @rcpts; - push @rcpts, map { $_->address } Mail::Address->parse($msg->get($_)) foreach (qw(To Cc Bcc)); - my $host; - if (@rcpts == 1) { - $rcpts[0] =~ /(.+)@(.+)$/; - $host = lc($2) . '@' . lc($1); # we store it reversed in database - } - my $job = TheSchwartz::Job->new(funcname => "TheSchwartz::Worker::SendEmail", - arg => { - env_from => $env_from, - rcpts => \@rcpts, - data => $msg->as_string, - }, - coalesce => $host, - ); - my $h = $sclient->insert($job); - - LJ::blocking_report( 'the_schwartz', 'send_mail', - tv_interval($starttime)); - - return $h ? 1 : 0; - }; - - if ($LJ::MAIL_TO_THESCHWARTZ || ($LJ::MAIL_SOMETIMES_TO_THESCHWARTZ && $LJ::MAIL_SOMETIMES_TO_THESCHWARTZ->($msg))) { - return $enqueue->(); - } - - return $enqueue->() if $LJ::ASYNC_MAIL && ! $async_caller; - - my $starttime = [gettimeofday()]; - my $rv; - if ($LJ::DMTP_SERVER) { - my $host = $LJ::DMTP_SERVER; - unless ($host =~ /:/) { - $host .= ":7005"; - } - # DMTP (Danga Mail Transfer Protocol) - $LJ::DMTP_SOCK ||= IO::Socket::INET->new(PeerAddr => $host, - Proto => 'tcp'); - if ($LJ::DMTP_SOCK) { - my $as = $msg->as_string; - my $len = length($as); - my $env = $opt->{'from'}; - $LJ::DMTP_SOCK->print("Content-Length: $len\r\n" . - "Envelope-Sender: $env\r\n\r\n$as"); - my $ok = $LJ::DMTP_SOCK->getline; - $rv = ($ok =~ /^OK/); - } - } else { - # SMTP or sendmail case - $rv = eval { $msg->send && 1; }; - } - my $notes = sprintf( "Direct mail send to %s %s: %s", - $msg->get('to'), - $rv ? "succeeded" : "failed", - $msg->get('subject') ); - - unless ($async_caller) { - LJ::blocking_report( $LJ::SMTP_SERVER || $LJ::SENDMAIL, 'send_mail', - tv_interval($starttime), $notes ); - } - - return 1 if $rv; - return 0 if $@ =~ /no data in this part/; # encoding conversion error higher - return $enqueue->() unless $opt->{'no_buffer'}; - return 0; -} - -1; diff -r 2d35bfea266d -r 88b20bf4dc78 cgi-bin/modperl_subs.pl --- a/cgi-bin/modperl_subs.pl Tue Oct 18 18:19:19 2011 +0800 +++ b/cgi-bin/modperl_subs.pl Tue Oct 18 18:30:10 2011 +0800 @@ -88,7 +88,7 @@ use LJ::Talk; require "ljfeed.pl"; use LJ::Memories; -require "ljmail.pl"; +use LJ::Sendmail; use LJ::Sysban; use LJ::Community; use LJ::Tags; --------------------------------------------------------------------------------