feat(stdlib): add Security.Crypto (SHA-1) and Encoding.Base64
Two small, independent units, split along the lines Java and .NET draw:
Security.Crypto SHA-1 (raw 20-byte digest + Sha1Hex), the home for hash
digests (cf. java.security / System.Security.Cryptography).
Encoding.Base64 Base64 encode + decode (RFC 4648), a general text encoding,
not crypto (cf. java.util.Base64 / System.Convert).
Callers compose them, e.g. the WebSocket handshake is
Base64Encode(Sha1(key + GUID)). Both TStringBuilder-backed (O(n)).
Adds Crypto.Tests (SHA-1 FIPS vectors + the RFC 6455 handshake) and
Base64.Tests (RFC 4648 vectors, decode, round-trip) to the stdlib test tree
via Test.Registry; pasbuild test -m blaise-stdlib runs 27 tests.
This commit is contained in:
Graeme Geldenhuys
parent
36065ecd7d
commit
304504886b
129
stdlib/src/main/pascal/encoding.base64.pas
Normal file
129
stdlib/src/main/pascal/encoding.base64.pas
Normal file
|
|
@ -0,0 +1,129 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{ Blaise stdlib - Base64 encoding (RFC 4648).
|
||||
|
||||
Base64 is a general-purpose binary-to-text encoding, not a cryptographic
|
||||
primitive, so it lives here under Encoding rather than under Security. (Java
|
||||
places it in java.util.Base64 and .NET in System.Convert, for the same
|
||||
reason.)
|
||||
|
||||
Strings are treated as raw bytes in and out. Output is accumulated through a
|
||||
TStringBuilder, so encoding/decoding large inputs is O(n). }
|
||||
|
||||
unit Encoding.Base64;
|
||||
|
||||
interface
|
||||
|
||||
{ Encode the raw bytes of S as standard Base64 (with '=' padding). }
|
||||
function Base64Encode(const S: string): string;
|
||||
|
||||
{ Decode standard Base64 back to raw bytes. Whitespace in the input is
|
||||
ignored; '=' padding is honoured. Returns the decoded bytes; on a malformed
|
||||
character the function stops and returns what it decoded so far. }
|
||||
function Base64Decode(const S: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils;
|
||||
|
||||
const
|
||||
ALPHA = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
|
||||
{ ASCII byte constants. NB: Byte('x') on a char *literal* does not yield the
|
||||
character code in this dialect (a literal is a UTF-8 string and the cast
|
||||
takes the pointer), so byte comparisons use numeric constants. A byte read
|
||||
FROM a string via S[i] does give the correct code. }
|
||||
CH_EQ = 61; { = }
|
||||
CH_PLUS = 43; { + }
|
||||
CH_SLASH = 47; { / }
|
||||
CH_UC_A = 65; { A } CH_UC_Z = 90;
|
||||
CH_LC_A = 97; { a } CH_LC_Z = 122;
|
||||
CH_0 = 48; CH_9 = 57;
|
||||
|
||||
function Base64Encode(const S: string): string;
|
||||
var
|
||||
SB: TStringBuilder;
|
||||
I, N: Integer;
|
||||
B0, B1, B2, Triple: Integer;
|
||||
begin
|
||||
SB := TStringBuilder.Create();
|
||||
N := Length(S);
|
||||
I := 0;
|
||||
while I < N do
|
||||
begin
|
||||
B0 := Byte(S[I]);
|
||||
if I + 1 < N then B1 := Byte(S[I + 1]) else B1 := 0;
|
||||
if I + 2 < N then B2 := Byte(S[I + 2]) else B2 := 0;
|
||||
Triple := (B0 shl 16) or (B1 shl 8) or B2;
|
||||
|
||||
{ ALPHA is 0-based in Blaise, so index directly with the 6-bit groups. }
|
||||
SB.AppendByte(Byte(ALPHA[(Triple shr 18) and $3F]));
|
||||
SB.AppendByte(Byte(ALPHA[(Triple shr 12) and $3F]));
|
||||
if I + 1 < N then
|
||||
SB.AppendByte(Byte(ALPHA[(Triple shr 6) and $3F]))
|
||||
else
|
||||
SB.AppendByte(CH_EQ);
|
||||
if I + 2 < N then
|
||||
SB.AppendByte(Byte(ALPHA[Triple and $3F]))
|
||||
else
|
||||
SB.AppendByte(CH_EQ);
|
||||
I := I + 3;
|
||||
end;
|
||||
Result := SB.ToString();
|
||||
SB.Free();
|
||||
end;
|
||||
|
||||
{ Map a Base64 character to its 6-bit value, or -1 if not a Base64 char. }
|
||||
function DecodeChar(B: Byte): Integer;
|
||||
begin
|
||||
if (B >= CH_UC_A) and (B <= CH_UC_Z) then Result := B - CH_UC_A
|
||||
else if (B >= CH_LC_A) and (B <= CH_LC_Z) then Result := B - CH_LC_A + 26
|
||||
else if (B >= CH_0) and (B <= CH_9) then Result := B - CH_0 + 52
|
||||
else if B = CH_PLUS then Result := 62
|
||||
else if B = CH_SLASH then Result := 63
|
||||
else Result := -1;
|
||||
end;
|
||||
|
||||
function Base64Decode(const S: string): string;
|
||||
var
|
||||
SB: TStringBuilder;
|
||||
I, N, Val, Bits, Acc: Integer;
|
||||
B, V: Integer;
|
||||
begin
|
||||
SB := TStringBuilder.Create();
|
||||
N := Length(S);
|
||||
Acc := 0;
|
||||
Bits := 0;
|
||||
I := 0;
|
||||
while I < N do
|
||||
begin
|
||||
B := Byte(S[I]);
|
||||
I := I + 1;
|
||||
if B = CH_EQ then
|
||||
Break; { padding — no more data }
|
||||
{ skip whitespace }
|
||||
if (B = 32) or (B = 9) or (B = 10) or (B = 13) then
|
||||
Continue;
|
||||
V := DecodeChar(B);
|
||||
if V < 0 then
|
||||
Break; { malformed — stop }
|
||||
Acc := (Acc shl 6) or V;
|
||||
Bits := Bits + 6;
|
||||
if Bits >= 8 then
|
||||
begin
|
||||
Bits := Bits - 8;
|
||||
Val := (Acc shr Bits) and $FF;
|
||||
SB.AppendByte(Val);
|
||||
end;
|
||||
end;
|
||||
Result := SB.ToString();
|
||||
SB.Free();
|
||||
end;
|
||||
|
||||
end.
|
||||
177
stdlib/src/main/pascal/security.crypto.pas
Normal file
177
stdlib/src/main/pascal/security.crypto.pas
Normal file
|
|
@ -0,0 +1,177 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{ Blaise stdlib - cryptographic hash functions.
|
||||
|
||||
The home for hash/digest primitives (Java's java.security, .NET's
|
||||
System.Security.Cryptography). SHA-1 is provided; further digests and HMAC
|
||||
belong here.
|
||||
|
||||
NB: SHA-1 is not collision-resistant and must not be used for new security
|
||||
decisions. It remains required for interop where a protocol mandates it
|
||||
(e.g. the WebSocket opening handshake, Git object ids).
|
||||
|
||||
Base64 lives in Encoding.Base64, not here: it is a text encoding, not crypto.
|
||||
Compose them at the call site, e.g. Base64Encode(Sha1(Key + GUID)).
|
||||
|
||||
NB: shifts and 'not' are not masked to 32 bits by the backend, so every
|
||||
32-bit operation is wrapped with 'and $FFFFFFFF'. }
|
||||
|
||||
unit Security.Crypto;
|
||||
|
||||
interface
|
||||
|
||||
{ Raw 20-byte SHA-1 digest of S (S treated as raw bytes), returned as a string
|
||||
of 20 bytes. }
|
||||
function Sha1(const AData: string): string;
|
||||
|
||||
{ SHA-1 digest as a 40-character lower-case hex string. }
|
||||
function Sha1Hex(const AData: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Classes, StrUtils;
|
||||
|
||||
const
|
||||
MASK32 = $FFFFFFFF;
|
||||
|
||||
function Rotl32(V: UInt32; ABits: Integer): UInt32;
|
||||
begin
|
||||
Result := ((V shl ABits) or (V shr (32 - ABits))) and MASK32;
|
||||
end;
|
||||
|
||||
function Sha1(const AData: string): string;
|
||||
var
|
||||
H0, H1, H2, H3, H4: UInt32;
|
||||
MsgLen, TotalBits: Int64;
|
||||
PadLen, I, T, ChunkStart, NumChunks, C: Integer;
|
||||
Msg: array[0..63] of Byte; { current 64-byte chunk }
|
||||
W: array[0..79] of UInt32;
|
||||
A, B, Cc, D, E, F, K, Temp: UInt32;
|
||||
PData: string;
|
||||
SB, OutSB: TStringBuilder;
|
||||
begin
|
||||
{ Build the padded message:
|
||||
original || 0x80 || 0x00... || 64-bit big-endian bit length.
|
||||
AppendByte guarantees raw single bytes. }
|
||||
MsgLen := Length(AData);
|
||||
TotalBits := MsgLen * 8;
|
||||
|
||||
PadLen := 56 - ((MsgLen + 1) mod 64);
|
||||
if PadLen < 0 then
|
||||
PadLen := PadLen + 64;
|
||||
|
||||
SB := TStringBuilder.Create();
|
||||
SB.Append(AData);
|
||||
SB.AppendByte(128);
|
||||
for I := 1 to PadLen do
|
||||
SB.AppendByte(0);
|
||||
for I := 7 downto 0 do
|
||||
SB.AppendByte((TotalBits shr (I * 8)) and $FF);
|
||||
PData := SB.ToString();
|
||||
SB.Free();
|
||||
|
||||
H0 := $67452301;
|
||||
H1 := $EFCDAB89;
|
||||
H2 := $98BADCFE;
|
||||
H3 := $10325476;
|
||||
H4 := $C3D2E1F0;
|
||||
|
||||
NumChunks := Length(PData) div 64;
|
||||
for C := 0 to NumChunks - 1 do
|
||||
begin
|
||||
ChunkStart := C * 64;
|
||||
for I := 0 to 63 do
|
||||
Msg[I] := Byte(PData[ChunkStart + I]);
|
||||
|
||||
for T := 0 to 15 do
|
||||
W[T] := ((UInt32(Msg[T * 4]) shl 24) or
|
||||
(UInt32(Msg[T * 4 + 1]) shl 16) or
|
||||
(UInt32(Msg[T * 4 + 2]) shl 8) or
|
||||
UInt32(Msg[T * 4 + 3])) and MASK32;
|
||||
for T := 16 to 79 do
|
||||
W[T] := Rotl32((W[T-3] xor W[T-8] xor W[T-14] xor W[T-16]), 1);
|
||||
|
||||
A := H0; B := H1; Cc := H2; D := H3; E := H4;
|
||||
|
||||
for T := 0 to 79 do
|
||||
begin
|
||||
if T < 20 then
|
||||
begin
|
||||
F := (B and Cc) or ((not B) and D);
|
||||
K := $5A827999;
|
||||
end
|
||||
else if T < 40 then
|
||||
begin
|
||||
F := B xor Cc xor D;
|
||||
K := $6ED9EBA1;
|
||||
end
|
||||
else if T < 60 then
|
||||
begin
|
||||
F := (B and Cc) or (B and D) or (Cc and D);
|
||||
K := $8F1BBCDC;
|
||||
end
|
||||
else
|
||||
begin
|
||||
F := B xor Cc xor D;
|
||||
K := $CA62C1D6;
|
||||
end;
|
||||
F := F and MASK32;
|
||||
Temp := (Rotl32(A, 5) + F + E + K + W[T]) and MASK32;
|
||||
E := D;
|
||||
D := Cc;
|
||||
Cc := Rotl32(B, 30);
|
||||
B := A;
|
||||
A := Temp;
|
||||
end;
|
||||
|
||||
H0 := (H0 + A) and MASK32;
|
||||
H1 := (H1 + B) and MASK32;
|
||||
H2 := (H2 + Cc) and MASK32;
|
||||
H3 := (H3 + D) and MASK32;
|
||||
H4 := (H4 + E) and MASK32;
|
||||
end;
|
||||
|
||||
{ Emit 20 raw bytes, big-endian. }
|
||||
OutSB := TStringBuilder.Create();
|
||||
OutSB.AppendByte((H0 shr 24) and $FF); OutSB.AppendByte((H0 shr 16) and $FF);
|
||||
OutSB.AppendByte((H0 shr 8) and $FF); OutSB.AppendByte(H0 and $FF);
|
||||
OutSB.AppendByte((H1 shr 24) and $FF); OutSB.AppendByte((H1 shr 16) and $FF);
|
||||
OutSB.AppendByte((H1 shr 8) and $FF); OutSB.AppendByte(H1 and $FF);
|
||||
OutSB.AppendByte((H2 shr 24) and $FF); OutSB.AppendByte((H2 shr 16) and $FF);
|
||||
OutSB.AppendByte((H2 shr 8) and $FF); OutSB.AppendByte(H2 and $FF);
|
||||
OutSB.AppendByte((H3 shr 24) and $FF); OutSB.AppendByte((H3 shr 16) and $FF);
|
||||
OutSB.AppendByte((H3 shr 8) and $FF); OutSB.AppendByte(H3 and $FF);
|
||||
OutSB.AppendByte((H4 shr 24) and $FF); OutSB.AppendByte((H4 shr 16) and $FF);
|
||||
OutSB.AppendByte((H4 shr 8) and $FF); OutSB.AppendByte(H4 and $FF);
|
||||
Result := OutSB.ToString();
|
||||
OutSB.Free();
|
||||
end;
|
||||
|
||||
function Sha1Hex(const AData: string): string;
|
||||
var
|
||||
Raw: string;
|
||||
SB: TStringBuilder;
|
||||
I, B: Integer;
|
||||
const
|
||||
Hex = '0123456789abcdef';
|
||||
begin
|
||||
Raw := Sha1(AData);
|
||||
SB := TStringBuilder.Create();
|
||||
for I := 0 to Length(Raw) - 1 do
|
||||
begin
|
||||
B := Byte(Raw[I]);
|
||||
SB.AppendByte(Byte(Hex[B div 16])); { Hex is 0-based in Blaise }
|
||||
SB.AppendByte(Byte(Hex[B mod 16]));
|
||||
end;
|
||||
Result := SB.ToString();
|
||||
SB.Free();
|
||||
end;
|
||||
|
||||
end.
|
||||
71
stdlib/src/test/pascal/base64.tests.pas
Normal file
71
stdlib/src/test/pascal/base64.tests.pas
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{ Tests for Encoding.Base64. Self-registers via the initialization section. }
|
||||
|
||||
unit Base64.Tests;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
blaise.testing, Encoding.Base64;
|
||||
|
||||
type
|
||||
TBase64Tests = class(TTestCase)
|
||||
published
|
||||
procedure TestEncode_KnownVectors;
|
||||
procedure TestEncode_Empty;
|
||||
procedure TestDecode_KnownVectors;
|
||||
procedure TestDecode_IgnoresWhitespace;
|
||||
procedure TestRoundTrip;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TBase64Tests.TestEncode_KnownVectors;
|
||||
begin
|
||||
{ RFC 4648 test vectors. }
|
||||
AssertEquals('f', 'Zg==', Base64Encode('f'));
|
||||
AssertEquals('fo', 'Zm8=', Base64Encode('fo'));
|
||||
AssertEquals('foo', 'Zm9v', Base64Encode('foo'));
|
||||
AssertEquals('foob', 'Zm9vYg==', Base64Encode('foob'));
|
||||
AssertEquals('fooba', 'Zm9vYmE=', Base64Encode('fooba'));
|
||||
AssertEquals('foobar', 'Zm9vYmFy', Base64Encode('foobar'));
|
||||
AssertEquals('Man', 'TWFu', Base64Encode('Man'));
|
||||
end;
|
||||
|
||||
procedure TBase64Tests.TestEncode_Empty;
|
||||
begin
|
||||
AssertEquals('empty', '', Base64Encode(''));
|
||||
end;
|
||||
|
||||
procedure TBase64Tests.TestDecode_KnownVectors;
|
||||
begin
|
||||
AssertEquals('Zg==', 'f', Base64Decode('Zg=='));
|
||||
AssertEquals('Zm8=', 'fo', Base64Decode('Zm8='));
|
||||
AssertEquals('Zm9v', 'foo', Base64Decode('Zm9v'));
|
||||
AssertEquals('Zm9vYmFy', 'foobar', Base64Decode('Zm9vYmFy'));
|
||||
end;
|
||||
|
||||
procedure TBase64Tests.TestDecode_IgnoresWhitespace;
|
||||
begin
|
||||
{ Newlines/spaces in wrapped Base64 are ignored. }
|
||||
AssertEquals('wrapped', 'foobar', Base64Decode('Zm9v' + #10 + 'YmFy'));
|
||||
end;
|
||||
|
||||
procedure TBase64Tests.TestRoundTrip;
|
||||
var s: string;
|
||||
begin
|
||||
s := 'The quick brown fox jumps over the lazy dog.';
|
||||
AssertEquals('roundtrip', s, Base64Decode(Base64Encode(s)));
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TBase64Tests);
|
||||
|
||||
end.
|
||||
57
stdlib/src/test/pascal/crypto.tests.pas
Normal file
57
stdlib/src/test/pascal/crypto.tests.pas
Normal file
|
|
@ -0,0 +1,57 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{ Tests for Security.Crypto (SHA-1), including the Base64-composed WebSocket
|
||||
handshake. Self-registers via the initialization section. }
|
||||
|
||||
unit Crypto.Tests;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
blaise.testing, Security.Crypto, Encoding.Base64;
|
||||
|
||||
type
|
||||
TCryptoTests = class(TTestCase)
|
||||
published
|
||||
procedure TestSha1Hex_KnownVectors;
|
||||
procedure TestSha1_DigestLength;
|
||||
procedure TestSha1Base64_WebSocketHandshake;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TCryptoTests.TestSha1Hex_KnownVectors;
|
||||
begin
|
||||
{ FIPS / well-known SHA-1 test vectors. }
|
||||
AssertEquals('empty', 'da39a3ee5e6b4b0d3255bfef95601890afd80709', Sha1Hex(''));
|
||||
AssertEquals('abc', 'a9993e364706816aba3e25717850c26c9cd0d89d', Sha1Hex('abc'));
|
||||
AssertEquals('quick brown fox',
|
||||
'2fd4e1c67a2d28fced849ee1bb76e7391b93eb12',
|
||||
Sha1Hex('The quick brown fox jumps over the lazy dog'));
|
||||
end;
|
||||
|
||||
procedure TCryptoTests.TestSha1_DigestLength;
|
||||
begin
|
||||
AssertEquals('raw digest is 20 bytes', 20, Length(Sha1('anything')));
|
||||
end;
|
||||
|
||||
procedure TCryptoTests.TestSha1Base64_WebSocketHandshake;
|
||||
const
|
||||
GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
|
||||
begin
|
||||
{ RFC 6455 example: Sec-WebSocket-Accept = base64(sha1(key + GUID)). }
|
||||
AssertEquals('ws accept',
|
||||
's3pPLMBiTxaQ9kYGzzhZRbK+xOo=',
|
||||
Base64Encode(Sha1('dGhlIHNhbXBsZSBub25jZQ==' + GUID)));
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TCryptoTests);
|
||||
|
||||
end.
|
||||
|
|
@ -21,7 +21,9 @@ unit Test.Registry;
|
|||
interface
|
||||
|
||||
uses
|
||||
Json.Tests;
|
||||
Json.Tests,
|
||||
Base64.Tests,
|
||||
Crypto.Tests;
|
||||
|
||||
implementation
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue