Implement Extent_Block_Map for ext4 extents
diff --git a/src/filo-fs-ext2.adb b/src/filo-fs-ext2.adb
index d0f91cb..3f82377 100644
--- a/src/filo-fs-ext2.adb
+++ b/src/filo-fs-ext2.adb
@@ -297,6 +297,233 @@
Success := False;
end Ext2_Block_Map;
+ procedure Extent_Block_Map
+ (State : in out T;
+ Logical : in FSBlock_Logical;
+ Physical : out FSBlock_Offset;
+ Success : out Boolean)
+ is
+ -- Extent blocks always start with a 12B header and contain 12B entries.
+ -- Every entry starts with the number of the first logical block it
+ -- covers. Entries are sorted by this number.
+ -- Depth > 0 blocks have index entries, referencing further extent blocks.
+ -- Depth = 0 blocks have extent entries, referencing a contiguous range
+ -- of data blocks.
+ --
+ -- +-----------------+
+ -- .-> | Hdr depth=0 |
+ -- | +-----------------+
+ -- | | Extent 0.. 12 |
+ -- +-------------+ | +-----------------+
+ -- | Hdr depth=1 | | | Extent 13.. 13 |
+ -- +-------------+ | +-----------------+
+ -- | Index 0 | --' | Extent 14..122 |
+ -- +-------------+ +-----------------+
+ -- | Index 123 | --.
+ -- +-------------+ | +-----------------+
+ -- `-> | Hdr depth=0 |
+ -- +-----------------+
+ -- | Extent 123..125 |
+ -- +-----------------+
+ -- | Extent 126..234 |
+ -- +-----------------+
+ --
+
+ Extent_Header_Size : constant := 12;
+ Extent_Header_Magic : constant := 16#f03a#;
+ subtype Extent_Off is Natural range 0 .. Extent_Header_Size;
+ subtype Extent_Idx is Natural range 1 .. (Max_Block_Index'Last + 1) / Extent_Header_Size - 1;
+
+ function Extent_Byte_Offset (Idx : Extent_Idx; Off : Extent_Off) return Natural
+ is
+ (Idx * Extent_Header_Size + Off);
+
+ function Header_Magic (Buf : Buffer_Type) return Unsigned_16
+ is
+ (Read_LE16 (Buf, 0))
+ with
+ Pre => Buf'Length >= 2;
+
+ function Header_Entries (Buf : Buffer_Type) return Natural
+ is
+ (Natural (Read_LE16 (Buf, 2)))
+ with
+ Pre => Buf'Length >= 4;
+
+ function Header_Depth (Buf : Buffer_Type) return Natural
+ is
+ (Natural (Read_LE16 (Buf, 6)))
+ with
+ Pre => Buf'Length >= 8;
+
+ function Index_Logical (Buf : Buffer_Type; Idx : Extent_Idx) return FSBlock_Logical
+ is
+ (FSBlock_Logical (Read_LE32 (Buf, Extent_Byte_Offset (Idx, 0))))
+ with
+ Pre => Buf'Length >= Extent_Byte_Offset (Idx, 4);
+
+ function Index_Physical (Buf : Buffer_Type; Idx : Extent_Idx) return FSBlock_Offset
+ is
+ (FSBlock_Offset
+ (Shift_Left (Unsigned_64 (Read_LE16 (Buf, Extent_Byte_Offset (Idx, 8))), 32) or
+ Unsigned_64 (Read_LE32 (Buf, Extent_Byte_Offset (Idx, 4)))))
+ with
+ Pre => Buf'Length >= Extent_Byte_Offset (Idx, 10);
+
+ function Extent_Logical (Buf : Buffer_Type; Idx : Extent_Idx) return FSBlock_Logical
+ renames Index_Logical;
+
+ function Extent_Length (Buf : Buffer_Type; Idx : Extent_Idx) return FSBlock_Logical
+ is
+ (FSBlock_Logical (Read_LE16 (Buf, Extent_Byte_Offset (Idx, 4))))
+ with
+ Pre => Buf'Length >= Extent_Byte_Offset (Idx, 6);
+
+ function Extent_Physical (Buf : Buffer_Type; Idx : Extent_Idx) return FSBlock_Offset
+ is
+ (FSBlock_Offset
+ (Shift_Left (Unsigned_64 (Read_LE16 (Buf, Extent_Byte_Offset (Idx, 6))), 32) or
+ Unsigned_64 (Read_LE32 (Buf, Extent_Byte_Offset (Idx, 8)))))
+ with
+ Pre => Buf'Length >= Extent_Byte_Offset (Idx, 12);
+
+ function Bin_Search (Buf : Buffer_Type; Refs : Extent_Idx) return Extent_Idx
+ with
+ Pre => Refs in 1 .. Extent_Idx (Buf'Length / Extent_Header_Size - 1) and
+ Extent_Logical (Buf, 1) <= Logical,
+ Post => Bin_Search'Result in 1 .. Refs and
+ Extent_Logical (Buf, Bin_Search'Result) <= Logical
+ is
+ Left : Extent_Idx := 1;
+ Right : Extent_Idx := Refs;
+ begin
+ while Left <= Right loop
+ declare
+ Mid : constant Extent_Idx := (Left + Right) / 2;
+ Ext_Logical : constant FSBlock_Logical := Extent_Logical (Buf, Mid);
+ begin
+ if Logical < Ext_Logical then
+ Right := Mid - 1;
+ else
+ Left := Mid + 1;
+ end if;
+ end;
+ end loop;
+ return Left - 1;
+ end Bin_Search;
+
+ procedure Next_Ref
+ (Current : in FSBlock_Offset;
+ Logical_Off : in FSBlock_Logical;
+ Depth : in Natural;
+ Next : out Extent_Idx;
+ Cache_Start : out Max_Block_Index;
+ Cache_End : out Max_Block_Index;
+ Success : out Boolean)
+ with
+ Pre => Logical_Off <= Logical,
+ Post => (if Success then
+ Extent_Logical (State.Block_Cache (Cache_Start .. Cache_End), Next) <= Logical)
+ is
+ Block_Size : constant Natural := 2 ** State.Block_Size_Bits;
+ Dynamic_Max_Index : constant Natural := Block_Size / Extent_Header_Size - 1;
+ begin
+ Cache_FSBlock
+ (State => State,
+ Phys => Current,
+ Level => Depth,
+ Logical_Off => Logical_Off,
+ Cache_Start => Cache_Start,
+ Cache_End => Cache_End,
+ Success => Success);
+ if not Success then
+ Next := 1;
+ return;
+ end if;
+
+ declare
+ Hdr_Magic : constant Unsigned_16 :=
+ Header_Magic (State.Block_Cache (Cache_Start .. Cache_End));
+ Hdr_Entries : constant Natural :=
+ Header_Entries (State.Block_Cache (Cache_Start .. Cache_End));
+ Hdr_Depth : constant Natural :=
+ Header_Depth (State.Block_Cache (Cache_Start .. Cache_End));
+ First_Logical : constant FSBlock_Logical :=
+ Extent_Logical (State.Block_Cache (Cache_Start .. Cache_End), 1);
+ begin
+ Success := Success and then
+ Hdr_Magic = Extent_Header_Magic and then
+ Hdr_Depth = Depth and then
+ Hdr_Entries <= Dynamic_Max_Index and then
+ First_Logical = Logical_Off;
+ if not Success then
+ Next := 1;
+ else
+ Next := Bin_Search (State.Block_Cache (Cache_Start .. Cache_End), Hdr_Entries);
+ end if;
+ end;
+ end Next_Ref;
+
+ Inode_Magic : constant Unsigned_16 := Header_Magic (State.Inode_Extents);
+ Inode_Entries : constant Natural := Header_Entries (State.Inode_Extents);
+ First_Logical : constant FSBlock_Logical := Extent_Logical (State.Inode_Extents, 1);
+ Depth : Natural := Header_Depth (State.Inode_Extents);
+
+ Cache_Start, Cache_End : Max_Block_Index;
+ Logical_Off, Length : FSBlock_Logical;
+ Idx : Extent_Idx;
+ begin
+ Success :=
+ Inode_Magic = Extent_Header_Magic and then
+ Inode_Entries > 0 and then
+ Inode_Entries < State.Inode_Extents'Length / Extent_Header_Size and then
+ First_Logical <= Logical;
+ if not Success then
+ Physical := 0;
+ return;
+ end if;
+
+ Idx := Bin_Search (State.Inode_Extents, Inode_Entries);
+ if Depth = 0 then
+ Physical := Extent_Physical (State.Inode_Extents, Idx);
+ Logical_Off := Extent_Logical (State.Inode_Extents, Idx);
+ Length := Extent_Length (State.Inode_Extents, Idx);
+ else
+ Physical := Index_Physical (State.Inode_Extents, Idx);
+ Logical_Off := Index_Logical (State.Inode_Extents, Idx);
+ loop
+ Depth := Depth - 1;
+ Next_Ref
+ (Current => Physical,
+ Logical_Off => Logical_Off,
+ Depth => Depth,
+ Next => Idx,
+ Cache_Start => Cache_Start,
+ Cache_End => Cache_End,
+ Success => Success);
+ if not Success then
+ return;
+ end if;
+
+ exit when Depth = 0;
+ Physical := Index_Physical (State.Block_Cache (Cache_Start .. Cache_End), Idx);
+ Logical_Off := Index_Logical (State.Block_Cache (Cache_Start .. Cache_End), Idx);
+ end loop;
+
+ Physical := Extent_Physical (State.Block_Cache (Cache_Start .. Cache_End), Idx);
+ Logical_Off := Extent_Logical (State.Block_Cache (Cache_Start .. Cache_End), Idx);
+ Length := Extent_Length (State.Block_Cache (Cache_Start .. Cache_End), Idx);
+ end if;
+
+ Success :=
+ Length > 0 and then
+ Logical_Off <= FSBlock_Logical'Last - Length + 1 and then
+ Logical < Logical_Off + Length;
+ if Success then
+ Physical := Physical + FSBlock_Offset (Logical - Logical_Off);
+ end if;
+ end Extent_Block_Map;
+
procedure Open
(State : in out T;
File_Len : out File_Length;