#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use JSON::PP;
use MIME::Base64 qw(encode_base64 decode_base64);
use Digest::SHA qw(sha256_hex);
use File::Path qw(make_path);
use File::Temp qw(tempdir tempfile);
use Fcntl qw(:flock);
use File::Spec;
use Getopt::Long qw(GetOptionsFromArray);
use IPC::Open3;

umask 0077;
my $user_home = $ENV{HOME} || $ENV{USERPROFILE} || die "HOME not set\n";
my $DIR = "$user_home/.pubkey-chat";
my $CFG = "$DIR/config.json";
my $DATA = $ENV{PUBKEY_DATA_URL} || 'https://data.pubkey.chat';
my $API = $ENV{PUBKEY_API_URL} || 'https://api.pubkey.chat';
my $JSON = JSON::PP->new->canonical(1)->utf8(1);
sub loadfile {
  my ($path) = @_;
  open my $f, '<:raw', $path or die "read $path: $!\n";
  local $/; my $s = <$f>; close $f; return $s;
}
sub savefile {
  my ($path, $value) = @_;
  my ($volume, $directory) = File::Spec->splitpath($path);
  my ($file, $temporary) = tempfile('.pubkey-XXXXXX', DIR => $directory, UNLINK => 1);
  binmode $file;
  print {$file} $value or die "write $path: $!\n";
  close $file or die "close $path: $!\n";
  rename $temporary, $path or die "rename $path: $!\n";
}
sub assert_hash {
  die "invalid hash\n" unless defined($_[0]) && !ref($_[0]) && $_[0] =~ /\A[0-9a-f]{64}\z/;
  return $_[0];
}
sub unbase64 {
  my ($value) = @_;
  die "invalid base64\n" unless defined($value) && !ref($value) &&
    $value =~ /\A(?:[A-Za-z0-9+\/]{4})*(?:[A-Za-z0-9+\/]{2}==|[A-Za-z0-9+\/]{3}=)?\z/;
  my $decoded = decode_base64($value);
  die "noncanonical base64\n" unless encode_base64($decoded, '') eq $value;
  return $decoded;
}
sub envelope_payload {
  my ($raw) = @_;
  die "envelope too large\n" if length($raw) > 120000;
  my $envelope = parse($raw);
  die "invalid envelope\n" unless ref($envelope) eq 'HASH';
  my $signed = unbase64($envelope->{payload_b64});
  my $signature = unbase64($envelope->{signature_b64});
  die "payload too large\n" if length($signed) > 65536;
  my $payload = parse($signed);
  die "invalid payload\n" unless ref($payload) eq 'HASH' && ($payload->{v} // 0) == 1;
  return ($payload, $signed, $signature);
}
sub json { $JSON->encode($_[0]) }
sub parse { $JSON->decode($_[0]) }
sub assert_addr {
  my ($a) = @_;
  die "address must be lowercase username\@github.com or username\@gitlab.com\n"
    unless defined($a) && !ref($a) && $a =~ /\A[a-z0-9][a-z0-9_.-]{0,62}\@(github|gitlab)\.com\z/;
  return $a;
}
sub run { system(@_) == 0 or die "command failed: $_[0]\n" }
sub command_exists {
  my ($name) = @_;
  for my $d (File::Spec->path()) {
    for my $suffix ('', '.exe') {
      return 1 if -x File::Spec->catfile($d, $name . $suffix);
    }
  }
  return 0;
}
sub temporary { tempdir('pubkey-XXXXXX', TMPDIR => 1, CLEANUP => 1) }
sub ensure_dir { make_path($DIR, { mode => 0700 }) unless -d $DIR; chmod 0700, $DIR or die "chmod $DIR: $!\n" }
sub config { -f $CFG or die "run: pubkey init <your-address> --ssh-key <path>\n"; my $cfg = parse(loadfile($CFG)); assert_addr($cfg->{identity}); return $cfg }
sub https_parts {
  my ($url) = @_;
  $url =~ m{\Ahttps://([A-Za-z0-9.-]+)(/[^\x00-\x20\x7f]*)\z} or die "invalid HTTPS URL\n";
  return ($1, $2);
}
sub unchunk {
  my ($in) = @_;
  my $out = '';
  while (1) {
    $in =~ s/\A([^\r\n]*)\r\n// or die "bad chunk length\n";
    my ($size) = $1 =~ /^([0-9A-Fa-f]+)(?:;.*)?$/ or die "bad chunk header\n";
    my $n = hex($size);
    if ($n == 0) {
      die "bad chunk trailer\n" unless $in =~ /\A(?:[A-Za-z0-9-]+:[^\r\n]*\r\n)*\r\n\z/;
      return $out;
    }
    die "bad chunk body\n" if length($in) < $n + 2;
    $out .= substr($in, 0, $n, '');
    substr($in, 0, 2, '') eq "\r\n" or die "bad chunk terminator\n";
  }
}
sub nc_request {
  my ($method, $url, $body) = @_;
  my ($host, $path) = https_parts($url);
  my $pid = open3(my $w, my $r, '>&STDERR', 'nc', '-c', '-N', '-w', '20', $host, '443');
  binmode($w); binmode($r);
  my $request = "$method $path HTTP/1.0\r\nHost: $host\r\nConnection: close\r\nAccept-Encoding: identity\r\n";
  if ($method eq 'POST') {
    $request .= 'Content-Type: application/json' . "\r\n";
    $request .= 'Content-Length: ' . length($body) . "\r\n";
  }
  print {$w} $request, "\r\n", ($method eq 'POST' ? $body : ''); close $w;
  my $raw = '';
  while (1) {
    my $length = read($r, my $chunk, 8192);
    if (!defined($length) || length($raw) + $length > 1048576) {
      kill 'TERM', $pid;
      close $r; waitpid($pid, 0);
      die "HTTP response unreadable or too large\n";
    }
    last if $length == 0;
    $raw .= $chunk;
  }
  close $r; waitpid($pid, 0);
  die "TLS connection failed\n" if $? != 0;
  return parse_http_response($raw);
}
sub parse_http_response {
  my ($raw) = @_;
  $raw =~ s/\AHTTP\/1\.[01] (\d{3})[^\r\n]*\r\n((?:[^\r\n]+\r\n)*)\r\n//
    or die "bad HTTP response\n";
  my ($code, $headers) = ($1, $2);
  my @transfer = $headers =~ /^Transfer-Encoding:[ \t]*([^\r\n]*)/gim;
  my @length = $headers =~ /^Content-Length:[ \t]*([^\r\n]*)/gim;
  die "ambiguous HTTP framing\n" if @transfer > 1 || @length > 1 || (@transfer && @length);
  if (@transfer) {
    die "unsupported transfer encoding\n" unless $transfer[0] =~ /\Achunked[ \t]*\z/i;
    $raw = unchunk($raw);
  }
  if (@length) {
    die "bad HTTP content length\n" unless $length[0] =~ /\A[0-9]+[ \t]*\z/ && length($raw) == 0 + $length[0];
  }
  return ($code + 0, $raw);
}
sub http {
  my ($method, $url, $body) = @_;
  https_parts($url);
  if (command_exists('curl')) {
    my $tmp = temporary();
    my $out = "$tmp/out"; my $code = "$tmp/code";
    my @args = ('curl', '--disable', '--silent', '--show-error', '--max-time', '20',
      '--max-filesize', '1048576', '--proto', '=https', '-o', $out, '-w', '%{http_code}');
    if ($method eq 'POST') {
      savefile("$tmp/body", $body);
      push @args, '-X', 'POST', '-H', 'Content-Type: application/json', '--data-binary', "\@$tmp/body";
    }
    push @args, $url;
    open my $saved, '>&', \*STDOUT or die $!;
    open STDOUT, '>:raw', $code or die $!;
    my $rc = system(@args);
    open STDOUT, '>&', $saved or die $!;
    close $saved;
    die "curl failed: $url\n" if $rc != 0;
    return (0 + loadfile($code), loadfile($out));
  }
  return nc_request($method, $url, $body) if command_exists('nc');
  die "No HTTPS transport: need curl or OpenBSD nc -c\n";
}
sub get {
  my ($url, $missing_ok) = @_;
  my ($code, $body) = http('GET', $url);
  return undef if $code == 404 && $missing_ok;
  die "GET $url: HTTP $code\n" if $code != 200;
  return $body;
}
sub post {
  my ($path, $body) = @_;
  my ($code, $resp) = http('POST', "$API$path", $body);
  die "POST $path: HTTP $code: $resp\n" unless $code >= 200 && $code < 300;
  return parse($resp);
}
sub sign {
  my ($payload, $namespace, $sshkey) = @_;
  my $tmp = temporary();
  savefile("$tmp/payload", json($payload));
  run('ssh-keygen', '-Y', 'sign', '-n', $namespace, '-f', $sshkey, "$tmp/payload");
  return json({ payload_b64 => encode_base64(loadfile("$tmp/payload"), ''),
                signature_b64 => encode_base64(loadfile("$tmp/payload.sig"), '') });
}
sub verify {
  my ($outer_bytes, $who, $namespace) = @_;
  assert_addr($who);
  my ($payload, $payload_raw, $signature) = envelope_payload($outer_bytes);
  my ($u, $provider) = split /\@/, $who;
  my $keys = get("https://$provider/$u.keys", 0);
  my $allowed = join '', map {
    my ($kind, $key) = split /\s+/, $_;
    defined($key) && $kind eq 'ssh-ed25519' ? "$who $kind $key\n" : '';
  } split /\r?\n/, $keys;
  die "No supported Ed25519 keys for $who\n" unless length($allowed);
  my $tmp = temporary();
  savefile("$tmp/signers", $allowed);
  savefile("$tmp/payload", $payload_raw);
  savefile("$tmp/sig", $signature);
  open my $in, '<:raw', "$tmp/payload" or die $!;
  open my $saved, '<&', \*STDIN or die $!;
  open STDIN, '<&', $in or die $!;
  open my $saved_out, '>&', \*STDOUT or die $!;
  open STDOUT, '>&', \*STDERR or die $!;
  my $rc = system('ssh-keygen', '-Y', 'verify', '-n', $namespace,
                  '-f', "$tmp/signers", '-I', $who, '-s', "$tmp/sig");
  open STDOUT, '>&', $saved_out or die $!;
  close $saved_out;
  open STDIN, '<&', $saved or die $!;
  close $saved;
  die "Signature verification failed for $who\n" if $rc != 0;
  return $payload;
}
sub profile_url { "$DATA/profiles/$_[0]/encryption-key.json" }
sub state_path { "$DIR/inbox.json" }
sub read_state { -f state_path() ? parse(loadfile(state_path())) : { cursor => undef, pending => {}, read => {} } }
sub write_state { savefile(state_path(), json($_[0])) }
sub initialize {
  my @args = @_;
  my $who = assert_addr(shift @args);
  my $sshkey = "$user_home/.ssh/id_ed25519";
  GetOptionsFromArray(\@args, 'ssh-key=s' => \$sshkey) or die "bad options\n";
  die "unexpected arguments\n" if @args;
  ensure_dir();
  die "$CFG exists; refusing to overwrite local private key\n" if -e $CFG;
  my $private = "$DIR/encryption-private.pem";
  my $cert = "$DIR/encryption-cert.pem";
  my $profile_path = "$DIR/encryption-profile.json";
  run('openssl', 'genpkey', '-algorithm', 'RSA', '-pkeyopt', 'rsa_keygen_bits:3072',
      '-aes-256-cbc', '-out', $private) unless -e $private;
  chmod 0600, $private;
  run('openssl', 'req', '-new', '-x509', '-sha256', '-days', '3650',
      '-key', $private, '-out', $cert, '-subj', '/CN=pubkey-chat') unless -e $cert;
  my $payload = { v => 1, type => 'encryption-key', recipient => $who,
                  cert_pem => loadfile($cert) };
  my $env = -f $profile_path ? loadfile($profile_path) : sign($payload, 'profile@pubkey.chat', $sshkey);
  my ($stored_profile) = envelope_payload($env);
  die "existing profile does not match identity or certificate\n" unless
    $stored_profile->{recipient} eq $who && $stored_profile->{cert_pem} eq loadfile($cert);
  savefile($profile_path, $env);
  my ($status, $response) = http('POST', "$API/v1/encryption-keys", $env);
  if ($status == 409) {
    die "a different profile is already published\n" unless get(profile_url($who), 0) eq $env;
  } elsif ($status != 201) { die "profile publication failed: HTTP $status\n"; }
  my $resp = { profile => "profiles/$who/encryption-key.json" };
  savefile($CFG, json({ identity => $who, ssh_key => $sshkey }));
  print "Published encryption profile: $resp->{profile}\n";
}
sub send_message {
  my @args = @_;
  my $to = assert_addr(shift @args);
  my $file = '-';
  GetOptionsFromArray(\@args, 'file=s' => \$file) or die "bad options\n";
  die "unexpected arguments\n" if @args;
  my $cfg = config(); my $tmp = temporary();
  my $profile_bytes = get(profile_url($to), 0);
  my $profile = verify($profile_bytes, $to, 'profile@pubkey.chat');
  die "wrong profile recipient\n" if $profile->{recipient} ne $to || $profile->{type} ne 'encryption-key' || !defined($profile->{cert_pem});
  savefile("$tmp/recipient.crt", $profile->{cert_pem});
  my $plaintext;
  if ($file eq '-') { binmode STDIN; local $/; $plaintext = <STDIN>; }
  else { $plaintext = loadfile($file); }
  $plaintext //= '';
  die "plaintext too large\n" if length($plaintext) > 32768;
  savefile("$tmp/plaintext", $plaintext);
  run('openssl', 'cms', '-encrypt', '-binary', '-aes256', '-in', "$tmp/plaintext",
      '-outform', 'DER', '-out', "$tmp/cipher.der", "$tmp/recipient.crt");
  my $payload = { v => 1, type => 'skeet', sender => $cfg->{identity}, recipient => $to,
    recipient_key_sha256 => sha256_hex($profile_bytes),
    ciphertext_b64 => encode_base64(loadfile("$tmp/cipher.der"), '') };
  my $env = sign($payload, 'skeet@pubkey.chat', $cfg->{ssh_key});
  my $resp = post('/v1/skeets', $env);
  print "Accepted skeet: $resp->{id}\n";
}
sub check_inbox {
  my @args = @_;
  die "unexpected arguments\n" if @args;
  my $cfg = config(); my $who = $cfg->{identity}; my $state = read_state();
  my $rawhead = get("$DATA/inboxes/$who/head.json", 1);
  if (defined $rawhead) {
    my $head = parse($rawhead);
    die "invalid inbox HEAD\n" unless ($head->{v} // 0) == 1;
    my $tip = assert_hash($head->{latest});
    my $cur = $tip;
    my %walk;
    while ($cur && (!$state->{cursor} || $cur ne $state->{cursor})) {
      die "invalid publication ID\n" unless $cur =~ /^[0-9a-f]{64}$/;
      die "publication cycle\n" if $walk{$cur}++;
      die "inbox walk limit exceeded\n" if keys(%walk) > 10000;
      my $raw = get("$DATA/publications/$cur.json", 1);
      last unless defined $raw;
      die "publication hash mismatch\n" if sha256_hex($raw) ne $cur;
      my $p = parse($raw);
      die "invalid publication\n" unless ($p->{v} // 0) == 1 && $p->{recipient} eq $who;
      assert_addr($p->{sender});
      assert_hash($p->{skeet});
      assert_hash($p->{parent}) if defined $p->{parent};
      $state->{pending}{$p->{skeet}} ||= { sender => $p->{sender}, pub => $cur };
      $cur = $p->{parent};
    }
    $state->{cursor} = $tip if $tip;
  }
  for my $id (keys %{$state->{pending}}) {
    delete $state->{pending}{$id} if $state->{read}{$id};
  }
  write_state($state);
  my %counts;
  for my $p (values %{$state->{pending}}) { $counts{$p->{sender}}++; }
  print "New senders (unverified until skeets are fetched):\n";
  for my $who (sort keys %counts) { printf "%-36s %d skeet(s)\n", $who, $counts{$who}; }
  print "No pending skeets.\n" unless keys %counts;
}
sub read_messages {
  my @args = @_;
  my $wanted = assert_addr(shift @args);
  die "unexpected arguments\n" if @args;
  my $cfg = config(); my $state = read_state();
  for my $id (sort keys %{$state->{pending}}) {
    my $hint = $state->{pending}{$id};
    next unless $hint->{sender} eq $wanted;
    die "invalid skeet hash\n" unless $id =~ /^[0-9a-f]{64}$/;
    my $raw = get("$DATA/skeets/$id.json", 1);
    next unless defined $raw;
    die "skeet hash mismatch\n" if sha256_hex($raw) ne $id;
    my $p = verify($raw, $wanted, 'skeet@pubkey.chat');
    die "sender or recipient mismatch\n" unless $p->{type} eq 'skeet' && $p->{sender} eq $wanted && $p->{recipient} eq $cfg->{identity};
    assert_hash($p->{recipient_key_sha256});
    die "recipient profile mismatch\n" unless $p->{recipient_key_sha256} eq sha256_hex(loadfile("$DIR/encryption-profile.json"));
    my $tmp = temporary();
    savefile("$tmp/cipher.der", unbase64($p->{ciphertext_b64}));
    run('openssl', 'cms', '-decrypt', '-binary', '-inform', 'DER',
      '-in', "$tmp/cipher.der", '-recip', "$DIR/encryption-cert.pem",
      '-inkey', "$DIR/encryption-private.pem", '-out', "$tmp/plaintext");
    print "--- $wanted [$id] ---\n", loadfile("$tmp/plaintext"), "\n";
    $state->{read}{$id} = 1;
    delete $state->{pending}{$id};
    write_state($state);
  }
}
sub main {
  my ($command, @args) = @_;
  $command //= '';
  my %commands = (init => \&initialize, send => \&send_message, inbox => \&check_inbox, read => \&read_messages);
  if (my $run = $commands{$command}) {
    ensure_dir();
    open my $lock, '>>', "$DIR/lock" or die "lock: $!\n";
    flock($lock, LOCK_EX) or die "lock: $!\n";
    $run->(@args);
    return 0;
  }
  print STDERR <<'USAGE';
Usage:
  pubkey init you@github.com --ssh-key ~/.ssh/id_ed25519
  echo 'hello' | pubkey send recipient@gitlab.com
  pubkey send recipient@github.com --file message.txt
  pubkey inbox
  pubkey read sender@github.com
USAGE
  return 2;
}

exit main(@ARGV) unless caller;
1;