BSOne.SFC/Tocsg.Lib/VCL/EncLib/AES/ppp.pas

339 lines
10 KiB
Plaintext

unit PPP;
(*************************************************************************
DESCRIPTION : AES PPP routines (GRC's Perfect Paper Passwords)
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : http://www.grc.com/ppp/algorithm.htm
REMARKS : This unit provides functions for using the PPP system
described on the http://www.grc.com/ppp.htm page.
Although there are hints to a PPP V3 Specification, there
seems to be no formal definition. IMO the best available
description is from the algorithm page:
"The 256-bit PPP "Sequence Key" directly provides the key
for the AES-standard keyed Rijndael block cipher. A 128-bit
sequence counter is initialized to zero for the first
passcode, then increments once for every subsequent
passcode to provide encrypted data that are translated into
individual passcodes for printing on PPP passcards."
Some programs linked by the GRC pages do not comply to this,
and produce e.g. five standard passcodes from one 128-bit
counter: Instead of '32YT 65!@' from the GRC example they
give '32YT YNBq LhY# sGsm cT47 65!@ V2o6 VFjK WPFn ?aWE'.
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 08.08.10 W.Ehrhardt Initial basic version
0.11 08.08.10 we Improved DivBlock
0.12 08.08.10 we PPP_First32, PPP_Next
0.13 08.08.10 we Map constants
0.14 08.08.10 we Error checking
0.15 09.08.10 we PPP_FirstCard, PPP_Init4Standard, PPP_Init4Extended
0.16 09.08.10 we Fix for mlen=0, PPP_SetCodesPerCard
0.17 09.08.10 we Sort character map
0.18 27.09.10 we Add $N- for TP5
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
{$ifdef VER50}
{$N-} {Once again: brain-damaged TP5 floating-point arithmetic!}
{$endif}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
type
TPPPKey = packed array[0..31] of byte; {PPP uses 256 bit keys}
TPPPMap = packed array[0..255] of char8;
type
TPPPctx = record
actx: TAESContext;
map : TPPPMap; {character map}
mlen: byte; {map length}
clen: byte; {code length}
cpc : word; {codes per card}
end;
const
PPP_Err_non_increasing = -30; {Characters in map are not strictly increasing}
PPP_Err_invalid_maplen = -31; {Invalid number of characters in map}
PPP_Err_invalid_codelen = -32; {Passcode length too large or zero}
const
map64: string[64] = '!#%+23456789:=?@ABCDEFGHJKLMNPRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
map88: string[88] = '!"#$%&''()*+,-./23456789:;<=>?@ABCDEFGHJKLMNOPRSTUVWXYZ[\]^_abcdefghijkmnopqrstuvwxyz{|}~';
procedure PPP_Init(var pctx: TPPPctx; SeqKey: TPPPKey; smap: str255; codelen: word; var Err: integer);
{-Initialize context pctx with Seqkey, character map smap, and passcode length.}
{ If smap is empty, all 256 characters #0..#255 are used.}
procedure PPP_Init4Standard(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, standard map64, passcode length = 4}
procedure PPP_Init4Extended(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, extended map88, passcode length = 4}
procedure PPP_SetCodesPerCard(var pctx: TPPPctx; newcpc: word);
{-Set new "codes per card" value, 70 if 0 }
function PPP_First32(var pctx: TPPPctx; startcode: longint): str255;
{-Get first PPP passcode starting with passcode startcode}
function PPP_First128(var pctx: TPPPctx; start128: TAESBlock): str255;
{-Get first PPP passcode for LSB 128 bit number start128}
function PPP_FirstCard(var pctx: TPPPctx; cardnum: word): str255;
{-Get first PPP passcode of card cardnum (use card 1 if cardnum=0)}
function PPP_Next(var pctx: TPPPctx): str255;
{-Return the next passcode from context pctx}
implementation
{---------------------------------------------------------------------------}
procedure DivBlock(var a: TAESBlock; b: byte; var r: byte);
{-Divide an AES LSB block by b (256 if b=0): r = a mod b; a = a div b}
var
i: integer;
q,w: word;
begin
q := b;
if q=0 then q := 256;
{initialize "carry"}
w := 0;
for i:=15 downto 0 do begin
{loop invariant: 0 <= w < q}
w := (w shl 8) or a[i];
r := w div q;
w := w mod q;
a[i] := r;
end;
{set r to remainder, w is still < q!}
r := byte(w);
end;
{---------------------------------------------------------------------------}
procedure IncBlock(var a: TAESBlock);
{-Increment an AES LSB block}
var
j: integer;
begin
for j:=0 to 15 do begin
if a[j]=$FF then a[j] := 0
else begin
inc(a[j]);
exit;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure SortMap(var pctx: TPPPctx);
{-Sort character map with CombSort routine}
var
i,j,gap,r: integer;
swapped: boolean;
c: char8;
begin
{See my CombSort routine from util archive}
with pctx do begin
if mlen=0 then r := 255 else r := mlen - 1;
gap := r;
if gap<1 then exit;
repeat
gap := longint(gap)*10 div 13;
if (gap=9) or (gap=10) then gap := 11
else if gap<1 then gap:=1;
swapped := false;
for i:=0 to r-gap do begin
j := i + gap;
if ord(map[j]) < ord(map[i]) then begin
c := map[j];
map[j] := map[i];
map[i] := c;
swapped := true;
end
end
until (gap=1) and not swapped;
end;
end;
{---------------------------------------------------------------------------}
procedure PPP_Init(var pctx: TPPPctx; SeqKey: TPPPKey; smap: str255; codelen: word; var Err: integer);
{-Initialize context pctx with Seqkey, character map smap, and passcode length.}
{ If smap is empty, all 256 characters #0..#255 are used.}
var
i: integer;
sorted: boolean;
begin
with pctx do begin
Err := AES_Init_Encr(SeqKey, 256, actx);
if Err<>0 then exit;
fillchar(map, sizeof(map),0);
if smap='' then begin
{use all chars #0..#255}
mlen := 0;
for i:=0 to 255 do map[i] := char8(i);
end
else begin
mlen := length(smap);
if mlen=1 then begin
Err := PPP_Err_invalid_maplen;
exit;
end;
move(smap[1],map[0],mlen);
sorted := true;
i:= 1;
while (i<mlen) and sorted do begin
sorted := ord(map[i-1]) < ord(map[i]);
inc(i);
end;
if not sorted then begin
SortMap(pctx);
for i:=1 to mlen-1 do begin
if ord(map[i-1]) >= ord(map[i]) then begin
Err := PPP_Err_non_increasing;
exit;
end;
end;
end;
end;
{here 2 <= mlen <= 256 or mlen=0}
if mlen=0 then i := 16
else i := trunc(128.0*ln(2.0)/ln(mlen));
if (codelen > i) or (codelen=0) then begin
Err := PPP_Err_invalid_codelen;
exit;
end;
clen := codelen;
cpc := 70; {default codes pre card}
end;
end;
{---------------------------------------------------------------------------}
procedure PPP_Init4Standard(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, standard map64, passcode length = 4}
begin
PPP_Init(pctx, SeqKey, map64, 4, Err);
end;
{---------------------------------------------------------------------------}
procedure PPP_Init4Extended(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, extended map88, passcode length = 4}
begin
PPP_Init(pctx, SeqKey, map88, 4, Err);
end;
{---------------------------------------------------------------------------}
procedure PPP_SetCodesPerCard(var pctx: TPPPctx; newcpc: word);
{-Set new "codes per card" value, 70 if 0 }
begin
if newcpc=0 then newcpc := 70;
pctx.cpc := newcpc;
end;
{---------------------------------------------------------------------------}
function PPP_Next(var pctx: TPPPctx): str255;
{-Return the next passcode from context pctx}
var
i: integer;
idx: byte;
s: str255;
begin
s := '';
with pctx do begin
AES_Encrypt(actx, actx.iv, actx.buf);
for i:=1 to clen do begin
DivBlock(actx.buf, mlen, idx);
s := s + map[idx];
end;
IncBlock(actx.IV);
end;
PPP_Next := s;
end;
{---------------------------------------------------------------------------}
function PPP_First32(var pctx: TPPPctx; startcode: longint): str255;
{-Get first PPP passcode starting with passcode startcode}
begin
with pctx do begin
fillchar(actx.iv, sizeof(actx.iv), 0);
TWA4(actx.iv)[0] := startcode;
end;
PPP_First32 := PPP_Next(pctx);
end;
{---------------------------------------------------------------------------}
function PPP_FirstCard(var pctx: TPPPctx; cardnum: word): str255;
{-Get first PPP passcode of card cardnum (use card 1 if cardnum=0)}
begin
if cardnum=0 then cardnum := 1;
PPP_FirstCard := PPP_First32(pctx, longint(cardnum-1)*pctx.cpc);
end;
{---------------------------------------------------------------------------}
function PPP_First128(var pctx: TPPPctx; start128: TAESBlock): str255;
{-Get first PPP passcode for LSB 128 bit number start128}
begin
pctx.actx.iv := start128;
PPP_First128 := PPP_Next(pctx);
end;
end.