#!/opt/local/bin/perl -w
# Copyright © 2008-2013 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.

# ===========================================================================
#
# This is how I post to my blog via email.  It takes an incoming mail
# message, extracts the images and saves them to a directory of your
# choice, then constructs HTML from those images and the rest of the
# message, and posts that.  If there are images and they have location
# data in them, it marks the post with that location.  It also allows
# you to write your text using Markdown instead of HTML.
#
# Attached images are resized, thumbnailed, and hosted on your own server.
# The code supports posting to WordPress, Livejournal and/or Twitter.
#
# It also handles attached videos, saving them locally and embedding them
# with <OBJECT>.  (Possibly posting them to Youtube first would be
# preferable, but that's not implemented.)
#
# ===========================================================================
# Installation:
# ===========================================================================
#
# When the mail server runs this script, you need to arrange for it to run
# as a user who can create files in $image_dir.  To make this work with
# Postfix:
#
#   /etc/postfix/main.cf:
#     alias_maps     = hash:/etc/aliases, hash:/etc/postfix/aliases-jwz
#     alias_database = hash:/etc/aliases, hash:/etc/postfix/aliases-jwz
#
#   /etc/postfix/aliases-jwz:
#     ljpost: "|/Users/jwz/www/hacks/ljpost.pl --wp USER"
#
#   chown root:wheel /etc/postfix/aliases-jwz*
#   newaliases
#   chown jwz /etc/postfix/aliases-jwz*
#     (this must be done after newaliases!)
#
#
# To post, you would send email to the address "ljpost+XYZ@example.com"
# where "XYZ" is the password in "~/.ljpost-pass" on the server.  Keep
# that secret, as anyone who knows it can post as you.  However, if you
# trust the sanctity of your address book, you might want to save it there.
#
#
# ===========================================================================
# Configuration:
# ===========================================================================
#
# To post to a WordPress blog, invoke this script with "--wp WPUSER".
# This will run my "wppost.php" script to do the actual hosting (which see).
# This assumes that your blog is on the same host as your mail server;
# and that the user this script is running as has access to WordPress's
# SQL database.
#
# To post to LiveJournal, set up "post by email" on LJ and invoke this
# script with "--lj LJUSER".  To post to a Livejournal community instead
# of a user account, use "--lj LJUSER.COMMUNITY".
#
# To post to Twitter, use "--twit TWITUSER".  It will convert HTML to
# plain text and truncate things sensibly.
#
# The password that protects *this* script is read from ~/.ljpost-pass.
#
# The password for the LJ account for user FOO is read from ~/.FOO-lj-pass.
# Likewise, the Twitter API keys are read from ~/.FOO-twitter-pass.
#
# All of those files should be readable by the user running this script
# and nobody else, so make them have the proper owner and "chmod og-w".
#
# The twitter-pass file needs to have four lines in it, the keys needed to
# drive your Twitter API Oauth Application thingy (see dev.twitter.com).
#
#    consumer        = ...DATA...
#    consumer_secret = ...DATA...
#    access          = ...DATA...
#    access_secret   = ...DATA...
# 
# Created: 27-Apr-2008.
#
# ===========================================================================


require 5;
use diagnostics;
use strict;

use POSIX;
use MIME::Parser;
use MIME::Entity;
use Encode qw/decode/;
use Image::Magick;
use Text::Markdown;
use Net::Twitter;

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.83 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/;

$ENV{PATH} = "/opt/local/bin:$ENV{PATH}";   # macports

my $verbose = 0;
my $debug_p = 0;

my $image_max_size = 800;   # create a thumb if bigger than this.


my $image_quality = 90;
my $image_dir     = '/home/jwz/www/images';
my $image_url     = 'http://www.jwz.org/images/';

my $exec_dir      = $0; $exec_dir =~ s@/[^/]+$@@s;
my $wp_post	  = "$exec_dir/wppost.php";

# What directory do you need to be in for wppost.php to work?
my $wp_dir = $ENV{HOME} . "/www/blog";


# If set, this cmd is run on each image to rotate the JPEG data according
# to the EXIF rotation values, so that things post right-side-up.
#
my $rotimg_cmd    = ((-d '/Users' ? '/Users' : '/home') .
                     '/jwz/www/hacks/rotimg');

# If set, run this command on an image to extract its GPS location from
# the EXIF data, and send that as a LiveJournal "location" header.
#
#my $location_cmd = ("exiftool -s -s -s -c %f -GPSPosition");
my $location_cmd  = ("identify -define jpeg:size=1x1 -format " .
                     "'%[EXIF:GPSLatitude] %[EXIF:GPSLatitudeRef], " .
                     "%[EXIF:GPSLongitude] %[EXIF:GPSLongitudeRef]'");


my $default_lj_tags       = 'firstperson, sf';
my $default_lj_photo_tags = 'photography';

#$default_lj_tags = 'firstperson, sxsw';
#$default_lj_photo_tags = 'photography, music';


my $upload_images_cmd = "cd $image_dir ; make -s commitq";

my $sendmail = "/usr/sbin/sendmail -t -oi";

my $twitter_json_url = 'https://api.twitter.com/1/statuses/update.json';


sub url_quote($) {
  my ($u) = @_;
  $u =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge;
  return $u;
}

sub url_unquote($) {
  my ($u) = @_;
  $u =~ s/[+]/ /g;
  $u =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
  return $u;
}

sub html_quote($) {
  my ($u) = @_;
  $u =~ s/&/&amp;/g;
  $u =~ s/</&lt;/g;
  $u =~ s/>/&gt;/g;
#  $u =~ s/\"/&quot;/g;
  return $u;
}

# Check and print error status from various Image::Magick commands,
# and die if it's not just a warning.
#
sub imagemagick_check_error($) {
  my ($err) = @_;
  return unless $err;
  my ($n) = ($err =~ m/(\d+)/);

  if ($n && $n == 395 && $err =~ m/unable to open module file/) {
    #
    # This error is bullshit: ignore it:
    #
    #    Exception 395: unable to open module file
    #      `/opt/local/lib/ImageMagick-6.3.0/modules-Q16/coders/008d1bed.la':
    #      No such file or directory
    #
    return;
  }

  print STDERR "$progname: $err\n";
  print STDERR "$progname: maybe \$TMPDIR (".
               ($ENV{TMPDIR} || "/tmp") . ") filled up?\n"
    if ($err =~ m/pixel cache/i);

  exit (1) if ($n >= 400);
}


sub save_image($$$) {
  my ($name, $ct, $data) = @_;

  $name = lc($name);
  $name =~ s/[^-_.a-z\d]/_/gsi;  # map stupid characters to underscores

  # "Photo 1.jpg" => "photo.jpg", since iPhone 3.x always names the first
  # attachment "Photo.jpg", the second "Photo 2.jpg", etc.  This numbers
  # them in order ("photo_37.jpg", "photo_38.jpg") instead of in a dumb
  # order like e.g. "photo-37.jpg", "photo_2-14.jpg".
  #
  # Likewise, iPhone 4.x names them "image.jpeg".
  # OSX Mail.app sometimes names them "JPG.JPG"!
  #
  if (! $debug_p) {
    $name =~ s/^(image|jpe?g)\./photo./si;
    $name =~ s/^(photo)[-_]*\d*(\.[a-z]+)$/$1$2/gsi;
    $name =~ s/\.p?jpe?g$/.jpg/si;
  }

  my $video_p = ($ct =~ m@^video/@si);

  my ($img, $fw, $fh);
  if ($video_p) {
    ($fw, $fh) = (320, 240);	#### Wild-assed guess.
  } else {
    $img = Image::Magick->new;
    $img->BlobToImage ($data);
    ($fw, $fh) = $img->Get ('width', 'height');
    error ("$name: unparsable") unless ($fw > 0 && $fh > 0);
  }

  my ($w, $h) = ($fw, $fh);

  my $big = $name;

  # Add a numeric suffix before the extension until we have a unique one.
  #
  while (-f "$image_dir/$big") {
    my ($head, $n, $tail) = ($big =~ m@^(.*?)(-\d+)?(\.[^.]+)$@s);
    $n = ($n || 0) - 1;
    $big = "$head$n$tail";
  }
#  error ("$image_dir/$big already exists")
#    if (-f "$image_dir/$big" && !$debug_p);

  my $file = "$image_dir/$big";

  if ($debug_p) {
    print STDERR "$progname: not writing $file ($w x $h)\n"
      if ($verbose);

    $file = sprintf ("%s/msg%08x", ($ENV{TMPDIR} || "/tmp"),
                     rand(0xFFFFFFFF));
    unlink $file;
  }

  umask 022;
  open (my $out, '>', "$file") || error ("$big: $!");
  (print $out $data)           || error ("$big: $!");
  close $out                   || error ("$big: $!");
  print STDERR "$progname: wrote $file ($w x $h)\n" 
    if ($verbose);


  my $loc = undef;
  if (!$video_p && defined ($location_cmd)) {
    my $cmd = "$location_cmd '$file'";
    print STDERR "$progname: exec: $cmd\n" if ($verbose);
    $loc = `$cmd`;

    # For some insane reason, ImageMagick reports GPS coordinates like this:
    #
    #   37/1, 4625/100, 0/1 N, 122/1, 2477/100, 0/1 W
    #
    # This regexp converts that to
    #
    #   37.770833 N, 122.412833 W
    #
    $loc =~ s@\b (\d+) / (\d+), \s+
                 (\d+) / (\d+), \s+
                 (\d+) / (\d+)  \b
             @{ sprintf ("%.6f",
                         ($1 / $2) +
                         ($3 / $4 / 60) +
                         ($5 / $6 / 3600));
              }@gsex;

    $loc =~ s/(^\s+|\s+$)//gs;
    $loc = undef unless ($loc =~ m/\d/);  # Avoid ", ".
    $loc = undef unless $loc;
  }

  if (!$video_p && defined ($rotimg_cmd)) {
    my @cmd = ($rotimg_cmd);
    push @cmd, ($verbose ? "--verbose" : "--quiet");
    push @cmd, "$file";
    print STDERR "$progname: exec: " . join(' ', @cmd) . "\n" if ($verbose);
    system (@cmd);

    # Re-read the file to get its new width/height after possible rotation.
    $img = Image::Magick->new;
    $img->Read ("$file");
    my ($nw, $nh) = $img->Get ('width', 'height');
    if ($nw != $fw || $nh != $fh) {
      print STDERR "$progname: image rotated: ${fw}x$fh => ${nw}x$nh\n"
        if ($verbose);
      ($fw, $fh) = ($nw, $nh);
      ($w, $h)   = ($fw, $fh);
    } elsif ($verbose) {
      print STDERR "$progname: image size unchanged\n";
    }
  }

  unlink $file if $debug_p;

  my $thumb = $big;

  if ($video_p) {
    # Nothing to do here.
  } elsif ($fw > $image_max_size || $fh > $image_max_size) {

    $thumb =~ s/(\.[^.]+)$/-thumb$1/s;
    error ("$thumb already exists")
      if (-f "$image_dir/$thumb" && !$debug_p);

    my $wscale = $image_max_size / $fw;
    my $hscale = $image_max_size / $fh;
    my $scale = ($wscale < $hscale ? $wscale : $hscale);
    my $status = $img->Scale (width  => int ($fw * $scale),
                              height => int ($fh * $scale));
    imagemagick_check_error ($status);
    $status = $img->Set (quality => $image_quality);
    imagemagick_check_error ($status);

    ($w, $h) = $img->Get ('width', 'height');
    error ("$thumb: resize didn't work") unless ($w > 0 && $h > 0);

    if ($debug_p) {
      print STDERR "$progname: not writing $image_dir/$thumb ($w x $h)\n"
        if ($verbose);
    } else {
      $status = $img->Write (filename => "$image_dir/$thumb");
      imagemagick_check_error ($status);

      print STDERR "$progname: wrote $image_dir/$thumb ($w x $h)\n" 
        if ($verbose);
    }
    undef $img;
  }

  $big   = $image_url . url_quote($big);
  $thumb = $image_url . url_quote($thumb);

  return ($big, $thumb, $w, $h, $loc);
}


sub trim_signature($) {
  my ($s) = @_;

  if ($s =~ s@<span id="signature".*?</span>@@si) {
    $s =~ s@\s*(<(p|br)>\s*)+$@@si;
  } elsif ($s =~ s@<br>\s*<br>\s*--\s*<br>.*$@@si) {
  } else {
    $s =~ s/(^|\n)-- *\n.*$//s;
    $s = '' if ($s =~ m/^\s+$/s);
  }
  return $s;
}


# Extend Markdown's syntax with two additional ways of typing links.
#
sub jwz_markdown($) {
  my ($md) = @_;

  # If there is a URL following a bracketed phrase, convert it from
  # "abc[def]ghi URL" to "abc[def](URL)ghi".  Be careful not to mess
  # with text already in "[anchor](URL)" form.
  #
  $md =~ s@ ( \[ [^][]+ \] )					# 1 [anchor]
            ( [^(] )						# 2 not (
            ( [^][()]*? )					# 3 stuff
            \b ((https?|mailto)://[^\s\[\]()<>\"\']+[a-z\d/])	# 4 url
            @$1($4)$2$3@gsix;

  # If there is a naked URL (not in parens) convert it to be a markdown
  # anchor on the preceding text on the source line, e.g.,
  # "abc def! URL ghi" => "[abc def](URL)! ghi".
  #
  $md =~ s@ ^[ \t]*
	     (.*?)						# 1 anchor
	     ([^a-z\d\s*;]*)[ \t]+				# 2 punc.
            \b ((https?|mailto)://[^\s\[\]()<>\"\']+[a-z\d/])	# 3 url
            @[$1]($3)$2@gmix;

  # Now process everything else using the normal Markdown rules.
  #
  return Text::Markdown::markdown($md);
}


sub split_tag_headers($) {
  my ($txt) = @_;
  my $head = '';
  my $tags = '';
  $txt =~ s/^\s*//s;
  if ($txt =~ m/^ ( (?: \s* <[^<>]*> )+ ) ( .* )$/six) {
    ($head, $txt) = ($1, $2);
  }
  while ($txt =~ m/^ ( (?: lj-)? (?: tags?|security) : [^\n]* \n ) (.*) $/six) {
    $tags .= $1;
    $txt = $2;
  }

  $txt = $head . $txt;
  return ($tags, $txt);
}


sub clean_html($) {
  my ($html) = @_;

  # Lose the multipart/related inline image stubs: we handle images manually.
  $html =~ s@<img\s+src="cid:[^<>]*>\s*@@gsi;

  # What I would like is: if I have typed Markdown text into the mail 
  # composition window, but the app has chosen to send that as HTML,
  # interpret it as Markdown anyway -- but, if there happens to be
  # "real" HTML in there (<B> or whatnot) then pass that through.
  #
  # But, the HTML generated by the iPhone is just too much of a pain
  # in the ass to deal with, so instead, we'll just convert the HTML
  # to plain-text and then interpret *that* as Markdown.  This means
  # that if you type raw HTML into the compose window, it will work,
  # but if you use a rich-text editor or cut-and-paste from a web
  # browser, it will strip out the markup.  Oh well, I can live with
  # that.

  $html = html_to_text($html);
  $html = trim_signature($html);

  my $tags;
  ($tags, $html) = split_tag_headers ($html);

  $html = jwz_markdown ($html);

  $html =~ s@\s*</P>\s*@<P>@gsi;
  $html =~ s@(\s*<P>)+@<P>@gsi;

  $html = "$tags\n$html" if $tags;

  return $html;
}


sub html_to_text($) {
  my ($html) = @_;
  my $txt = $html;
  $txt =~ s/&nbsp;/ /gs;
  $txt =~ s/\s+/ /g;
  $txt =~ s@</DIV>\s*<DIV>@\n@gsi;	             # join adjascent DIVs
  $txt =~ s@[ \t]*</?\s*P\b[^<>]*>[ \t]*@\n\n@gsi;   # <P>
  $txt =~ s@[ \t]*</?\s*BR\b[^<>]*>[ \t]*@\n@gsi;    # <BR>
  $txt =~ s@[ \t]*</?\s*DIV\b[^<>]*>[ \t]*@\n@gsi;   # <DIV>

  $txt =~ s@\s*<IMG[^<>]*?SRC=[\"']?([^<>\"']+)[^<>]*>\s*@ $1 @gsi;  # <IMG SRC
# $txt =~ s@\s*<A[^<>]*?HREF=[\"']?([^<>\"']+)[^<>]*>\s*@ $1 @gsi;   # <A HREF

  $txt =~ s@<[^<>]*>@@gs;  # all other tags

  $txt =~ s@&lt;@<@gs;
  $txt =~ s@&gt;@>@gs;
  $txt =~ s@&nbsp;@ @gs;
  $txt =~ s@&amp;@&@gs;

  return $txt;
}


# Run the URL through http://tinyurl.com/ and return the shortened one.
#
sub tinyurlify($) {
  my ($url) = @_;
  return $url if ($url =~ m@^http://tinyurl@s);
  my $ua = LWP::UserAgent->new;
  $ua->agent ("$progname/$version");

  # See if the URL has a <LINK REL="shortlink"> tag.
  # (This doesn't work if there's an #anchor).
  if ($url !~ m/#/s) {
    my $body = LWP::Simple::get($url) || '';
    if ($body =~ m@<LINK\b [^<>]*? \b REL \s* = \s* [\"\']? shortlink [\"\']?
                   [^<>]*? \b HREF \s* = \s* [\"\']? ([^\"\'<>]+)@six) {
      return $1 if (length ($1) < length($body));
    }
  }

  # Otherwise use tinyurl.com.
  # For some reason we have to post for it to preserve the #anchor in the URL.
  my $res = $ua->post ('http://tinyurl.com/api-create.php',
                      { 'url' => $url });
  my $url2 = ($res->is_success ? $res->decoded_content : '');
  print STDERR "tinyurl: $url\n     ==> $url2\n" if ($verbose);
  return $url unless $url2;
  return $url2 if (length($url2) < length($url));
  return $url;
}


# Run URLs in the text through http://tinyurl.com/ until the text is less
# than 140 characters.  Only shrink URLs until the text is short enough;
# leave remaining URLs un-shrunk as soon as the text is short enough.
#
sub shorten_urls($) {
  my ($txt) = @_;

  my $max_length = 140 - 10;	# slack for re-twits
  #$max_length = 10;		# always shrink 'em

  return $txt if (length($txt) <= $max_length);

  my @chunks = split(m@(\bhttps?://[^\s<>]+[A-Za-z\d/])@s, $txt);
  foreach my $chunk (@chunks) {
    next unless ($chunk =~ m@^https?://@s);
    $chunk = tinyurlify ($chunk);

    $txt = join ('', @chunks);
    last if (length($txt) <= $max_length);
  }

  return $txt;
}


sub ljpost_1($$$$$) {
  my ($user, $from, $subj, $loc, $html) = @_;

  my $tags;
  ($tags, $html) = split_tag_headers ($html);

  my $def =  $default_lj_tags;
  if ($html =~ m/<IMG/si) {
    $def .= ", " if $def;
    $def .= $default_lj_photo_tags;
  }

  # Append default tags to existing tags header.
  if (! ($tags =~ s/^( (?: lj-)? tags?: [^\n]* )/$1, $def/six)) {
    # Or add the tag header if it didn't already exist.
    $tags .= "lj-tags: $def\n";
  }

  $tags .= "lj-location: $loc\n" if ($loc);
  $tags .= "lj-security: private\n" if ($debug_p);

  $tags =~ s/^\s+//s;

  return ($html, $tags);
}


sub ljpost($$$$$) {
  my ($user, $from, $subj, $loc, $html) = @_;

  my $passfile = "$ENV{HOME}/.$user-lj-pass";
  my $pass = 'UNKNOWN';
  if (open (my $in, "<$passfile")) {
    $pass = <$in>;
    chop ($pass);
    close $in;
    error ("$passfile: no password") unless $pass;
  } elsif (!$debug_p) {
    error ("$passfile: $!");
  }

  my $tags;
  ($html, $tags) = ljpost_1 ($user, $from, $subj, $loc, $html);

  $html = "$tags\n$html" if $tags;

  # The HTML has to have long lines, since LJ interprets \n in HTML as BR.
  # Therefore, we need to QP-encode, else SMTP inserts random newlines.

  my $to = "${user}+${pass}\@post.livejournal.com";
  my $msg = MIME::Entity->build (Type     =>"text/html",
                                 Encoding => "quoted-printable",
                                 From     => $from,
                                 To       => $to,
                                 Subject  => $subj,
                                 Data     => $html);

  if ($debug_p) {
    print STDERR ("#" x 72) . "\nResultant message:\n" . ("#" x 72) . "\n";
    $msg->print(\*STDERR);
    print "\n";
  } else {
    open my $mail, "| $sendmail" || error ("sendmail: $!");
    $msg->print($mail);
    close $mail;
  }
}


sub wppost($$$$$$) {
  my ($user, $from, $subj, $date, $loc, $html) = @_;

  my $tags;
  ($html, $tags) = ljpost_1 ($user, $from, $subj, $loc, $html);

  my $priv_p = ($tags && $tags =~ m/^(lj-)?security:/mi);

  if ($tags && $tags =~ s/^ (?:lj-)? tags?: \s* (.*?) \s* $/$1/mix) {
    $tags = $1;
  } else {
    $tags = undef;  # maybe other lj-crud, but not lj-tags.
  }

  my @cmd = ($wp_post, "--user", $user, "--body", $html);
  push @cmd, ("--subject", $subj) if $subj;
  push @cmd, ("--date", $date)    if $date;
  push @cmd, ("--tags", $tags)    if $tags;
  push @cmd, ("--location", $loc) if $loc;
  push @cmd, ("--draft")          if $priv_p;

  chdir ($wp_dir) || error ("cd $wp_dir/: $!")
    if defined ($wp_dir);

  if ($debug_p) {
    print STDERR ("#" x 72) . "\nWould have run:\n" . ("#" x 72) . "\n";
    foreach my $a (@cmd) {
      $a =~ s/^\s+|\s+$//gs;
      if ($a =~ m%[^-a-z\d/_.,]%si) {
        $a =~ s/'/\\'/gs;
        $a = "'$a'";
      }
    }
    print STDERR join(' ', @cmd) . "\n";
  } else {
    # Discard stdout since wppost prints the post-id.
    open (my $o, '>&', \*STDOUT);
    open (STDOUT, '>', '/dev/null') unless ($verbose);
    system (@cmd);
    open (STDOUT, '>&', $o);
  }
}



sub load_keys($) {
  my ($user) = @_;

  my $consumer        = 'UNKNOWN';
  my $consumer_secret = 'UNKNOWN';
  my $access          = 'UNKNOWN';
  my $access_secret   = 'UNKNOWN';

  # Read our twitter tokens
  my $twitter_pass_file = "$ENV{HOME}/.$user-twitter-pass";
  if (open (my $in, '<', $twitter_pass_file)) {
    print STDERR "$progname: read $twitter_pass_file\n" if ($verbose);
    while (<$in>) { 
      s/#.*$//s;
      if (m/^\s*$/s) {
      } elsif (m/^consumer\s*=\s*(.*?)\s*$/) { 
        $consumer = $1;
      } elsif (m/^consumer_secret\s*=\s*(.*?)\s*$/) { 
        $consumer_secret = $1;
      } elsif (m/^access\s*=\s*(.*?)\s*$/) { 
        $access = $1;
      } elsif (m/^access_secret\s*=\s*(.*?)\s*$/) { 
        $access_secret = $1;
      } else {
        error ("$twitter_pass_file: unparsable line: $_");
      }
    }
    close $in;

  } elsif ($debug_p) {
    print STDERR "$progname: $twitter_pass_file: $!\n";
  } else {
    error ("$twitter_pass_file: $!");
  }

  return ($consumer, $consumer_secret, $access, $access_secret);
}


sub twitter_status_update($$$$) {
  my ($user, $txt, $lat, $long) = @_;

  my ($consumer, $consumer_secret, $access, $access_secret) = load_keys($user);

  $txt = shorten_urls ($txt);
  print STDERR "$progname: twit [" . length($txt) . "]: $txt\n"
    if ($verbose);

  my $nt = Net::Twitter->new (
      traits              => [qw/OAuth API::REST WrapError/],
      consumer_key        => $consumer,
      consumer_secret     => $consumer_secret,
      access_token        => $access,
      access_token_secret => $access_secret,
  );

  if ($debug_p) {
    print STDERR "$progname: debug: not twitting\n";
    return;
  }

  my $retries = 3;
  my $err;
  for (my $i = 0; $i < $retries; $i++) {
    my $ret = $nt->update ({status              => $txt,
                            lat                 => $lat,
                            long                => $long,
                            display_coordinates => 1});
    last if defined ($ret);
    $err = $nt->get_error()->{error};
  }
  error ("twitter: $err (after $retries tries)") if $err;
}


sub twit($$$$) {
  my ($user, $subj, $loc, $html) = @_;

  my $txt = html_to_text ($html);

  # Lose all newlines.
  $txt =~ s/\s+/ /gsi;
  $txt  =~ s/^\s+|\s+$//gsi;
  $subj =~ s/^\s+|\s+$//gsi;
  if ($subj) {
    $subj .= "." unless ($subj =~ m/[^\sA-Z\d]\s*$/si);
    $txt = "$subj $txt";
    $txt =~ s/\.\.\.+\s+\.+/.../g;  # conv "subj... ...body" to "subj... body"
  }

  $txt = shorten_urls ($txt);

  # Last resort: if the text is still too long, and there are URLs at the
  # end, truncate before the URLs instead of after.
  #
  1 while (length($txt) >= 140 &&
           $txt =~ s/^(.*?).((\s+http:[^\s]+)+)\s*$/$1$2/s);

  # If that fails, just truncate.
  $txt =~ s/^(.{140}).*$/$1/si;


  my ($lat, $long);
  if ($loc) {
    # Convert "122.412694 W" to "-122.412694".
    $loc =~ s@\b(\d+\.\d+)\s*([NSEW])\b@{ my ($n, $c) = ($1, uc($2));
                                          $n = -$n if ($c eq 'S' || $c eq 'W');
                                          "$n"; }@gsexi;
    # Extract the two floats.
    ($lat, $long) = ($loc =~ m/^\s*(-?\d+\.\d+),?\s+(-?\d+\.\d+)\s*$/s);
  }

  twitter_status_update ($user, $txt, $lat || '', $long || '');
}


sub cvs(@) {
  my @files = @_;

  my $files = join (' ', sort(@files));
  return unless $files;

  my $cmd = ("cd $image_dir" .
             " && cvs -Q add -kb $files" .
             " && cvs -Q commit -m '' $files");

  if ($debug_p) {
    print STDERR "$progname: not running: $cmd\n" if ($verbose);
  } else {
    print STDERR "$progname: exec: $cmd\n" if ($verbose);
    system ($cmd);
  }
}


# In a multipart/related, there will be an HTML part with IMG tags in it
# refering to "cid:" URLs, then a bunch of parts with those IDs.  This
# divides up the HTML part and interleaves the images in a list.  So
# we start with something like (HTML, IMG-1, IMG-2, IMG-3) and end up
# with (HTML-1, IMG-1, HTML-2, IMG-2, HTML-3, IMG-3, HTML-4).
#
sub splice_related($$) {
  my ($main, $imgs) = @_;

  my @result = ("");
  foreach my $s (split (m/(<IMG[^<>]*>)/si, $main)) {
    if ($s =~ m@^<img [^<>]*? \b src=[\"\'] cid: ([^\"\'<>]+) @six) {
      my $id = $1;
      my $img = $imgs->{$id};
      error ("unmatched cid: $id") unless $img;
      push @result, ($img, "");
    } else {
      $result[$#result] .= $s;
    }
  }
  return @result;
}


# Recursively processes the MIME::Entity, handling multipart entities.
# Returns a list of text-chunks and images, in the order encountered.
#
sub process_part($$@);
sub process_part($$@) {
  my ($part, $depth, @imgs) = @_;
  my $type = lc($part->effective_type);
  my $body = $part->bodyhandle;
  my @result = ();

  print STDERR "$progname: " . ("  " x $depth) .
    "Content-Type: $type\n" if ($verbose > 1);
  if ($type eq 'text/plain') {
    $body = html_quote($body->as_string());
    $body =~ s/\n/<BR>\n/gsi;
    $body .= "<P>\n";
    push @result, $body;

  } elsif ($type eq 'text/html') {
    $body = $body->as_string() . '<P>';
    push @result, $body;

  } elsif ($type =~ m@^(image|video)/@) {
    push @result, $part;

  } elsif ($type eq 'multipart/mixed') {
    foreach my $subpart ($part->parts) {
      push @result, process_part ($subpart, $depth+1, @imgs);
    }

  } elsif ($type eq 'multipart/related') {
    my $main;
    my %imgs;
    foreach my $subpart ($part->parts) {
      my @p = process_part ($subpart, $depth+1, @imgs);
      error ("unparsable $type") if ($#p != 0);
      my $p = $p[0];
      if (ref($p) =~ m/^MIME/s) {  # It's an image
        my $id = $subpart->head->get('Content-ID');
        error ("no Content-ID in $p") unless $id;
        $id =~ s/^[\s<]*|[\s>]*$//gsi;
        $imgs{$id} = $p;
      } elsif ($main) {
        error ("multiple roots in $type");
      } else {
        $main = $p;
      }
    }
    push @result, splice_related ($main, \%imgs);

  } elsif ($type eq 'multipart/alternative') {
    #
    # multipart/alternative types are sorted from least to most preferred.
    # Take the last one in the list that is plain-text, html, or an image.
    # Ignore all others.
    #
    my $prev = undef;
    foreach my $subpart ($part->parts) {
      my $subtype = lc($subpart->effective_type);
      print STDERR "$progname: " . ("  " x $depth) .
                   "Subtype: $subtype\n" if ($verbose > 1);
      if ($subtype =~ m@^text/(plain|html)$@ ||
          $subtype =~ m@^(image|multipart)/@) {
        $prev = $subpart;
      } else {
        print STDERR "$progname: " . ("  " x $depth) .
                     " SKIP: $subtype\n" if ($verbose > 1);
      }
    }
    error ("no known subtypes in $type") unless $prev;

    push @result, process_part ($prev, $depth+1, @imgs);

  } else {
    error ("unknown type $type");
  }

  return @result;
}



# If the HTML contains two or more, assume the layout is two per line.
# If any two on the same line mix portrait and landscape orientation,
# adjust their width percentages until they are roughly the same height.
#
sub adjust_image_layout($$) {
  my ($total_images, $html) = @_;

  $html =~ s@(</A>)\s*(<A)@$1\001$2@gs;
  my @imgs = split(/\001/, $html);

  my @sizes;
  my $i = 0;
  foreach my $img (@imgs) {
    my ($w) = ($img =~ m/max-width:\s*(\d+)px/si);
    my ($h) = ($img =~ m/max-height:\s*(\d+)px/si);
    $sizes[$i] = [$w, $h, ($w > $h)];
    $i++;
  }

  for (my $j = 0; $j < $i; $j += 2) {

    if (! defined($imgs[$j+1])) {		# single image on line

      my $w = ($total_images == 1 ? 90 :	# only image on page
               $sizes[$j][2]      ? 60 :	# portrait, on last line
               45);				# landscape, on last line
      $imgs[$j] =~ s/(width:\s*)\d+%/$1${w}%/s;

    } elsif ($sizes[$j][2] != $sizes[$j+1][2]) {	# orientation differs
      my $r = ($sizes[$j][0] /				# ratio of scaled width
               ($sizes[$j][0] + 
                ($sizes[$j][1] * ($sizes[$j+1][0] / $sizes[$j+1][1]))));
      my $ww = 90;
      my $w1 = sprintf("%.1f", $ww * $r);
      my $w2 = sprintf("%.1f", $ww * (1 - $r));
      $imgs[$j]   =~ s/(width:\s*)\d+%/$1${w1}%/s;
      $imgs[$j+1] =~ s/(width:\s*)\d+%/$1${w2}%/s;

    } else {					# same orientation, same width
      my $w = 45;
      $imgs[$j]   =~ s/(width:\s*)\d+%/$1${w}%/s;
      $imgs[$j+1] =~ s/(width:\s*)\d+%/$1${w}%/s;
    }
  }

  return join ('', @imgs);
}


sub post($$$) {
  my ($lj, $wp, $twit) = @_;

  my $pass;
  my $passfile = "$ENV{HOME}/.ljpost-pass";
  if (open (my $in, "<$passfile")) {
    $pass = <$in>;
    chop ($pass);
    close $in;
  } elsif ($debug_p) {
    print STDERR "$progname: $passfile: $!\n";
    $pass = 'DEBUG';
  } else {
    error ("$passfile: $!");
  }
  error ("$passfile: no password") unless ($pass);

  my $ent;
  {
    my $parser = new MIME::Parser;
    $parser->ignore_errors(1);
    $parser->tmp_to_core(1);
    $parser->output_to_core(1);
    eval { $ent = $parser->parse(\*STDIN); };
    my $err = ($@ || $parser->last_error);
    $parser->filer->purge;
    error ("parse failed: $err") if ($err);
  }

  if ($debug_p > 1) {
    print STDERR ("#" x 72) . "\nSource message:\n" . ("#" x 72) . "\n";
    $ent->print(\*STDERR);
    print STDERR "\n" . ("#" x 72) . "\n";
  }

  my $head = $ent->head;
  my $from = $head->get('From');
  my $date = $head->get('Date');
  my $to = $head->get('To');
  my $dto = $head->get('Delivered-To');
  my $subj = $head->get('Subject') || '';
  my ($topass) = ($to  =~ m/^[^\+@]+\+([^\+@]+)\@/s);
     ($topass) = ($dto =~ m/^[^\+@]+\+([^\+@]+)\@/s)
       if ($dto && !defined($topass));
  error ("no posting password provided: $to") 
    unless ($debug_p || defined($topass));
  error ("password mismatch") unless ($debug_p || $pass eq $topass);

  $subj = decode ('MIME-Header', $subj);	# Fucking Unicrud.

  # Sadly, sending photos with SMS to this address causes the URL on
  # Sprint's site to reveal my phone number.  Avoid mistakenly sending
  # an SMS instead of an email by just refusing messages from Sprint's
  # gateway.
  #
  error ("no SMS to this address!")
    if ($from =~ m/sprintpcs\.com/);

  my $html = "";
  my $img_count = 0;
  my $loc;

  my %files;

  foreach my $part (process_part ($ent, 0, ())) {

    if (ref($part) =~ m/^MIME/s) {  # It's an image
      $img_count++;
      my $name = $part->head->recommended_filename;
      my $ct = $part->head->mime_type;
      my ($big, $thumb, $w, $h, $loc2) = 
        save_image ($name, $ct, $part->bodyhandle->as_string());
      my $video_p = ($ct =~ m@video/@si);
      
      $files{$1} = 1 if ($big   && $big   =~ m@([^/]+)$@si);
      $files{$1} = 1 if ($thumb && $thumb =~ m@([^/]+)$@si);

      if ($w < $h) {			# if it's portrait, shrink it by 1/3rd
        $w = int($w * 0.666 + 0.5);
        $h = int($h * 0.666 + 0.5);
      }

      my $hh = $h + 16;  # for controller
      $part = ($video_p
               ? (" <OBJECT DATA=\"$big\" TYPE=\"$ct\" WIDTH=$w HEIGHT=$hh>\n" .
                  "  <PARAM NAME=\"movie\" VALUE=\"$big\" />\n" .
                  "  <PARAM NAME=\"allowFullScreen\" VALUE=\"true\" />\n" .
                  "  <PARAM NAME=\"controller\" VALUE=\"true\" />\n" .
                  "  <PARAM NAME=\"autoplay\" VALUE=\"false\" />\n" .
                  "  <PARAM NAME=\"scale\" VALUE=\"aspect\" />\n" .
                  " </OBJECT>"
                 )
               : ("<A HREF=\"$big\">" .
                  "<IMG SRC=\"$thumb\" STYLE=\"width:100%; height:auto;" .
                     " max-width:${w}px; max-height:${h}px;" .
                     " border: 1px solid; margin: 2px;\">" .
                  "</A>"));
      $part = ("<DIV ALIGN=CENTER>" .
               $part .
               "</DIV>\n");
      $loc = $loc2 if $loc2;
    } else {
      $part = trim_signature($part);
      $part = clean_html($part);
    }
    $html .= $part;
  }

  # Group adjacent images together into the same DIV.
  #
  1 while ($html =~ s@( <DIV[^<>]*> \s* )
                      (( <A[^<>]*> \s* <IMG[^<>]*> \s* </A> \s* )+ )
                      </DIV> \s*
                      \1
                     @$1$2@gsix);

  # If two adjascent images are portrait+landscape, adjust their target widths.
  #
  $html =~ s@( <DIV[^<>]*> \s* )
             ( (?: <A[^<>]*> \s* <IMG[^<>]*> \s* </A> \s* )+ )
             ( \s* </DIV> )
            @{ $1 . adjust_image_layout ($img_count, $2) . $3 }@gsexi;

  if ($img_count > 0) {
    system ($upload_images_cmd)
      if (defined($upload_images_cmd) && !$debug_p);
  }

  my $tags;
  ($tags, $html) = split_tag_headers ($html);

  # Trim newlines since LJ preformats that shit.
  $html =~ s/\s+/ /gsi;
  $html =~ s@\s+(</?(DIV|P))@$1@gsi;
  $html =~ s/\s+$/\n/si;

  $html = "$tags\n$html" if $tags;

  my $priv_p = ($tags && $tags =~ m/^(lj-)?security:/mi);

  # LJ and WordPress can have prettier locations.  Twitter requires floats.
  #
  # Convert: "37.771007 N, 122.412694 W"
  #      to: "37° 46' 15.63" N 122° 24' 45.70 W"
  #      or: "37.771007, -122.412694"
  #      to: "37° 46' 15.63" -122° 24' 45.70"
  #
  my $loc2 = $loc;
  $loc2 =~ s@\b([-+]?\d+\.\d+)\b
            @{ my $d = $1;
               my $m = (60 * ($d - int($d)));
               my $s = (60 * ($m - int($m)));
               sprintf("%d\302\260 %d' %.2f\"", $d, $m, $s);
             }@gsexi
    if $loc2;

  $subj =~ s/^\s+|\s+$//gsi;

  ljpost ($lj, $from, $subj, $loc2, $html)
    if ($lj);
  wppost ($wp, $from, $subj, $date, $loc2, $html)
    if ($wp);
  twit ($twit, $subj, $loc, $html)
    if ($twit && !$priv_p);
  cvs (sort keys (%files));
}


sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage() {
  print STDERR "usage: $progname [--verbose] [--debug] " .
    "[--livejournal user] [--twitter user] [--wordpress user]\n";
  exit 1;
}

sub main() {
  my ($lj, $wp, $twit);

  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if (m/^--?verbose$/) { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^--?debug$/) { $debug_p++; }
    elsif (m/^--?(lj|livejournal)$/) { $lj = shift @ARGV; }
    elsif (m/^--?(wp|wordpress)$/) { $wp = shift @ARGV; }
    elsif (m/^--?twit(ter)?$/) { $twit = shift @ARGV; }
    elsif (m/^-./) { usage; }
    else { usage; }
  }

  if ($debug_p > 1) {
    my $f = "/tmp/ljpost.log";
    unlink $f;
    print STDERR "$progname: logging to $f\n";
    open (STDOUT, ">$f") || error ("$f: $!");
    *STDERR = *STDOUT;
  }

  usage unless (defined($lj) || defined($wp) || defined($twit));
  post ($lj, $wp, $twit);
}

main();
POSIX::_exit(0);  # Something is causing a SEGV at exit!
exit 0;