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;