------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- This file is part of 'Cryostat', an Ada library for persistent storage. -- -- -- -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) -- -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -- -- -- -- You do not have, nor can you ever acquire the right to use, copy or -- -- distribute this software ; Should you use this software for any purpose, -- -- or copy and distribute it to anyone or in any manner, you are breaking -- -- the laws of whatever soi-disant jurisdiction, and you promise to -- -- continue doing so for the indefinite future. In any case, please -- -- always : read and understand any software ; verify any PGP signatures -- -- that you use - for any purpose. -- ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with System; use System; package body PMaps is -- Open a backing file at Path, with given params, for use with Initialize function OpenMapFile(Path : in String; Writable : in Boolean := False; Create : in Boolean := False) return FD is -- Buffer for converting the civilized Path string to a C-style string : CPath : String(1 .. Path'Length + 1) := (others => Character'Val(0)); -- Unix FD handle for the backing file, obtained by Open() FileFD : FD; -- Flags provided to Open() -- default 'read only' COpenFlag : O_Flags := O_RDONLY; begin -- Convert civilized string to the barbaric type expected by Open() : CPath(Path'Range) := Path; -- Set the writability flag for Open() if Writable is enabled : if Writable then COpenFlag := O_RDWR; end if; -- If file does not exist, and Create is enabled, it will be created : if Create then COpenFlag := COpenFlag or O_CREAT; end if; -- Open the file : FileFD := Open(CPath'Address, COpenFlag); -- If Open() failed, eggog : if FileFD = FD_EGGOG then raise PMapFailedOpen with "PMap: Failed to Open backing file"; end if; -- Return the FD of the backing file : return FileFD; end OpenMapFile; -- Initialize a new map procedure Initialize(Map : in out PMap) is -- Prot flags to be given to MMap() MProtFlag : MM_Prot := PROT_READ; -- Result code returned by FTruncate() CErr : Unix_Int; begin -- Check that we have not already Open'd: if Map.Status /= Stop then Map.Status := Eggog; raise PMapFailedOpen with "PMap: already Opened backing file"; end if; -- If Write is enabled, set the appropriate flag for MMap() : if Map.MapWritable then MProtFlag := PROT_READ or PROT_WRITE; end if; -- If creating, pad the backing file to the payload size : if Map.MapCreate then CErr := FTruncate(Map.FileFD, Map.MapLength); if CErr /= 0 then Map.Status := Eggog; raise PMapFailedOpen with "PMap: Failed to FTruncate backing file"; end if; end if; -- Ask the OS to set up the map itself: Map.Address := MMap(Length => Map.MapLength, Off_T => Map.MapOffset, Prot => MProtFlag, Flags => MAP_SHARED, Handle => Map.FileFD); -- Test for failure of MMap() call : if Map.Address = MAP_FAILED then Map.Status := Eggog; raise PMapFailedMMap with "PMap: MAP_FAILED"; end if; if Map.Address = NullPtr then Map.Status := Eggog; raise PMapFailedAddr with "PMap: Map Address is Null"; end if; -- If no failure detected, mark the map as usable : Map.Status := Run; end Initialize; -- Test whether a map is operating function IsReady(Map : in PMap) return Boolean is begin return Map.Status = Run; end IsReady; -- Retrieve the memory address where the map payload resides function GetAddress(Map : in PMap) return MapAddress is begin -- Ensure that the map is active : if not IsReady(Map) then raise PMapNotRunning with "PMap: GetAddress on inactive Map"; end if; -- Return the address : return Map.Address; end GetAddress; -- Zeroize the map, if it is writable procedure Zap(Map : in out PMap) is -- Represent the map's payload as a byte array across full length : RawArray : array(1 .. Map.MapLength) of Byte; for RawArray'Address use Map.Address; begin -- If map is inactive, do nothing : if not IsReady(Map) then return; end if; -- If tried to zap a read-only map, eggog : if Map.MapWritable = False then raise PMapNotWritable with "PMap: Tried to Zap a Read-Only Map"; end if; -- Zeroize the payload of the map : RawArray := (others => 0); end Zap; -- Sync the map to disk procedure Sync(Map : in out PMap) is -- Result code returned by MSync() and Close() CErr : Unix_Int := 0; begin -- If map is inactive, do nothing : if not IsReady(Map) then return; end if; -- If map is writable, sync it to disk : if Map.MapWritable then CErr := MSync(Map.Address, Map.MapLength, MS_SYNC); end if; -- If eggog during MSync() : if CErr /= 0 then Map.Status := Eggog; CErr := Close(Map.FileFD); raise PMapFailedSync with "PMap: Failed to Sync"; end if; end Sync; -- Close map and mark it unusable procedure Stop(Map : in out PMap) is -- Result code returned by MUnmap() and Close() CErr : Unix_Int; begin -- If map is already inactive, do nothing : if not IsReady(Map) then return; end if; -- Sync all changes to disk, if map was writable : Sync(Map); -- Mark map as inactive : Map.Status := Stop; -- Unmap the map : CErr := MUnmap(Map.Address, Map.MapLength); if CErr /= 0 then Map.Status := Eggog; raise PMapFailedUnmap with "PMap: Failed to Unmap"; end if; -- Lastly, close out the FD : CErr := Close(Map.FileFD); if CErr /= 0 then Map.Status := Eggog; raise PMapFailedClose with "PMap: Failed to Close backing file"; end if; end Stop; -- Sync and close a given map, if fell out of scope procedure Finalize(Map : in out PMap) is begin -- Close the map : Stop(Map); end Finalize; end PMaps;