oddmuse/scripts/imap2wiki

#!/usr/bin/perl -w
#
# Copyright (C) 2012  Alex Schroeder <alex@gnu.org>
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.

use strict;
use Getopt::Std;
use LWP::UserAgent;
use Net::IMAP::Simple;
use Email::Simple;
use Email::MIME;
use IO::Socket::SSL; # fail unless this is available

my $usage = "Usage:\n"
  . "  imap2wiki TARGET SERVER PORT FROM TO MAIL_USER MAIL_PASSWORD \\\n"
  . "            MAIL_USER MAIL_PASSWORD WIKI_USER [WIKI_PASSWORD]\n\n"
  . "TARGET is the base URL for the wiki.\n"
  . "SERVER is the IMAP server you are checking.\n"
  . "PORT is the port you are using.\n"
  . "  (We assume that you must use SSL.)\n"
  . "FROM is sender you are looking for.\n"
  . "TO is recipient you are looking for.\n"
  . "MAIL_USER is the username to connect to the mail server.\n"
  . "MAIL_PASSWORD is the password to use for the mail server.\n"
  . "WIKI_USER is the username to use for the edit.\n"
  . "WIKI_PASSWORD is the password to use if required.\n"
  . "Example:\n"
  . "  imap2wiki http://www.emacswiki.org/cgi-bin/test imap.gmail.com 993 \\\n"
  . "             kensanata\@gmail.com kensanata+post\@gmail.com \\\n"
  . "             kensanata\@gmail.com '*secret*' \\\n"
  . "             Alex test\n\n";

sub UrlEncode {
  my $str = shift;
  return '' unless $str;
  my @letters = split(//, $str);
  my @safe = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.', '!',
	      '~', '*', "'", '(', ')', '#');
  foreach my $letter (@letters) {
    my $pattern = quotemeta($letter);
    if (not grep(/$pattern/, @safe)) {
      $letter = sprintf("%%%02x", ord($letter));
    }
  }
  return join('', @letters);
}

sub GetRaw {
  my ($uri) = @_;
  my $ua = LWP::UserAgent->new;
  my $response = $ua->get($uri);
  return $response->content if $response->is_success;
}

sub PostRaw {
  my ($uri, $id, $data, $user, $pwd) = @_;
  my $ua = LWP::UserAgent->new;
  my $summary;
  if ($data =~ /^#FILE (\S+) ?(\S+)?\n/) {
    $summary = 'file upload';
  }
  my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1,
				  summary=>$summary,
				  username=>$user, pwd=>$pwd});
  warn "POST $id failed: " . $response->status_line . "\n"
    unless $response->is_success;
  return $response->is_success;
}

sub post {
  my ($target, $page, $data, $user, $pwd) = @_;
  $page =~ s/ /_/g;
  $page = UrlEncode ($page);
  return PostRaw($target, $page, $data, $user, $pwd);
}

sub main {
  my ($target, $server, $port, $from, $to,
      $mail_user, $mail_pwd, $wiki_user, $wiki_pwd) = @ARGV;
  # all parameters except the wiki password are mandatory
  for my $arg ($target, $server, $port, $from, $to,
	       $mail_user, $mail_pwd, $wiki_user) {
    die $usage unless $arg;
  }

  my $imap = Net::IMAP::Simple->new($server, port=>$port, use_ssl=>1 )
    or die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";

  if (not $imap->login($mail_user, $mail_pwd)) {
    print STDERR "Login failed: " . $imap->errstr . "\n";
    exit(64);
  }

  my %result;
  my $rfrom = quotemeta($from);
  my $rto = quotemeta($to);

  # go through the inbox and look for appropriate mails
  my $num = $imap->select('INBOX');
  for (my $i = 1; $i <= $num; $i++) {
    # looking at headers only
    my $email = Email::Simple->new(join '', @{ $imap->top($i) } );
    if ($email->header("From") =~ /$rfrom/io
	and $email->header("To") =~ /$rto/io) {
      my $subject = $email->header('Subject');
      my $n = 1;
      # fetch the body and parse the MIME stuff
      $email = Email::MIME->new(join '', @{ $imap->get($i) } );

      $email->walk_parts(sub {
          my ($part) = @_;
          return if $part->subparts; # multipart

	  my ($pagename, $data);

	  warn $part->content_type;

	  if ($part->content_type =~ m[text/plain]i) {
	    ($pagename, $data) = ($subject, $part->body);
	  } elsif ($part->content_type =~ m!(image/[a-z]+)!i) {
	    ($pagename, $data) = ($subject . " " . $n++,
				"#FILE " . $1 . "\n" . $part->body_raw);
	  }

	  if ($pagename and $data) {
	    warn "Posting $pagename\n";
	    post($target, $pagename, $data, $wiki_user, $wiki_pwd)
	      || die "Posting aborted, INBOX not expunged\n";
	  }
	} );

      # mark as deleted
      $imap->delete($i);
    }
  }

  # expunge messages that are marked for deletion
  $imap->quit;
}

main();