#!/usr/bin/env perl
our $VERSION = '0.000001';
use strict;
use warnings;
use v5.20.0;
use experimental 'signatures';

use Crypt::Sodium::XS;
use Crypt::Sodium::XS::MemVault;
use Crypt::Sodium::XS::ProtMem 'protmem_flags_decrypt_default';
use Crypt::Sodium::XS::Util qw(sodium_random_bytes);
use Fcntl qw(O_CREAT O_EXCL O_TRUNC O_RDONLY O_RDWR O_WRONLY);
use Getopt::Long qw(:config gnu_getopt);

use constant CSXS_MAGIC_FORMAT => 'A4CCA2CCS<';
use constant CSXS_MAGIC_LEN => 12;
use constant CSXS_MAGIC_FIELDS => [qw[
  magic_bytes
  version
  opts
  reserved_1
  hash_primitive
  sstream_primitive
  bufksize
]];
use constant CSXS_OPTFLAG_PAD_LAST_BLOCK => 1;

# csxs magic
#  4 bytes "CSXS"
#  1 bytes version
#  1 bytes option flags
#  2 bytes RESERVED
#  1 bytes hash primitive
#  1 bytes secretstream primitive
#  2 bytes LE bufsize in kilobytes
# algorithm-specific; but for the only ones supported:
# 16 bytes pwhash salt
#  8 bytes opslimit
#  8 bytes memlimit
# 24 bytes secretstream header
#
# 68 total

# written blocks are 4096 bufsize + 17 abytes = 4113

# opts flags
# 00000000
# ||||||||--- 1   use padding
# |||||||---- 2   RESERVED
# ||||||----- 4   RESERVED
# |||||------ 8   RESERVED
# ||||------- 16  RESERVED
# |||-------- 32  RESERVED
# ||--------- 64  RESERVED
# |---------- 128 RESERVED

# hardcoded primitives, can be added to in future with header values.
my $pwhash = Crypt::Sodium::XS->pwhash(primitive => 'argon2id');
my $sstream = Crypt::Sodium::XS->secretstream(primitive => 'xchacha20poly1305');

sub usage {
  print STDERR "@_\n" if @_;
  print STDERR <<'EOUSAGE';
usage:
  csxs-ppcrypt -h
  csxs-ppcrypt -D [-f] <infile> <outfile>
  csxs-ppcrypt -E [-f] [-p] <infile> <outfile>

  actions:
    -h        print this help message and exit
    -D        decrypt
    -E        encrypt

  options:
    -f        force; overwrite an existing <outfile>
    -p        pad; ISO/IEC 7816-4 padding on final block
  arguments:
    <infile>  path to input file, or '-' for stdin
    <outfile> path to output file, or '-' for stdout
EOUSAGE
  exit 1 if @_;
  exit 0;
}

sub make_file_magic($opts) {
  return +{
    magic_bytes => 'CSXS',
    version => 1,
    opts => ($opts->{pad} ? CSXS_OPTFLAG_PAD_LAST_BLOCK : 0),
    hash_primitive => 1,
    sstream_primitive => 0,
    bufksize => 4,
  };
}

sub parse_file_magic($str) {
  my %magic;
  @magic{@{;CSXS_MAGIC_FIELDS}} = unpack(CSXS_MAGIC_FORMAT, $str);
  return \%magic;
}

sub stringify_file_magic($magic) {
  local $magic->{reserved_1} = "\0\0";
  return pack(CSXS_MAGIC_FORMAT, @$magic{@{;CSXS_MAGIC_FIELDS}});
}

sub verify_file_magic($magic) {
  die "invalid magic: bad magic bytes" unless $magic->{magic_bytes} eq 'CSXS';
  die "invalid magic: incompatible version $magic->{version}" unless $magic->{version} == 1;
  # only padding supported currently
  die "invalid magic: invalid opts" if $magic->{opts} != 0 and $magic->{opts} != 1;
  die "invalid magic: invalid hash primitive" if $magic->{hash_primitive} != 1;
  die "invalid magic: invalid sstream primitive" if $magic->{sstream_primitive} != 0;
  # hardcoded
  $magic->{bufksize} ||= 4; # REMOVEME: legacy format did not have bufsize.
  die "invalid magic: invalid bufsize" if $magic->{bufksize} != 4;
  return $magic;
}

sub open_handles($opts) {
  my ($ifh, $ofh);
  my ($infile, $outfile) = @{$opts}{qw{infile outfile}};

  if ($infile eq '-' and !$outfile) {
    die "reading from stdin requires -o <outfile>";
  }
  unless ($outfile) {
    if ($opts->{decrypt}) {
      $outfile = $infile;
      unless ($outfile =~ s/\.csxspp\z//) {
        die "cannot determine output filename from input filename. use -o <outfile>.";
      }
    }
    else {
      $outfile = "$infile.csxspp";
    }
  }
  if ($outfile ne '-' and -e $outfile and !$opts->{force}) {
    die "<outfile> '$outfile' exists. use -f to overwrite";
  }

  if ($infile eq '-') {
    $ifh = \*STDIN;
  }
  else {
    if ($opts->{encrypt}) {
      sysopen($ifh, $infile, O_RDONLY) or die "sysopen: $infile: $!";
      binmode($ifh, ":raw") or die "binmode: $infile: $!";
    }
    else {
      open($ifh, "<:raw", $infile) or die "open: $infile: $!";
    }
  }

  my $omode = 0644;
  $omode = 0600 if $opts->{decrypt};
  if ($outfile eq '-') {
    $ofh = \*STDOUT;
  }
  else {
    my $flags = O_CREAT|O_TRUNC|O_WRONLY;
    $flags |= O_EXCL unless $opts->{force};
    sysopen($ofh, $outfile, $flags, $omode) or die "open: $outfile: $!";
    binmode($ofh, ":raw") or die "binmode: $outfile: $!";
  }
  if ($opts->{encrypt} and !$opts->{force} and -t $ofh) {
    die "cowardly refusing to encrypt to a tty. use -f to override";
  }

  return ($ifh, $ofh);
}

sub decrypt($ifh, $ofh, $opts) {
  # CSXS header
  my $magic_len = CSXS_MAGIC_LEN;
  my $salt_len = $pwhash->SALTBYTES;
  my $header_len = $magic_len + $salt_len + 16; # opslimit 8 memlimit 8
  my $r = read($ifh, my $header, $header_len);
  die "read: $!" unless defined($r);
  die "read: unexpected EOF reading header (expected: $header_len got: $r)" unless $r == $header_len;
  my ($magic, $salt, $opslimit, $memlimit) = unpack("a${magic_len}a${salt_len}Q<2", $header);
  $magic = verify_file_magic(parse_file_magic($magic));
  unless ($memlimit >= $pwhash->MEMLIMIT_MIN and $memlimit <= $pwhash->MEMLIMIT_MAX) {
    die "read: bad header (invalid memlimit $memlimit)";
  }
  unless ($opslimit >= $pwhash->OPSLIMIT_MIN and $opslimit <= $pwhash->OPSLIMIT_MAX) {
    die "read: bad header (invalid opslimit $memlimit)";
  }
  my $key = $pwhash->pwhash($opts->{passphrase}, $salt, $sstream->KEYBYTES, $opslimit, $memlimit);

  # secretstream header
  $r = read($ifh, $header, $sstream->HEADERBYTES) or die "read: $!";
  die "read: $!" unless defined($r);
  die "read: short stream header" unless $r == $sstream->HEADERBYTES;

  my $stream_dec = $sstream->init_decrypt($header, $key);
  my $tag = -1;
  my $buf;
  my $bufsize = $magic->{bufksize} * 1024;
  my $decrypt_bufsize = $bufsize + $sstream->ABYTES;
  while ($r = read($ifh, $buf, $decrypt_bufsize)) {
    if ($tag == $sstream->TAG_FINAL) {
      die "extra data after end-of-stream";
    }
    (my $plaintext, $tag) = $stream_dec->decrypt($buf);
    if ($tag == $sstream->TAG_FINAL
        && $magic->{opts} & CSXS_OPTFLAG_PAD_LAST_BLOCK) {
      $plaintext = $plaintext->unpad($bufsize);
    }
    $plaintext->to_fd(fileno($ofh));
  }
  die "read: $!" unless defined($r);
  die "missing end-of-stream" unless $tag == $sstream->TAG_FINAL;
}

sub encrypt($ifh, $ofh, $opts) {
  my $salt_len = $pwhash->SALTBYTES;
  my $salt = sodium_random_bytes($salt_len);
  # TODO: make memlimit/opslimit choosable. accept low, med*, high, or number
  my $opslimit = $pwhash->OPSLIMIT_MODERATE;
  my $memlimit = $pwhash->MEMLIMIT_MODERATE;
  my $key = $pwhash->pwhash($opts->{passphrase}, $salt, $sstream->KEYBYTES, $opslimit, $memlimit);
  # write as static string because only one version and primitive supported
  my $magic = make_file_magic($opts);
  my $file_magic = stringify_file_magic($magic);
  syswrite($ofh, $file_magic . pack("a${salt_len}Q<2", $salt, $opslimit, $memlimit)) or die "write: $!";

  my ($header, $stream_enc) = $sstream->init_encrypt($key);
  syswrite($ofh, $header) or die "write: $!";
  my $fd = fileno($ifh);
  # what follows is tricky. ugly. sorry.
  # writing to output is "one buffer behind" reading from input. this is so the
  # final tag and padding can be put on the last block.
  my $bufsize = $magic->{bufksize} * 1024;
  my $prev_buf = Crypt::Sodium::XS::MemVault->new_from_fd($fd, $bufsize, protmem_flags_decrypt_default());
  while (1) {
    last unless defined $prev_buf;
    my $next_buf;
    if ($prev_buf->size == $bufsize) {
      $next_buf = Crypt::Sodium::XS::MemVault->new_from_fd($fd, $bufsize, protmem_flags_decrypt_default());
      undef $next_buf unless $next_buf->size;
    }
    my $tag = $next_buf ? $sstream->TAG_MESSAGE : $sstream->TAG_FINAL;
    my $this_buf = $next_buf ? $prev_buf
                             : $opts->{pad} ? $prev_buf->pad($bufsize)
                                            : $prev_buf;
    undef $prev_buf;
    my $block = $stream_enc->encrypt($this_buf, $tag);
    syswrite($ofh, $block) or die "write: $!";
    $prev_buf = $next_buf;
  }
}

sub main(@argv) {
  Getopt::Long::GetOptionsFromArray(
    \@argv,
    my $opts = {},
    qw(
      decrypt|D
      encrypt|E
      force|f
      help|h
      pad|p
      version|V
    ),
  ) or usage("Invalid options");

  usage() if $opts->{help};
  print "csxs-ppcrypt $VERSION\n" and exit(0) if $opts->{version};

  if ((grep { $opts->{$_} } qw(decrypt encrypt)) != 1) {
    usage("one (and only one) of -D or -E must be specified");
  }

  $opts->{infile} = shift(@argv);
  $opts->{outfile} = shift(@argv);
  usage("missing <infile>") unless $opts->{infile};
  usage("missing <infile>") unless $opts->{outfile};
  usage("too many arguments") if @argv;

  my ($ifh, $ofh) = open_handles($opts);

  # yes, this intentionally requires opening a controlling tty.
  sysopen(my $ttyfh, "/dev/tty", O_RDWR) or die "sysopen: /dev/tty: $!";
  binmode($ttyfh, ":raw") or die "binmode: $!";
  my $pp = Crypt::Sodium::XS::MemVault->new_from_ttyno(fileno($ttyfh), "Passphrase: ");
  if ($opts->{encrypt}) {
    my $pp_confirm = Crypt::Sodium::XS::MemVault->new_from_ttyno(fileno($ttyfh), "Passphrase (again): ");
    die "passphrases do not match" unless $pp->length == $pp_confirm->length and $pp eq $pp_confirm;
    undef $pp_confirm;
  }
  else {
    die "refusing to use empty passphrase" unless $pp->length;
  }
  $opts->{passphrase} = $pp;

  if ($opts->{decrypt}) {
    decrypt($ifh, $ofh, $opts);
  }
  elsif ($opts->{encrypt}) {
    encrypt($ifh, $ofh, $opts);
  }
  close($ifh) or die "<infile>: close: $!";
  close($ofh) or die "<outfile>: close: $!";
}

main(@ARGV) unless caller;

1;

__END__

=encoding utf8

=head1 NAME

csxs-ppcrypt -- simple passphrase-based encryption and decryption

=head1 SYNOPSIS

  # suggested file name suffix ".csxpp"
  csxs-ppcrypt -E myfile.txt myfile.txt.csxpp
  echo 'some output' | csxs-ppcrypt -E - somefile.txt.csxpp

  csxs-ppcrypt -D myfile.txt.csxspp -
  csxs-ppcrypt -D somedir/somefile otherfile.txt
  curl https://example.com/super_secret | csxs-ppcrypt -D - -

=head1 DESCRIPTION

L<csxs-ppcrypt> encrypts or decrypts data from an input file (or stdin) to an
output file (or stdout).

This is a simple demo program. It's not intended for much real-world use, but
can still be handy. It is meant to be an example of using
L<Crypt::Sodium::XS::secretstream>. Encryption keys are generated from
passphrase input using L<Crypt::Sodium::XS::pwhash>.

=head1 USAGE

  csxs-ppcrypt -h
  csxs-ppcrypt -D [-f] <infile> <outfile>
  csxs-ppcrypt -E [-f] [-p] <infile> <outfile>

  actions:
    -h        print this help message and exit
    -D        decrypt
    -E        encrypt

  options:
    -f        force; overwrite an existing <outfile>
    -p        pad; ISO/IEC 7816-4 padding on final block
  arguments:
    <infile>  path to input file, or '-' for stdin
    <outfile> path to output file, or '-' for stdout

=head1 FILE FORMAT

       4 bytes) magic value "CSXS"
       1 bytes) version number (currently always 1)
       1 bytes) option flags
       2 bytes) RESERVED
       1 bytes) hash primitive id
       1 bytes) secretstream primitive id
       2 bytes) 'bufsize' (blocksize without auth tags) in kilobytes
      16 bytes) salt for pwhash
       8 bytes) opslimit for pwhash
       8 bytes) memlimit for pwhash
      24 bytes) secretstream header
    4113 bytes) 0 or more complete encrypted blocks
                all have tag TAG_MESSAGE
  <=4113 bytes) 1 final block
                must have tag TAG_FINAL
                optionally padded to block size

         no further data is allowed.

=head1 AUTHOR

Brad Barden E<lt>perlmodules@5c30.orgE<gt>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2025 Brad Barden

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut
