From 2ccfd04f69f242f3322ba3e0a2fce2567c35f092 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 23 Jun 2026 00:15:03 +0100 Subject: [PATCH] stdlib: add Security.Guid (RFC 4122 v4 GUIDs) NewGuid returns a canonical lowercase v4 GUID; NewGuidRaw returns the 16 raw bytes. Randomness comes from the kernel CSPRNG via getrandom(2), with the version (4) and variant (RFC 4122) bits forced. Tests cover the canonical format, version/variant bits in both string and raw forms, and uniqueness (47 tests total). --- stdlib/src/main/pascal/security.guid.pas | 98 ++++++++++++++++++++++++ stdlib/src/test/pascal/guid.tests.pas | 90 ++++++++++++++++++++++ stdlib/src/test/pascal/test.registry.pas | 3 +- 3 files changed, 190 insertions(+), 1 deletion(-) create mode 100644 stdlib/src/main/pascal/security.guid.pas create mode 100644 stdlib/src/test/pascal/guid.tests.pas diff --git a/stdlib/src/main/pascal/security.guid.pas b/stdlib/src/main/pascal/security.guid.pas new file mode 100644 index 0000000..fe9138b --- /dev/null +++ b/stdlib/src/main/pascal/security.guid.pas @@ -0,0 +1,98 @@ +{ + 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 - RFC 4122 version-4 (random) GUID/UUID generation. + + A v4 GUID is 16 random bytes with the version (4) and variant (RFC 4122) + bits forced. Randomness comes from the kernel CSPRNG via getrandom(2) + (Linux 3.17+, glibc 2.25+); no seeding and no PRNG state. + + NewGuid -> canonical lowercase string, e.g. + '3f2504e0-4f89-41d3-9a0c-0305e82c3301'. + NewGuidRaw -> the 16 raw bytes (as a string), for callers that want the + binary form. } + +unit Security.Guid; + +interface + +{ A new random (v4) GUID in canonical 8-4-4-4-12 lowercase hex form. } +function NewGuid: string; + +{ The 16 raw bytes of a new v4 GUID (version/variant bits already set). } +function NewGuidRaw: string; + +implementation + +uses + StrUtils; { TStringBuilder } + +{ getrandom(buf, buflen, flags): fill buf with buflen random bytes from the + kernel CSPRNG. flags=0 reads from the same pool as /dev/urandom. } +function c_getrandom(ABuf: Pointer; ALen: Int64; AFlags: Integer): Int64; + external name 'getrandom'; + +function NewGuidRaw: string; +var + Buf: array[0..15] of Byte; + SB: TStringBuilder; + I: Integer; +begin + if c_getrandom(@Buf[0], 16, 0) <> 16 then + begin + Result := ''; + Exit; + end; + { version 4: high nibble of byte 6 = 0100 } + Buf[6] := (Buf[6] and $0F) or $40; + { variant RFC 4122: top two bits of byte 8 = 10 } + Buf[8] := (Buf[8] and $3F) or $80; + + SB := TStringBuilder.Create(); + for I := 0 to 15 do + SB.AppendByte(Buf[I]); + Result := SB.ToString(); + SB.Free(); +end; + +function HexDigit(AValue: Integer): Byte; +begin + { 0-9 -> '0'..'9' (48..57), 10-15 -> 'a'..'f' (97..102) } + if AValue < 10 then + Result := 48 + AValue + else + Result := 87 + AValue; +end; + +function NewGuid: string; +var + Raw: string; + SB: TStringBuilder; + I, B: Integer; +begin + Raw := NewGuidRaw(); + if Raw = '' then + begin + Result := ''; + Exit; + end; + SB := TStringBuilder.Create(); + for I := 0 to 15 do + begin + { hyphens after bytes 4, 6, 8, 10 (the 8-4-4-4-12 grouping) } + if (I = 4) or (I = 6) or (I = 8) or (I = 10) then + SB.AppendByte(45); { '-' } + B := Byte(Raw[I]); + SB.AppendByte(HexDigit((B shr 4) and $0F)); + SB.AppendByte(HexDigit(B and $0F)); + end; + Result := SB.ToString(); + SB.Free(); +end; + +end. diff --git a/stdlib/src/test/pascal/guid.tests.pas b/stdlib/src/test/pascal/guid.tests.pas new file mode 100644 index 0000000..efc2634 --- /dev/null +++ b/stdlib/src/test/pascal/guid.tests.pas @@ -0,0 +1,90 @@ +{ + 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.Guid: v4 GUID format, version/variant bits, uniqueness. + Self-registers via the initialization section. } + +unit Guid.Tests; + +interface + +uses + blaise.testing, Security.Guid; + +type + TGuidTests = class(TTestCase) + published + procedure TestFormat; + procedure TestVersionAndVariant; + procedure TestRawLength; + procedure TestUnique; + end; + +implementation + +function IsHexLower(B: Byte): Boolean; +begin + Result := ((B >= 48) and (B <= 57)) or ((B >= 97) and (B <= 102)); +end; + +procedure TGuidTests.TestFormat; +var + G: string; + I: Integer; + Ch: Byte; +begin + G := NewGuid(); + AssertEquals('length', 36, Integer(Length(G))); + for I := 0 to 35 do + begin + Ch := Byte(G[I]); + if (I = 8) or (I = 13) or (I = 18) or (I = 23) then + AssertEquals('hyphen at ' + IntToStr(I), 45, Integer(Ch)) + else + AssertTrue('hex at ' + IntToStr(I), IsHexLower(Ch)); + end; +end; + +procedure TGuidTests.TestVersionAndVariant; +var + G: string; +begin + G := NewGuid(); + { version nibble: position 14 (after 'xxxxxxxx-xxxx-') must be '4' (=52) } + AssertEquals('version 4', 52, Integer(Byte(G[14]))); + { variant nibble: position 19 must be one of '8','9','a','b' (56,57,97,98) } + AssertTrue('variant 8/9/a/b', + (Byte(G[19]) = 56) or (Byte(G[19]) = 57) or + (Byte(G[19]) = 97) or (Byte(G[19]) = 98)); +end; + +procedure TGuidTests.TestRawLength; +var + R: string; +begin + R := NewGuidRaw(); + AssertEquals('16 bytes', 16, Integer(Length(R))); + { version bits in raw byte 6 (index 6): high nibble = 4 } + AssertEquals('raw version', $40, Integer(Byte(R[6]) and $F0)); + { variant bits in raw byte 8: top two bits = 10 } + AssertEquals('raw variant', $80, Integer(Byte(R[8]) and $C0)); +end; + +procedure TGuidTests.TestUnique; +var + A, B: string; +begin + A := NewGuid(); + B := NewGuid(); + AssertTrue('two guids differ', A <> B); +end; + +initialization + RegisterTest(TGuidTests); + +end. diff --git a/stdlib/src/test/pascal/test.registry.pas b/stdlib/src/test/pascal/test.registry.pas index 9a83640..d38b6ae 100644 --- a/stdlib/src/test/pascal/test.registry.pas +++ b/stdlib/src/test/pascal/test.registry.pas @@ -26,7 +26,8 @@ uses Crypto.Tests, Sockets.Tests, WebSockets.Tests, - HttpServer.Tests; + HttpServer.Tests, + Guid.Tests; implementation