#!/usr/bin/perl -c
# SPDX-License-Identifier: BSD-3-Clause-CMU
# See COPYING file at the root of the distribution for more details.

package Cyrus::CacheFile;

use strict;
use warnings;

use IO::File;
use IO::File::fcntl;
use IO::Handle;
use File::Temp;
use YAML;

=pod

=head1 NAME

Cyrus::CacheFile - A pure perl interface to the "cyrus.cache" file
format as generated by Cyrus IMAPd.

=head1 EXAMPLES

XXX: document.

See examples/index_uids.pl for some usage

=cut

# /* Access assistance macros for memory-mapped cache file data */
# /* CACHE_ITEM_BIT32: Convert to host byte order */
# /* CACHE_ITEM_LEN: Get the length out */
# /* CACHE_ITEM_NEXT: Return a pointer to the next entry.  Sizes are
#  * 4-byte aligned, so round up to the next 4 byte boundary */
#  #define CACHE_ITEM_BIT32(ptr) (ntohl(*((bit32 *)(ptr))))
#  #define CACHE_ITEM_LEN(ptr) CACHE_ITEM_BIT32(ptr)
#  #define CACHE_ITEM_NEXT(ptr) ((ptr)+4+((3+CACHE_ITEM_LEN(ptr))&~3))

# #define MAILBOX_CACHE_MINOR_VERSION 2
# #define NUM_CACHE_FIELDS 10

our $NUM_CACHE_FIELDS = 10;
our @NAMES = qw(
  ENVELOPE
  BODYSTRUCTURE
  BODY
  SECTION
  HEADERS
  FROM
  TO
  CC
  BCC
  SUBJECT
);

# PUBLIC API

sub new {
  my $class = shift;
  my $handle = shift;

  # read header
  my $buf;
  # XXX - check for success!
  sysread($handle, $buf, 4);
  my $generation = unpack('N', $buf);
  my $Self = bless { version => 0, generation => $generation, handle => $handle, offset => 4 }, ref($class) || $class;
  return $Self;
}

sub new_file {
  my $class = shift;
  my $file = shift;
  my $lockopts = shift;

  my $fh;
  if ($lockopts) {
    $lockopts = ['lock_ex'] unless ref($lockopts) eq 'ARRAY';
    $fh = IO::File::fcntl->new($file, '+<', @$lockopts)
          || die "Can't open $file for locked read: $!";
  } else {
    $fh = IO::File->new("< $file")
          || die "Can't open $file for read: $!";
  }

  return $class->new($fh);
}

sub next_record {
  my ($Self, $index_record) = @_;

  if ($index_record) {
    $Self->offset($index_record->{CacheOffset});
    $Self->{version} = $index_record->{CacheVersion};
  }

  my $buf;

  my @record;
  my $size = 0;
  for (1..$NUM_CACHE_FIELDS) {
    sysread($Self->{handle}, $buf, 4);
    return undef unless $buf;
    my $num = unpack('N', $buf);
    my $bytes = $num;
    $bytes += 4 - $num % 4 if $num % 4; # offsets are multiple of 4 bytes
    sysread($Self->{handle}, $buf, $bytes);
    push @record, [$num, $bytes, $buf];
    $size += $bytes + 4;
  }

  my $ret = {
    size => $size,
    records => \@record,
  };

  $Self->{record} = $ret;
  $Self->{offset} += $size;

  return $ret;
}

sub record {
  my $Self = shift;
  my $Field = shift;

  return undef unless ($Self->{record});

  if ($Field) {
    return $Self->{record}{$Field};
  }
  return $Self->{record};
}

sub offset {
  my $Self = shift;

  if (@_) {
    my $spot = shift;
    seek($Self->{handle}, $spot, 0);
    $Self->{offset} = $spot;
  }

  return $Self->{offset};
}

sub dump {
  my $Self = shift;

  while (my $rec = $Self->next_record()) {
    $Self->dump_record($rec);
  }
}

sub dump_record {
  my $Self = shift;
  my $rec = shift || $Self->{record};
  return unless $rec;
  print Dump($rec->{records});
}

sub print_record {
  my $Self = shift;
  my $rec = shift || $Self->{record};
  return unless $rec;
  foreach my $rnum (0..$NUM_CACHE_FIELDS-1) {
    my $record = $rec->{records}[$rnum];
    my $str = substr($record->[2], 0, $record->[0]);
    if ($rnum == 3) { # section
      my @items = unpack('N*', $str);
      $str = "\n" . $Self->parse_section(0, \@items);
    }
    print "$NAMES[$rnum]: $str\n";
  }
}

sub parse_section {
  my $Self = shift;
  my $part = shift;
  my $items = shift;
  my $depth = shift || 4;
  my $pad = (' ' x ($depth * 2));

  my $num_parts = shift @$items;
  return '' unless $num_parts;
  my $ret = "$pad$part:(" . scalar(@$items) . "\n";
  my $n = 0;
  while ($n < $num_parts) {
    my $subpart = $part ? "$part.$n" : $n;
    $ret .= "$pad $subpart: " . $Self->parse_item($items) . "\n";
    $n++;
  }
  $ret .= "$pad)\n";
  $n = 1;
  while ($n < $num_parts) {
    my $subpart = $part ? "$part.$n" : $n;
    $ret .= $Self->parse_section($subpart, $items, $depth) . "\n";
    $n++;
  }
  return $ret;
}

sub parse_item {
  my $Self = shift;
  my $items = shift;
  my $header_offset = shift @$items;
  my $header_size = shift @$items;
  my $content_offset = shift @$items;
  my $content_size = shift @$items;
  my $encoding = shift @$items;
  my $length = ($encoding >> 16);
  $encoding &= 0xff;
  my $charset = $length;
  if ($Self->{version} >= 4) {
    if ($length) {
      my $str = pack('N*', @$items);
      $charset = substr($str, 0, $length, '');
      $charset =~ s/\0+$//;
      @$items = unpack('N*', $str);
    }
  }
  my $sha1 = '';
  if ($Self->{version} >= 5) {
    $sha1 = unpack('h*', pack('N*', splice(@$items, 0, 5)));
  }
  my $decode_size = 0;
  if ($Self->{version} >= 8) {
    $decode_size = shift @$items;
  }
  my $content_lines = 0;
  if ($Self->{version} >= 9) {
    $content_lines = shift @$items;
  }
  return "($header_offset:$header_size $content_offset:$content_size $encoding/$charset/$sha1)";
}

1;
