Merge pull request #893 from metacpan/oalders/pause-email

oalders · web-flow · commit 17d6c796a496 · 2019-04-15T12:36:43.000-04:00
Move email sending to a model class
diff --git a/cpanfile b/cpanfile
@@ -2,6 +2,7 @@ requires 'perl', '5.010';
 
 requires 'Archive::Any', 0.0942;
 requires 'Archive::Tar', '2.04';
+requires 'Authen::SASL', '2.16';
 requires 'BackPAN::Index', '0.42';
 requires 'CHI', '0.60';
 requires 'CPAN::DistnameInfo', '0.12';
@@ -95,6 +96,7 @@ requires 'Log::Log4perl::Appender::ScreenColoredLevels';
 requires 'MetaCPAN::Moose';
 requires 'MetaCPAN::Pod::XHTML';
 requires 'MetaCPAN::Role', '0.06';
+requires 'MIME::Base64', '3.15';
 requires 'Minion', '>= 9.03';
 requires 'Minion::Backend::SQLite';
 requires 'Module::Load';
diff --git a/cpanfile.snapshot b/cpanfile.snapshot
@@ -198,6 +198,27 @@ DISTRIBUTIONS
       Array::Iterator::Reusable 0.11
     requirements:
       ExtUtils::MakeMaker 6.30
+  Authen-SASL-2.16
+    pathname: G/GB/GBARR/Authen-SASL-2.16.tar.gz
+    provides:
+      Authen::SASL 2.16
+      Authen::SASL::CRAM_MD5 2.14
+      Authen::SASL::EXTERNAL 2.14
+      Authen::SASL::Perl 2.14
+      Authen::SASL::Perl::ANONYMOUS 2.14
+      Authen::SASL::Perl::CRAM_MD5 2.14
+      Authen::SASL::Perl::DIGEST_MD5 2.14
+      Authen::SASL::Perl::EXTERNAL 2.14
+      Authen::SASL::Perl::GSSAPI 0.05
+      Authen::SASL::Perl::LOGIN 2.14
+      Authen::SASL::Perl::Layer 2.14
+      Authen::SASL::Perl::PLAIN 2.14
+    requirements:
+      Digest::HMAC_MD5 0
+      Digest::MD5 0
+      ExtUtils::MakeMaker 6.42
+      Test::More 0
+      perl 5.005
   B-Hooks-EndOfScope-0.21
     pathname: E/ET/ETHER/B-Hooks-EndOfScope-0.21.tar.gz
     provides:
@@ -310,6 +331,7 @@ DISTRIBUTIONS
       CGI::Simple::Standard 1.114
       CGI::Simple::Util 1.114
     requirements:
+      ExtUtils::MakeMaker 0
       IO::Scalar 0
       Test::More 0
   CGI-Struct-1.21
@@ -1208,6 +1230,7 @@ DISTRIBUTIONS
       Config::Any::XML undef
       Config::Any::YAML undef
     requirements:
+      Config::General 2.47
       Module::Pluggable::Object 3.6
   Config-General-2.63
     pathname: T/TL/TLINDEN/Config-General-2.63.tar.gz
@@ -3688,6 +3711,7 @@ DISTRIBUTIONS
       IO::Prompt 0.997004
       IO::Prompt::ReturnVal 0.997004
     requirements:
+      ExtUtils::MakeMaker 0
       IO::Handle 0
       Term::ReadKey 0
       Test::More 0
diff --git a/lib/MetaCPAN/Model/Email/PAUSE.pm b/lib/MetaCPAN/Model/Email/PAUSE.pm
@@ -0,0 +1,92 @@
+package MetaCPAN::Model::Email::PAUSE;
+
+use MetaCPAN::Moose;
+
+use Email::Sender::Simple qw( sendmail );
+use Email::Sender::Transport::SMTP ();
+use Email::Simple                  ();
+use Encode                         ();
+use MetaCPAN::Types qw( Object Uri );
+use Try::Tiny qw( catch try );
+
+with('MetaCPAN::Role::HasConfig');
+
+has _author => (
+    is       => 'ro',
+    isa      => Object,
+    init_arg => 'author',
+    required => 1,
+);
+
+has _url => (
+    is       => 'ro',
+    isa      => Uri,
+    init_arg => 'url',
+    required => 1,
+);
+
+sub send {
+    my $self = shift;
+
+    my $email = Email::Simple->create(
+        header => [
+            'Content-Type' => 'text/plain; charset=utf-8',
+            To             => $self->_author->{email}->[0],
+            From           => 'notifications@metacpan.org',
+            Subject        => 'Connect MetaCPAN with your PAUSE account',
+            'MIME-Version' => '1.0',
+        ],
+        body => $self->_email_body,
+    );
+
+    my $config    = $self->config->{smtp};
+    my $transport = Email::Sender::Transport::SMTP->new(
+        {
+            debug         => 1,
+            host          => $config->{host},
+            port          => $config->{port},
+            sasl_username => $config->{username},
+            sasl_password => $config->{password},
+            ssl           => 1,
+        }
+    );
+
+    my $success = 0;
+    try {
+        $success = sendmail( $email, { transport => $transport } );
+    }
+    catch {
+        warn 'Could not send message: ' . $_;
+    };
+
+    return $success;
+}
+
+sub _email_body {
+    my $self = shift;
+    my $name = $self->_author->name;
+    my $uri  = $self->_url;
+
+    my $body = <<EMAIL_BODY;
+Hi ${name},
+
+please click on the following link to verify your PAUSE account:
+
+$uri
+
+Cheers,
+MetaCPAN
+EMAIL_BODY
+
+    try {
+        $body = Encode::encode( 'UTF-8', $body,
+            Encode::FB_CROAK | Encode::LEAVE_SRC );
+    }
+    catch {
+        warn $_[0];
+    };
+
+    return $body;
+}
+
+1;
diff --git a/lib/MetaCPAN/Role/HasConfig.pm b/lib/MetaCPAN/Role/HasConfig.pm
@@ -5,8 +5,9 @@ use Moose::Role;
 use FindBin;
 use Config::ZOMG ();
 use MetaCPAN::Types qw(HashRef);
+use Module::Runtime qw( require_module );
 
-# Done like this so can be required by a roles
+# Done like this so can be required by a role
 sub config {
     return $_[0]->_config;
 }
@@ -19,11 +20,29 @@ has _config => (
 );
 
 sub _build_config {
+    my $self   = shift;
+    my $config = $self->_zomg("$FindBin::RealBin/..");
+    return $config if $config;
+
+    require_module('Git::Helpers');
+    $config = $self->_zomg( Git::Helpers::checkout_root() );
+
+    return $config if $config;
+
+    die "Couldn't find config file in $FindBin::RealBin/.. or "
+        . Git::Helpers::checkout_root();
+}
+
+sub _zomg {
     my $self = shift;
-    return Config::ZOMG->new(
+    my $path = shift;
+
+    my $config = Config::ZOMG->new(
         name => 'metacpan_server',
-        path => "$FindBin::RealBin/..",
-    )->load;
+        path => $path,
+    );
+
+    return $config->open;
 }
 
 1;
diff --git a/lib/MetaCPAN/Server/Controller/Login/PAUSE.pm b/lib/MetaCPAN/Server/Controller/Login/PAUSE.pm
@@ -4,19 +4,18 @@ use strict;
 use warnings;
 use namespace::autoclean;
 
-use CHI                   ();
-use Email::Sender::Simple ();
-use Email::Simple         ();
-use Encode                ();
-use Cpanel::JSON::XS;
+use CHI ();
+use Log::Contextual qw( :log :dlog );
 use Moose;
-use Try::Tiny;
-use MetaCPAN::Util;
+use Try::Tiny qw( catch try );
+use MetaCPAN::Model::Email::PAUSE ();
+use MetaCPAN::Util qw( generate_sid );
 
 BEGIN { extends 'MetaCPAN::Server::Controller::Login' }
 
 has cache => (
     is      => 'ro',
+    isa     => 'CHI::Driver',
     builder => '_build_cache',
 );
 
@@ -44,48 +43,26 @@ sub index : Path {
         my $author = $c->model('CPAN::Author')->get( uc($id) );
         $c->controller('OAuth2')->redirect( $c, error => "author_not_found" )
             unless ($author);
-        my $code = MetaCPAN::Util::generate_sid;
-        $self->cache->set( $code, $author->pauseid, 86400 );
-        my $uri = $c->request->uri->clone;
-        $uri->query("code=$code");
-        my $email = Email::Simple->create(
-            header => [
-                'Content-Type' => 'text/plain; charset=utf-8',
-                To             => $author->{email}->[0],
-                From           => 'noreply@metacpan.org',
-                Subject        => "Connect MetaCPAN with your PAUSE account",
-                'MIME-Version' => '1.0',
-            ],
-            body => $self->email_body( $author->name, $uri ),
-        );
-        Email::Sender::Simple->send($email);
-        $c->controller('OAuth2')->redirect( $c, success => "mail_sent" );
-    }
-}
 
-sub email_body {
-    my ( $self, $name, $uri ) = @_;
+        my $code = generate_sid();
+        $self->cache->set( $code, $author->pauseid, 86400 );
 
-    my $body = <<EMAIL_BODY;
-Hi ${name},
+        my $url = $c->request->uri->clone;
+        $url->query("code=$code");
 
-please click on the following link to verify your PAUSE account:
+        my $email = MetaCPAN::Model::Email::PAUSE->new(
+            author => $author,
+            url    => $url,
+        );
 
-$uri
+        my $sent = $email->send;
 
-Cheers,
-MetaCPAN
-EMAIL_BODY
+        if ( !$sent ) {
+            log_error { 'Could not send PAUSE email to ' . $author->pauseid };
+        }
 
-    try {
-        $body = Encode::encode( 'UTF-8', $body,
-            Encode::FB_CROAK | Encode::LEAVE_SRC );
+        $c->controller('OAuth2')->redirect( $c, success => 'mail_sent' );
     }
-    catch {
-        warn $_[0];
-    };
-
-    return $body;
 }
 
 1;
diff --git a/lib/MetaCPAN/Util.pm b/lib/MetaCPAN/Util.pm
@@ -6,27 +6,27 @@ use strict;
 use warnings;
 use version;
 
-use Digest::SHA;
-use Encode;
+use Digest::SHA qw( sha1_base64 sha1_hex );
+use Encode qw( decode_utf8 );
 use Ref::Util qw( is_arrayref is_hashref );
 use Sub::Exporter -setup => {
     exports => [
         'author_dir',      'digest',
         'extract_section', 'fix_pod',
-        'fix_version',     'numify_version',
-        'pod_lines',       'strip_pod',
-        'single_valued_arrayref_to_scalar'
+        'fix_version',     'generate_sid',
+        'numify_version',  'pod_lines',
+        'strip_pod',       'single_valued_arrayref_to_scalar'
     ]
 };
 
 sub digest {
-    my $digest = Digest::SHA::sha1_base64( join( "\0", grep {defined} @_ ) );
+    my $digest = sha1_base64( join( "\0", grep {defined} @_ ) );
     $digest =~ tr/[+\/]/-_/;
     return $digest;
 }
 
 sub generate_sid {
-    Digest::SHA::sha1_hex( rand() . $$ . {} . time );
+    return sha1_hex( rand . $$ . {} . time );
 }
 
 sub numify_version {
@@ -76,7 +76,7 @@ sub strip_pod {
 
 sub extract_section {
     my ( $pod, $section ) = @_;
-    eval { $pod = Encode::decode_utf8( $pod, Encode::FB_CROAK ) };
+    eval { $pod = decode_utf8( $pod, Encode::FB_CROAK ) };
     return undef
         unless ( $pod =~ /^=head1\s+$section\b(.*?)(^((\=head1)|(\=cut)))/msi
         || $pod =~ /^=head1\s+$section\b(.*)/msi );
diff --git a/metacpan_server.conf b/metacpan_server.conf
@@ -10,3 +10,10 @@ minion_dsn = postgresql:///minion_queue
 <controller Login::OpenID>
     secret_key 8225b1874fdc431cedb1cf7d454a92b8fde3a5e6
 </controller>
+
+<smtp>
+    host      smtp.fastmail.com
+    port      465
+    username  foo@metacpan.org
+    password  seekrit
+</smtp>
diff --git a/metacpan_server_testing.conf b/metacpan_server_testing.conf
@@ -22,3 +22,10 @@ github_key = foo
 github_secret = bar
 
 secret weak
+
+<smtp>
+    host      smtp.fastmail.com
+    port      465
+    username  foo@metacpan.org
+    password  seekrit
+</smtp>
diff --git a/t/model/email/pause.t b/t/model/email/pause.t
diff --git a/t/util.t b/t/util.t
