# SPDX-License-Identifier: GPL-2.0-or-later

package Amavis::IO::FileHandle;

# Provides a virtual file (a filehandle tie - a TIEHANDLE) representing
# a view to a mail message (accessed on an open file handle) prefixed by
# a couple of synthesized mail header fields supplied as an array of lines.

use strict;
use re 'taint';
use Errno qw(EAGAIN);

sub new { shift->TIEHANDLE(@_) }

sub TIEHANDLE {
  my $class = shift;
  my $self = bless { 'fileno' => undef }, $class;
  if (@_) { $self->OPEN(@_) or return }
  $self;
}

sub UNTIE {
  my($self,$count) = @_;
  $self->CLOSE  if !$count && defined $self->FILENO;
  1;
}

sub DESTROY {
  my $self = $_[0]; local($@,$!,$_);
  $self->CLOSE  if defined $self->FILENO;
  1;
}

sub BINMODE { 1 }
sub FILENO { my $self = $_[0]; $self->{'fileno'} }
sub CLOSE  { my $self = $_[0]; undef $self->{'fileno'}; 1 }
sub EOF    { my $self = $_[0]; defined $self->{'fileno'} ? $self->{'eof'} : 1 }

# creates a view on an already open file, prepended by some text
#
sub OPEN {
  my($self, $filehandle,$prefix_lines_ref,$size_limit) = @_;
  # $filehandle is a fh of an already open file;
  # $prefix_lines_ref is a ref to an array of lines, to be prepended
  #   to a created view on an existing file; these lines must each
  #   be terminated by a \n, and must not include other \n characters
  $self->CLOSE  if defined $self->FILENO;
  $self->{'fileno'} = 9999; $self->{'eof'} = 0;
  $self->{'prefix'} = $prefix_lines_ref;
  $self->{'prefix_n'} = 0;  # number of lines of a prefix
  $self->{'prefix_l'} = 0;  # number of characters of a prefix
  $self->{'pos'} = 0; $self->{'rec_ind'} = 0;
  $self->{'size_limit'} = $size_limit;  # pretend file ends at the byte limit
  if (ref $prefix_lines_ref) {
    my $len = 0;
    $len += length($_) for @$prefix_lines_ref;
    $self->{'prefix_l'} = $len;
    $self->{'prefix_n'} = @$prefix_lines_ref;
  }
  $self->{'handle'} = $filehandle;
  seek($filehandle, 0,0);  # also provides a return value and errno
};

sub SEEK {
  my($self,$offset,$whence) = @_;
  $whence == 0  or die "Only absolute SEEK is supported on this file";
  $offset == 0  or die "Only SEEK(0,0) is supported on this file";
  $self->{'eof'} = 0; $self->{'pos'} = 0; $self->{'rec_ind'} = 0;
  seek($self->{'handle'}, 0,0);  # also provides a return value and errno
}

# sub TELL (not implemented)
#   Returns the current position in bytes for FILEHANDLE, or -1 on error.

# mixing of READ and READLINE is not supported (without rewinding inbetween)
#
sub READLINE {
  my $self = $_[0];
  my $size_limit = $self->{'size_limit'};
  my $pos = $self->{'pos'};
  if ($self->{'eof'}) {
    return;
  } elsif (defined $size_limit && $pos >= $size_limit) {
    $self->{'eof'} = 1;
    return;
  } elsif (wantarray) {  # return entire file as an array
    my $rec_ind = $self->{'rec_ind'};  $self->{'eof'} = 1;
    my $fh = $self->{'handle'};
    if (!defined $size_limit) {
      $self->{'rec_ind'} = $self->{'prefix_n'};  # just an estimate
      $self->{'pos'} = $self->{'prefix_l'};      # just an estimate
      if ($rec_ind >= $self->{'prefix_n'}) {
        return readline($fh);
      } elsif ($rec_ind == 0) {  # common case: get the whole thing
        return ( @{$self->{'prefix'}}, readline($fh) );
      } else {
        return ( @{$self->{'prefix'}}[ $rec_ind .. $#{$self->{'prefix'}} ],
                 readline($fh) );
      }
    } else {  # take size limit into account
      my(@array);
      if ($rec_ind == 0) {
        @array = @{$self->{'prefix'}};
      } elsif ($rec_ind < $self->{'prefix_n'}) {
        @array = @{$self->{'prefix'}}[ $rec_ind .. $#{$self->{'prefix'}} ];
      }
      for my $j (0..$#array) {
        $pos += length($array[$j]);
        if ($pos >= $size_limit) {  # truncate at NL past limit
          $#array = $j; last;
        }
      }
      my $nread = 0;
      if ($pos < $size_limit) {
        my($inbuf,$carry); my $beyond_limit = 0;
        while ( $nread=read($fh,$inbuf,16384) ) {  # faster than line-by-line
          if ($pos+$nread >= $size_limit) {
            my $k = index($inbuf, "\n",  # find a clean break at next NL
                          $pos >= $size_limit ? 0 : $size_limit-$pos);
            substr($inbuf, $k >= 0 ? $k+1 : $size_limit-$pos) = '';
            $beyond_limit = 1;
          }
          $pos += $nread;
          my $k = $#array + 1;  # insertion point
          push(@array, split(/^/m, $inbuf, -1));
          if (defined $carry) { $array[$k] = $carry.$array[$k]; $carry=undef }
          $carry = pop(@array)  if substr($array[-1],-1,1) ne "\n";
          last  if $beyond_limit;
        }
        push(@array,$carry)  if defined $carry;
      }
      $self->{'rec_ind'} = $rec_ind + @array;
      $self->{'pos'} = $pos;
      if (!defined $nread) {
        undef @array;
        # errno should still be in $!, caller should be checking it
        # die "error reading: $!";
      }
      return @array;
    }
  } else {  # read one line
    if ($self->{'rec_ind'} < $self->{'prefix_n'}) {
      my $line = $self->{'prefix'}->[$self->{'rec_ind'}];
      $self->{'rec_ind'}++; $self->{'pos'} += length($line);
      return $line;
    } else {
      my $line = scalar(readline($self->{'handle'}));
      if (!defined($line)) { $self->{'eof'} = 1 }  # errno in $!
      else { $self->{'rec_ind'}++; $self->{'pos'} += length($line) }
      return $line;
    }
  }
}

# mixing of READ and READLINE is not supported (without rewinding inbetween)
#
sub READ {  # SCALAR,LENGTH,OFFSET
  my $self = shift; my $len = $_[1]; my $offset = $_[2];
  my $str = ''; my $nbytes = 0;
  my $pos = $self->{'pos'};
  my $beyond_limit = 0;
  my $size_limit = $self->{'size_limit'};
  if (defined $size_limit && $pos+$len > $size_limit) {
    $len = $pos >= $size_limit ? 0 : $size_limit - $pos;
    $beyond_limit = 1;
  }
  if ($len > 0 && $pos < $self->{'prefix_l'}) {
    # not efficient, but typically only occurs once
    $str = substr(join('',@{$self->{'prefix'}}), $pos, $len);
    $nbytes += length($str); $len -= $nbytes;
  }
  my $msg;  my $buff_directly_accessed = 0;
  if ($len > 0) {
    # avoid shuffling data through multiple buffers for a common case
    $buff_directly_accessed = $nbytes == 0;
    my $nb = $buff_directly_accessed
               ? read($self->{'handle'}, $_[0], $len, $offset)
               : read($self->{'handle'}, $str,  $len, $nbytes);
    if (!defined $nb) {
      $msg = "Error reading: $!";
    } elsif ($nb < 1) {  # read returns 0 at eof
      $self->{'eof'} = 1;
    } else {
      $nbytes += $nb; $len -= $nb;
    }
  }
  if (defined $msg) {
    undef $nbytes;  # $! already set by a failed sysread
  } elsif ($beyond_limit && $nbytes == 0) {
    $self->{'eof'} = 1;
  } else {
    if (!$buff_directly_accessed) {
      ($offset ? substr($_[0],$offset) : $_[0]) = $str;
    }
    $pos += $nbytes; $self->{'pos'} = $pos;
  }
  $nbytes;   # eof: 0;  error: undef
}

sub close    { shift->CLOSE(@_) }
sub fileno   { shift->FILENO(@_) }
sub binmode  { shift->BINMODE(@_) }
sub seek     { shift->SEEK(@_) }
#sub tell    { shift->TELL(@_) }
sub read     { shift->READ(@_) }
sub readline { shift->READLINE(@_) }
sub getlines { shift->READLINE(@_) }
sub getline  { scalar(shift->READLINE(@_)) }

1;