#!/usr/bin/perl
#
# Authors:
#      Afuna <coder.dw@afunamatata.com>
#
# Copyright (c) 2013-2018 by Dreamwidth Studios, LLC.
#
# This code is a refactoring and extension of code originally forked
# from the LiveJournal project owned and operated by Live Journal, Inc.
# The code has been refactored, modified, and expanded by Dreamwidth
# Studios, LLC. These files were originally licensed under the terms
# of the license supplied by Live Journal, Inc, which can currently
# be found at:
#
# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
#
# In accordance with the original license, this code and all its
# modifications are provided under the GNU General Public License.
# A copy of that license can be found in the LICENSE file included as
# part of this distribution.
#
# This file is a refactoring of "cgi-bin/LJ/Emailpost.pm"
# from the original LiveJournal repository

package DW::EmailPost::Entry;

use base qw(DW::EmailPost::Base);
use strict;

use LJ::Protocol;

use Date::Parse;
use IO::Handle;
use XML::Simple;
use DW::Media;

my $workdir = "/tmp";

=head1 NAME

DW::EmailPost::Entry - Handle entries posted through email

=cut

sub _find_destination {
    my ( $class, @to_addresses ) = @_;

    foreach my $dest (@to_addresses) {
        next unless $dest =~ /^(\S+?)\@\Q$LJ::EMAIL_POST_DOMAIN\E$/i;
        return $1;
    }
    return;
}

sub _parse_destination {
    my ( $self, $auth_string ) = @_;

    # user and journal
    my ( $user, $journal, $pin );

    # ignore pin, handle it later
    ( $user, $pin )     = split /\+/, $auth_string;
    ( $user, $journal ) = split /\./, $user if $user =~ /\./;

    $self->{u} = LJ::load_user($user);
    return unless $self->{u};

    $self->{journal} = $journal || $self->{u}->user;

    return 1;
}

sub _process {
    my $self = $_[0];

    $self->_extract_pin;
    $self->_check_pin_validity      or return $self->send_error;
    $self->_cleanup_mobile_carriers or return $self->send_error;

    # figure out what entryprops should be based on post headers in email
    # and user's defaults
    $self->_set_props( $self->{u}, $self->{email_date}, %{ $self->{post_headers} || {} } )
        or return $self->send_error;

    # insert any images.
    # must be done after we've processed the props, to make sure we respect security settings
    $self->insert_images;

    # do a final cleanup of the body text
    $self->cleanup_body_final;

    # build the entry
    my $time = $self->{time};
    my $req  = {
        usejournal => $self->{journal},
        ver        => 1,
        username   => $self->{u}->user,
        event      => $self->{body},
        subject    => $self->{subject},
        security   => $self->{security},
        allowmask  => $self->{amask},
        props      => $self->{props},
        tz         => $time->{zone},
        year       => $time->{year} + 1900,
        mon        => $time->{mon} + 1,
        day        => $time->{day},
        hour       => $time->{hour},
        min        => $time->{min},
    };

    # post!
    my $post_error;
    LJ::Protocol::do_request( "postevent", $req, \$post_error,
        { noauth => 1, allow_truncated_subject => 1 } );
    return $self->send_error( LJ::Protocol::error_message($post_error) ) if $post_error;

    $self->dblog( s => $self->{subject} );
    return ( 1, "Post success" );
}

sub _extract_pin {
    my $self = $_[0];

    my ( undef, $pin ) = split /\+/, $self->{destination};
    $self->{pin} = $pin;

    # Strip (and maybe use) pin data from viewable areas
    my $strip_pin = sub {
        my $textref = $_[0];
        my $pin;

        if ( $$textref =~ s/^\s*\+([a-z0-9]+)\b//i ) {
            $pin = $1;
        }

        return $pin;
    };
    $self->{pin} ||= $strip_pin->( \$self->{subject} );
    $self->{pin} ||= $strip_pin->( \$self->{body} );
}

sub _set_props {
    my ( $self, $u, $email_date, %post_headers ) = @_;

    my $props = {};
    my $time  = {};

    # Pull the Date: header details
    my ( $ss, $mm, $hh, $day, $month, $year, $zone ) = strptime($email_date);

    # If we had an lj/post-date pseudo header, override the real Date header
    ( $ss, $mm, $hh, $day, $month, $year, $zone ) = strptime( $post_headers{date} )
        if $post_headers{date};

    # TZ is parsed into seconds, we want something more like -0800
    $zone = defined $zone ? sprintf( '%+05d', $zone / 36 ) : 'guess';

    $time = {
        sec  => $ss,
        min  => $mm,
        hour => $hh,
        day  => $day,
        mon  => $month,
        year => $year,
        zone => $zone,
    };

    $u->preload_props(
        qw/
            emailpost_userpic emailpost_security
            emailpost_comments emailpost_gallery
            /
    );

    # Get post options, using post-headers first, and falling back
    # to user props.  If neither exist, the regular journal defaults
    # are used.
    $props->{taglist} = $post_headers{tags};
    $props->{picture_keyword} =
           $post_headers{userpic}
        || $post_headers{icon}
        || $u->{emailpost_userpic};
    if ( my $id = DW::Mood->mood_id( $post_headers{mood} ) ) {
        $props->{current_moodid} = $id;
    }
    else {
        $props->{current_mood} = $post_headers{mood};
    }
    $props->{current_music}    = $post_headers{music};
    $props->{current_location} = $post_headers{location};
    $props->{editor}           = $self->_choose_editor( $post_headers{format} );
    $props->{opt_nocomments}   = 1
        if $post_headers{comments} =~ /off/i
        || $u->{emailpost_comments} =~ /off/i;
    $props->{opt_noemail} = 1
        if $post_headers{comments} =~ /noemail/i
        || $u->{emailpost_comments} =~ /noemail/i;
    if ( exists $post_headers{screenlevel} ) {
        if ( $post_headers{screenlevel} =~ /^all$/i ) {
            $props->{opt_screening} = 'A';
        }
        elsif ( $post_headers{screenlevel} =~ /^untrusted$/i ) {
            $props->{opt_screening} = 'F';
        }
        elsif ( $post_headers{screenlevel} =~ /^(anonymous|anon)$/i ) {
            $props->{opt_screening} = 'R';    # needs-Remote
        }
        elsif ( $post_headers{screenlevel} =~ /^(disabled|none)$/i ) {
            $props->{opt_screening} = 'N';
        }
        elsif ( $post_headers{screenlevel} ne '' ) {
            $props->{opt_screening} = 'A';
            $self->send_error(
                "Unrecognized screening keyword. Your entry was posted with all comments screened.",
                { nolog => 1 }
            );
        }
        else {                                # blank
            $props->{opt_screening} = '';     # User default
        }
    }
    else {                                    # unspecified
        $props->{opt_screening} = '';         # User default
    }

    my $security;
    my $amask;

    # "lc" is right here because groupnames are forcibly lowercased in
    # LJ::User->trust_groups;
    $security = lc $post_headers{security}
        || $u->emailpost_security;    # FIXME: relies on emailpost_security ne 'usemask'?

    if ( $security =~ /^(public|private|friends|access)$/ ) {
        if ( $1 eq 'friends' or $1 eq 'access' ) {
            $security = 'usemask';
            $amask    = 1;
        }
    }
    elsif ($security) {               # Assume a trust group list if unknown security.
            # Get the mask for the requested trust group list, discarding those
            # that don't exist.
        $amask = 0;
        my @unrecognized = ();
        foreach my $groupname ( split( /\s*,\s*/, $security ) ) {
            my $group = $u->trust_groups( name => $groupname );
            if ($group) {
                $amask |= ( 1 << $group->{groupnum} );
            }
            else {
                push @unrecognized, $groupname;
            }
        }

        $security = 'usemask';

        if (@unrecognized) {

            # send the error, but not shortcircuiting the posting process
            # probably the only time that we call $self->send_error inside of a convenience sub
            my $unrecognized = join( ', ', @unrecognized );
            $self->send_error(
"Access group(s) \"$unrecognized\" not found. Your journal entry was posted to the other groups, or privately if no groups exist.",
                { nolog => 1 }
            );
        }
    }

    $self->{props}    = $props;
    $self->{security} = $security;
    $self->{amask}    = $amask;
    $self->{time}     = $time;

    return 1;
}

=head2 C<< $self->insert_images >>

Take images from the email body and insert them into the entry

=cut

# could hypothetically be refactored out into Base.pm so that other subclasses could use
# but you'd probably want to pass in the variables instead of referring to $self
sub insert_images {
    my ($self) = @_;

    # upload picture attachments
    # undef return value? retry posting for later.
    my $fb_upload = $self->_upload_images(
        security  => $self->{security},
        allowmask => $self->{amask},
    );

    # if we found and successfully uploaded some images...
    if ( ref $fb_upload eq 'ARRAY' ) {
        my $fb_html = join( '<br />', map { '<img src="' . $_->url . '" />' } @$fb_upload );

        ##
        ## A problem was here:
        ## $body is utf-8 text without utf-8 flag (see Unicode::MapUTF8::to_utf8),
        ## $fb_html is ASCII with utf-8 flag on (because uploaded image description
        ## is parsed by XML::Simple, see cgi-bin/fbupload.pl, line 153).
        ## When 2 strings are concatenated, $body is auto-converted (incorrectly)
        ## from Latin-1 to UTF-8.
        ##
        $fb_html = Encode::encode( "utf8", $fb_html ) if Encode::is_utf8($fb_html);
        $self->{body} .= '<br />' . $fb_html;
    }

    # at this point, there are either no images in the message ($fb_upload == 1)
    # or we had some error during upload that we may or may not want to retry
    # from.  $fb_upload contains the http error code.
    if (
        $fb_upload == 400        # bad http request
        || $fb_upload == 1401    # user has exceeded the fb quota
        || $fb_upload == 1402    # user has exceeded the fb quota
        )
    {
        # don't retry these errors, go ahead and post the body
        # to the journal, postfixed with the remote error.
        $self->{body} .= "\n";
        $self->{body} .= "(Your picture was not posted)";
    }
}

# Return codes
# 1 - no images found in mime entity
# undef - failure during upload
# http_code - failure during upload w/ code
# hashref - { title => url } for each image uploaded
sub _upload_images {
    my ( $self, %opts ) = @_;

    my @imgs = $self->get_entity( $self->{_entity}, 'image' );
    return 1 unless scalar @imgs;

    return 1401 unless DW::Media->can_upload_media( $self->{u} );    # error code from insert_images

    my @images;
    foreach my $img_entity (@imgs) {
        my $obj = DW::Media->upload_media(
            user => $self->{u},
            data => $img_entity->bodyhandle->as_string,
            %opts,                                                   # Should contain security.
        );
        push @images, $obj if $obj;
    }

    return unless scalar @images;
    return \@images;
}

sub _check_pin_validity {
    my $self = $_[0];

    my $from = $self->{from};
    my $pin  = $self->{pin};
    my $u    = $self->{u};

    my $addrlist = LJ::Emailpost::Web::get_allowed_senders( $self->{u} );
    unless ( ref $addrlist && keys %$addrlist ) {
        return $self->err( "No allowed senders have been saved for your account.",
            { nomail => 1 } );
        return;
    }

    return $self->err("Unauthorized sender address: $from")
        unless grep { lc $from eq lc $_ } keys %$addrlist;

    return $self->err("Unable to locate your PIN.")
        unless $pin;
    return $self->err("Invalid PIN.")
        unless lc $pin eq lc $u->prop('emailpost_pin');

    return 1;
}

sub _cleanup_mobile_carriers {
    my $self = $_[0];

    # Is this message from a sprint PCS phone?  Sprint doesn't support
    # MMS (yet) - when it does, we should just be able to rip this block
    # of code completely out.
    #
    # Sprint has two methods of non-mms mail sending.
    #   -  Normal text messaging just sends a text/plain piece.
    #   -  Sprint "PictureMail".
    # PictureMail sends a text/html piece, that contains XML with
    # the location of the image on their servers - and a text/plain as well.
    # (The text/plain used to be blank, now it's really text/plain.  We still
    # can't use it, however, without heavy and fragile parsing.)
    # We assume the existence of a text/html means this is a PictureMail message,
    # as there is no other method (headers or otherwise) to tell the difference,
    # and Sprint tells me that their text messaging never contains text/html.
    # Currently, PictureMail can only contain one image per message
    # and the image is always a jpeg. (2/2/05)
    my $return_path  = $self->{return_path};
    my $content_type = $self->{content_type};
    my $tent         = $self->{_tent};

    if (   $return_path =~ /(?:messaging|pm)\.sprint(?:pcs)?\.com/
        && $content_type->{"_orig"} =~ m#^multipart/alternative#i )
    {

        $tent = $self->get_entity( $self->{_entity}, 'html' );

        return $self->err("Unable to find Sprint HTML content in PictureMail message.")
            unless $tent;

        # ok, parse the XML.
        my $html = $tent->bodyhandle->as_string();
        my $xml_string;
        $xml_string = $1 if $html =~ /<!-- lsPictureMail-Share-\w+-comment\n(.+)\n-->/is;
        return $self->err("Unable to find XML content in PictureMail message.")
            unless $xml_string;

        LJ::dhtml($xml_string);    # $xml_string is being modified by this function call
                                   # special characters are replaced with equivalent HTML entities
        my $xml = eval { XML::Simple::XMLin($xml_string); };
        return $self->err("Unable to parse XML content in PictureMail message.")
            if !$xml || $@;

        return $self->err("Sorry, we currently only support image media.")
            unless $xml->{messageContents}->{type} eq 'PICTURE';

        my $url =
            LJ::dhtml( $xml->{messageContents}->{mediaItems}->{mediaItem}->{url} );
        $url = LJ::trim($url);
        $url =~ s#</?url>##g;

        return $self->err("Invalid remote SprintPCS URL.")
            unless $url =~ m#^http://pictures.sprintpcs.com/#;

        # we've got the url to the full sized image.
        # fetch!
        my ( $tmpdir, $tempfile );
        $tmpdir = File::Temp::tempdir( "ljmailgate_" . 'X' x 20, DIR => $workdir );
        ( undef, $tempfile ) = File::Temp::tempfile(
            'sprintpcs_XXXXX',
            SUFFIX => '.jpg',
            OPEN   => 0,
            DIR    => $tmpdir
        );
        my $ua = LJ::get_useragent(
            role    => 'emailgateway',
            timeout => 20,
        );

        $ua->agent("Mozilla");

        my $ua_rv = $ua->get( $url, ':content_file' => $tempfile );

        $self->{body} = $xml->{messageContents}->{messageText};
        $self->{body} = ref $self->{body} ? "" : LJ::dhtml( $self->{body} );

        if ( $ua_rv->is_success ) {

            # (re)create a basic mime entity, so the rest of the
            # emailgateway can function without modifications.
            # (We don't need anything but Data, the other parts have
            # already been pulled from $head->unfold)
            $self->{subject} = 'Picture Post';
            $self->{_entity} = MIME::Entity->build( Data => $self->{body} );
            $self->{_entity}->attach(
                Path => $tempfile,
                Type => 'image/jpeg'
            );
        }
        else {
            # Retry if we are unable to connect to the remote server.
            # Otherwise, the image has probably expired.  Dequeue.
            my $reason = $ua_rv->status_line;
            return $self->err(
                "Unable to fetch SprintPCS image. ($reason)",
                {
                    retry => $reason =~ /Connection refused/
                }
            );
        }
    }

    # tmobile hell.
    # if there is a message, then they send text/plain and text/html,
    # with a slew of their tmobile specific images.  If no message
    # is attached, there is no text/plain piece, and the journal is
    # polluted with their advertising.  (The tmobile images (both good
    # and junk) are posted to scrapbook either way.)
    # gross.  do our best to strip out the nasty stuff.
    if ( $return_path && $return_path =~ /tmomail\.net$/ ) {

        # if we aren't using their text/plain, then it's just
        # advertising, and nothing else.  kill it.
        $self->{body} = "" if $tent->effective_type eq 'text/html';

        # t-mobile has a variety of different file names, so we can't just allow "good"
        # files through; rather, we can just strip out the bad filenames.
        my @imgs;
        foreach my $img ( $self->get_entity( $self->{_entity}, 'image' ) ) {
            my $path = $img->bodyhandle->path;
            $path =~ s!.*/!!;
            next if $path =~ /^dottedline(350|600).gif$/;
            next if $path =~ /^audio.gif$/;
            next if $path =~ /^tmobilelogo.gif$/;
            next if $path =~ /^tmobilespace.gif$/;
            push @imgs, $img;    # it's a good file if it made it this far.
        }
        $self->{entity}->parts( \@imgs );
    }

    # alltel. similar logic to t-mobile.
    if ( $return_path && $return_path =~ /mms\.alltel\.net$/ ) {
        my @imgs;
        foreach my $img ( $self->get_entity( $self->{_entity}, 'image' ) ) {
            my $path = $img->bodyhandle->path;
            $path =~ s!.*/!!;
            next if $path =~ /^divider\.gif$/;
            next if $path =~ /^spacer\.gif$/;
            next if $path =~ /^bluebar\.gif$/;
            next if $path =~ /^header\.gif$/;
            next if $path =~ /^greenbar\.gif$/;
            next if $path =~ /^alltel_logo\.jpg$/;

            push @imgs, $img;    # it's a good file if it made it this far.
        }
        $self->{_entity}->parts( \@imgs );
    }

    # verizon crap.  remove paragraphs of text.
    $self->{body} =~ s/This message was sent using.+?Verizon.+?faster download\.//s;

    # virgin mobile adds text to the *top* of the message, killing post-headers.
    # Kill this silly (and grammatically incorrect) string.
    if ( $return_path && $return_path =~ /vmpix\.com$/ ) {
        $self->{body} =~ s/^This is an? MMS message\.\s+//ms;
    }

    # UK service 'O2' does some bizarre stuff.
    # No concept of a subject - it uses the first 40 characters from the body,
    # truncating the rest.  The first text/plain is all advertising.
    # The text/plain titled 'smil.txt' is the actual body of the message.
    if ( $return_path && $return_path =~ /mediamessaging\.o2\.co\.uk$/ ) {
        foreach my $ent ( $self->get_entity( $self->{_entity}, '*' ) ) {
            my $path = $ent->bodyhandle->path;
            $path =~ s#.*/##;
            if ( $path eq 'smil.txt' ) {
                $self->{body} = $ent->bodyhandle->as_string();
                last;
            }
        }
        $self->{subject} = 'Picture Post';
    }

    return 1;
}

1;