Server IP : 85.214.239.14 / Your IP : 3.145.88.104 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Amavis/Out/SMTP/ |
Upload File : |
# SPDX-License-Identifier: GPL-2.0-or-later package Amavis::Out::SMTP::Protocol; use strict; use re 'taint'; use warnings; use warnings FATAL => qw(utf8 void); no warnings 'uninitialized'; # use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict'; BEGIN { require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '2.412'; @ISA = qw(Exporter); } use Errno qw(EIO EINTR EAGAIN ECONNRESET); use Encode (); use Time::HiRes (); use Amavis::Conf qw(:platform); use Amavis::IO::RW; use Amavis::Util qw(ll do_log min max minmax); sub init { my $self = $_[0]; delete $self->{domain}; delete $self->{supports}; $self->{pipelining} = 0; } sub new { my($class,$socket_specs,%arg) = @_; my $self = bless {}, $class; $self->{at_line_boundary} = 1; $self->{dotstuffing} = 1; # defaults to on $self->{dotstuffing} = 0 if defined $arg{DotStuffing} && !$arg{DotStuffing}; $self->{strip_cr} = 1; # sanitizing bare CR enabled by default $self->{strip_cr} = 0 if defined $arg{StripCR} && !$arg{StripCR}; $self->{sanitize_nul} = 1; # sanitizing NUL bytes enabled by default $self->{sanitize_nul} = 0 if defined $arg{SanitizeNUL} && !$arg{SanitizeNUL}; $self->{null_cnt} = 0; $self->{io} = Amavis::IO::RW->new($socket_specs, Eol => "\015\012", %arg); $self->init; $self; } sub close { my $self = $_[0]; $self->{io}->close; } sub DESTROY { my $self = $_[0]; local($@,$!,$_); eval { $self->close } or 1; # ignore failure, make perlcritic happy } sub ehlo_response_parse { my($self,$smtp_resp) = @_; delete $self->{domain}; delete $self->{supports}; my(@ehlo_lines) = split(/\n/,$smtp_resp,-1); my $bad; my $first = 1; local($1,$2); for my $el (@ehlo_lines) { if ($first) { if ($el =~ /^(\d{3})(?:[ \t]+(.*))?\z/s) { $self->{domain} = $2 } elsif (!defined($bad)) { $bad = $el } $first = 0; } elsif ($el =~ /^([A-Z0-9][A-Z0-9-]*)(?:[ =](.*))?\z/si) { $self->{supports}{uc($1)} = defined $2 ? $2 : ''; } elsif ($el =~ /^[ \t]*\z/s) { # don't bother (e.g. smtp-sink) } elsif (!defined($bad)) { $bad = $el; } } $self->{pipelining} = defined $self->{supports}{'PIPELINING'} ? 1 : 0; do_log(0, "Bad EHLO kw %s ignored in %s, socket %s", $bad, $smtp_resp, $self->socketname) if defined $bad; 1; } sub domain { my $self = $_[0]; $self->{domain} } sub supports { my($self,$keyword) = @_; $self->{supports}{uc($keyword)} } *print = \&datasend; # alias name for datasend sub datasend { my $self = shift; my $buff = @_ == 1 ? $_[0] : join('',@_); do_log(-1,"WARN: Unicode string passed to datasend: %s", $buff) if utf8::is_utf8($buff); # always false on tainted, Perl 5.8 bug #32687 # ll(5) && do_log(5, 'smtp print %d bytes>', length($buff)); $buff =~ tr/\015//d if $self->{strip_cr}; # sanitize bare CR if necessary if ($self->{sanitize_nul}) { my $cnt = $buff =~ tr/\x00//; # quick triage if ($cnt) { # this will break DKIM signatures, but IMAP (cyrus) hates NULs in mail $self->{null_cnt} += $cnt; $buff =~ s{\x00}{\xC0\x80}gs; # turn to "Modified UTF-8" encoding of NUL } } # CR/LF are never split across a buffer boundary $buff =~ s{\n}{\015\012}gs; # quite fast, but still a bottleneck if ($self->{dotstuffing}) { $buff =~ s{\015\012\.}{\015\012..}gs; # dot stuffing $self->{io}->print('.') if substr($buff,0,1) eq '.' && $self->{at_line_boundary}; } $self->{io}->print($buff); $self->{at_line_boundary} = $self->{io}->at_line_boundary; $self->{io}->out_buff_large ? $self->flush : 1; } sub socketname { my $self = shift; $self->{io}->socketname(@_) } sub protocol { my $self = shift; $self->{io}->protocol(@_) } sub timeout { my $self = shift; $self->{io}->timeout(@_) } sub ssl_active { my $self = shift; $self->{io}->ssl_active(@_) } sub ssl_upgrade { my $self = shift; $self->{io}->ssl_upgrade(@_) } sub last_io_event_timestamp { my $self = shift; $self->{io}->last_io_event_timestamp(@_) } sub last_io_event_tx_timestamp { my $self = shift; $self->{io}->last_io_event_tx_timestamp(@_) } sub eof { my $self = shift; $self->{io}->eof(@_) } sub flush { my $self = shift; $self->{io}->flush(@_) } sub dataend { my $self = $_[0]; if (!$self->{at_line_boundary}) { $self->datasend("\n"); } if ($self->{dotstuffing}) { $self->{dotstuffing} = 0; $self->datasend(".\n"); $self->{dotstuffing} = 1; } if ($self->{null_cnt}) { do_log(0, 'smtp forwarding: SANITIZED %d NULL byte(s)', $self->{null_cnt}); $self->{null_cnt} = 0; } $self->{io}->out_buff_large ? $self->flush : 1; } sub command { my($self,$command,@args) = @_; my $line = $command =~ /:\z/ ? $command.join(' ',@args) : join(' ',$command,@args); ll(3) && do_log(3, 'smtp cmd> %s', $line); $self->datasend($line."\n"); $self->{at_line_boundary} = 1; # RFC 2920: commands that can appear anywhere in a pipelined command group # RSET, MAIL FROM, SEND FROM, SOML FROM, SAML FROM, RCPT TO, (data) if (!$self->{pipelining} || $self->{io}->out_buff_large || $command !~ /^(?:RSET|MAIL|SEND|SOML|SAML|RCPT)\b/is) { return $self->flush; } 1; } sub smtp_response { my $self = $_[0]; my $resp = ''; my($line,$code,$enh); my $first = 1; for (;;) { $line = $self->{io}->get_response_line; last if !defined $line; # eof, error, timeout my $line_complete = $line =~ s/\015\012\z//s; $line .= ' INCOMPLETE' if !$line_complete; my $more; local($1,$2,$3); $line =~ s/^(\d{3}) (-|\ |\z) (?: ([245] \. \d{1,3} \. \d{1,3}) (\ |\z) )?//xs; if ($first) { $code = $1; $enh = $3; $first = 0 } else { $resp .= "\n" } $resp .= $line; $more = $2 eq '-'; last if !$more || !$line_complete; } !defined $code ? undef : $code . (defined $enh ? " $enh" : '') . ' '. $resp; } sub helo { my $self = shift; $self->init; $self->command("HELO",@_) } sub ehlo { my $self = shift; $self->init; $self->command("EHLO",@_) } sub lhlo { my $self = shift; $self->init; $self->command("LHLO",@_) } sub noop { my $self = shift; $self->command("NOOP",@_) } sub rset { my $self = shift; $self->command("RSET",@_) } sub auth { my $self = shift; $self->command("AUTH",@_) } sub data { my $self = shift; $self->command("DATA",@_) } sub quit { my $self = shift; $self->command("QUIT",@_) } sub mail { my($self,$reverse_path,%params) = @_; my(@mail_parameters) = map { my $v = $params{$_}; defined($v) ? "$_=$v" : "$_" } (keys %params); $self->command("MAIL FROM:", $reverse_path, @mail_parameters); } sub recipient { my($self,$forward_path,%params) = @_; my(@rcpt_parameters) = map { my $v = $params{$_}; defined($v) ? "$_=$v" : "$_" } (keys %params); $self->command("RCPT TO:", $forward_path, @rcpt_parameters); } 1;