---

---

 1 ------------------------------------------------------------------------------
 2 ------------------------------------------------------------------------------
 3 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
 4 -- --
 5 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
 6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
 7 -- --
 8 -- You do not have, nor can you ever acquire the right to use, copy or --
 9 -- distribute this software ; Should you use this software for any purpose, --
 10 -- or copy and distribute it to anyone or in any manner, you are breaking --
 11 -- the laws of whatever soi-disant jurisdiction, and you promise to --
 12 -- continue doing so for the indefinite future. In any case, please --
 13 -- always : read and understand any software ; verify any PGP signatures --
 14 -- that you use - for any purpose. --
 15 ------------------------------------------------------------------------------
 16 ------------------------------------------------------------------------------
 17 
 18 with System; use System;
 19 
 20 
 21 package body PMaps is
 22  
 23  -- Open a backing file at Path, with given params, for use with Initialize
 24  function OpenMapFile(Path : in String;
 25  Writable : in Boolean := False;
 26  Create : in Boolean := False) return FD is
 27  
 28  -- Buffer for converting the civilized Path string to a C-style string :
 29  CPath : String(1 .. Path'Length + 1) := (others => Character'Val(0));
 30  
 31  -- Unix FD handle for the backing file, obtained by Open()
 32  FileFD : FD;
 33  
 34  -- Flags provided to Open() -- default 'read only'
 35  COpenFlag : O_Flags := O_RDONLY;
 36  
 37  begin
 38  
 39  -- Convert civilized string to the barbaric type expected by Open() :
 40  CPath(Path'Range) := Path;
 41  
 42  -- Set the writability flag for Open() if Writable is enabled :
 43  if Writable then
 44  COpenFlag := O_RDWR;
 45  end if;
 46  
 47  -- If file does not exist, and Create is enabled, it will be created :
 48  if Create then
 49  COpenFlag := COpenFlag or O_CREAT;
 50  end if;
 51  
 52  -- Open the file :
 53  FileFD := Open(CPath'Address, COpenFlag);
 54  
 55  -- If Open() failed, eggog :
 56  if FileFD = FD_EGGOG then
 57  raise PMapFailedOpen with "PMap: Failed to Open backing file";
 58  end if;
 59  
 60  -- Return the FD of the backing file :
 61  return FileFD;
 62  
 63  end OpenMapFile;
 64  
 65  
 66  -- Initialize a new map
 67  procedure Initialize(Map : in out PMap) is
 68  
 69  -- Prot flags to be given to MMap()
 70  MProtFlag : MM_Prot := PROT_READ;
 71  
 72  -- Result code returned by FTruncate()
 73  CErr : Unix_Int;
 74  
 75  begin
 76  
 77  -- Check that we have not already Open'd:
 78  if Map.Status /= Stop then
 79  Map.Status := Eggog;
 80  raise PMapFailedOpen with "PMap: already Opened backing file";
 81  end if;
 82  
 83  -- If Write is enabled, set the appropriate flag for MMap() :
 84  if Map.MapWritable then
 85  MProtFlag := PROT_READ or PROT_WRITE;
 86  end if;
 87  
 88  -- If creating, pad the backing file to the payload size :
 89  if Map.MapCreate then
 90  CErr := FTruncate(Map.FileFD, Map.MapLength);
 91  if CErr /= 0 then
 92  Map.Status := Eggog;
 93  raise PMapFailedOpen with "PMap: Failed to FTruncate backing file";
 94  end if;
 95  end if;
 96  
 97  -- Ask the OS to set up the map itself:
 98  Map.Address := MMap(Length => Map.MapLength,
 99  Off_T => Map.MapOffset,
 100  Prot => MProtFlag,
 101  Flags => MAP_SHARED,
 102  Handle => Map.FileFD);
 103  
 104  -- Test for failure of MMap() call :
 105  if Map.Address = MAP_FAILED then
 106  Map.Status := Eggog;
 107  raise PMapFailedMMap with "PMap: MAP_FAILED";
 108  end if;
 109  
 110  if Map.Address = NullPtr then
 111  Map.Status := Eggog;
 112  raise PMapFailedAddr with "PMap: Map Address is Null";
 113  end if;
 114  
 115  -- If no failure detected, mark the map as usable :
 116  Map.Status := Run;
 117  
 118  end Initialize;
 119  
 120  
 121  -- Test whether a map is operating
 122  function IsReady(Map : in PMap) return Boolean is
 123  begin
 124  
 125  return Map.Status = Run;
 126  
 127  end IsReady;
 128  
 129  
 130  -- Retrieve the memory address where the map payload resides
 131  function GetAddress(Map : in PMap) return MapAddress is
 132  begin
 133  
 134  -- Ensure that the map is active :
 135  if not IsReady(Map) then
 136  raise PMapNotRunning with "PMap: GetAddress on inactive Map";
 137  end if;
 138  
 139  -- Return the address :
 140  return Map.Address;
 141  
 142  end GetAddress;
 143  
 144  
 145  -- Zeroize the map, if it is writable
 146  procedure Zap(Map : in out PMap) is
 147  
 148  -- Represent the map's payload as a byte array across full length :
 149  RawArray : array(1 .. Map.MapLength) of Byte;
 150  for RawArray'Address use Map.Address;
 151  
 152  begin
 153  
 154  -- If map is inactive, do nothing :
 155  if not IsReady(Map) then
 156  return;
 157  end if;
 158  
 159  -- If tried to zap a read-only map, eggog :
 160  if Map.MapWritable = False then
 161  raise PMapNotWritable with "PMap: Tried to Zap a Read-Only Map";
 162  end if;
 163  
 164  -- Zeroize the payload of the map :
 165  RawArray := (others => 0);
 166  
 167  end Zap;
 168  
 169  
 170  -- Sync the map to disk
 171  procedure Sync(Map : in out PMap) is
 172  
 173  -- Result code returned by MSync() and Close()
 174  CErr : Unix_Int := 0;
 175  
 176  begin
 177  
 178  -- If map is inactive, do nothing :
 179  if not IsReady(Map) then
 180  return;
 181  end if;
 182  
 183  -- If map is writable, sync it to disk :
 184  if Map.MapWritable then
 185  CErr := MSync(Map.Address, Map.MapLength, MS_SYNC);
 186  end if;
 187  
 188  -- If eggog during MSync() :
 189  if CErr /= 0 then
 190  Map.Status := Eggog;
 191  CErr := Close(Map.FileFD);
 192  raise PMapFailedSync with "PMap: Failed to Sync";
 193  end if;
 194  
 195  end Sync;
 196  
 197  
 198  -- Close map and mark it unusable
 199  procedure Stop(Map : in out PMap) is
 200  
 201  -- Result code returned by MUnmap() and Close()
 202  CErr : Unix_Int;
 203  
 204  begin
 205  
 206  -- If map is already inactive, do nothing :
 207  if not IsReady(Map) then
 208  return;
 209  end if;
 210  
 211  -- Sync all changes to disk, if map was writable :
 212  Sync(Map);
 213  
 214  -- Mark map as inactive :
 215  Map.Status := Stop;
 216  
 217  -- Unmap the map :
 218  CErr := MUnmap(Map.Address, Map.MapLength);
 219  if CErr /= 0 then
 220  Map.Status := Eggog;
 221  raise PMapFailedUnmap with "PMap: Failed to Unmap";
 222  end if;
 223  
 224  -- Lastly, close out the FD :
 225  CErr := Close(Map.FileFD);
 226  if CErr /= 0 then
 227  Map.Status := Eggog;
 228  raise PMapFailedClose with "PMap: Failed to Close backing file";
 229  end if;
 230  
 231  end Stop;
 232  
 233  
 234  -- Sync and close a given map, if fell out of scope
 235  procedure Finalize(Map : in out PMap) is
 236  begin
 237  
 238  -- Close the map :
 239  Stop(Map);
 240  
 241  end Finalize;
 242  
 243 end PMaps;