#!/usr/bin/perl

package gcrypt;

######################################################################
#                                                                    #
#    Domero Safe Key and Data Interchange                            #
#    (C) 2019 Domero, All rights reserved                            #
#                                                                    #
#    Clients generates key to be used (Km)                           #
#    Client encodes Km with private keys Kc,Kr to Kr(Km,Kc)          #
#    Server encodes (Km,Kc) with private keys Ks,Kq                  #
#      to doublelocked key Kq(Kr(Km,Kc),Ks)                          #
#    Client unlocks doublelocked key with Kc,Kr to Kq(Km,Ks)         #
#    Server unlocks key Kq(Km,Ks) with Ks,Kq to Km.                  #
#                                                                    #
######################################################################

use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Crypt::Ed25519;
use Digest::SHA qw(sha512);
use JSON qw(decode_json encode_json);
use gclient;
use gserv;
use gerr qw(error trace);

$VERSION     = '1.1.1';
@ISA         = qw(Exporter);
@EXPORT      = qw(createkey scramblekey sendkey doublelock freelock unlock crypt iscrypt);
@EXPORT_OK   = qw(makejson hexoct octhex);

my $cpu32 = (~0 == 4294967295);

1;

sub createkey {
  my ($pubkey, $privkey) = Crypt::Ed25519::generate_keypair;
  return $privkey
}

sub scramblekey {
  # 64 bit CPU-mode only!
  if ($cpu32) { return scramblekey32(@_) }
  my ($shared,$private,$fkey) = @_;
  my @plist=unpack('Q*',$private);
  my @flist=unpack('Q*',$fkey);
  my $key=""; my $i=0;
  for my $c (unpack('Q*',$shared)) {
    my $x = $c ^ $plist[$i];
    $key.=pack('Q',(($x & ~$flist[$i]) | (~$x & $flist[$i])));
    $i++
  }
  return $key
}

sub scramblekey32 {
  # 32 bit CPU-mode only!
  my ($shared,$private,$fkey) = @_;
  my @plist=unpack('N*',$private);
  my @flist=unpack('N*',$fkey);
  my $key=""; my $i=0;
  for my $c (unpack('N*',$shared)) {
    my $x = $c ^ $plist[$i];
    $key.=pack('N',(($x & ~$flist[$i]) | (~$x & $flist[$i])));
    $i++
  }
  return $key
}

sub makejson {
  return JSON->new->encode($_[0]);
}

sub senddata {
  my ($client,$out) = @_;
  if ($client->{serverport}) {
    if ($client->{websockets}) {
      gserv::wsmessage($client,$out,'binary')
    } else {
      gserv::out($client,$out)
    }
  } else {
    if ($client->{websocket}) {
      gclient::wsout($client,$out,'binary')
    } else {
      gclient::out($client,$out)
    }
  }
}

sub sendkey {
  my ($client) = @_;
  $client->{encryptkey}=createkey();
  $client->{randomizer}=createkey();
  $client->{privatekey}=createkey();
  $client->{functionkey}=createkey();
  my $skey = octhex(scramblekey($client->{encryptkey},$client->{privatekey},$client->{functionkey}));
  my $fkey = octhex(scramblekey($client->{randomizer},$client->{privatekey},$client->{functionkey}));
  senddata($client,makejson({ command => 'singlelock', key => $skey, fkey => $fkey }))
}

sub doublelock {
  my ($client,$singlelock,$randomizer) = @_;
  $client->{privatekey}=createkey();
  $client->{functionkey}=createkey();
  my $slkey = hexoct($singlelock);
  my $slfkey = hexoct($randomizer);
  my $dlkey = octhex(scramblekey($slkey,$client->{privatekey},$client->{functionkey}));
  my $dlfkey = octhex(scramblekey($slfkey,$client->{privatekey},$client->{functionkey}));
  senddata($client,makejson({ command => 'doublelock', key => $dlkey, fkey => $dlfkey }))
}

sub freelock {
  my ($client,$doublelock,$randomizer) = @_;
  my $dlkey = hexoct($doublelock);
  my $dlfkey = hexoct($randomizer);
  my $unlocked = octhex(scramblekey($dlkey,$client->{privatekey},$client->{functionkey}));
  my $runlocked = octhex(scramblekey($dlfkey,$client->{privatekey},$client->{functionkey}));
  senddata($client,makejson({ command => 'unlocked', key => $unlocked, fkey => $runlocked }))
}

sub unlock {
  my ($client,$unlocked,$randomizer) = @_;
  my $lkey = hexoct($unlocked);
  my $lfkey = hexoct($randomizer);
  $client->{encryptkey} = scramblekey($lkey,$client->{privatekey},$client->{functionkey});
  $client->{randomizer} = scramblekey($lfkey,$client->{privatekey},$client->{functionkey});
}

sub iscrypt {
  my ($data) = @_;
  return (substr($data,0,4) eq 'DSKE')
}

sub crypt {
  # EXTREME strong encoding
  my ($client,$data,$nosend,$forceencode) = @_;
  my $decode=(substr($data,0,4) eq 'DSKE'); my $ofs=0;
  if ($forceencode) { $decode=0 }
  my $datalen=length($data)-8*$decode; my $orglen=$datalen;
  if ($decode) {
    $orglen=unpack('N',substr($data,4,4)); $ofs=8;
    my $rest=$orglen % 64; if ($rest) { $rest=64-$rest }
    if ($orglen+$rest != $datalen) {
      # Found size ($len) different from actual size ($datalen)
      return undef
    }
  } elsif ($datalen > 16777216) {
    error("GCrypt::Crypt(Encoder): Datalength exceeds 16Mb.")
  }
  my $sha=sha512($client->{encryptkey});
  my $scram; my $kscram;
  if ($datalen > 4096) {
    $scram=sha512($client->{randomizer});
    if ($datalen > 262144) {
      $kscram=sha512($sha.$scram);
    }
  }
  my $dataoffset=unpack('n',substr($sha,0,2)) % $orglen;
  if (!$decode) { $ofs+=$dataoffset }
  # add padding to get 64 byte granularity
  my $rest=$datalen % 64;
  if ($rest) { $data.=chr(0)x(64-$rest); $datalen+=64-$rest }
  my $nb = $datalen >> 6; my $out=""; my $dat;
  my $filter = $client->{randomizer};
  for my $b (1..$nb) {
    if (!$decode && ($ofs+64>$datalen)) {
      my $rest=64+$ofs-$datalen;
      $dat=substr($data,$ofs).substr($data,0,$rest); $ofs=$rest
    } else {
      $dat=substr($data,$ofs,64); $ofs+=64
    }
    $out.=scramblekey($dat,$client->{encryptkey},$filter);
    $filter=substr($filter,1).substr($filter,0,1);
    if ($b % 64 == 0) {
      # every 4Kb -> new filter (all used up), filter = 64 bytes * 4Kb = max 256Kb
      if ($b % 4096 == 0) {
        # every 256Kb -> new scram (all used up), kscram = 64 bytes * 256Kb = 16Mb
        my @sl=unpack('N*',$kscram); my $ns=""; my $i=0;
        for my $f (unpack('N*',$scram)) {
          $ns.=pack('N',$f ^ $sl[$i]); $i++
        }
        $scram=$ns;
        $kscram=substr($kscram,1).substr($kscram,0,1);
      }
      $filter=""; my $i=0;
      my @sl=unpack('N*',$scram);
      for my $f (unpack('N*',$client->{randomizer})) {
        $filter.=pack('N',$f ^ $sl[$i]); $i++
      }
      $scram=substr($scram,1).substr($scram,0,1);
    }
  }
  # add header
  if ($decode) {
    # delete encoded zeros padding ( = garbage) and re-adjust data for dataoffset
    $out=substr($out,$datalen-$dataoffset).substr($out,0,$orglen-$dataoffset)
  } else {  
    $out='DSKE'.pack('N',$orglen).$out
  }
  # delete added zeros
  if ($decode || $nosend) {
    return $out
  } else {
    senddata($client,$out)
  }
}

sub octhex {
  my ($key) = @_;
  if (!defined $key) { return "" }
  my $hex;
  for (my $i=0;$i<length($key);$i++) {
    my $c=ord(substr($key,$i,1));
    $hex.=sprintf('%02X',$c);
  }
  return $hex  
}

sub hexoct {
  my ($hex) = @_;
  if (!defined $hex) { return "" }
  my $key="";
  for (my $i=0;$i<length($hex);$i+=2) {
    my $h=substr($hex,$i,2);
    $key.=chr(hex($h));
  }
  return $key
}

# EOF gcrypt.pm (C) 2019 Chaosje, Domero