Skip to content

Commit

Permalink
Add support for encode()/decode() methods in Net::Cmd
Browse files Browse the repository at this point in the history
Some mechanisms in Authen::SASL offer additional security layers and
encode()/decode() methods for them.  The I/O routines in Net::Cmd now use
it if they are available.  Currently only Net::SMTP defines
protocol-specific methods.

In addition to that, EHLO is now issued just after a successful
authentication with an additional security layer as described in
Sec. 4 in RFC 4954.
  • Loading branch information
hrs-allbsd committed Oct 16, 2023
1 parent 808bb35 commit 6212af8
Show file tree
Hide file tree
Showing 2 changed files with 69 additions and 8 deletions.
19 changes: 18 additions & 1 deletion lib/Net/Cmd.pm
Original file line number Diff line number Diff line change
Expand Up @@ -188,9 +188,24 @@ sub set_status {
1;
}

# The default encode/decode methods
sub encode {
my ($cmd, $text, $len) = @_;

$text;
}


sub decode {
my ($cmd, $text, $len) = @_;

$text;
}


sub _syswrite_with_timeout {
my $cmd = shift;
my $line = shift;
my $line = $cmd->encode($_[0], length($_[0]));

my $len = length($line);
my $offset = 0;
Expand Down Expand Up @@ -352,6 +367,8 @@ sub getline {

substr($buf, 0, 0) = $partial; ## prepend from last sysread

$buf = $cmd->decode($buf, length($buf)); ## decode it

my @buf = split(/\015?\012/, $buf, -1); ## break into lines

$partial = pop @buf;
Expand Down
58 changes: 51 additions & 7 deletions lib/Net/SMTP.pm
Original file line number Diff line number Diff line change
Expand Up @@ -122,6 +122,8 @@ sub new {
return;
}
}
# {Hello} will be reused when a security layer is negotiated after the EHLO
${*$obj}{'net_smtp_hello'} = $arg{Hello} || "";

$obj;
}
Expand Down Expand Up @@ -158,6 +160,34 @@ sub etrn {
}


# Overload encode method when Authen::SASL is available
sub encode {
my ($self, $text, $len) = @_;
my $sasl = ${*$self}{'net_smtp_sasl'};

if ($sasl and $sasl->can('encode')) {
my $ret = $sasl->encode($text, $len);

# Add the leading 4 octects for the length (Sec 3.7, RFC 4422)
pack('N', length($ret)) . $ret;
} else {
$self->SUPER::encode($text, $len);
}
}


# Overload decode method when Authen::SASL is available
sub decode {
my ($self, $text, $len) = @_;
my $sasl = ${*$self}{'net_smtp_sasl'};

# Remove the leading 4 octects for the length (Sec 3.7, RFC 4422)
return ($sasl and $sasl->can('decode'))
? $sasl->decode(substr($text, 4), unpack('N', substr($text, 0, 4)))
: $self->SUPER::decode($text, $len);
}


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

Expand Down Expand Up @@ -216,13 +246,6 @@ sub auth {
# todo that we would really need to change the ISA hierarchy
# so we don't inherit from IO::Socket, but instead hold it in an attribute

# DIGEST-MD5 can support integrity and/or confidentiality protection
# over the socket traffic (auth-int and auth-conf) which we do not
# support here for now. To disable them, set maxssf=minssf=0.

$client->property('maxssf' => 0, 'minssf' => 0)
if ($client->mechanism eq 'DIGEST-MD5');

my @cmd = ("AUTH", $client->mechanism);
my $code;

Expand All @@ -241,6 +264,27 @@ sub auth {
$self->debug_print(1, "(decoded) " . $str . "\n") if $self->debug;
}

# Some mechanisms in Authen::SASL offer additional security layers
# for integrity and/or confidentiality and define encode() and
# decode() methods. To support them, store the Authen::SASL
# object in {net_smtp_sasl}.
#
${*$self}{'net_smtp_sasl'} = $sasl->{conn};

$self->debug_print(0, "sasl->conn is installed\n");

# When an additional security layer is negotiated, the client SHOULD send
# an EHLO again (Sec. 4, RFC 4954)
#
if ($sasl->{conn}->can('encode') or $sasl->{conn}->can('decode')) {
unless ($self->hello(${*$self}{'net_smtp_hello'})) {
my $err = ref($self) . ": " . $self->code . " " . $self->message;
$self->close();
$@ = $err;
return;
}
}

$code == CMD_OK;
}

Expand Down

0 comments on commit 6212af8

Please sign in to comment.