# t/emailpost.t # # Test posting via email. # # Authors: # Afuna # Mark Smith # # Copyright (c) 2013-2018 by Dreamwidth Studios, LLC. # # This program is free software; you may redistribute it and/or modify it under # the same terms as Perl itself. For a copy of the license, please reference # 'perldoc perlartistic' or 'perldoc perlgpl'. # use strict; use warnings; use Test::More tests => 26; BEGIN { $LJ::_T_CONFIG = 1; require "$ENV{LJHOME}/cgi-bin/ljlib.pl"; } use DW::EmailPost; use LJ::Emailpost::Web; use LJ::Test; use FindBin qw($Bin); use File::Temp; use MIME::Parser; local $LJ::T_ALLOW_EMAILPOST = 1; # override caps my $u = temp_user(); my $emailpin = "emailpin123"; my $user_email_info = { TEMPUSER => $u->user, EMAILPIN => $emailpin, POSTDOMAIN => "post.$LJ::DOMAIN", FROM_EMAIL => 'foo@example.com', }; # the brian aker example/bug report my $mime = get_mime( "delspyes", $user_email_info ); ok( $mime, "got delspyes MIME" ); my ( $email_post, $ok, $msg ); my $user = $u->user; $email_post = DW::EmailPost->get_handler($mime); $email_post->destination($user); ( $ok, $msg ) = $email_post->process; ok( !$ok, "not posted" ); like( $msg, qr/No allowed senders have been saved for your account/, "rejected due to no allowed senders" ); is( $email_post->dequeue, 1, "and it's dequeued" ); LJ::Emailpost::Web::set_allowed_senders( $u, { 'foo@example.com' => { get_errors => 1 } } ); is( $u->prop("emailpost_allowfrom"), "foo\@example.com(E)", "allowed sender set correctly" ); $email_post = DW::EmailPost->get_handler($mime); $email_post->destination($user); ( $ok, $msg ) = $email_post->process; ok( !$ok, "not posted" ); like( $msg, qr/Unable to locate your PIN/, "rejected due to no PIN" ); is( $email_post->dequeue, 1, "and it's dequeued" ); $email_post = DW::EmailPost->get_handler($mime); $email_post->destination("$user+$emailpin"); ( $ok, $msg ) = $email_post->process; ok( !$ok, "not posted" ); like( $msg, qr/Invalid PIN/, "rejected due to invalid PIN" ); is( $email_post->dequeue, 1, "and it's dequeued" ); $u->set_prop( "emailpost_pin", $emailpin ); $email_post = DW::EmailPost->get_handler($mime); $email_post->destination("$user+$emailpin"); ( $ok, $msg ) = $email_post->process; ok( $ok, "posted" ); like( $msg, qr/Post success/, "posted!" ); is( $email_post->dequeue, 1, "and it's dequeued" ); my $entry = LJ::Entry->new( $u, jitemid => 1 ); ok( $entry->valid, "Entry is valid" ); diag( "Posted to: " . $entry->url ); my $text = $entry->event_raw; ok( $text !~ qr!http://krow\.livejournal\.com/ 434338\.html!, "no space in URLs. delsp=yes working." ); ok( $text =~ qr!http://krow\.livejournal\.com/434338\.html!, "got correct URL in post, all together." ); { my $email_post = DW::EmailPost->get_handler( get_mime( "long-subject", $user_email_info ) ); my ( $ok, $msg ) = $email_post->process; ok( $ok, "posted entry with long subject" ); my $entry = LJ::Entry->new( $u, jitemid => 2 ); is( $entry->subject_raw, "Here's an entry emailed-in with a long subject (>100 characters) which will end up being truncated s", "Entry subject truncated" ); } { $u->set_prop( 'opt_whoscreened', 'F' ); my $foobit = $u->create_trust_group( groupname => 'foo' ); $u->create_trust_group( groupname => 'foo, bar' ); my $barbit = $u->create_trust_group( groupname => 'bar' ); my $email_post = DW::EmailPost->get_handler( get_mime( "parse-props", $user_email_info ) ); my ( $ok, $msg ) = $email_post->process; ok( $ok, "posted entry with custom settings" ); my $entry = LJ::Entry->new( $u, jitemid => 3 ); is( $entry->event_raw, "This is a test post.", "Settings removed from body text" ); is( $entry->security, 'usemask', "Entry security is correct" ); is( $entry->allowmask, ( 1 << $foobit ) | ( 1 << $barbit ), 'Entry allowmask is correct' ); is( $entry->prop('current_moodid'), 56, "Entry mood is correct" ); is( $entry->prop('current_music'), "Jonathan Coulton -- Code Monkey", "Entry music is correct" ); is( $entry->prop('opt_screening'), 'R', 'Entry comment screening is correct' ); } sub get_mime { my ( $filepart, $replace ) = @_; $replace ||= {}; my $file = "$Bin/data/emailpost/$filepart.txt"; my $tmpdir = File::Temp::tempdir( CLEANUP => 1 ); open( my $fh, $file ) or die "Couldn't open file $file: $!"; my $outfile = "$tmpdir/email-with-substs-$filepart"; open( my $newfh, "+>$outfile" ) or die "Couldn't open file $outfile for writing: $!"; while (<$fh>) { s/\$\{(.+?)\}/$replace->{$1} || die "Unknown substitution: $1"/eg; print $newfh $_; } seek( $newfh, 0, 0 ); # seek to beginning my $parser = MIME::Parser->new; $parser->output_dir($tmpdir); my $entity; return eval { $entity = $parser->parse($newfh); }; } 1;