GmailのSMTPでOAuth2.0を使う in Perl

こちらの記事の続き。

kkobayashi-a.hatenablog.com

IMAPに比べてSMTPでOAuth 2.0の認証をするサンプルコードについてはほとんど情報がありませんでしたが、唯一こちらが参考になりました。

www.perlmonks.org

Gmail用のAuthen::SASLオブジェクトをAuthen::SASL::Perl::XOAUTH2として定義していて、これをそのまま使えば良さそう。

package Authen::SASL::Perl::XOAUTH2 ;

use strict ;
use warnings ;

our $VERSION = "0.01c" ;
our @ISA = qw( Authen::SASL::Perl ) ;

my %secflags = ( ) ;

sub _order { 1 }

sub _secflags {
  shift ;
  scalar grep { $secflags{$_} } @_ ;
}

sub mechanism {
    # SMTP->auth may call mechanism again with arg $mechanisms
    #            but that means something is not right
    if ( defined $_[1] ) { die "XOAUTH2 not supported by host\n" } ;
    return 'XOAUTH2' ;
} ;

my @tokens = qw( user auth access_token ) ;

sub client_start {
    # Create authorization string:
    # "user=" {User} "^Aauth=Bearer " {Access Token} "^A^A"
    my $self = shift ;
    $self->{ error } = undef ;
    $self->{ need_step } = 0 ;
    return
        'user=' .
        $self->_call( $tokens[0] ) .
        "\001auth=" .
        $self->_call( $tokens[1] ) .
        " " .
        $self->_call( $tokens[2] ) .
        "\001\001" ;
}

1 ;

他に使う機会もないし、スクリプトにそのまま埋め込めばいいかと思っていたけど
これを使うNet::SMTPS(Net::SMTP)内部でreuireする処理があるので
実ファイルとして@INCのパスの通ったディレクトリに保存する必要がありました。

Net::SMTPSから直接送信

とりあえずシンプルな例としてNet::SMTPSから直接叩いてメールを送るサンプルです。

最もシンプルな例としてはAuthen::SASLオブジェクト経由ではなく
直接 Net::SMTPS->command()で認証コマンドを実行することになりますが、
勉強も兼ねて公開されているAuthen::SASL::Perl::XOAUTH2を活かす方向で行きます。

use strict;
use warnings;
use utf8;
use Encode qw /encode/;

use Net::SMTPS;
use Authen::SASL qw/Perl/;
use Email::MIME;

my $USER_MAIL = 'kobayashi01234@gmail.com';
my $access_token = '[my access token]';

my $email = Email::MIME->create( header => [
  From    => $USER_MAIL,
  To      => $USER_MAIL,
  Subject => 'test mail',
  ],
  attributes => {
    content_type => 'text/plain',
    charset      => 'UTF-8',
    encoding     => '8bit',
  },
  body => encode('utf8', "テストメール"),
);
my $msg_string = $email->as_string;

my $sasl = Authen::SASL->new(
  mechanism => 'XOAUTH2',
  callback => {
    user => $USER_MAIL,
    auth => 'Bearer',
    access_token => $access_token,
  }
);

my $smtp = Net::SMTPS->new(
  'smtp.gmail.com',
  Port  => 587,
  doSSL => 'starttls',
  Debug => 1
);

$smtp->auth($sasl) or die "Can't authenticate:" . $smtp->message();
$smtp->mail($USER_MAIL);
$smtp->recipient($USER_MAIL);
$smtp->data();
$smtp->datasend($msg_string);
$smtp->dataend();

実行結果

Net::SMTPS=GLOB(0x80009c5f0)<<< 220 smtp.gmail.com ESMTP
Net::SMTPS=GLOB(0x80009c5f0)>>> EHLO localhost.localdomain
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-smtp.gmail.com at your service, [39.111.129.226]
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-SIZE 35882577
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-8BITMIME
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-STARTTLS
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-ENHANCEDSTATUSCODES
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-PIPELINING
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-CHUNKING
Net::SMTPS=GLOB(0x80009c5f0)<<< 250 SMTPUTF8
Net::SMTPS=GLOB(0x80009c5f0)>>> STARTTLS
Net::SMTPS=GLOB(0x80009c5f0)<<< 220 2.0.0 Ready to start TLS
Net::SMTPS=GLOB(0x80009c5f0)>>> EHLO localhost.localdomain
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-smtp.gmail.com at your service, [39.111.129.226]
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-SIZE 35882577
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-8BITMIME
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-AUTH LOGIN PLAIN XOAUTH2 PLAIN-CLIENTTOKEN OAUTHBEARER XOAUTH
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-ENHANCEDSTATUSCODES
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-PIPELINING
Net::SMTPS=GLOB(0x80009c5f0)<<< 250-CHUNKING
Net::SMTPS=GLOB(0x80009c5f0)<<< 250 SMTPUTF8
Net::SMTPS=GLOB(0x80009c5f0)>>> AUTH XOAUTH2 XXXXXXXXXX
Net::SMTPS=GLOB(0x80009c5f0)<<< 235 2.7.0 Accepted
Net::SMTPS=GLOB(0x80009c5f0)>>> MAIL FROM:<kobayashi01234@gmail.com>
Net::SMTPS=GLOB(0x80009c5f0)<<< 250 2.1.0 OK
Net::SMTPS=GLOB(0x80009c5f0)>>> RCPT TO:<kobayashi01234@gmail.com>
Net::SMTPS=GLOB(0x80009c5f0)<<< 250 2.1.5 OK
Net::SMTPS=GLOB(0x80009c5f0)>>> DATA
Net::SMTPS=GLOB(0x80009c5f0)<<< 354  Go ahead
Net::SMTPS=GLOB(0x80009c5f0)>>> From: kobayashi01234@gmail.com
Net::SMTPS=GLOB(0x80009c5f0)>>> To: kobayashi01234@gmail.com
Net::SMTPS=GLOB(0x80009c5f0)>>> Subject: test mail
Net::SMTPS=GLOB(0x80009c5f0)>>> Date: Wed, 15 Jun 2022 16:35:50 +0900
Net::SMTPS=GLOB(0x80009c5f0)>>> MIME-Version: 1.0
Net::SMTPS=GLOB(0x80009c5f0)>>> Content-Type: text/plain; charset=UTF-8
Net::SMTPS=GLOB(0x80009c5f0)>>> Content-Transfer-Encoding: 8bit
Net::SMTPS=GLOB(0x80009c5f0)>>>
Net::SMTPS=GLOB(0x80009c5f0)>>> テストメール
Net::SMTPS=GLOB(0x80009c5f0)>>> .
Net::SMTPS=GLOB(0x80009c5f0)<<< 250 2.0.0 OK  1655278555
Net::SMTPS=GLOB(0x80009c5f0)>>> QUIT
Net::SMTPS=GLOB(0x80009c5f0)<<< 221 2.0.0 closing connection

いい感じですね！

Email::Senderから送信

ようやく最終目標であるEmail::Senderから送る方法を考えます。
Net::SMTP(S)をそのまま使ってもいいですが、Email::Senderがいい感じにラップしてくれるので
モダンなPerlコードはこれを使うみたいです。

Email::Senderを使うにはGmailの認証に対応したEmail::Sender::Transportが必要になりますが
うまい具合に指定する方法が見つからなかったので、強引にEmail::Sender::Transport::SMTPを上書き（継承）した
Email::Sender::Transport::SMTP::Gmailクラスを作成します。

sendmail()の処理では_smtp_client()関数からsmtpオブジェクトの生成や認証を行うのですが、
コンストラクタで認証済みのNet::SMTPオブジェクトをセットし、それをそのまま返すようにしています。

package Email::Sender::Transport::SMTP::Gmail;

use strict;
use warnings;
use base qw(Email::Sender::Transport::SMTP);

sub new{
  my $this = shift;
  my $class = ref $this || $this;
  return bless {_smtps_client => $_[0]}, $class;
}

sub _smtp_client{
  return $_[0]->{_smtps_client};
}

1;

package main;

use strict;
use warnings;
use utf8;
use Encode qw /encode/;

use Net::SMTPS;
use Authen::SASL qw/Perl/;
use Email::MIME;
use Email::Sender::Simple qw(sendmail);

my $USER_MAIL = 'kobayashi01234@gmail.com';
my $access_token = '[my access token]';

my $email = Email::MIME->create( header => [
  From    => $USER_MAIL,
  To      => $USER_MAIL,
  Subject => 'test mail',
  ],
  attributes => {
    content_type => 'text/plain',
    charset      => 'UTF-8',
    encoding     => '8bit',
  },
  body => encode('utf8', "テストメール"),
);
my $msg_string = $email->as_string;

my $sasl = Authen::SASL->new(
  mechanism => 'XOAUTH2',
  callback => {
    user => $USER_MAIL,
    auth => 'Bearer',
    access_token => $access_token,
  }
);

my $smtp = Net::SMTPS->new(
  'smtp.gmail.com',
  Port  => 587,
  doSSL => 'starttls',
  Debug => 1
);
$smtp->auth($sasl) or die "Can't authenticate: " . $smtp->message();

my $sender = Email::Sender::Transport::SMTP::Gmail->new($smtp);

sendmail($email, {transport => $sender});