rc2mail.pl

   1 #! /usr/bin/perl
   2 # Copyright (C) 2010  Alex Schroeder <alex@gnu.org>
   3
   4 # This program is free software: you can redistribute it and/or modify it under
   5 # the terms of the GNU General Public License as published by the Free Software
   6 # Foundation, either version 3 of the License, or (at your option) any later
   7 # version.
   8 #
   9 # This program is distributed in the hope that it will be useful, but WITHOUT
  10 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  11 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along with
  14 # this program. If not, see <http://www.gnu.org/licenses/>.
  15
  16 package OddMuse;
  17
  18 use Getopt::Std;
  19 use XML::RSS;
  20 use LWP::UserAgent;
  21 use MIME::Entity;
  22 use File::Temp;
  23 use File::Basename;
  24 use File::Path;
  25
  26 # This script can be invoked as follows:
  27 # perl rc2mail.pl -r http://localhost/cgi-bin/wiki \
  28 #                 -p test \
  29 #                 -m "alex:*secret*@mail.epfarms.org" \
  30 #                 -f "kensanata@gmail.com" \
  31 #                 -t ~/.rc2mail
  32
  33 # -n Don't send email; useful if debugging the script
  34 # -p Oddmuse administrator password
  35 # -r Oddmuse full URL, eg. http://localhost/cgi-bin/wiki
  36 #    gets http://localhost/cgi-bin/wiki?action=rss;days=1;full=1;short=0
  37 #    And http://localhost/cgi-bin/wiki?action=subscriptionlist;raw=1;pwd=foo
  38 # -m user:password@mailhost for sending email using SMTP Auth. Without this
  39 #    information, the script will send mail to localhost.
  40 # -f email address to use as the sender.
  41 # -t timestamp file; it's last modified date is used to determine when the
  42 #    the last run was and an appropriate URL is used. Instead of days=1 it
  43 #    will use from=n where n is the last modified date of the timestamp file.
  44 # -q quiet (default: number of messages sent)
  45 # -v verbose output (recipients)
  46 # -x debug output
  47
  48 my %opts;
  49 getopts('np:r:m:f:t:qvx', \%opts);
  50 my $nomail = exists $opts{n};
  51 my $verbose = exists $opts{v};
  52 my $quiet = exists $opts{q};
  53 my $debug = exists $opts{x};
  54 my $admin_password = $opts{p};
  55 my $root = $opts{r};
  56 die "Must provide an url with the -r option\n" unless $root;
  57 $opts{m} =~ /(.*?):(.*)\@(.*)/;
  58 my ($user, $password, $host) = ($1, $2, $3);
  59 die "Cannot parse -m " . $opts{m} . "\n" if $opts{m} && !$host;
  60 my $from = $opts{f};
  61 die "Must provide sender using -f\n" if !$nomail && $host && !$from;
  62 my $ts = $opts{t};
  63
  64 my $ua = new LWP::UserAgent;
  65
  66 # Fetch subscribers first because we need to verify the password
  67
  68 sub get_subscribers {
  69   my $url = "$root?action=subscriptionlist;raw=1;pwd=$admin_password";
  70   print "Getting $url\n" if $debug;
  71   my $response = $ua->get($url);
  72   die "Must provide an admin password with the -p option\n"
  73     if $response->code == 403 and not $admin_password;
  74   die "Must provide the correct admin password with the -p option\n"
  75     if $response->code == 403;
  76   die $url, "\n", $response->status_line unless $response->is_success;
  77
  78   my %data;
  79   foreach my $line (split(/\n/, $response->content)) {
  80     my ($key, @entries) = split(/ +/, $line);
  81     # print "Subscription for $key: ", join(', ', @entries), "\n";
  82     $data{$key} = \@entries;
  83   }
  84   print "Found " . scalar(keys(%data)) . " subscribers\n" if $debug;
  85   return \%data;
  86 }
  87
  88 # Fetch RSS feed
  89
  90 sub get_timestamp {
  91   if ($ts and -f $ts) {
  92     return "from=" . (stat($ts))[9];
  93   } else {
  94     return "days=1";
  95   }
  96 }
  97
  98 sub update_timestamp {
  99   # Only update timestamps if $ts is provided.
 100   return unless $ts;
 101   if (-f $ts) {
 102     # File exists: update timestamp.
 103     utime undef, undef, $ts;
 104   } else {
 105     # File does not exist: create it. File content is ignored on the
 106     # next run!
 107     my $dir = dirname($ts);
 108     mkpath($dir) unless -d $dir;
 109     open(F, ">$ts") or warn "Unable to create $ts: $!";
 110     close(F);
 111   }
 112 }
 113
 114 sub get_rss {
 115   my $url = "$root?action=rss;full=1;short=0;" . get_timestamp();
 116   print "Getting $url\n" if $debug;
 117   my $response = $ua->get($url);
 118   die $url, $response->status_line unless $response->is_success;
 119   my $rss = new XML::RSS;
 120   $rss->parse($response->content);
 121   print "Found " . @{$rss->{items}} . " items.\n" if $debug;
 122   return $rss;
 123 }
 124
 125 sub send_files {
 126   my ($rss, $subscribers) = @_;
 127   my @items = @{$rss->{items}};
 128   die "No items to send\n" unless @items;
 129   my $sent = 0;
 130   foreach my $item (@items) {
 131     my $title = $item->{title};
 132     print "Looking at $title\n" if $debug;
 133     my $id = $title;
 134     $id =~ s/ /_/g;
 135     my @subscribers = @{$subscribers->{$id}};
 136     print "Subscribers: ", join(', ', @subscribers), "\n" if $debug;
 137     $sent += @subscribers;
 138     send_file($id, $title, $item, @subscribers);
 139   }
 140   print "$sent messages sent\n" if $sent;
 141 }
 142
 143 sub send_file {
 144   my ($id, $title, $item, @subscribers) = @_;
 145   return unless @subscribers;
 146   my $fh = File::Temp->new(SUFFIX => '.html');
 147   binmode($fh, ":utf8");
 148   warn "No content for $title\n" unless $item->{description};
 149   my $link = $item->{link};
 150   my $sub = "$root?action=subscriptions";
 151   my $text = qq(<p>Visit <a href="$link">$title</a>)
 152     . qq( or <a href="$sub">manage your subscriptions</a>.</p><hr />)
 153     . $item->{description};
 154   # prevent 501 Syntax error - line too long
 155   $text =~ s/<(p|h[1-6]|[duo]l|pre|li|form|div|blockquote|hr|table|tr)>/\r\n<$1>/gi;
 156   print $fh $text;
 157   $fh->close;
 158   foreach my $subscriber (@subscribers) {
 159     send_mail($subscriber, $title, $fh);
 160   }
 161 }
 162
 163 sub send_mail {
 164   my ($subscriber, $title, $fh) = @_;
 165   print "Skipping mail to $subscriber...\n" if $debug && $nomail;
 166   return if $nomail;
 167   my $mail = new MIME::Entity->build(To => $subscriber,
 168                                      From => $from,
 169                                      Subject => $title,
 170                                      Path => $fh,
 171                                      Type=> "text/html");
 172   if ($host) {
 173     print "Sending $title to $subscriber using ${user}\@${host}\n" if $verbose;
 174     eval {
 175       require Net::SMTP::TLS;
 176       my $smtp = Net::SMTP::TLS->new($host,
 177                                      User => $user,
 178                                      Password => $password);
 179       $smtp->mail($from);
 180       $smtp->to($subscriber);
 181       $smtp->data;
 182       $smtp->datasend($mail->stringify);
 183       $smtp->dataend;
 184       $smtp->quit;
 185     };
 186     if ($@) {
 187       require Net::SMTP::SSL;
 188       my $smtp = Net::SMTP::SSL->new($host, Port => 465);
 189       $smtp->auth($user, $password);
 190       $smtp->mail($from);
 191       $smtp->to($subscriber);
 192       $smtp->data;
 193       $smtp->datasend($mail->stringify);
 194       $smtp->dataend;
 195       $smtp->quit;
 196     }
 197   } else {
 198     my @recipients = $mail->smtpsend();
 199     if (@recipients) {
 200       print "Sent $title to ", join(', ', @recipients), "\n" unless $quiet;
 201     } else {
 202       print "Failed to send $title to $subscriber\n" unless $quiet;
 203     }
 204   }
 205 }
 206
 207 sub main {
 208   my $rss = get_rss();
 209   return unless @{$rss->{items}};
 210   my $subscribers = get_subscribers();
 211   return unless %{$subscribers};
 212   send_files($rss, $subscribers);
 213   update_timestamp();
 214 }
 215
 216 main ();