From 304504886ba7214882af78464648049ba1d742da Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Mon, 22 Jun 2026 20:33:55 +0100 Subject: [PATCH] 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. --- stdlib/src/main/pascal/encoding.base64.pas | 129 +++++++++++++++ stdlib/src/main/pascal/security.crypto.pas | 177 +++++++++++++++++++++ stdlib/src/test/pascal/base64.tests.pas | 71 +++++++++ stdlib/src/test/pascal/crypto.tests.pas | 57 +++++++ stdlib/src/test/pascal/test.registry.pas | 4 +- 5 files changed, 437 insertions(+), 1 deletion(-) create mode 100644 stdlib/src/main/pascal/encoding.base64.pas create mode 100644 stdlib/src/main/pascal/security.crypto.pas create mode 100644 stdlib/src/test/pascal/base64.tests.pas create mode 100644 stdlib/src/test/pascal/crypto.tests.pas diff --git a/stdlib/src/main/pascal/encoding.base64.pas b/stdlib/src/main/pascal/encoding.base64.pas new file mode 100644 index 0000000..2297695 --- /dev/null +++ b/stdlib/src/main/pascal/encoding.base64.pas @@ -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. diff --git a/stdlib/src/main/pascal/security.crypto.pas b/stdlib/src/main/pascal/security.crypto.pas new file mode 100644 index 0000000..79a49fb --- /dev/null +++ b/stdlib/src/main/pascal/security.crypto.pas @@ -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. diff --git a/stdlib/src/test/pascal/base64.tests.pas b/stdlib/src/test/pascal/base64.tests.pas new file mode 100644 index 0000000..beb9166 --- /dev/null +++ b/stdlib/src/test/pascal/base64.tests.pas @@ -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. diff --git a/stdlib/src/test/pascal/crypto.tests.pas b/stdlib/src/test/pascal/crypto.tests.pas new file mode 100644 index 0000000..759425e --- /dev/null +++ b/stdlib/src/test/pascal/crypto.tests.pas @@ -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. diff --git a/stdlib/src/test/pascal/test.registry.pas b/stdlib/src/test/pascal/test.registry.pas index 8dad0f7..4fc00ec 100644 --- a/stdlib/src/test/pascal/test.registry.pas +++ b/stdlib/src/test/pascal/test.registry.pas @@ -21,7 +21,9 @@ unit Test.Registry; interface uses - Json.Tests; + Json.Tests, + Base64.Tests, + Crypto.Tests; implementation