| Description: |
This program is intended to be used as a procmail filter. It accepts e-mail from the internet, finds the SprintPCS Picture Share and uploads the first picture it finds as your monkpic. The program requires a small amount configuration - you must add a line after the __DATA__ marker to indicate the e-mail address to expect messages from and then your username and password. This is designed to allow multiple users to be served by the same script so if you can't run this locally I can be a gateway for you. Send me a message if you're interested. The image fetching portion of the code is separated from the image uploading portion so someone could rewrite it for the other services as well.
# Add to your .procmailrc
PMDIR=$HOME/.procmail
INCLUDERC=$PMDIR/rc.picturemail
# Add to your .procmail/rc.picturemail
:0:
* pcs2pm@grenekatz.org
|/home/josh/bin/pmail
|
#!/home/josh/perl5.8.3/bin/perl
use strict;
use warnings;
use Mail::Internet ();
use MIME::Parser ();
use WWW::Mechanize ();
use Archive::Zip ();
use File::Spec ();
use File::Slurp ();
use IO::Handle ();
use Image::Magick::Thumbnail ();
use File::MMagic ();
use Mail::Sendmail ();
use vars qw( $PERLMONKS $PM_BROWSER $PIXELS $SENDTO $SENDFROM);
use Data::Dumper 'Dumper';
$PERLMONKS = 'http://perlmonks.org';
$PIXELS = 500;
exit main( );
sub main
{
my $fh = slurp_to_string( \*STDIN );
my ( $username, $password,
$sendfrom, $sendto ) = match_pm_user( $fh, [ <DATA> ] );
my $nm = get_sprint_image( $fh );
if ( $sendfrom ne $SENDFROM )
{
die "$sendfrom ne $SENDFROM";
}
if ( $sendto ne $SENDTO )
{
die "$sendto ne $SENDTO";
}
resize_image( $nm );
authenticate_to_perlmonks( username => $username,
password => $password )
or die "Couldn't authenticate ($username, $password)";
upload_image_to_perlmonks( username => $username,
filename => $nm )
or die "Couldn't upload image ($username, $nm)";
announce_image( $username );
0;
}
sub announce_image
{
$PM_BROWSER->get( "$PERLMONKS/?node=ad_and_talk;displaytype=raw" )
+;
$PM_BROWSER->field( 'message', "/me just uploaded a new monkpic" )
+;
$PM_BROWSER->submit;
}
sub resize_image
{
my $name = shift;
my $img = Image::Magick->new;
$img->Read( $name );
my ($thumb, $x, $y ) = Image::Magick::Thumbnail::create( $img, $PI
+XELS );
$thumb->Write( $name );
0;
}
sub match_pm_user
{
my $fh = shift;
my @users = @{ shift() };
my $user = quotemeta mail_from( $fh );
split ' ', ( grep s/^$user\s+//i, @users )[0]
}
sub mail_from
{
my $fh = shift;
$fh->seek( 0, Fcntl::SEEK_SET );
my $from = Mail::Internet->new( $fh )->head->header_hashref->{'Fro
+m'}[0];
$from =~ s/\s+//g;
$from;
}
sub slurp_to_string
{
my $fh = shift;
local $/;
local $,;
local $;;
my $str;
open my $ofh, "+>:raw", \ $str or die $!;
$ofh->print( <$fh> );
$ofh->seek( 0, Fcntl::SEEK_SET );
$ofh;
}
sub authenticate_to_perlmonks
{
my %p = @_;
$PM_BROWSER = WWW::Mechanize->new;
$PM_BROWSER->get( $PERLMONKS );
$PM_BROWSER->form_name( 'login' );
$PM_BROWSER->set_fields( user => $p{'username'},
passwd => $p{'password'} );
$PM_BROWSER->submit->content;
!! $PM_BROWSER->find_link( text_regex => qr/log.+?out/ );
}
sub upload_image_to_perlmonks
{
my %p = @_;
my $magic = File::MMagic->new->checktype_filename( $p{'filename'}
+);
$PM_BROWSER->get( "$PERLMONKS/?node=$p{'username'};displaytype=edi
+t" );
$PM_BROWSER->form_number( 2 );
my $widget = $PM_BROWSER->current_form->find_input( 'imgsrc_file'
+);
$widget->file( $p{'filename'} );
$widget->filename( $p{'filename'} );
$widget->headers( 'Content-Type' => $magic );
$PM_BROWSER->click->content =~ /Received \d+ bytes/;
}
sub get_sprint_image
{
my $fh = shift;
my $zfile = Archive::Zip::tempFile( File::Spec->tmpdir );
my $ifile = Archive::Zip::tempFile( File::Spec->tmpdir );
File::Slurp::write_file( $zfile,
{ binmode => 1,
buf_ref => get_sprint_zip( $fh ) } );
my $zip = Archive::Zip->new( $zfile );
my $magic = File::MMagic->new;
my $ok;
for my $name ( $zip->memberNames )
{
$zip->extractMember( $name, $ifile );
my $type = $magic->checktype_filename( $ifile );
if ( $type =~ /^image\/(?:png|gif|jpeg)/ )
{
$ok = 1;
last;
}
}
unlink $zfile or die $!;
$ok ? $ifile : ();
}
sub get_sprint_zip
{
my $fh = shift;
my $browser = WWW::Mechanize->new;
# Get the URL from the text portion of the email.
my $url = ( ${get_text_from_email( $fh )}
=~ m((\Qhttp://pictures.sprintpcs.com/\E\S+)) )[0];
my $page = $browser->get( $url );
# Get the next URL from inside the JavaScript
$url = unpack "N/a*",
( sort { $b cmp $a }
map pack( "N/a*", $_),
$page->content =~ m((\Qhttp://pictures.sprintpcs.com/\E[^\'\"]+)
+)g )[0];
$browser->get( $url );
# Authenticate that the
$page = $browser->follow_link( url_regex => qr/comment/ );
$url = unpack "N/a*",
( sort { $b cmp $a }
map pack( "N/a*", $_),
$page->content =~ m((\Qhttp://pictures.sprintpcs.com/\E[^\'\"]+)
+)g )[0];
$page = $browser->get( $url );
$SENDTO = ( map +( /\bvalue\s*=\s*([\'\"])(.+?)\1/ && $2 ),
grep /\bname\s*=\s*([\'\"]).+?\1/ && $& =~ /\bemail\b/,
$page->content =~ m(<input[^>]+)g )[0];
$SENDFROM = ( $page->content =~ m/addGuest\("(.+?)"/g )[0];
$SENDFROM =~ s/\|$//;
$browser->back;
$browser->back;
# Now hit the javascript:download() action which is really just
# a document.listForm.submit(); This returns a .ZIP file containin
+g
# a higher resolution picture image.
$page = $browser->submit_form( form_name => 'listForm' );
my $zip_file = \ $page->content;
}
sub get_text_from_email
{
my $fh = shift;
$fh->seek( 0, Fcntl::SEEK_SET );
my $p = MIME::Parser->new;
$p->output_to_core(1);
my $e = $p->parse( $fh );
\ join( '',
map $_->stringify_body,
grep $_->mime_type =~ m(text/plain),
$e->parts );
}
# One line per user, each field is separated by white space.
# 1: the address to be matched against From: from the email
# 2: URI encoded perlmonks.org username
# 3: URI encoded perlmonks.org password
# 4: the address to validate on the web page - typically the same as #
+1
# 5: the address the message is expected to have been sent to
__DATA__
from@foo.bar username password from@foo.bar script@foo.bar
|
