root/trunk/plagger/lib/Plagger/Plugin/Publish/Gmail.pm

Revision 33 (checked in by miyagawa, 15 years ago)

Added TLS support to Publish::Gmail. Fixes #9

  • Property svn:keywords set to Id Revision
Line 
1 package Plagger::Plugin::Publish::Gmail;
2 use strict;
3 use base qw( Plagger::Plugin );
4
5 our $VERSION = '0.10';
6
7 use DateTime;
8 use DateTime::Format::Mail;
9 use Encode;
10 use Encode::MIME::Header;
11 use MIME::Lite;
12
13 sub register {
14     my($self, $context) = @_;
15     $context->register_hook(
16         $self,
17         'publish.notify' => \&notify,
18     );
19 }
20
21 sub notify {
22     my($self, $context, $feed) = @_;
23
24     my @items = $feed->entries;
25     if ($self->conf->{group_items}) {
26         $self->send_email_feed($context, $feed, \@items);
27     } else {
28         for my $item (@items) {
29             $self->send_email_item($context, $feed, $item);
30         }
31     }
32 }
33
34 sub send_email_feed {
35     my($self, $context, $feed, $items) = @_;
36     my $subject = $feed->title || '(no-title)';
37     my $body = join '<hr />', map $self->templatize($context, $feed, $_), @$items;
38     $self->do_send_mail($context, $feed, $subject, $body);
39 }
40
41 sub send_email_item {
42     my($self, $context, $feed, $item) = @_;
43     my $subject = $item->title || '(no-title)';
44     my $body    = $self->templatize($context, $feed, $item);
45     $self->do_send_mail($context, $feed, $subject, $body);
46 }
47
48 sub do_send_mail {
49     my($self, $context, $feed, $subject, $body) = @_;
50
51     $body = $self->htmlize($body);
52
53     my $cfg = $self->conf;
54     $context->log(warn => "Sending $subject to $cfg->{mailto}");
55
56     my $feed_title = $feed->title;
57        $feed_title =~ tr/,//d;
58
59     my $now = Plagger::Date->now(timezone => $context->conf->{timezone});
60
61     my $msg = MIME::Lite->new(
62         Date => $now->format('Mail'),
63         From => encode('MIME-Header', qq("$feed_title" <$cfg->{mailfrom}>)),
64         To   => $cfg->{mailto},
65         Subject => encode('MIME-Header', $subject),
66         Type => 'multipart/related',
67     );
68     $msg->attach(
69         Type => 'text/html; charset=utf-8',
70         Data => encode("utf-8", $body),
71     );
72
73     my $route = $cfg->{mailroute} || { via => 'smtp', host => 'localhost' };
74     if ($route->{via} eq 'smtp_tls') {
75         $msg->send_by_smtp_tls(
76             $route->{host},
77             User     => $route->{username},
78             Password => $route->{password},
79         );
80     } else {
81         my @args  = $route->{host} ? ($route->{host}) : ();
82         $msg->send($route->{via}, @args);
83     }
84 }
85
86 sub htmlize {
87     my($self, $body) = @_;
88     return <<HTML;
89 <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
90 <html>
91 <head>
92 <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
93 </head>
94 <body>
95 $body
96 </body>
97 </html>
98 HTML
99 }
100
101 sub templatize {
102     my($self, $context, $feed, $item) = @_;
103     my $tt = $context->template();
104     $tt->process('gmail_notify.tt', {
105         feed => $feed,
106         item => $item,
107         cfg  => $self->conf,
108     }, \my $out) or $context->error($tt->error);
109     $out;
110 }
111
112 # hack MIME::Lite to support TLS Authentication
113 package MIME::Lite;
114
115 sub send_by_smtp_tls {
116     my($self, @args) = @_;
117
118     ### We need the "From:" and "To:" headers to pass to the SMTP mailer:
119     my $hdr  = $self->fields();
120     my $from = $self->get('From');
121     my $to   = $self->get('To');
122
123     ### Sanity check:
124     defined($to) or Carp::croak "send_by_smtp_tls: missing 'To:' address\n";
125
126     ### Get the destinations as a simple array of addresses:
127     my @to_all = extract_addrs($to);
128     if ($MIME::Lite::AUTO_CC) {
129         foreach my $field (qw(Cc Bcc)) {
130             my $value = $self->get($field);
131             push @to_all, extract_addrs($value) if defined($value);
132         }
133     }
134
135     ### Create SMTP TLS client:
136     require Net::SMTP::TLS;
137     my $smtp = MIME::Lite::SMTP::TLS->new(@args)
138         or Carp::croak("Failed to connect to mail server: $!\n");
139     $smtp->mail($from);
140     $smtp->to(@to_all);
141     $smtp->data();
142
143     ### MIME::Lite can print() to anything with a print() method:
144     $self->print_for_smtp($smtp);
145     $smtp->dataend();
146     eval {
147         local $SIG{__WARN__} = sub { };
148         $smtp->quit;
149     };
150
151     # known error from Gmail SMTP
152     if ($@ && $@ !~ /An error occurred disconnecting from the mail server/) {
153         warn $@;
154     }
155
156     1;
157 }
158
159 package MIME::Lite::SMTP::TLS;
160 use base qw( Net::SMTP::TLS );
161
162 sub print { shift->datasend(@_) }
163
164 1;
Note: See TracBrowser for help on using the browser.