paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 21:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Base16/32/64/64URL encoders/decoders, not stream based

Browse Source 
(cherry picked from commit 446cc62b60)
This commit is contained in:
Michaël Van Canneyt 2021-10-30 12:59:10 +02:00 committed by marcoonthegit
parent 9f773b5219
commit ae7d2a953c
3 changed files with 627 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
packages/fcl-base/examples/demobasenenc.lpr Normal file
View File

@ -0,0 +1,135 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2021 by Michael Van Canneyt,
member of the Free Pascal development team
Demo program for Base16,Base32,Base32-hex,Base32-crockford, Base64,Base64url encoding/decoding
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
program demobasenenc;
uses sysutils, basenenc, typinfo, custapp, Classes;
Type
{ TDemoApp }
TDemoApp = Class(TCustomApplication)
private
FEncoder : TStandardEncoder;
FPadding,
FDoDecode : Boolean;
procedure ParseOptions;
procedure Usage(aError: String);
Protected
Procedure DoRun; override;
end;
{ TDemoApp }
procedure TDemoApp.Usage(aError : String);
Var
Enc : TStandardEncoder;
begin
if (aError<>'') then
Writeln('Error : ',aError);
Writeln('Usage ', ExtractFileName(Self.ExeName),' [options]');
Writeln('Where options is one or more of');
Writeln('-h --help This message');
Writeln('-e --encode=ENC Encode input to output using algorithm ENC, one of');
For Enc in TStandardEncoder do
Writeln(' ',Copy(GetEnumName(TypeInfo(TStandardEncoder),Ord(Enc)),3,MaxInt));
Writeln('-d --decode=ENC Encode input to output using algorithm ENC, one of the above');
Writeln('-i --input=FileName Set input filename. Required.');
Writeln('-o --output=FileName Set input filename. Required.');
Writeln('-p --pad Use Padding when encoding.');
ExitCode:=Ord(aError<>'');
end;
procedure TDemoApp.ParseOptions;
Var
S : String;
I : Integer;
begin
FDoDecode:=False;
S:=CheckOptions('hi:o:e:p',['help','input:','output:','encode:','decode:','pad']);
if Not (HasOption('i','input') and HasOption('o','output')) then
S:='Input and output filename are required';
if (S<>'') or HasOption('h','help') then
begin
Usage(S);
Exit;
end;
FPadding:=HasOption('p','pad');
S:=GetOptionValue('e','encode');
if S='' then
begin
S:=GetOptionValue('d','decode');
if S<>'' then
FDoDecode:=True;
end;
if (S='') then
S:='base64';
i:=GetEnumValue(TypeInfo(TStandardEncoder),S);
if I=-1 then
i:=GetEnumValue(TypeInfo(TStandardEncoder),'se'+S);
if I=-1 then
begin
Usage('Not a valid algorithm: '+s);
Exit;
end;
FEncoder:=TStandardEncoder(I);
end;
procedure TDemoApp.DoRun;
Var
B,Res : TBytes;
F : TFileStream;
Coder : TAlphabetEncoder;
begin
B:=[];
Terminate;
Parseoptions;
if ExitCode<>0 then
exit;
F:=TFileStream.Create(GetOptionValue('i','input'),fmOpenRead or fmShareDenyWrite);
try
SetLength(B,F.Size);
F.ReadBuffer(B,F.Size);
finally
F.Free;
end;
Coder:=GetStandardEncoder(FEncoder);
if FDoDecode then
Res:=Coder.Decode(PByte(B),Length(B))
else
Res:=TEncoding.UTF8.GetAnsiBytes(Coder.Encode(PByte(B),Length(B),FPadding));
F:=TFileStream.Create(GetOptionValue('o','output'),fmCreate);
try
F.WriteBuffer(Res,Length(Res))
finally
F.Free;
end;
end;
begin
CustomApplication:=TDemoApp.Create(Nil);
CustomApplication.Initialize;
CustomApplication.Run;
CustomApplication.Free;
end.

327
packages/fcl-base/src/basenenc.pp Normal file
View File

@ -0,0 +1,327 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2021 by Michael Van Canneyt,
member of the Free Pascal development team
Base16,Base32,Base32-hex,Base32-crockford, Base64,Base64url encoding/decoding, with or without padding
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit basenenc;
{$mode ObjFPC}{$H+}
interface
uses Types, SysUtils;
Type
{ TAlphabetEncoder }
TReverseAlphabet = Array[0..255] of Byte;
TStandardEncoder = (seBase16,
seBase32,seBase32hex,seBase32CrockFord,
seBase64,seBase64URL);
TAlphabetEncoder = Class (TObject)
protected
Const
StdBits : Array[TStandardEncoder] of Byte = (4,5,5,5,6,6);
StdPads : Array[TStandardEncoder] of Byte = (0,8,8,8,4,4);
StdAlpha : Array[TStandardEncoder] of String = (
'0123456789ABCDEF',
'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567',
'0123456789ABCDEFGHIJKLMNOPQRSTUV',
'0123456789ABCDEFGHJKMNPQRSTVWZYZ',
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/',
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_');
Private
FBits : Byte;
FAlphabet : TByteDynArray;
FReverse : TReverseAlphabet;
FPadding : Integer;
class var StdEncoders : Array[TStandardEncoder] of TAlphabetEncoder;
class function GetStdEncoder(AIndex: Integer): TAlphabetEncoder; static;
public
// Construct an encoder with alphabet, bits per letter, padding size in bits
Constructor Create(aAlphabet : AnsiString; aBits : Byte; aPadding : Integer); virtual;
// Destroy all standard encoders
Class Destructor Done;
// Create a standard encoder. You must free the result
Class Function CreateStdEncoder(Std: TStandardEncoder): TAlphabetEncoder;
// Encode data in buffer aBuffer with length aLen. If doPad is true, add padding if needed.
Function Encode(aBuffer : PByte; aLen : Cardinal; doPad : Boolean = True) : AnsiString; virtual; overload;
// Encode data in buffer aBuffer. If doPad is true, add padding if needed.
Function Encode(aBuffer : TBytes; doPad : Boolean = True) : AnsiString; overload;
// Encode data in string aBuffer. If doPad is true, add padding if needed.
Function Encode(aBuffer : AnsiString; doPad : Boolean = True) : AnsiString; overload;
// Decode aSrcBuffer with length aLen.
// Buffer must have enough room. Calculate maximum needed room with GetDecodeLen
Function Decode(const aSrcBuffer : PByte; aLen : Integer; ABuffer : PByte) : Integer; virtual; overload;
// Buffer must have enough room. Calculate maximum needed room with GetDecodeLen
Function Decode(const S : AnsiString; ABuffer : PByte) : Integer; overload;
// Return a buffer with decoded data.
Function Decode(const S : AnsiString) : TBytes; overload;
// Return a buffer with decoded data, starting with buffer.
Function Decode(const aBuffer: PByte; aLen : Integer) : TBytes; overload;
// Get a decoding length for the encoded string S. May be oversized due to padding.
Function GetDecodeLen(const S : AnsiString) : Integer;
// Bits per characters
Property Bits : Byte Read FBits;
// ASCII value of characters
Property Alphabet : TByteDynArray Read FAlphabet;
// Reverse byte->character map
Property Reverse : TReverseAlphabet Read FReverse;
// Bits of padding
Property Padding : Integer Read FPadding;
// Standard encoders.
Class Property Base16 : TAlphabetEncoder Index Ord(seBase16) Read GetStdEncoder;
Class Property Base32 : TAlphabetEncoder Index Ord(seBase32) Read GetStdEncoder;
Class Property Base32Hex : TAlphabetEncoder Index Ord(seBase32Hex) Read GetStdEncoder;
Class Property Base32Crockford : TAlphabetEncoder Index Ord(seBase32Crockford) Read GetStdEncoder;
Class Property Base64 : TAlphabetEncoder Index Ord(seBase64) Read GetStdEncoder;
Class Property Base64URL : TAlphabetEncoder Index Ord(seBase64Url) Read GetStdEncoder;
end;
// Shortcut access to standard encoders.
// Do not free the results !
Function Base16 : TAlphabetEncoder;
Function Base32 : TAlphabetEncoder;
Function Base32Hex : TAlphabetEncoder;
Function Base32Crockford : TAlphabetEncoder;
Function Base64 : TAlphabetEncoder;
Function Base64URL : TAlphabetEncoder;
Function GetStandardEncoder(aEncoder : TStandardEncoder): TAlphabetEncoder;
implementation
Function TAlphabetEncoder.Encode(aBuffer : TBytes; doPad : Boolean = True) : AnsiString;
begin
Result:=Encode(PByte(aBuffer),Length(aBuffer),DoPad);
end;
function TAlphabetEncoder.Encode(aBuffer: AnsiString; doPad : Boolean = True): AnsiString;
begin
Result:=Encode(TEncoding.UTF8.GetAnsiBytes(aBuffer),DoPad);
end;
Constructor TAlphabetEncoder.Create(aAlphabet: AnsiString; aBits: Byte; aPadding: Integer);
Var
I : Integer;
begin
if (Length(aAlphabet)<2) or (Length(aAlphabet)>255) then
Raise Exception.Create('Invalid alphabet length');
FBits:=ABits;
FPadding:=aPadding;
SetLength(FAlphaBet,Length(aAlphabet));
Move(aAlphabet[1],FAlphaBet[0],Length(aAlphabet));
for I:=1 to Length(aAlphabet) do
FReverse[Ord(aAlphaBet[i])]:=I;
end;
class destructor TAlphabetEncoder.Done;
Var
Std : TStandardEncoder;
begin
For Std in TStandardEncoder do
FreeAndNil(StdEncoders[Std]);
end;
class function TAlphabetEncoder.CreateStdEncoder(Std : TStandardEncoder) : TAlphabetEncoder;
begin
Result:=TAlphaBetEncoder.Create(StdAlpha[Std],StdBits[Std],StdPads[Std]);
end;
class function TAlphabetEncoder.GetStdEncoder(AIndex: Integer): TAlphabetEncoder; static;
Var
Std : TStandardEncoder;
begin
Std:=TStandardEncoder(aIndex);
if (StdEncoders[Std]=Nil) then
StdEncoders[Std]:=CreateStdEncoder(Std);
Result:=StdEncoders[Std];
end;
function TAlphabetEncoder.Encode(aBuffer: PByte; Alen : Cardinal; doPad : Boolean = True): Ansistring;
var
pSrc, pDest: pByte;
I, Reg, lBits, PadLen,OutLen: integer;
begin
Result:='';
Reg:=0;
lBits:=0;
PadLen:=0;
OutLen:=aLen*8;
OutLen:=(OutLen div Bits)+Ord((OutLen mod Bits) > 0 );
if DoPad and (Padding>0) then
begin
PadLen:=OutLen mod Padding;
if PadLen>0 then
Inc(OutLen,(Padding-PadLen));
end;
SetLength(Result,OutLen);
pSrc:=aBuffer;
pDest:=@Result[1];
for i:=1 to aLen do
begin
Reg:=Reg shl 8;
Reg:=Reg or pSrc^;
Inc(lBits,8);
inc(pSrc);
while (lBits>=Bits) do
begin
Dec(lBits,Bits);
pDest^:=Alphabet[(Reg shr lBits)];
Reg:= Reg-((Reg shr lBits) shl lBits);
inc(pDest);
end;
end;
if (lBits>0) then
begin
pDest^:=Alphabet[Reg shl (Bits-lBits)];
inc(pDest);
end;
if DoPad and (PadLen>0) then
FillChar(pDest^,Padding-PadLen,'=');
end;
Function TAlphabetEncoder.Decode(const aSrcBuffer : PByte; aLen : Integer; ABuffer : PByte) : Integer;
var
i, Reg, lBits : Integer;
pSrc, pDest: pByte;
begin
Reg:=0;
lBits:=0;
Result:=0;
while (aLen>0) and (aSrcBuffer[aLen-1]=Ord('=')) do
Dec(aLen);
if Alen=0 then exit;
pSrc:=@aSrcBuffer[0];
pDest:=aBuffer;
for i:=1 to aLen do
begin
if Reverse[pSrc^] <= 0 then
break;
Reg:=Reg shl Bits;
Reg:=Reg or (Reverse[pSrc^]-1);
Inc(lBits,Bits);
while (lBits>=8) do
begin
Dec(lBits,8);
pDest^:=Reg shr lBits;
inc(pDest);
end;
inc(pSrc);
end;
Result:=pDest-aBuffer;
end;
Function TAlphabetEncoder.GetDecodeLen(const S : AnsiString) : Integer;
begin
Result:=(length(s)*Bits) div 8;
end;
function TAlphabetEncoder.Decode(const S: AnsiString): TBytes;
begin
Result:=[];
SetLength(Result,GetDecodeLen(S));
SetLength(Result,Decode(S,PByte(Result)));
end;
function TAlphabetEncoder.Decode(const aBuffer: PByte; aLen: Integer): TBytes;
begin
Result:=[];
SetLength(Result,(aLen*Bits) div 8);
SetLength(Result,Decode(aBuffer,aLen,PByte(Result)));
end;
Function TAlphabetEncoder.Decode(const S : AnsiString; ABuffer : PByte) : Integer; overload;
begin
Result:=Decode(PByte(S),Length(S),ABuffer);
end;
Function Base16 : TAlphabetEncoder;
begin
Result:=TAlphabetEncoder.Base16;
end;
Function Base32 : TAlphabetEncoder;
begin
Result:=TAlphabetEncoder.Base32;
end;
Function Base32Hex : TAlphabetEncoder;
begin
Result:=TAlphabetEncoder.Base32Hex;
end;
Function Base32CrockFord : TAlphabetEncoder;
begin
Result:=TAlphabetEncoder.Base32CrockFord;
end;
Function Base64 : TAlphabetEncoder;
begin
Result:=TAlphabetEncoder.Base64;
end;
Function Base64URL : TAlphabetEncoder;
begin
Result:=TAlphabetEncoder.Base64URL;
end;
Function GetStandardEncoder(aEncoder : TStandardEncoder): TAlphabetEncoder;
begin
Result:=TAlphabetEncoder.GetStdEncoder(Ord(aEncoder));
end;
end.

165
packages/fcl-base/tests/testbasenenc.lpr Normal file
View File

@ -0,0 +1,165 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2021 by Michael Van Canneyt,
member of the Free Pascal development team
Test for Base 16,32,32hex,32-crockford, 64,64url encoding/decoding, with or without padding
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
program testbasenenc;
uses sysutils, basenenc;
Procedure AssertEquals(Const aActual,aExpected : TBytes; aMsg : String);
function ToStr(aBytes : TBytes) : string;
Var
I : Integer;
begin
Result:='';
For I:=0 to Length(aBytes) do
begin
if I>0 then
Result:=Result+',';
Result:=Result+IntToStr(aBytes[i]);
end;
Result:='['+Result+']';
end;
begin
if (Length(aActual)<>Length(aExpected))
or Not CompareMem(PByte(aActual),PByte(aExpected),Length(aActual)) then
begin
Writeln(aMsg,': results differ, actual: "',ToStr(aActual),'" <> "',ToStr(aExpected),'" (expected)');
Halt(1);
end;
end;
Procedure AssertEquals(Const aActual,aExpected,aMsg : String);
begin
if aActual<>aExpected then
begin
Writeln(aMsg,': results differ, actual: "',aActual,'" <> "',aExpected,'" (expected)');
Halt(1);
end;
end;
Procedure DoTest(B : Tbytes; aExpected : String; aURL : Boolean = False);
Var
B2 : TBytes;
S : Ansistring;
begin
if aURL then
S:=Base64URL.Encode(B)
else
S:=Base64.Encode(B);
AssertEquals(S,aExpected,'DoTest Wrong encode');
if aURL then
B2:=Base64URL.Decode(S)
else
B2:=Base64.Decode(S);
AssertEquals(B2,B,'DoTest Wrong decode');
end;
Procedure DoTest64(aValue, aExpected : String);
begin
DoTest(TEncoding.UTF8.GetAnsiBytes(aValue),aExpected);
end;
Procedure DoTest32(aValue, aExpected : String);
Var
B2 : TBytes;
S : Ansistring;
begin
S:=Base32.Encode(aValue);
AssertEquals(S,aExpected,'base32 encode');
B2:=Base32.Decode(S);
AssertEquals(b2,TEncoding.UTF8.GetAnsiBytes(aValue),'Base32 Wrong encode for '+aValue);
end;
Procedure DoTest32Hex(aValue, aExpected : String);
Var
B2 : TBytes;
S : Ansistring;
begin
S:=Base32Hex.Encode(aValue);
AssertEquals(S,aExpected,'Base32-hex Wrong encode for '+aValue);
B2:=Base32Hex.Decode(S);
AssertEquals(B2,TEncoding.UTF8.GetAnsiBytes(aValue),'Base32Hex Wrong encode for '+aValue);
end;
Procedure DoTest16(aValue, aExpected : String);
Var
B2 : TBytes;
S : Ansistring;
begin
S:=Base16.Encode(aValue);
AssertEquals(S,aExpected,'Base16 Wrong encode for '+aValue);
B2:=Base16.Decode(S);
AssertEquals(B2,TEncoding.UTF8.GetAnsiBytes(aValue),'Base16 Wrong decode for '+aValue);
end;
begin
// From RFC 3548
DoTest([$14,$fb,$9c,$03,$d9,$7e],'FPucA9l+');
DoTest([$14,$fb,$9c,$03,$d9],'FPucA9k=');
DoTest([$14,$fb,$9c,$03],'FPucAw==');
DoTest([$14,$fb,$9c,$03,$d9,$7e],'FPucA9l-',True);
// From RFC 4648
DoTest64('','');
DoTest64('f','Zg==');
DoTest64('fo','Zm8=');
DoTest64('foo','Zm9v');
DoTest64('foob','Zm9vYg==');
DoTest64('fooba','Zm9vYmE=');
DoTest64('foobar','Zm9vYmFy');
DoTest32('','');
DoTest32('f','MY======');
DoTest32('fo','MZXQ====');
DoTest32('foo','MZXW6===');
DoTest32('foob','MZXW6YQ=');
DoTest32('fooba','MZXW6YTB');
DoTest32('foobar','MZXW6YTBOI======');
DoTest32HEX('','');
DoTest32HEX('f','CO======');
DoTest32HEX('fo','CPNG====');
DoTest32HEX('foo','CPNMU===');
DoTest32HEX('foob','CPNMUOG=');
DoTest32HEX('fooba','CPNMUOJ1');
DoTest32HEX('foobar','CPNMUOJ1E8======');
DoTest16('','');
DoTest16('f','66');
DoTest16('fo','666F');
DoTest16('foo','666F6F');
DoTest16('foob','666F6F62');
DoTest16('fooba','666F6F6261');
DoTest16('foobar','666F6F626172');
end.