path: root/rsaunit.pas

unit rsaunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, gmp, math, crt, mlockunit,
  dcprijndael, dcpmars, dcpblowfish, dcptwofish, dcpserpent, dcpcrypt2,
  dcphaval;

type
  tRSAAction = (raUnk,raGen,raEnc,raDec,raChk,raUpd);
  tEncryptionDirection = (edEnc,edDec);
  tUsedCiphers = (ucRijndael,ucMars,ucBlowfish,ucTwofish,ucSerpent);

  tLockedString = class
  private
    _inh:          pchar;
    memstart:      pointer;
    locked,memlen,
      pagesize:    longint;
    procedure lock;
    procedure unlock;
    procedure wInh(i: pchar);
  public
    constructor create;
    destructor destroy; override;
    procedure assign(ls: tLockedString);
    procedure delete(posi,leng: longint);
    procedure append(s: string);
    function substr(start,leng: longint): string;
    function len: longint;
    function isEqual(s: tLockedString): boolean;
    function teil(num,tot: longint): string; overload;
    function teil(cph: tUsedCiphers): string; overload;
    property inh: pchar
      read _inh
      write wInh;
  end;

  tNextPrimeThread = class(tThread)
    fertig:      byte; // Bit 0: Primzahl gefunden; Bit 1: execute beendet
    myNum:       mpz_t;
    abbruch,
      arbeite:   boolean;
    myStep:      longint;
    cnt:         int64;
    constructor create(num: mpz_t; offset,step: longint);
    destructor destroy; override;
    procedure execute; override;
  end;

function acquireRandomness(bytes: int64): string; // hex-encoded
function nextPrime(var num: mpz_t; threads: longint): boolean;
function nextPrimeSt(var num: mpz_t; step: longint; var keepWorking, abort: boolean; var getestet: int64): boolean; // Prime found?
function importKey(var m,e,d: mpz_t; out version: string; nam: string): byte; // bit 0: enc-Key found; bit 1: dec-Key found
procedure symmetricEncryption(var input: mpz_t; key: tLockedString; direction: tEncryptionDirection; version: string);
function hexdump(arr: array of byte): string; overload;
function hexdump(s: string): string; overload;
procedure readlnblind(out s: tLockedString);
procedure userCallback;
function mydatetimetostr(tm: extended): string;
procedure readNewPassword(var pass: tLockedString; len: int64);
function cpuUtilization: extended;

const
  cipherClasses: array[tUsedCiphers] of class of TDCP_blockcipher =
    (tDCP_Rijndael,tDCP_Mars,tDCP_Blowfish,tDCP_Twofish,tDCP_Serpent);
  ciphNam: array[tUsedCiphers] of string =
    ('Rijndael','Mars','Blowfish','Twofish','Serpent');

implementation

var
  _cpuLastUsed,_cpuLastIdle: int64;

function acquireRandomness(bytes: int64): string;
var
  tf:   file;
  buff: array of byte;
  i,j:  int64;
begin
  write(stderr,'Zufall sammeln ...');
  try
    assignfile(tf,'/dev/random');
    setlength(buff,bytes);
    i:=0;
    j:=0;
    reset(tf,1);
    while i<length(buff) do begin
      blockread(tf,buff[i],(length(buff)-i)*sizeof(buff[0]),j);
      i:=i+j;
      if i<length(buff) then begin
        write(stderr,'.');
        sleep(100);
        userCallback;
      end;
    end;
  finally
    closefile(tf);
  end;
  result:='';
  for i:=0 to length(buff)-1 do
    result:=result+inttohex(buff[i],2);
  writeln(stderr,' fertig');
end;

function nextPrime(var num: mpz_t; threads: longint): boolean;
// multi threaded
var
  npts:           array of tNextPrimeThread;
  i,cnt,step,
    x,y,penalty:  longint;
  offsets:        array of longint;
  dummy:          mpz_t;
  total:          int64;
  enps,start:     extended;
begin
  mpz_setbit(num,0);
  result:=false;

  setlength(offsets,0);
  step:=0;

  enps:=mpz_sizeinbase(num,2)*ln(2)/2;

  mpz_init(dummy);
  repeat
    cnt:=0;
    for i:=0 to length(offsets)-1 do begin
      mpz_add_ui(dummy,num,offsets[i]);
      if mpz_gcd_ui(dummy,dummy,step)=1 then inc(cnt)
      else offsets[i]:=-1;
    end;
    if cnt<threads then begin // zu wenige wirklich arbeitende Threads?
      setlength(offsets,max(threads,length(offsets)+1));
      for i:=0 to length(offsets)-1 do
        offsets[i]:=i*2;
      step:=2*length(offsets);
    end;
  until cnt>=threads; // genug wirklich arbeitende Threads?
  mpz_clear(dummy);

  if cnt<>threads then
    writeln(stderr,'Genau '+inttostr(threads)+' arbeitende Threads habe ich nicht hinbekommen, daher habe ich auf '+inttostr(cnt)+' Threads erhöht.');

  setlength(npts,cnt);
  cnt:=0;
  for i:=0 to length(npts)-1 do begin
    while (cnt<length(offsets)) and (offsets[cnt]=-1) do
      inc(cnt);
    if cnt>=length(offsets) then
      raise Exception.create('Ich habe mich bei den Threads verzählt (zu viele Threads)!');

    npts[i]:=tNextPrimeThread.create(num,offsets[cnt],step);
    inc(cnt);
  end;

  while (cnt<length(offsets)) and (offsets[cnt]=-1) do
    inc(cnt);

  if cnt<>length(offsets) then
    raise Exception.create('Ich habe mich bei den Threads verzählt (zu wenige Threads)!');

  for i:=0 to length(npts)-1 do
    npts[i].suspended:=false;

  x:=whereX;
  y:=whereY;
  start:=now;
  penalty:=0;
  repeat
    for i:=0 to length(npts)-1 do
      result:=result or odd(npts[i].fertig);
    if not result then begin
      if penalty=0 then sleep(1000)
      else sleep(100);
      total:=0;
      for i:=0 to length(npts)-1 do
        total:=total+npts[i].cnt;

      gotoxy(x,y);
      x:=whereX;
      y:=whereY;
      write(' '+floattostrf(total/enps*100,ffFixed,10,3)+' % ETA: '+mydatetimetostr((now-start)/max(1,total)*enps)+'  ');

      if cpuUtilization > 0.8 then begin
        inc(penalty);
        if penalty>2 then begin
          for i:=0 to length(npts)-1 do
            npts[i].arbeite:=false;
          writeln('Zu hohe Gesamtlast auf der CPU, ich pausiere!');

          repeat
            userCallback;
            sleep(1000);
          until cpuUtilization<0.4;

          penalty:=0;
          writeln('CPU-Last ist wieder gesunken, ich mache weiter!');
          for i:=0 to length(npts)-1 do
            npts[i].arbeite:=true;
        end;
      end
      else penalty:=0;

      userCallback;
    end;
  until result;

  for i:=0 to length(npts)-1 do
    npts[i].abbruch:=true;

  repeat
    result:=true;
    for i:=0 to length(npts)-1 do
      result:=result and odd(npts[i].fertig shr 1);
    if not result then sleep(100);
  until result;

  result:=false;
  for i:=0 to length(npts)-1 do begin
    if (not result) and odd(npts[i].fertig) then begin
      result:=true;
      mpz_set(num,npts[i].myNum);
    end;
    npts[i].free;
  end;
end;

function nextPrimeSt(var num: mpz_t; step: longint; var keepWorking, abort: boolean; var getestet: int64): boolean;
// single threaded
begin
  step:=step+byte(odd(step));
  mpz_setbit(num,0);
  result:=false;

  getestet:=0;
  result:=mpz_probab_prime_p(num,25) > 0;
  while not (abort or result) do begin
    while not keepWorking do
      sleep(100);
    userCallback;
    mpz_add_ui(num,num,step);
    inc(getestet);
    result:=mpz_probab_prime_p(num,25) > 0;
  end;
end;

function importKey(var m,e,d: mpz_t; out version: string; nam: string): byte; // bit 0: enc-Key found; bit 1: dec-Key found
var
  f: textfile;
  s: string;
begin
  assignfile(f,nam);
  reset(f);
  result:=0;
  version:='';
  while not eof(f) do begin
    readln(f,s);
    if pos('Modul: ',s)=1 then begin
      delete(s,1,pos(' ',s));
      s:=trim(s);
      mpz_set_str(m,pchar(s),16);
      result:=result or $04;
      continue;
    end;
    if pos('d-Exponent: ',s)=1 then begin
      delete(s,1,pos(' ',s));
      s:=trim(s);
      mpz_set_str(d,pchar(s),16);
      result:=result or $02;
      continue;
    end;
    if pos('e-Exponent: ',s)=1 then begin
      delete(s,1,pos(' ',s));
      s:=trim(s);
      mpz_set_str(e,pchar(s),16);
      result:=result or $01;
      continue;
    end;
    if pos('Version: ',s)=1 then begin
      delete(s,1,pos(' ',s));
      version:=trim(s);
      continue;
    end;
    writeln(stderr,'Warnung: Unbekannte Zeile in Schlüsseldatei gefunden und ignoriert.');
  end;
  if (result and $04) = 0 then result:=$00
  else result:=result and $03;
  closefile(f);
end;

procedure symmetricEncryption(var input: mpz_t; key: tLockedString; direction: tEncryptionDirection; version: string);
var
  ciphers:      array[tUsedCiphers] of TDCP_blockcipher;
  ciph:         tUsedCiphers;
  i:            longint;
  bs,vNum:      int64;
  inh:          array[boolean] of array of byte;
  curr:         boolean;
  mpLen:        mpz_t;
begin

  if version='' then
    vNum:=0
  else if version='latest' then begin
    vNum:=1;
    version:=inttostr(vNum);
  end
  else
    vNum:=strtoint(version);

  if direction=edEnc then begin
    bs:=input.size*sizeof(input.data^);

    mpz_mul_2exp(input,input,sizeof(bs)*8);
    mpz_add_ui(input,input,bs);
  end;

  mpz_init(mpLen);
  mpz_set_ui(mpLen,1);

  for ciph:=low(tUsedCiphers) to high(tUsedCiphers) do begin
    ciphers[ciph]:=cipherClasses[ciph].Create(nil);
    case vNum of
      0: ciphers[ciph].InitStr(key.teil(ciph),TDCP_haval);
      1: ciphers[ciph].InitStr(key.inh+ciphNam[ciph],TDCP_haval);
    end{of case};
    mpz_lcm_ui(mpLen,mpLen,ciphers[ciph].getBlockSize div 8);
  end;

  bs:=mpz_get_ui(mpLen);
  mpz_clear(mpLen);
  bs:=ceil(bs/(input.size*sizeOf(input.data^)))*input.size*sizeOf(input.data^);

  for curr:=false to true do begin
    setlength(inh[curr],bs);
    fillchar(inh[curr][0],length(inh[curr]),$00);
    move(input.data^,inh[curr][0],min(length(inh[curr]),input.size*sizeOf(input.data^)));
  end;

  curr:=false;

  if direction=edEnc then begin
    for ciph:=low(tUsedCiphers) to high(tUsedCiphers) do begin
      bs:=ciphers[ciph].getBlockSize div 8;
      for i:=0 to (length(inh[curr]) div bs)-1 do begin
        inh[curr][i*bs]:=inh[curr][i*bs] xor (i and $ff);
        ciphers[ciph].EncryptECB(inh[curr][i*bs],inh[not curr][i*bs]);
      end;
      curr:=not curr;
    end;
  end
  else
    for ciph:=high(tUsedCiphers) downto low(tUsedCiphers) do begin
      bs:=ciphers[ciph].getBlockSize div 8;
      for i:=0 to (length(inh[curr]) div bs)-1 do begin
        ciphers[ciph].DecryptECB(inh[curr][i*bs],inh[not curr][i*bs]);
        inh[not curr][i*bs]:=inh[not curr][i*bs] xor (i and $ff);
      end;
      curr:=not curr;
    end;

  if direction=edDec then begin
    bs:=0;
    for i:=sizeof(bs)-1 downto 0 do
      bs:=(bs shl 8) or inh[curr][i];

    mpz_realloc2(input,bs*8);
    move(inh[curr][sizeof(bs)],input.data^,input.alloc*sizeof(input.data^));
  end
  else begin
    mpz_realloc2(input,length(inh[curr])*8);
    move(inh[curr][0],input.data^,input.alloc*sizeof(input.data^));
  end;

  input.size:=input.alloc;

  for curr:=false to true do
    setlength(inh[curr],0);

  for ciph:=low(tUsedCiphers) to high(tUsedCiphers) do
    ciphers[ciph].free;
end;

function hexdump(arr: array of byte): string;
var i: longint;
begin
  result:='';
  for i:=0 to length(arr)-1 do
    result:=result + inttohex(arr[i],2);
end;

function hexdump(s: string): string;
var i: longint;
begin
  result:='';
  for i:=1 to length(s) do
    result:=result + inttohex(ord(s[i]),2);
end;

procedure readlnblind(out s: tLockedString);
var c: char;
begin
  s:=tLockedString.create;
  c:=#0;
  while not (c in [#13,#27]) do begin
    c:=readkey;
    case c of
      #8:
        s.delete(s.len,1);
      #13,#27:
        writeln;
      else
        s.append(c);
    end{of case};
  end;
end;

procedure userCallback;
begin
  if keypressed then
    if readkey in [#27,'q'] then begin
      writeln('Abbruch durch Benutzer!');
      halt;
    end;
end;

function mydatetimetostr(tm: extended): string;
var
  zeit: int64;
begin
  zeit:=floor(tm*24*60*60);                 // in Sekunden
  result:=inttostr(zeit mod 60);            // Sekunden
  zeit:=zeit div 60;
  if zeit=0 then exit;
  while length(result)<2 do
    result:='0'+result;
  result:=inttostr(zeit mod 60)+':'+result; // Minuten
  zeit:=zeit div 60;
  if zeit=0 then exit;
  while length(result)<5 do
    result:='0'+result;
  result:=inttostr(zeit mod 24)+':'+result; // Stunden
  zeit:=zeit div 24;
  if zeit=0 then exit;
  result:=', '+result;
  if (zeit mod 7)<>1 then result:='e'+result;
  result:=inttostr(zeit mod 7)+' Tag'+result;
  zeit:=zeit div 7;
  if zeit=0 then exit;
  result:=', '+result;
  if zeit<>1 then result:='n'+result;
  result:=inttostr(zeit)+' Woche'+result;
end;

procedure readNewPassword(var pass: tLockedString; len: int64);
var
  cPass: tLockedString;
begin
  cPass:=nil;
  repeat
    if cPass<>nil then
      writeln('Fehler: Die Passwörter unterscheiden sich!');
    pass.free;
    write('Passwort zum Sichern des Schlüssels eingeben: ');
    readlnblind(pass);
    cPass.Free;
    write('Wiederholen: ');
    readlnblind(cPass);
    if pass.inh='' then begin
      writeln('Fehler: Leeres Passwort!');
      pass.free;
      cPass.free;
      halt(1);
    end;
    if pass.len<len then begin
      writeln('Fehler: Passwort zu kurz, sollte mindestens '+inttostr(len)+' Zeichen lang sein!');
      pass.inh:='';
      continue;
    end;
  until pass.isEqual(cPass) and (pass.len<>0);
  cPass.Free;
end;

function cpuUtilization: extended;
var
  procstat:  textfile;
  s:         string;
  used,idle: int64;
  i:         integer;
begin
  result:=0;
  s:='';
  assignfile(procstat,'/proc/stat');
  reset(procstat);
  while not eof(procstat) do begin
    readln(procstat,s);
    if pos('cpu ',s)=1 then break;
  end;
  closefile(procstat);
  if pos('cpu ',s)<>1 then exit;
  delete(s,1,pos(' ',s));
  s:=trim(s);
  used:=0;
  idle:=0;
  for i:=0 to 3 do begin
    used:=used+idle;
    idle:=strtoint(copy(s,1,pos(' ',s)-1));
    delete(s,1,pos(' ',s));
    s:=trim(s);
  end;
  result:=(used-_cpuLastUsed)/max(1,used-_cpuLastUsed + idle-_cpuLastIdle);
  _cpuLastUsed:=used;
  _cpuLastIdle:=idle;
end;

// tLockedString ***************************************************************

constructor tLockedString.create;
begin
  inherited create;
  pagesize:=sysconf(_SC_PAGESIZE);

  locked:=0;
  memlen:=0;
  _inh:=nil;
  memstart:=nil;
end;

destructor tLockedString.destroy;
begin
  unlock;
  inherited destroy;
end;

procedure tLockedString.lock;
begin
  if locked>0 then begin
    if (locked and (pagesize-1)) <> 0 then          // nur ganze Speicherseiten locken!
      locked:=(locked and not (pagesize-1)) + pagesize;
    memlen:=locked+pagesize;
    getmem(memstart,memlen);
    if memstart=nil then begin
      writeln('Fehler beim Reservieren des Speichers!');
      halt(1);
    end;
    _inh:=pchar(uint64(memstart) and not (pagesize-1)) + pagesize;
    if mlock(_inh,locked)<>0 then begin
      writeln('Fehler beim Sperren des Speichers!');
      halt(1);
    end;
  end;
end;

procedure tLockedString.unlock;
begin
  if locked>0 then begin
    fillchar(memstart^,memlen,$00);
    if munlock(_inh,locked)<>0 then begin
      writeln('Fehler beim Entsperren des Speichers!');
      halt(1);
    end;
    freemem(memstart,memlen);
    memlen:=0;
    locked:=0;
  end;
end;

procedure tLockedString.wInh(i: pchar);
begin
  if length(i)>=locked-1 then begin
    unlock;
    locked:=length(i)+1;
    lock;
  end;
  move(i^,_inh^,length(i)+1);
end;

procedure tLockedString.assign(ls: tLockedString);
begin
  unlock;
  locked:=ls.len+1;
  lock;
  move(ls._inh^,_inh^,ls.len+1);
end;

procedure tLockedString.delete(posi,leng: longint);
var
  tmp: tLockedString;
begin
  if len=0 then exit;
  while posi<1 do
    posi:=posi+len;
  leng:=min(leng,len-posi+1);
  if leng=0 then exit;

  tmp:=tLockedString.create;
  tmp.assign(self);
  move((tmp._inh+posi-1+leng)^,(_inh+posi-1)^,len+2-posi-leng);
  tmp.free;
end;

procedure tLockedString.append(s: string);
var
  tmp: tLockedString;
begin
  if length(s)=0 then exit;
  if len=0 then begin
    inh:=pchar(s);
    exit;
  end;

  tmp:=tLockedString.create;
  tmp.assign(self);
  unlock;

  locked:=tmp.len+length(s)+1;
  lock;

  move(tmp._inh^,_inh^,tmp.len);        // Teil 1
  move(s[1],(_inh+tmp.len)^,length(s)); // Teil 2
  (_inh+tmp.len+length(s)+1)^:=#0;      // Terminator

  tmp.free;
end;

function tLockedString.substr(start,leng: longint): string;
begin
  leng:=min(leng,len-start+1);
  if leng<=0 then begin
    result:='';
    exit;
  end;
  setlength(result,leng);
  move((_inh+(start-1))^,result[1],length(result));
end;

function tLockedString.len: longint;
begin
  result:=length(_inh);
end;

function tLockedString.isEqual(s: tLockedString): boolean;
begin
  result:=s.len=len;
  if result and (len<>0) then
    result:=compareMem(s._inh,_inh,len+1);
end;

function tLockedString.teil(cph: tUsedCiphers): string;
begin
  result:=
    teil(ord(cph),ord(high(tUsedCiphers))-ord(low(tUsedCiphers))+1);
end;

function tLockedString.teil(num,tot: longint): string;
begin
  result:=
    substr(
      round(1 + num/(2*tot+1)*2*len),
      ceil(3*len/(2*tot+1))
    );
end;

// tNextPrimeThread ************************************************************

constructor tNextPrimeThread.create(num: mpz_t; offset,step: longint);
begin
  inherited create(true);
  fertig:=0;
  abbruch:=false;
  arbeite:=true;
  mpz_init(myNum);
  mpz_add_ui(myNum,num,offset);
  myStep:=step;
  cnt:=0;
end;

destructor tNextPrimeThread.destroy;
begin
  mpz_clear(myNum);
  inherited destroy;
end;

procedure tNextPrimeThread.execute;
var
  dummy:        mpz_t;
  hoffnungslos: boolean;
begin
  mpz_init(dummy);
  hoffnungslos:=mpz_gcd_ui(dummy,myNum,myStep)>1;
  mpz_clear(dummy);
  if hoffnungslos then
    writeln(stderr,'Warnung: Dieser Thread kann keine Primzahlen finden.')
  else
    if nextPrimeSt(myNum,myStep,arbeite,abbruch,cnt) then
      fertig:=fertig or $01;
  fertig:=fertig or $02;
end;

begin
  ReturnNilIfGrowHeapFails:=true;
  _cpuLastUsed:=0;
  _cpuLastIdle:=0;
end.