raw
vtools_tempfile_s...    1 with Bits; use Bits;
vtools_tempfile_s...    2 with System; use System;
vtools_tempfile_s...    3 with SMG_Keccak; use SMG_Keccak;
vtools_tempfile_s...    4 
vtools_tempfile_s...    5 package body Temporary_File is
vtools_tempfile_s...    6    -- Create a new file or exit when the file with specified name exists.
vtools_tempfile_s...    7    -- Use fopen(3) with "x" mode to create the file or error out if it
vtools_tempfile_s...    8    -- already exists.
vtools_tempfile_s...    9    subtype File_Ptr is System.Address;
vtools_tempfile_s...   10    subtype C_String is System.Address;
vtools_tempfile_s...   11 
vtools_tempfile_s...   12    function fopen (Path: C_String;
vtools_tempfile_s...   13                    Mode: C_String) return File_Ptr;
vtools_tempfile_s...   14    pragma Import (C, fopen);
vtools_tempfile_s...   15 
vtools_tempfile_s...   16    procedure fclose (Stream: File_Ptr);
vtools_tempfile_s...   17    pragma Import (C, fclose);
vtools_tempfile_s...   18 
vtools_tempfile_s...   19    function Create_File_Exclusive(Path: String) return Boolean is
vtools_tempfile_s...   20       Fptr: File_Ptr;
vtools_tempfile_s...   21    begin
vtools_tempfile_s...   22       declare
vtools_tempfile_s...   23          XP : aliased String := Path & ASCII.NUL;
vtools_tempfile_s...   24          XM : aliased String := "wx" & ASCII.NUL;
vtools_tempfile_s...   25       begin
vtools_tempfile_s...   26          Fptr := fopen(XP'Address, XM'Address);
vtools_tempfile_s...   27       end;
vtools_tempfile_s...   28       if Fptr = System.Null_Address then
vtools_tempfile_s...   29          return False;
vtools_tempfile_s...   30       end if;
vtools_tempfile_s...   31       fclose(Fptr);
vtools_tempfile_s...   32       return True;
vtools_tempfile_s...   33    end Create_File_Exclusive;
vtools_tempfile_s...   34 
vtools_tempfile_s...   35    -- Create a temporary file with a randomly generated name;
vtools_tempfile_s...   36    -- if the file with random component F exists, retry with
vtools_tempfile_s...   37    -- H(F) as a new random component.
vtools_tempfile_s...   38    Function Temporary_File(Path_Prefix: String;
vtools_tempfile_s...   39                            Seed: Bitstream) return String is
vtools_tempfile_s...   40       Hash: Bitstream(1..64*8);
vtools_tempfile_s...   41       Name_Ctx: Keccak_Context;
vtools_tempfile_s...   42 
vtools_tempfile_s...   43       procedure Hash_Bitstream(Input: Bitstream) is
vtools_tempfile_s...   44       begin
vtools_tempfile_s...   45          KeccakBegin(Name_Ctx);
vtools_tempfile_s...   46          KeccakHash(Name_Ctx, Input);
vtools_tempfile_s...   47          KeccakEnd(Name_Ctx, Hash);
vtools_tempfile_s...   48       end Hash_Bitstream;
vtools_tempfile_s...   49    begin
vtools_tempfile_s...   50       Hash_Bitstream(Seed);
vtools_tempfile_s...   51       loop
vtools_tempfile_s...   52          declare
vtools_tempfile_s...   53             File_Name: String := Path_Prefix & ToHex(Hash);
vtools_tempfile_s...   54          begin
vtools_tempfile_s...   55             if Create_File_Exclusive(File_Name) then
vtools_tempfile_s...   56                return File_Name;
vtools_tempfile_s...   57             end if;
vtools_tempfile_s...   58          end;
vtools_tempfile_s...   59          Hash_Bitstream(Hash);
vtools_tempfile_s...   60       end loop;
vtools_tempfile_s...   61    end Temporary_File;
vtools_tempfile_s...   62 
vtools_tempfile_s...   63    function Temporary_File(Path_Prefix: String;
vtools_tempfile_s...   64                            Seed: String) return String is
vtools_tempfile_s...   65       B: Bitstream(1..Seed'Length*8);
vtools_tempfile_s...   66    begin
vtools_tempfile_s...   67       ToBitstream(Seed, B);
vtools_tempfile_s...   68       return Temporary_File(Path_Prefix, B);
vtools_tempfile_s...   69    end Temporary_File;
vtools_tempfile_s...   70 
vtools_tempfile_s...   71 end Temporary_File;