Perl Net::SMTP 强制认证方法

Posted 2023-03-15

【中文标题】Perl Net::SMTP 强制认证方法

【英文标题】：Perl Net::SMTP force auth method

【发布时间】：2017-12-30 06:12:48

【问题描述】：

我正在尝试使用 Perl Net::SMTP 使用默认选择的 GSSAPI 以外的身份验证方法发送邮件（例如 force PLAIN）。

我试过了：

my $smtp;
$smtp = Net::SMTP::SSL->new($host, Port => $port);
$smtp->auth($user, $passwd);

并将最后一行替换为：

$smtp->auth('PLAIN', $user, $passwd);

或将具有选定机制的Authen::SASL 对象传递给$smtp->auth()。以上都不起作用 - 调试（和邮件服务器日志）说它仍在尝试AUTH GSSAPI。

有谁知道如何在Net::SMTP 中正确强制验证方法？

我的 Perl 版本是 Debian 8 的 5.20.2-3+deb8u8，软件包版本：

Net::SMTP - 2.33 Net::SMTP::SSL - 1.01 Authen::SASL - 2.16

【问题讨论】：

我正在尝试使用 Perl 发送邮件Net::SMTP 在 2017 年，这听起来确实不是一个好主意。这些天我们有像Email::Sender这样的工具。

你准备好接受丑陋的黑客攻击了吗？ 3.0 之前的 Net::SMTP “覆盖”在 Authen::SASL 构造函数中配置的机制，其中服务器在 EHLO 回复中通告了 AUTH 机制。

【参考方案1】：

Net::SMTP 3.00 以上版本

Net::SMTP 以上版本 3： * 不会覆盖auth 方法的Authen::SASL 参数中的机制 * 支持STARTTLS 和 smtps

use Net::SMTP;
use Authen::SASL;

my($host, $user, $pass) = ('...','...','...'); # fill correct data

my $smtp = Net::SMTP->new( $host, SSL=>1, Debug => 1 ); # SSL=>1 - use smtps
$smtp->auth(
  Authen::SASL->new(
    mechanism => 'PLAIN LOGIN',
    callback  =>  user => $user, pass => $passwd 
  )
);

【讨论】：

Perl 5.20 Net::SMTP->new 无法启动 SSL 连接 (SSL => 1) 编辑：并且不能 $smtp->auth($sasl_object) :( 但您的解决方案适用于 Debian 9 (Perl 5.24)

您能否发布 1) 准确的错误消息 2) 您想使用的 Net::SMTP、Net::SMTP::SSL 和 Authen::SASL 版本

【参考方案2】：

Net::SMTP 版本低于 3.00

Net::SMTP 版本 2.31_1（libnet 中最新的 pre 3.00）用EHLO 回复中列出的机制覆盖Authen::SASL 中的机制。请在下面找到我的 UGLY 修复。

use Net::SMTP::SSL;
use Authen::SASL;

my ( $host, $port, $user, $pass ) = ( '...', '...', '...', '...' );    # fill correct data

my $smtp = Net::SMTP::SSL->new( $host, Port => $port, Debug => 1 );
my $auth = Authen::SASL->new(
  mechanism => 'PLAIN LOGIN',
  callback  =>  user => $user, pass => $passwd 
);

  no warnings 'redefine';
  my $count;
  local *Authen::SASL::mechanism = sub 
    my $self = shift;

    # Fix Begin
    # ignore first setting of mechanism
    if ( !$count++ && @_ && $Net::SMTP::VERSION =~ /^2\./ ) 
      return;
    

    # Fix End
    @_
      ? $self->mechanism = shift
      : $self->mechanism;
  ;
  $smtp->auth($auth);

---

需要修复的代码 - Net::SMTP 2.31_1 from libnet 1.22_01

sub auth 
  my ($self, $username, $password) = @_;

  ...

  my $mechanisms = $self->supports('AUTH', 500, ["Command unknown: 'AUTH'"]);
  return unless defined $mechanisms;

  my $sasl;

  if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) 
    $sasl = $username;
    $sasl->mechanism($mechanisms); # <= HERE Authen::SASL mechanism overwrite 
  

【讨论】：

你应该use Net::SMTP::SSL;通过此更改，它可以在 Debian 8 和 9 上运行，谢谢！

@WojciechDyżewski 已修复