Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
XP is just a number
 
PerlMonks  

SprintPCS camera phone to Perlmonks Monkpics

by diotalevi (Canon)
on Jun 03, 2004 at 17:32 UTC ( #360308=sourcecode: print w/ replies, xml ) Need Help??

Category: PerlMonks.org related scripts
Author/Contact Info
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

Comment on SprintPCS camera phone to Perlmonks Monkpics
Download Code
Re: SprintPCS camera phone to Perlmonks Monkpics
by mojotoad (Monsignor) on Jun 03, 2004 at 19:35 UTC
    I like to see bridging scripts of all sorts -- they're fun, so ++.

    However, in this case -- isn't it possible to forge the email headers, making the message appear to be from a user, and thereby helpfully changing that user's monk picture to an attachment of the sender's choice?

    I haven't tried this with the email address you list in your procmail recipe, but you might want to change it in case it's the one you were intending to use.

    (I suppose you could have other procmail recipes in place that try and filter out instances of messages with forged headers...but if that's the case perhaps you should include a caveat to other users)

    Cheers,
    Matt

      I thought about this a bit initially and while I thought that there wasn't a hole because the URI has to be on http://pictures.sprintpcs.com/, it turns out that there is. Anyone else that is capable of creating a picture share on pictures.sprintpcs.com is capable of publishing to users using this script. Foo. I'm looking to see if there is a way to tie the fetched web site with the user.
        Hmmm, initially I thought that the photo was actually in the attachment, rather than the attachment being a URL pointing to the sprintpcs site. So it's not totally wide open like I thought, but as you said, can be manipulated if you can upload zaps to the sprint share site.

        At the very least, you could track who was doing what. :)

        Matt

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://360308]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (5)
As of 2014-04-23 23:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (557 votes), past polls