imap2wiki

   1 #!/usr/bin/perl -w
   2 #
   3 # Copyright (C) 2012  Alex Schroeder <alex@gnu.org>
   4 #
   5 # This program is free software: you can redistribute it and/or modify it under
   6 # the terms of the GNU General Public License as published by the Free Software
   7 # Foundation, either version 3 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # This program is distributed in the hope that it will be useful, but WITHOUT
  11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along with
  15 # this program. If not, see <http://www.gnu.org/licenses/>.
  16
  17 use strict;
  18 use Getopt::Std;
  19 use LWP::UserAgent;
  20 use Net::IMAP::Simple;
  21 use Email::Simple;
  22 use Email::MIME;
  23 use IO::Socket::SSL; # fail unless this is available
  24
  25 my $usage = "Usage:\n"
  26   . "  imap2wiki TARGET SERVER PORT FROM TO MAIL_USER MAIL_PASSWORD \\\n"
  27   . "            MAIL_USER MAIL_PASSWORD WIKI_USER [WIKI_PASSWORD]\n\n"
  28   . "TARGET is the base URL for the wiki.\n"
  29   . "SERVER is the IMAP server you are checking.\n"
  30   . "PORT is the port you are using.\n"
  31   . "  (We assume that you must use SSL.)\n"
  32   . "FROM is sender you are looking for.\n"
  33   . "TO is recipient you are looking for.\n"
  34   . "MAIL_USER is the username to connect to the mail server.\n"
  35   . "MAIL_PASSWORD is the password to use for the mail server.\n"
  36   . "WIKI_USER is the username to use for the edit.\n"
  37   . "WIKI_PASSWORD is the password to use if required.\n"
  38   . "Example:\n"
  39   . "  imap2wiki http://www.emacswiki.org/cgi-bin/test imap.gmail.com 993 \\\n"
  40   . "             kensanata\@gmail.com kensanata+post\@gmail.com \\\n"
  41   . "             kensanata\@gmail.com '*secret*' \\\n"
  42   . "             Alex test\n\n";
  43
  44 sub UrlEncode {
  45   my $str = shift;
  46   return '' unless $str;
  47   my @letters = split(//, $str);
  48   my @safe = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.', '!',
  49               '~', '*', "'", '(', ')', '#');
  50   foreach my $letter (@letters) {
  51     my $pattern = quotemeta($letter);
  52     if (not grep(/$pattern/, @safe)) {
  53       $letter = sprintf("%%%02x", ord($letter));
  54     }
  55   }
  56   return join('', @letters);
  57 }
  58
  59 sub GetRaw {
  60   my ($uri) = @_;
  61   my $ua = LWP::UserAgent->new;
  62   my $response = $ua->get($uri);
  63   return $response->content if $response->is_success;
  64 }
  65
  66 sub PostRaw {
  67   my ($uri, $id, $data, $user, $pwd) = @_;
  68   my $ua = LWP::UserAgent->new;
  69   my $summary;
  70   if ($data =~ /^#FILE (\S+) ?(\S+)?\n/) {
  71     $summary = 'file upload';
  72   }
  73   my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1,
  74                                   summary=>$summary,
  75                                   username=>$user, pwd=>$pwd});
  76   warn "POST $id failed: " . $response->status_line . "\n"
  77     unless $response->is_success;
  78   return $response->is_success;
  79 }
  80
  81 sub post {
  82   my ($target, $page, $data, $user, $pwd) = @_;
  83   $page =~ s/ /_/g;
  84   $page = UrlEncode ($page);
  85   return PostRaw($target, $page, $data, $user, $pwd);
  86 }
  87
  88 sub main {
  89   my ($target, $server, $port, $from, $to,
  90       $mail_user, $mail_pwd, $wiki_user, $wiki_pwd) = @ARGV;
  91   # all parameters except the wiki password are mandatory
  92   for my $arg ($target, $server, $port, $from, $to,
  93                $mail_user, $mail_pwd, $wiki_user) {
  94     die $usage unless $arg;
  95   }
  96
  97   my $imap = Net::IMAP::Simple->new($server, port=>$port, use_ssl=>1 )
  98     or die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
  99
 100   if (not $imap->login($mail_user, $mail_pwd)) {
 101     print STDERR "Login failed: " . $imap->errstr . "\n";
 102     exit(64);
 103   }
 104
 105   my %result;
 106   my $rfrom = quotemeta($from);
 107   my $rto = quotemeta($to);
 108
 109   # go through the inbox and look for appropriate mails
 110   my $num = $imap->select('INBOX');
 111   for (my $i = 1; $i <= $num; $i++) {
 112     # looking at headers only
 113     my $email = Email::Simple->new(join '', @{ $imap->top($i) } );
 114     if ($email->header("From") =~ /$rfrom/io
 115         and $email->header("To") =~ /$rto/io) {
 116       my $subject = $email->header('Subject');
 117       my $n = 1;
 118       # fetch the body and parse the MIME stuff
 119       $email = Email::MIME->new(join '', @{ $imap->get($i) } );
 120
 121       $email->walk_parts(sub {
 122           my ($part) = @_;
 123           return if $part->subparts; # multipart
 124
 125           my ($pagename, $data);
 126
 127           warn $part->content_type;
 128
 129           if ($part->content_type =~ m[text/plain]i) {
 130             ($pagename, $data) = ($subject, $part->body);
 131           } elsif ($part->content_type =~ m!(image/[a-z]+)!i) {
 132             ($pagename, $data) = ($subject . " " . $n++,
 133                                 "#FILE " . $1 . "\n" . $part->body_raw);
 134           }
 135
 136           if ($pagename and $data) {
 137             warn "Posting $pagename\n";
 138             post($target, $pagename, $data, $wiki_user, $wiki_pwd)
 139               || die "Posting aborted, INBOX not expunged\n";
 140           }
 141         } );
 142
 143       # mark as deleted
 144       $imap->delete($i);
 145     }
 146   }
 147
 148   # expunge messages that are marked for deletion
 149   $imap->quit;
 150 }
 151
 152 main();