166 lines
4.6 KiB
Ada
166 lines
4.6 KiB
Ada
-- File: adaid-generate.adb
|
|
-- Description: UUID Generation
|
|
-- Author: Anthony Arnold
|
|
-- License: Simplified BSD License (see LICENSE)
|
|
|
|
with SHA.Process_Data; -- For From_Name
|
|
with Ada.Numerics.Discrete_Random; -- For RNG
|
|
with Ada.Streams.Stream_IO; -- For reading from /dev/random
|
|
use Ada.Streams.Stream_IO;
|
|
|
|
package body AdaID.Generate is
|
|
|
|
-- For RNG
|
|
package RNG is new Ada.Numerics.Discrete_Random(Result_Subtype =>
|
|
Unsigned_32);
|
|
generator: RNG.Generator;
|
|
generator_is_set: Boolean := false;
|
|
|
|
|
|
procedure Seed_RNG is
|
|
seed : Integer;
|
|
file : File_Type;
|
|
begin
|
|
-- Set up the generator first time
|
|
if not generator_is_set then
|
|
begin
|
|
Open (File => file,
|
|
Mode => In_File,
|
|
Name => "/dev/urandom");
|
|
Integer'Read (Stream(file), seed);
|
|
Close(file);
|
|
RNG.Reset(generator, seed);
|
|
exception
|
|
when others =>
|
|
RNG.Reset(generator); -- Fallback to time-based
|
|
end;
|
|
generator_is_set := true;
|
|
end if;
|
|
end Seed_RNG;
|
|
|
|
|
|
--Reset a UUID to Nil
|
|
procedure Nil(id : in out UUID) is
|
|
begin
|
|
Initialize(id);
|
|
end Nil;
|
|
|
|
|
|
-- Generate a random UUID
|
|
procedure Random(id : in out UUID) is
|
|
rand : Unsigned_32;
|
|
x : Integer := 0;
|
|
begin
|
|
-- Ensure RNG is seeded
|
|
Seed_RNG;
|
|
|
|
-- Get a random number
|
|
rand := RNG.Random(generator);
|
|
|
|
for i in ByteArray'Range loop
|
|
if x = 4 then
|
|
x := 0;
|
|
rand := RNG.Random(generator);
|
|
end if;
|
|
id.data(i) := Byte(shift_right(rand, x * 8) and 16#FF#);
|
|
x := x + 1;
|
|
end loop;
|
|
|
|
-- Set the variant
|
|
id.data(8) := (id.data(8) and 16#BF#) or 16#80#;
|
|
|
|
--Set the version to random-number-based
|
|
id.data(6) := (id.data(6) and 16#4F#) or 16#40#;
|
|
end;
|
|
|
|
|
|
--Generate a UUID based on a name
|
|
procedure From_Name(namespace: in UUID; name: in String; id: in out UUID) is
|
|
use SHA.Process_Data;
|
|
|
|
c : Context;
|
|
d : SHA.Digest;
|
|
begin
|
|
Initialize(c);
|
|
|
|
-- Start SHA1 hashing with namespace uuid
|
|
for i in namespace.data'Range loop
|
|
Add(SHA.Process_Data.Byte(namespace.data(i)), c);
|
|
end loop;
|
|
|
|
-- Continuing hashing the actual name
|
|
for i in name'Range loop
|
|
Add(SHA.Process_Data.Byte(Character'Pos(name(i))), c);
|
|
end loop;
|
|
|
|
--Get the digest
|
|
Finalize(d, c);
|
|
|
|
-- Now make the UUID from the hash
|
|
for i in 0 .. 3 loop
|
|
id.data(i*4+0) := Byte(shift_right(d(i), 24) and 16#FF#);
|
|
id.data(i*4+1) := Byte(shift_right(d(i), 16) and 16#FF#);
|
|
id.data(i*4+2) := Byte(shift_right(d(i), 8) and 16#FF#);
|
|
id.data(i*4+3) := Byte(shift_right(d(i), 0) and 16#FF#);
|
|
end loop;
|
|
|
|
-- set variant
|
|
id.data(8) := (id.data(8) and 16#BF#) or 16#80#;
|
|
|
|
--set version
|
|
id.data(6) := (id.data(6) and 16#5F#) or 16#50#;
|
|
end From_Name;
|
|
|
|
|
|
-- Generate a UUID from a string.
|
|
-- This is not so much generation, but reconstruction
|
|
procedure From_String(str : in String; id : in out UUID) is
|
|
delim: constant Character := '-';
|
|
open : constant Character := '{';
|
|
close : constant Character := '}';
|
|
|
|
-- expect dashes if str is 36 or 38 in length
|
|
dashed: constant Boolean := str'Length = 36 or str'Length = 38;
|
|
|
|
-- check to see if braces surround the string
|
|
braced: constant Boolean := str(str'First) = open and
|
|
str(str'Last) = close;
|
|
|
|
-- track where to read from/write to
|
|
idx : Integer := 0;
|
|
start, rel : Integer;
|
|
begin
|
|
|
|
-- Check that length is valid
|
|
if not dashed and str'Length /= 32 and str'Length /= 34 then
|
|
raise Invalid_String;
|
|
end if;
|
|
|
|
-- Check that brace are valid
|
|
start := str'First;
|
|
if not braced and
|
|
(str(str'First) = open or str(str'Last) = close) then
|
|
raise Invalid_String; -- only one brace present
|
|
elsif braced then
|
|
start := str'First + 1;
|
|
end if;
|
|
|
|
idx := start;
|
|
|
|
-- Grab each pair and stuff into byte
|
|
for i in ByteArray'Range loop
|
|
rel := idx - start;
|
|
if dashed and (rel = 8 or rel = 13 or rel = 18 or rel = 23) then
|
|
if str(idx) /= delim then
|
|
raise Invalid_String; -- expected '-'
|
|
end if;
|
|
idx := idx + 1;
|
|
end if;
|
|
-- Convert to byte
|
|
id.data(i) := Byte'Value("16#" & str(idx .. idx+1) & "#");
|
|
idx := idx + 2;
|
|
end loop;
|
|
end From_String;
|
|
|
|
end AdaID.Generate;
|