Tao of Mac

Aug 12th 2003 · 4 min read

Instant Moblogging With Nokia Phones And Any Perl-Capable Box

Boy, that's a long title... Nevertheless, I though I'd share the Perl code that allowed me to update my photo album with (admittedly crappy) photos from my phone (and a few from my DSC-F707 I sent by e-mail to the server).

The basic workings are trivial:

  • Have something listen on the SMTP port (or any other port you can redirect port 25 to, which is what I actually did, but the code below specifies 25 for clarity)
  • Check every inbound connection to make sure it comes from an "authorized" server (again, I have removed large pieces of paranoia from the code to make it readable)
  • Accept e-mail from specific addresses (paranoia removed here as well, including content checks)
  • Decode any photos that come along
  • Check if they carry tags (using jhead, a standalone utility you can get here)
  • Do some extra Nokia-specific checks (the guy who coded the Series 60 tagging didn't follow standards and placed the picture date/time stamp in a Comment field...)
  • Write the picture where the web server can see it.
    • We assume it's an MMS message, which is equivalent to a single plaintext message with an image attachment (more paranoia removed, of course, since the full version completely strips HTML content)
    • We store both photo and text alongside as YYYYMMDDHHMMSS.jpg and YYYYMMDDHHMMSS.txt. Displaying the images and captions on the web site is a trivial matter, and can be done by any 2-line for loop in .
  • Loop. Computers can be very patient.

The code below (which is strewn with vim folding markup - hence the extra brackets) was tested on Perl 5.8.0 on and Cygwin, and has to work on (I couldn't be bothered to configure CPAN and re-compile Perl on my iBook, and besides, it wasn't going to be left running 24/7 on a laptop...). It should also work on earlier versions of Perl provided you can get the MIME::Tools module and its dependencies for your version of Perl.

use Carp;
use Net::SMTP::Server;
use Net::SMTP::Server::Client;
use MIME::Parser;
use Socket;
use POSIX; # strftime
use Date::Manip qw(ParseDate UnixDate);
use strict;

$| = 1; # flush

our @gaValidFroms   = ( "my.first\@email.com", "my.other\@email.org" );
our @gaValidDomains = ( "my.gsm.operator.com", "another.mmsc.hostname.com" );

our $oServer = new Net::SMTP::Server('0.0.0.0',25) ||
    croak( "Unable to handle client connection: $!\n" );

our ($gszText,$gszImagePath) = ("","");

sub work_entity { # {{{
    my $ent = shift;
    my @parts = $ent->parts;

    if (@parts) {        # multipart...
      map { work_entity($_) } @parts;
    }
    else {               # single part...
        if ($ent->head->mime_type =~ /^text/) {
            my $IO = $ent->bodyhandle->open("r");
            $gszText .= $_ while (defined($_ = $IO->getline));
            $IO->close;
        }
        # handles octet-stream for S60 and anything else that
        # doesn't send proper MIME types
        if (($ent->head->mime_type =~ /^image/) ||
            ($ent->head->mime_type =~ /octet\-stream$/)) {
            $gszImagePath = $ent->bodyhandle->path;
        }
    }
} # work_entity }}}

sub get_exif { # {{{ Obtains EXIF data from images
               # - handles Nokia-style dates in 'Comment' tag.
    my %aFields;
    my $szFilename = shift;

    # Have jhead look at the file (the current CPAN libraries are
    # useless for parsing EXIF tags)
    open( EXIF, "jhead $szFilename|" );
    while( <EXIF> ) {
        chomp;
        if( $_ ne "" ) { # skip blank lines
            s/\s*//g; # get rid of whitespace - it's mostly redundant
            my ($szField,$szData) = split /:/,$_,2;
            for( $szField ) { # switch
                /Filedate/ and do { $szData =~ s/://g; };
                /Filesize/ and do { $szData =~ s/bytes//g; };
                # concatenate all comments
                /Comment/  and do { $aFields{$_} .= "$szData "; last; };
                $aFields{$_} = $szData;
            }
        }
    }
    # Now check for Nokia-style dates in the 'Comment' field
    if( $aFields{'Comment'} =~ /Nokia.650/ ) { # 7650, 3650, etc.
        my($szManufacturer,$szPhone,$szDate,
           $szTime,$szMode,$unknown,$unknown)=split / /,$aFields{'Comment'};
        my($szDay, $szMonth, $szYear)=split /\//, $szDate;
        $szTime =~ s/://g;
        # add synthetic 'Date/Time' field
        $aFields{'Date/Time'} = "$szYear$szMonth$szDay$szTime";
    }
    close EXIF;
    return %aFields;
} # get_exif }}}

sub handle_file { # {{{
    my( $szFile, $szText ) = @_;
    my $szNewName = "";

    my %aEXIF = get_exif( $szFile );
    if( $aEXIF{'Jpegprocess'} ) { # it's a valid JPEG image
        if( $aEXIF{'Date/Time'} ) {  # with time tags
            $szNewName = $aEXIF{'Date/Time'};
        }
        else {
            $szNewName = strftime "%Y%m%D%H%M%s", localtime();
        }
        `mv $szFile /usr/local/www/raw/$szNewName.jpg`;
        open( TEXT, ">/usr/local/www/raw/$szNewName.txt" );
        print TEXT $szText;
        close TEXT;
    }
} # handle_file }}}

sub in_array { # {{{
    my( $szNeedle, @aHaystack ) = @_;
    foreach( @aHaystack ) {
        error_log( "Checking $szNeedle for $_" );
        my $szPattern = quotemeta( $_ );
        if( $szNeedle =~ /.*$szPattern.*/ ) {
            return 1;
        }
    }
    return 0;
} # in_array }}}

sub error_log { # {{{
    print strftime("%Y-%m-%d %H:%M:%S",localtime())." ".join(" ",@_)."\n";
} # error_log }}}

sub terminate { # {{{
    my $szMessage = join( " ", @_ ) . "\n";
    error_log( $szMessage );
    croak( $szMessage );
} # terminate }}}

error_log( "Waiting for Connections" );
our $hConnection;
while( $hConnection = $oServer->accept() ) { # {{{
    my $oClient = new Net::SMTP::Server::Client( $hConnection ) ||
        terminate( "Unable to handle client connection: $!" );
    # Resolve Addresses {{{
    my $aPeer = getpeername( $hConnection );
    my ($nPort, $nAddress) = unpack_sockaddr_in($aPeer);
    my $szAddress = inet_ntoa( $nAddress );
    my $szHostname = gethostbyaddr( $nAddress, AF_INET );
    # Large pieces of paranoia coding removed from here
    # }}}
    error_log( "Handling Connection from $szAddress:$nPort ($szHostname)" );
    if( in_array( $szHostname, @gaValidDomains ) ) { # {{{
      $oClient->process || next;
    }
    else {
        print "Invalid Origin Connection - Skipping\n";
        close $hConnection;
        next;
    } # }}}

    error_log( 'Got e-mail from "' . $oClient->{FROM} . '"' );

    # WARNING - THIS IS NOT SECURE ENOUGH. You have been warned
    if( !( in_array( $oClient->{FROM}, @gaValidFroms ) ) ) {
        error_log( "Invalid Headers - Skipping" );
        close $hConnection;
        next;
    }
    my $oParser = new MIME::Parser;
    $oParser->output_dir( '/tmp' );
    my $oEntity = $oParser->parse_data( $oClient->{MSG} );
    $gszText = $gszImagePath = "";
    work_entity( $oEntity );
    handle_file( $gszImagePath, $gszText );
    error_log( "Message processed: $gszImagePath $gszText" );
} # main loop }}}

# VIM Local variables: {{{
# tab-width: 4
# c-basic-offset: 4
# End:
# vim600: sw=4 ts=4 fdm=marker
# vim<600: sw=4 ts=4
# }}}

Notes:

  • The code as presented does not include a lot of paranoia checking (validating addresses more fully, stripping improper content, etc.). We've covered that. Work for your own security.
  • This should NEVER be run as root, except for testing. Make it listen on 10025 or so, run it as an unprivileged user and set up your firewall to map port 25 to 10025. That's what I did, since I also had sendmail running on 25.
  • A specific portion of the code (the Content-type handling for Nokia phones on work_entity) was lifted from someone else's code. I forget whom, but due credit will be posted when I can find the original.
  • As with all Perl code, this can be written in an entirely different way. I tend to write mostly and have a heavy Windows C++ background, so I like my code readable and verbose. Do your own version if it annoys you.

This page is referenced in: