# SPDX-License-Identifier: GPL-2.0-or-later package Amavis::MIME::Body::OnOpenFh; # A body class that keeps data on an open file handle, read-only, # while allowing to prepend a couple of lines when reading from it. # $skip_bytes bytes at the beginning of a given open file are ignored. use strict; use re 'taint'; BEGIN { require Exporter; require MIME::Body; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '2.412'; @ISA = qw(Exporter MIME::Body); # subclass of MIME::Body } use Amavis::Util qw(ll do_log); sub init { my($self, $fh,$prefix_lines,$skip_bytes) = @_; $self->{MB_Am_fh} = $fh; $self->{MB_Am_prefix} = defined $prefix_lines ? join('',@$prefix_lines) : ''; $self->{MB_Am_prefix_l} = length($self->{MB_Am_prefix}); $self->{MB_Am_skip_bytes} = !defined $skip_bytes ? 0 : $skip_bytes; $self->is_encoded(1); $self; } sub open { my($self,$mode) = @_; $self->close; # ignoring status $mode eq 'r' or die "Only offers read-only access, mode: $mode"; my $fh = $self->{MB_Am_fh}; my $skip = $self->{MB_Am_skip_bytes}; $fh->seek($skip,0) or die "Can't rewind mail file: $!"; $self->{MB_Am_pos} = 0; bless { parent => $self }; #** One-argument "bless" warning } sub close { 1 } sub read { # SCALAR,LENGTH,OFFSET my $self = shift; my $len = $_[1]; my $offset = $_[2]; my $parent = $self->{parent}; my $pos = $parent->{MB_Am_pos}; my $str1 = ''; my $str2 = ''; my $nbytes = 0; if ($len > 0 && $pos < $parent->{MB_Am_prefix_l}) { $str1 = substr($parent->{MB_Am_prefix}, $pos, $len); $nbytes += length($str1); $len -= $nbytes; } my $msg; if ($len > 0) { my $nb = $parent->{MB_Am_fh}->read($str2,$len); if (!defined $nb) { $msg = "Error reading: $!"; } elsif ($nb < 1) { # read returns 0 at eof } else { $nbytes += $nb; $len -= $nb; } } if (defined $msg) { undef $nbytes; # $! already set by a failed read } else { ($offset ? substr($_[0],$offset) : $_[0]) = $str1.$str2; $pos += $nbytes; $parent->{MB_Am_pos} = $pos; } $nbytes; # eof: 0; error: undef } 1;