-
+ F32079AAC09AC289E830F64803D3AAF2C0A31309900340D9548AF67FF86FE07741238BEED1E25741C33D2CB67C9AC8AFD4B23FA9B1E652CCBBEDDD0B50F1A31A
cryostat/libcryo/pmaps.adb

(0 . 0)(1 . 243)
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- 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;