From a06119f6fde2e0b284f631df9f3c856ce6fab212 Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Sun, 30 Jul 2017 19:49:16 +0200 Subject: [PATCH] Filesystem: Create a "front-end" for file handling in a package called File_IO. This hides some of the complexity of dealing with access to handle and answers some of the questions discussed in the issue #68. The package also provides the mounting interface, taken from Filesystem.VFS. --- ...e-filesystem.adb => filesystem-native.adb} | 21 +- ...e-filesystem.ads => filesystem-native.ads} | 17 +- middleware/src/bitmap/bitmap_file_output.adb | 17 +- middleware/src/bitmap/bitmap_file_output.ads | 6 +- .../FAT/filesystem-fat-directories.adb | 1 - .../filesystem/FAT/filesystem-fat-files.adb | 1 + .../filesystem/FAT/filesystem-fat-files.ads | 3 +- .../src/filesystem/FAT/filesystem-fat.adb | 7 + .../src/filesystem/FAT/filesystem-fat.ads | 26 +- .../src/filesystem/MBR/filesystem-mbr.adb | 27 +- .../src/filesystem/MBR/filesystem-mbr.ads | 8 +- .../src/filesystem/VFS/filesystem-vfs.adb | 349 --------- .../src/filesystem/VFS/filesystem-vfs.ads | 104 --- middleware/src/filesystem/file_io.adb | 723 ++++++++++++++++++ middleware/src/filesystem/file_io.ads | 246 ++++++ middleware/src/filesystem/filesystem.adb | 62 -- middleware/src/filesystem/filesystem.ads | 42 - .../src/filesystems/pathname_manipulation.ads | 2 - middleware/src/utils/file_block_drivers.adb | 30 +- middleware/src/utils/file_block_drivers.ads | 16 +- .../bitmap_drawing/src/tc_bitmap_drawing.adb | 24 +- .../tests/fat_driver/src/tc_fat_read.adb | 133 ++-- .../tests/fat_driver/src/tc_fat_write.adb | 123 ++- testsuite/utils/src/compare_files.adb | 9 +- testsuite/utils/src/compare_files.ads | 4 +- testsuite/utils/src/copy_files.ads | 38 - .../{copy_files.adb => test_directories.adb} | 34 +- testsuite/utils/src/test_directories.ads | 9 +- 28 files changed, 1243 insertions(+), 839 deletions(-) rename boards/native/src/{native-filesystem.adb => filesystem-native.adb} (97%) rename boards/native/src/{native-filesystem.ads => filesystem-native.ads} (95%) delete mode 100644 middleware/src/filesystem/VFS/filesystem-vfs.adb delete mode 100644 middleware/src/filesystem/VFS/filesystem-vfs.ads create mode 100644 middleware/src/filesystem/file_io.adb create mode 100644 middleware/src/filesystem/file_io.ads delete mode 100644 middleware/src/filesystem/filesystem.adb delete mode 100644 testsuite/utils/src/copy_files.ads rename testsuite/utils/src/{copy_files.adb => test_directories.adb} (75%) diff --git a/boards/native/src/native-filesystem.adb b/boards/native/src/filesystem-native.adb similarity index 97% rename from boards/native/src/native-filesystem.adb rename to boards/native/src/filesystem-native.adb index aefb96734..15770d2c4 100644 --- a/boards/native/src/native-filesystem.adb +++ b/boards/native/src/filesystem-native.adb @@ -1,7 +1,7 @@ with Ada.Directories; with Ada.Unchecked_Deallocation; -package body Native.Filesystem is +package body Filesystem.Native is -- ??? There are a bunch of 'Unrestricted_Access here because the -- HAL.Filesystem API embeds implicit references to filesystems. It @@ -265,8 +265,8 @@ package body Native.Filesystem is overriding function Get_FS - (This : Directory_Handle) return Any_Filesystem - is (Any_Filesystem (This.FS)); + (This : Directory_Handle) return Any_Filesystem_Driver + is (Any_Filesystem_Driver (This.FS)); --------------- -- Root_Node -- @@ -484,8 +484,8 @@ package body Native.Filesystem is overriding function Get_FS - (This : in out File_Handle) return Any_Filesystem - is (Any_Filesystem (This.FS)); + (This : in out File_Handle) return Any_Filesystem_Driver + is (Any_Filesystem_Driver (This.FS)); ---------- -- Size -- @@ -516,16 +516,20 @@ package body Native.Filesystem is return Status_Code is Data : UInt8_Array (1 .. Natural (Length)) with Address => Addr; + Ret : File_Size := 0; begin for B of Data loop Byte_IO.Read (This.File, B); + Ret := Ret + 1; end loop; + Length := Ret; return OK; exception when Byte_IO.Mode_Error | Byte_IO.End_Error | Byte_IO.Data_Error => + Length := Ret; return Generic_Error; end Read; @@ -668,9 +672,8 @@ package body Native.Filesystem is ------------ overriding - function Get_FS (This : Node_Handle) return Any_Filesystem - is (Any_Filesystem (This.FS)); - + function Get_FS (This : Node_Handle) return Any_Filesystem_Driver + is (Any_Filesystem_Driver (This.FS)); -------------- -- Basename -- @@ -794,4 +797,4 @@ package body Native.Filesystem is return +Result; end Join; -end Native.Filesystem; +end Filesystem.Native; diff --git a/boards/native/src/native-filesystem.ads b/boards/native/src/filesystem-native.ads similarity index 95% rename from boards/native/src/native-filesystem.ads rename to boards/native/src/filesystem-native.ads index ccd9bf4ca..935a1dc43 100644 --- a/boards/native/src/native-filesystem.ads +++ b/boards/native/src/filesystem-native.ads @@ -8,7 +8,7 @@ with System; -- Simple wrappers around the Ada standard library to provide implementations -- for HAL.Filesystem interfaces. -package Native.Filesystem is +package Filesystem.Native is package HALFS renames HAL.Filesystem; @@ -40,11 +40,6 @@ package Native.Filesystem is return Status_Code; -- Open a new Directory Handle at the given Filesystem Path - overriding - function Create_File (This : in out Native_FS_Driver; - Path : String) - return Status_Code; - overriding function Unlink (This : in out Native_FS_Driver; Path : String) @@ -59,7 +54,7 @@ package Native.Filesystem is overriding function Get_FS - (This : Directory_Handle) return Any_Filesystem; + (This : Directory_Handle) return Any_Filesystem_Driver; -- Return the filesystem the handle belongs to. overriding @@ -91,7 +86,7 @@ package Native.Filesystem is --------------------- overriding - function Get_FS (This : Node_Handle) return Any_Filesystem; + function Get_FS (This : Node_Handle) return Any_Filesystem_Driver; overriding function Basename (This : Node_Handle) return String; @@ -138,7 +133,7 @@ package Native.Filesystem is overriding function Get_FS - (This : in out File_Handle) return Any_Filesystem; + (This : in out File_Handle) return Any_Filesystem_Driver; overriding function Size @@ -250,7 +245,7 @@ private package Byte_IO is new Ada.Direct_IO (UInt8); - type Native_FS_Driver is limited new HAL.Filesystem.Filesystem with record + type Native_FS_Driver is limited new Filesystem_Driver with record Root_Dir : Ada.Strings.Unbounded.Unbounded_String; -- Path on the host file system to be used as root directory for this FS @@ -334,4 +329,4 @@ private -- Current index in the vector of Node end record; -end Native.Filesystem; +end Filesystem.Native; diff --git a/middleware/src/bitmap/bitmap_file_output.adb b/middleware/src/bitmap/bitmap_file_output.adb index 7271d0bcf..f606fb98e 100644 --- a/middleware/src/bitmap/bitmap_file_output.adb +++ b/middleware/src/bitmap/bitmap_file_output.adb @@ -31,7 +31,6 @@ with Interfaces; use Interfaces; with HAL; use HAL; -with Filesystem; use Filesystem; package body Bitmap_File_Output is @@ -71,7 +70,7 @@ package body Bitmap_File_Output is -- Write_BMP_File -- -------------------- - procedure Write_BMP_File (File : Any_File_Handle; + procedure Write_BMP_File (File : in out File_Descriptor; Bitmap : Bitmap_Buffer'Class) is Hdr : Header; @@ -84,8 +83,8 @@ package body Bitmap_File_Output is Pix_Out : UInt8_Array (1 .. 3); Padding : constant UInt8_Array (1 .. Integer (Row_Padding)) := (others => 0); - function Write is new Filesystem.Generic_Write (Header); - function Write is new Filesystem.Generic_Write (Info); +-- function Write is new Generic_Write (Header); +-- function Write is new Generic_Write (Info); begin Hdr.Signature := 16#4D42#; Hdr.Size := (Data_Size + 54) / 4; @@ -107,11 +106,11 @@ package body Bitmap_File_Output is Inf.Important := 0; - if Write (File, Hdr) /= OK then + if Write (File, Hdr'Address, Hdr'Size / 8) /= (Hdr'Size / 8) then raise Program_Error; end if; - if Write (File, Inf) /= OK then + if Write (File, Inf'Address, Inf'Size / 8) /= (Inf'Size / 8) then raise Program_Error; end if; @@ -124,12 +123,14 @@ package body Bitmap_File_Output is Pix_Out (2) := RGB_Pix.Green; Pix_Out (3) := RGB_Pix.Red; - if File.Write (Pix_Out'Address, Pix_Out'Length) /= OK then + if Write (File, Pix_Out'Address, Pix_Out'Length) /= Pix_Out'Length + then raise Program_Error; end if; end loop; - if File.Write (Padding'Address, Padding'Length) /= OK then + if Write (File, Padding'Address, Padding'Length) /= Padding'Length + then raise Program_Error; end if; end loop; diff --git a/middleware/src/bitmap/bitmap_file_output.ads b/middleware/src/bitmap/bitmap_file_output.ads index 0c3252ce8..d932a3bef 100644 --- a/middleware/src/bitmap/bitmap_file_output.ads +++ b/middleware/src/bitmap/bitmap_file_output.ads @@ -29,12 +29,12 @@ -- -- ------------------------------------------------------------------------------ -with HAL.Filesystem; use HAL.Filesystem; -with HAL.Bitmap; use HAL.Bitmap; +with File_IO; use File_IO; +with HAL.Bitmap; use HAL.Bitmap; package Bitmap_File_Output is - procedure Write_BMP_File (File : Any_File_Handle; + procedure Write_BMP_File (File : in out File_Descriptor; Bitmap : Bitmap_Buffer'Class); end Bitmap_File_Output; diff --git a/middleware/src/filesystem/FAT/filesystem-fat-directories.adb b/middleware/src/filesystem/FAT/filesystem-fat-directories.adb index 55eb4d348..4ebc2e9b3 100644 --- a/middleware/src/filesystem/FAT/filesystem-fat-directories.adb +++ b/middleware/src/filesystem/FAT/filesystem-fat-directories.adb @@ -30,7 +30,6 @@ ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion; -with HAL; use HAL; package body Filesystem.FAT.Directories is diff --git a/middleware/src/filesystem/FAT/filesystem-fat-files.adb b/middleware/src/filesystem/FAT/filesystem-fat-files.adb index d43864923..5cb0a0bc2 100644 --- a/middleware/src/filesystem/FAT/filesystem-fat-files.adb +++ b/middleware/src/filesystem/FAT/filesystem-fat-files.adb @@ -34,6 +34,7 @@ with Filesystem.FAT.Directories; package body Filesystem.FAT.Files is + function Absolute_Block (File : in out FAT_File_Handle) return Block_Number with Inline_Always; diff --git a/middleware/src/filesystem/FAT/filesystem-fat-files.ads b/middleware/src/filesystem/FAT/filesystem-fat-files.ads index 580fb7ca4..96a9f1e4f 100644 --- a/middleware/src/filesystem/FAT/filesystem-fat-files.ads +++ b/middleware/src/filesystem/FAT/filesystem-fat-files.ads @@ -65,8 +65,7 @@ private package Filesystem.FAT.Files is function Read (File : in out FAT_File_Handle; Addr : System.Address; - Length : in out FAT_File_Size) return Status_Code - with Pre => Mode (File) /= Write_Mode; + Length : in out FAT_File_Size) return Status_Code; -- read data from file. -- @return number of bytes read (at most Data'Length), or -1 on error. diff --git a/middleware/src/filesystem/FAT/filesystem-fat.adb b/middleware/src/filesystem/FAT/filesystem-fat.adb index b13b0d9a4..6d35f840f 100644 --- a/middleware/src/filesystem/FAT/filesystem-fat.adb +++ b/middleware/src/filesystem/FAT/filesystem-fat.adb @@ -1146,4 +1146,11 @@ package body Filesystem.FAT is null; end Close; + ---------- + -- Size -- + ---------- + + overriding function Size (E : FAT_Node) return File_Size + is (File_Size (E.Size)); + end Filesystem.FAT; diff --git a/middleware/src/filesystem/FAT/filesystem-fat.ads b/middleware/src/filesystem/FAT/filesystem-fat.ads index 653db168c..eb4643cda 100644 --- a/middleware/src/filesystem/FAT/filesystem-fat.ads +++ b/middleware/src/filesystem/FAT/filesystem-fat.ads @@ -31,7 +31,6 @@ with System; with Interfaces; use Interfaces; -with HAL; use HAL; with HAL.Block_Drivers; use HAL.Block_Drivers; with HAL.Filesystem; use HAL.Filesystem; @@ -51,7 +50,7 @@ package Filesystem.FAT is type FAT_Name is private; - type FAT_Filesystem is limited new HAL.Filesystem.Filesystem with private; + type FAT_Filesystem is limited new Filesystem_Driver with private; type FAT_Node is new Node_Handle with private; @@ -101,7 +100,7 @@ package Filesystem.FAT is overriding function Size (E : FAT_Node) return File_Size; overriding procedure Close (E : in out FAT_Node); overriding function Get_FS - (E : FAT_Node) return Any_Filesystem; + (E : FAT_Node) return Any_Filesystem_Driver; ------------------- -- FILE HANDLING -- @@ -291,7 +290,7 @@ private Last_Allocated_Cluster at 8 range 0 .. 31; end record; - type FAT_Filesystem is limited new HAL.Filesystem.Filesystem with record + type FAT_Filesystem is limited new Filesystem_Driver with record Initialized : Boolean := False; Disk_Parameters : FAT_Disk_Parameter; LBA : Block_Number; @@ -402,7 +401,7 @@ private type Any_FAT_Directory_Handle is access all FAT_Directory_Handle'Class; overriding function Get_FS - (Dir : FAT_Directory_Handle) return Any_Filesystem; + (Dir : FAT_Directory_Handle) return Any_Filesystem_Driver; overriding function Read (Dir : in out FAT_Directory_Handle; @@ -487,7 +486,7 @@ private type FAT_File_Handle_Access is access all FAT_File_Handle; overriding function Get_FS - (File : in out FAT_File_Handle) return Any_Filesystem; + (File : in out FAT_File_Handle) return Any_Filesystem_Driver; overriding function Size (File : FAT_File_Handle) return File_Size; @@ -701,15 +700,15 @@ private -- for the trailing ASCII.NUL + 0xFFFF sequence. overriding function Get_FS - (Dir : FAT_Directory_Handle) return Any_Filesystem - is (Any_Filesystem (Dir.FS)); + (Dir : FAT_Directory_Handle) return Any_Filesystem_Driver + is (Any_Filesystem_Driver (Dir.FS)); overriding function Get_FS - (File : in out FAT_File_Handle) return Any_Filesystem - is (Any_Filesystem (File.FS)); + (File : in out FAT_File_Handle) return Any_Filesystem_Driver + is (Any_Filesystem_Driver (File.FS)); - overriding function Get_FS (E : FAT_Node) return Any_Filesystem - is (Any_Filesystem (E.FS)); + overriding function Get_FS (E : FAT_Node) return Any_Filesystem_Driver + is (Any_Filesystem_Driver (E.FS)); function Long_Name (E : FAT_Node) return FAT_Name is (if E.L_Name.Len > 0 then E.L_Name else Short_Name (E)); @@ -741,9 +740,6 @@ private function Get_Start_Cluster (E : FAT_Node) return Cluster_Type is (E.Start_Cluster); - overriding function Size (E : FAT_Node) return File_Size - is (File_Size (E.Size)); - function Size (E : FAT_Node) return FAT_File_Size is (E.Size); diff --git a/middleware/src/filesystem/MBR/filesystem-mbr.adb b/middleware/src/filesystem/MBR/filesystem-mbr.adb index 7d131e6fd..1f7d234db 100644 --- a/middleware/src/filesystem/MBR/filesystem-mbr.adb +++ b/middleware/src/filesystem/MBR/filesystem-mbr.adb @@ -39,23 +39,24 @@ package body Filesystem.MBR is function Read (Controller : HAL.Block_Drivers.Any_Block_Driver; - MBR : out Master_Boot_Record) return Status_Code + MBR : out Master_Boot_Record) + return File_IO.Status_Code is Tmp : aliased Master_Boot_Record; Data : aliased HAL.UInt8_Array (1 .. 512) with Address => Tmp'Address; begin -- Let's read the MBR: located in the first block if not Controller.Read (0, Data) then - return Disk_Error; + return File_IO.Disk_Error; end if; MBR := Tmp; if MBR.Signature /= 16#AA55# then - return No_MBR_Found; + return File_IO.No_MBR_Found; end if; - return OK; + return File_IO.OK; end Read; ------------------- @@ -66,7 +67,8 @@ package body Filesystem.MBR is (Controller : HAL.Block_Drivers.Any_Block_Driver; MBR : Master_Boot_Record; P : Partition_Number; - EBR : out Extended_Boot_Record) return Status_Code + EBR : out Extended_Boot_Record) + return File_IO.Status_Code is BA : constant Block_Number := LBA (MBR, P); Tmp : aliased Extended_Boot_Record; @@ -74,16 +76,16 @@ package body Filesystem.MBR is begin -- Let's read the MBR: located in the first block if not Controller.Read (HAL.UInt64 (BA), Data) then - return Disk_Error; + return File_IO.Disk_Error; end if; EBR := Tmp; if EBR.Signature /= 16#AA55# then - return No_MBR_Found; + return File_IO.No_MBR_Found; end if; - return OK; + return File_IO.OK; end Read_Extended; ------------ @@ -176,7 +178,8 @@ package body Filesystem.MBR is function Read_Next (Controller : HAL.Block_Drivers.Any_Block_Driver; - EBR : in out Extended_Boot_Record) return Status_Code + EBR : in out Extended_Boot_Record) + return File_IO.Status_Code is BA : constant Block_Number := Block_Number (EBR.P_Entries (2).LBA); Tmp : aliased Extended_Boot_Record; @@ -184,16 +187,16 @@ package body Filesystem.MBR is begin -- Let's read the MBR: located in the first block if not Controller.Read (BA, Data) then - return Disk_Error; + return File_IO.Disk_Error; end if; EBR := Tmp; if EBR.Signature /= 16#AA55# then - return No_MBR_Found; + return File_IO.No_MBR_Found; end if; - return OK; + return File_IO.OK; end Read_Next; end Filesystem.MBR; diff --git a/middleware/src/filesystem/MBR/filesystem-mbr.ads b/middleware/src/filesystem/MBR/filesystem-mbr.ads index 1eda2017e..be1b2691f 100644 --- a/middleware/src/filesystem/MBR/filesystem-mbr.ads +++ b/middleware/src/filesystem/MBR/filesystem-mbr.ads @@ -31,7 +31,7 @@ with Interfaces; with HAL.Block_Drivers; -with HAL.Filesystem; use HAL.Filesystem; +with File_IO; package Filesystem.MBR is @@ -44,7 +44,7 @@ package Filesystem.MBR is function Read (Controller : HAL.Block_Drivers.Any_Block_Driver; - MBR : out Master_Boot_Record) return Status_Code; + MBR : out Master_Boot_Record) return File_IO.Status_Code; function Active (MBR : Master_Boot_Record; P : Partition_Number) return Boolean; @@ -65,7 +65,7 @@ package Filesystem.MBR is (Controller : HAL.Block_Drivers.Any_Block_Driver; MBR : Master_Boot_Record; P : Partition_Number; - EBR : out Extended_Boot_Record) return Status_Code; + EBR : out Extended_Boot_Record) return File_IO.Status_Code; function Get_Type (EBR : Extended_Boot_Record) return Partition_Type; function LBA (EBR : Extended_Boot_Record) return Block_Number; @@ -75,7 +75,7 @@ package Filesystem.MBR is function Read_Next (Controller : HAL.Block_Drivers.Any_Block_Driver; - EBR : in out Extended_Boot_Record) return Status_Code; + EBR : in out Extended_Boot_Record) return File_IO.Status_Code; private diff --git a/middleware/src/filesystem/VFS/filesystem-vfs.adb b/middleware/src/filesystem/VFS/filesystem-vfs.adb deleted file mode 100644 index eaff93fed..000000000 --- a/middleware/src/filesystem/VFS/filesystem-vfs.adb +++ /dev/null @@ -1,349 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- Copyright (C) 2015-2017, AdaCore -- --- -- --- Redistribution and use in source and binary forms, with or without -- --- modification, are permitted provided that the following conditions are -- --- met: -- --- 1. Redistributions of source code must retain the above copyright -- --- notice, this list of conditions and the following disclaimer. -- --- 2. Redistributions in binary form must reproduce the above copyright -- --- notice, this list of conditions and the following disclaimer in -- --- the documentation and/or other materials provided with the -- --- distribution. -- --- 3. Neither the name of the copyright holder nor the names of its -- --- contributors may be used to endorse or promote products derived -- --- from this software without specific prior written permission. -- --- -- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- --- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- --- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- --- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- --- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- --- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- --- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- --- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- --- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- --- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- --- -- ------------------------------------------------------------------------------- - -with Filesystem.MBR; use Filesystem.MBR; -with Filesystem.FAT; use Filesystem.FAT; - -package body Filesystem.VFS is - - Mount_Points : Mount_Array; - - Handles : array (1 .. 2) of aliased VFS_Directory_Handle; - - function Name (Point : Mount_Record) return Mount_Path; - procedure Set_Name (Point : in out Mount_Record; - Path : Mount_Path); - procedure Split - (Path : String; - FS : out Any_Filesystem; - Start_Index : out Natural); - - ---------- - -- Name -- - ---------- - - function Name (Point : Mount_Record) return Mount_Path - is (Point.Name (1 .. Point.Name_Len)); - - -------------- - -- Set_Name -- - -------------- - - procedure Set_Name (Point : in out Mount_Record; - Path : Mount_Path) - is - begin - Point.Name (1 .. Path'Length) := Path; - Point.Name_Len := Path'Length; - end Set_Name; - - ----------- - -- Split -- - ----------- - - procedure Split - (Path : String; - FS : out Any_Filesystem; - Start_Index : out Natural) - is - begin - if Path (Path'First) /= '/' then - FS := null; - Start_Index := 0; - - return; - end if; - - Start_Index := Path'Last + 1; - - for J in Path'First + 1 .. Path'Last loop - if Path (J) = '/' then - Start_Index := J; - - exit; - end if; - end loop; - - for M of Mount_Points loop - if not M.Is_Free - and then Name (M) = Path (Path'First + 1 .. Start_Index - 1) - then - FS := M.FS; - - return; - end if; - end loop; - - FS := null; - Start_Index := 0; - end Split; - - ------------------ - -- Mount_Volume -- - ------------------ - - function Mount_Volume - (Mount_Point : Mount_Path; - FS : Any_Filesystem) return Status_Code - is - Idx : Natural := 0; - begin - for P in Mount_Points'Range loop - if not Mount_Points (P).Is_Free - and then Name (Mount_Points (P)) = Mount_Point - then - return Already_Exists; - - elsif Idx = 0 and then Mount_Points (P).Is_Free then - Idx := P; - end if; - end loop; - - if Idx = 0 then - return Too_Many_Open_Files; - end if; - - Mount_Points (Idx).Is_Free := False; - Mount_Points (Idx).FS := FS; - Set_Name (Mount_Points (Idx), Mount_Point); - - return OK; - end Mount_Volume; - - ----------------- - -- Mount_Drive -- - ----------------- - - function Mount_Drive - (Mount_Point : Mount_Path; - Device : HAL.Block_Drivers.Any_Block_Driver) - return Status_Code - is - MBR : Master_Boot_Record; - Status : Status_Code; - FAT_FS : access FAT_Filesystem; - begin - Status := Read (Device, MBR); - - if Status /= OK then - return Status; - end if; - - for P in Partition_Number'Range loop - if Valid (MBR, P) - and then Get_Type (MBR, P) in 6 | 11 .. 12 - then - Status := OK; - FAT_FS := new FAT_Filesystem; - Status := Open (Controller => Device, - LBA => LBA (MBR, P), - FS => FAT_FS.all); - return Mount_Volume (Mount_Point, FAT_FS); - end if; - end loop; - - return No_Filesystem; - end Mount_Drive; - - ------------- - -- Unmount -- - ------------- - - function Unmount (Mount_Point : Mount_Path) return Status_Code - is - begin - for P in Mount_Points'Range loop - if Name (Mount_Points (P)) = Mount_Point then - Mount_Points (P).FS.Close; - Mount_Points (P).Is_Free := True; - - return OK; - end if; - end loop; - - return Not_Mounted; - end Unmount; - - ---------- - -- Open -- - ---------- - - function Open - (Path : String; - Handle : out Any_Directory_Handle) - return Status_Code - is - Idx : Natural; - FS : Any_Filesystem; - begin - if Path = "/" then - for J in Handles'Range loop - if Handles (J).Is_Free then - Handles (J).Is_Free := False; - Handles (J).Mount_Id := 0; - Handle := Handles (J)'Access; - return OK; - end if; - end loop; - - Handle := null; - return Too_Many_Open_Files; - end if; - - Split (Path, FS, Idx); - - if FS = null then - Handle := null; - return No_Such_Path; - end if; - - if Idx > Path'Last then - return FS.Open ("/", Handle); - else - return FS.Open (Path (Idx .. Path'Last), Handle); - end if; - end Open; - - ---------- - -- Open -- - ---------- - - function Open - (Path : String; - Mode : File_Mode; - Handle : out Any_File_Handle) - return Status_Code - is - Idx : Natural; - FS : Any_Filesystem; - begin - Split (Path, FS, Idx); - - if FS = null then - Handle := null; - return No_Such_Path; - end if; - - return FS.Open (Path (Idx .. Path'Last), Mode, Handle); - end Open; - - ------------ - -- Unlink -- - ------------ - - function Unlink (Path : String) return Status_Code is - Idx : Natural; - FS : Any_Filesystem; - begin - Split (Path, FS, Idx); - - if FS = null then - return No_Such_Path; - end if; - - return FS.Unlink (Path (Idx .. Path'Last)); - end Unlink; - - ---------------------- - -- Remove_Directory -- - ---------------------- - - function Remove_Directory (Path : String) return Status_Code is - Idx : Natural; - FS : Any_Filesystem; - begin - Split (Path, FS, Idx); - - if FS = null then - return No_Such_Path; - end if; - - return FS.Remove_Directory (Path (Idx .. Path'Last)); - end Remove_Directory; - - ------------ - -- Get_FS -- - ------------ - - overriding function Get_FS - (Dir : VFS_Directory_Handle) return Any_Filesystem - is - pragma Unreferenced (Dir); - begin - return null; - end Get_FS; - - ---------- - -- Read -- - ---------- - - overriding function Read - (Dir : in out VFS_Directory_Handle; - Handle : out Any_Node_Handle) return Status_Code - is - begin - loop - if Dir.Mount_Id = Mount_Points'Last then - Handle := null; - return No_More_Entries; - end if; - - Dir.Mount_Id := Dir.Mount_Id + 1; - - if not Mount_Points (Dir.Mount_Id).Is_Free then - return Mount_Points (Dir.Mount_Id).FS.Root_Node - (Name (Mount_Points (Dir.Mount_Id)), - Handle); - end if; - end loop; - end Read; - - ----------- - -- Reset -- - ----------- - - overriding procedure Reset (Dir : in out VFS_Directory_Handle) - is - begin - Dir.Mount_Id := 0; - end Reset; - - ----------- - -- Close -- - ----------- - - overriding procedure Close (Dir : in out VFS_Directory_Handle) - is - begin - Dir.Is_Free := True; - end Close; - -end Filesystem.VFS; diff --git a/middleware/src/filesystem/VFS/filesystem-vfs.ads b/middleware/src/filesystem/VFS/filesystem-vfs.ads deleted file mode 100644 index e5920ec7f..000000000 --- a/middleware/src/filesystem/VFS/filesystem-vfs.ads +++ /dev/null @@ -1,104 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- Copyright (C) 2015-2017, AdaCore -- --- -- --- Redistribution and use in source and binary forms, with or without -- --- modification, are permitted provided that the following conditions are -- --- met: -- --- 1. Redistributions of source code must retain the above copyright -- --- notice, this list of conditions and the following disclaimer. -- --- 2. Redistributions in binary form must reproduce the above copyright -- --- notice, this list of conditions and the following disclaimer in -- --- the documentation and/or other materials provided with the -- --- distribution. -- --- 3. Neither the name of the copyright holder nor the names of its -- --- contributors may be used to endorse or promote products derived -- --- from this software without specific prior written permission. -- --- -- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- --- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- --- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- --- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- --- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- --- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- --- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- --- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- --- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- --- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- --- -- ------------------------------------------------------------------------------- - --- Simple virtual file system allowing to mount actual fs into a virtual --- fs environment composed of 1 level of virtual directories. - -with HAL.Filesystem; use HAL.Filesystem; -with HAL.Block_Drivers; - -package Filesystem.VFS is - - MAX_MOUNT_POINTS : constant := 2; - MAX_MOUNT_NAME_LENGTH : constant := 128; - - subtype Mount_Path is String - with Dynamic_Predicate => Mount_Path'Length <= MAX_MOUNT_NAME_LENGTH; - - function Mount_Volume - (Mount_Point : Mount_Path; - FS : Any_Filesystem) return Status_Code; - - function Mount_Drive - (Mount_Point : Mount_Path; - Device : HAL.Block_Drivers.Any_Block_Driver) return Status_Code; - - function Unmount (Mount_Point : Mount_Path) return Status_Code; - - function Open - (Path : String; - Handle : out Any_Directory_Handle) - return Status_Code; - - function Open - (Path : String; - Mode : File_Mode; - Handle : out Any_File_Handle) - return Status_Code; - - function Unlink (Path : String) return Status_Code; - function Remove_Directory (Path : String) return Status_Code; - -private - - type Mount_Record is record - Is_Free : Boolean := True; - Name : String (1 .. MAX_MOUNT_NAME_LENGTH); - Name_Len : Positive; - FS : Any_Filesystem; - end record; - - subtype Mount_Index is Integer range 0 .. MAX_MOUNT_POINTS; - subtype Valid_Mount_Index is Mount_Index range 1 .. MAX_MOUNT_POINTS; - type Mount_Array is array (Valid_Mount_Index) of Mount_Record; - - type VFS_Directory_Handle is new Directory_Handle with record - Is_Free : Boolean := True; - Mount_Id : Mount_Index; - end record; - - overriding function Get_FS - (Dir : VFS_Directory_Handle) return Any_Filesystem; - -- Return the filesystem the handle belongs to. - - overriding function Read - (Dir : in out VFS_Directory_Handle; - Handle : out Any_Node_Handle) return Status_Code; - -- Reads the next directory entry. If no such entry is there, an error - -- code is returned in Status. - - overriding procedure Reset (Dir : in out VFS_Directory_Handle); - -- Resets the handle to the first node - - overriding procedure Close (Dir : in out VFS_Directory_Handle); - -- Closes the handle, and free the associated resources. - -end Filesystem.VFS; diff --git a/middleware/src/filesystem/file_io.adb b/middleware/src/filesystem/file_io.adb new file mode 100644 index 000000000..a5d241958 --- /dev/null +++ b/middleware/src/filesystem/file_io.adb @@ -0,0 +1,723 @@ +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2015-2017, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ + +with Filesystem; use Filesystem; +with Filesystem.MBR; use Filesystem.MBR; +with Filesystem.FAT; use Filesystem.FAT; +with HAL.Filesystem; use HAL.Filesystem; +with Ada.Unchecked_Conversion; + +package body File_IO is + + package HALFS renames HAL.Filesystem; + + function Convert is new Ada.Unchecked_Conversion (HALFS.Status_Code, Status_Code); + function Convert is new Ada.Unchecked_Conversion (File_Mode, HALFS.File_Mode); + function Convert is new Ada.Unchecked_Conversion (File_Size, HALFS.File_Size); + function Convert is new Ada.Unchecked_Conversion (HALFS.File_Size, File_Size); + function Convert is new Ada.Unchecked_Conversion (Seek_Mode, HALFS.Seek_Mode); + + type Mount_Record is record + Is_Free : Boolean := True; + Name : String (1 .. MAX_MOUNT_NAME_LENGTH); + Name_Len : Positive; + FS : Any_Filesystem_Driver; + end record; + + subtype Mount_Index is Integer range 0 .. MAX_MOUNT_POINTS; + subtype Valid_Mount_Index is Mount_Index range 1 .. MAX_MOUNT_POINTS; + type Mount_Array is array (Valid_Mount_Index) of Mount_Record; + + type VFS_Directory_Handle is new Directory_Handle with record + Is_Free : Boolean := True; + Mount_Id : Mount_Index; + end record; + + overriding function Get_FS + (Dir : VFS_Directory_Handle) return Any_Filesystem_Driver; + -- Return the filesystem the handle belongs to. + + overriding function Read + (Dir : in out VFS_Directory_Handle; + Handle : out Any_Node_Handle) return HALFS.Status_Code; + -- Reads the next directory entry. If no such entry is there, an error + -- code is returned in Status. + + overriding procedure Reset (Dir : in out VFS_Directory_Handle); + -- Resets the handle to the first node + + overriding procedure Close (Dir : in out VFS_Directory_Handle); + -- Closes the handle, and free the associated resources. + + function Open + (Path : String; + Handle : out Any_Directory_Handle) + return Status_Code; + + function Open + (Path : String; + Mode : File_Mode; + Handle : out Any_File_Handle) + return Status_Code; + + Mount_Points : Mount_Array; + + Handles : array (1 .. 2) of aliased VFS_Directory_Handle; + + function Name (Point : Mount_Record) return Mount_Path; + procedure Set_Name (Point : in out Mount_Record; + Path : Mount_Path); + procedure Split + (Path : String; + FS : out Any_Filesystem_Driver; + Start_Index : out Natural); + + ---------- + -- Open -- + ---------- + + function Open + (File : in out File_Descriptor; + Name : String; + Mode : File_Mode) + return Status_Code + is + Ret : Status_Code; + begin + if Is_Open (File) then + return Invalid_Parameter; + end if; + Ret := Open (Name, Mode, File.Handle); + + if Ret /= OK then + File.Handle := null; + end if; + + return Ret; + end Open; + + ----------- + -- Close -- + ----------- + + procedure Close (File : in out File_Descriptor) is + begin + if File.Handle /= null then + File.Handle.Close; + File.Handle := null; + end if; + end Close; + + ------------- + -- Is_Open -- + ------------- + + function Is_Open + (File : File_Descriptor) + return Boolean + is (File.Handle /= null); + + ----------- + -- Flush -- + ----------- + + function Flush + (File : File_Descriptor) + return Status_Code + is + begin + if File.Handle /= null then + return Convert (File.Handle.Flush); + else + return Invalid_Parameter; + end if; + end Flush; + + ---------- + -- Size -- + ---------- + + function Size + (File : File_Descriptor) + return File_Size + is + begin + if File.Handle = null then + return 0; + else + return Convert (File.Handle.Size); + end if; + end Size; + + ---------- + -- Read -- + ---------- + + function Read + (File : File_Descriptor; + Addr : System.Address; + Length : File_Size) + return File_Size + is + Ret : HALFS.File_Size; + Status : Status_Code with Unreferenced; + begin + if File.Handle = null then + return 0; + end if; + + Ret := Convert (Length); + Status := Convert (File.Handle.Read (Addr, Ret)); + + return Convert (Ret); + end Read; + + ----------- + -- Write -- + ----------- + + function Write + (File : File_Descriptor; + Addr : System.Address; + Length : File_Size) + return File_Size + is + Ret : HALFS.File_Size; + Status : Status_Code with Unreferenced; + begin + if File.Handle = null then + return 0; + end if; + + Ret := Convert (Length); + Status := Convert (File.Handle.Write (Addr, Ret)); + + return Convert (Ret); + end Write; + + ------------ + -- Offset -- + ------------ + + function Offset + (File : File_Descriptor) + return File_Size + is + begin + if File.Handle /= null then + return Convert (File.Handle.Offset); + else + return 0; + end if; + end Offset; + + ---------- + -- Seek -- + ---------- + + function Seek + (File : in out File_Descriptor; + Origin : Seek_Mode; + Amount : in out File_Size) + return Status_Code + is + Ret : Status_Code; + HALFS_Amount : HALFS.File_Size; + begin + if File.Handle /= null then + HALFS_Amount := Convert (Amount); + Ret := Convert (File.Handle.Seek (Convert (Origin), HALFS_Amount)); + Amount := Convert (HALFS_Amount); + return Ret; + else + return Invalid_Parameter; + end if; + end Seek; + + ------------------- + -- Generic_Write -- + ------------------- + + function Generic_Write + (File : File_Descriptor; + Value : T) + return Status_Code + is + begin + if File.Handle /= null then + return Convert (File.Handle.Write (Value'Address, T'Size / 8)); + else + return Invalid_Parameter; + end if; + end Generic_Write; + + ------------------ + -- Generic_Read -- + ------------------ + + function Generic_Read + (File : File_Descriptor; + Value : out T) + return Status_Code + is + L : HALFS.File_Size := T'Size / 8; + begin + if File.Handle /= null then + return Convert (File.Handle.Read (Value'Address, L)); + else + return Invalid_Parameter; + end if; + end Generic_Read; + + ---------- + -- Open -- + ---------- + + function Open + (Dir : in out Directory_Descriptor; + Name : String) + return Status_Code + is + Ret : Status_Code; + begin + if Dir.Handle /= null then + return Invalid_Parameter; + end if; + Ret := Open (Name, Dir.Handle); + + if Ret /= OK then + Dir.Handle := null; + end if; + + return Ret; + end Open; + + ----------- + -- Close -- + ----------- + + procedure Close (Dir : in out Directory_Descriptor) is + begin + if Dir.Handle /= null then + Dir.Handle.Close; + end if; + end Close; + + ---------- + -- Read -- + ---------- + + function Read (Dir : in out Directory_Descriptor) + return Directory_Entry + is + Node : Any_Node_Handle; + Status : Status_Code; + begin + if Dir.Handle = null then + return Invalid_Dir_Entry; + end if; + + Status := Convert (Dir.Handle.Read (Node)); + if Status /= OK then + return Invalid_Dir_Entry; + end if; + + declare + Name : constant String := Node.Basename; + Ret : Directory_Entry (Name_Length => Name'Length); + begin + Ret.Name := Name; + Ret.Subdirectory := Node.Is_Subdirectory; + Ret.Read_Only := Node.Is_Read_Only; + Ret.Hidden := Node.Is_Hidden; + Ret.Symlink := Node.Is_Symlink; + Ret.Size := Convert (Node.Size); + Node.Close; + return Ret; + end; + end Read; + + ----------- + -- Reset -- + ----------- + + procedure Reset (Dir : in out Directory_Descriptor) is + begin + if Dir.Handle /= null then + Dir.Handle.Reset; + end if; + end Reset; + + ------------ + -- Unlink -- + ------------ + + function Unlink (Path : String) return Status_Code is + Idx : Natural; + FS : Any_Filesystem_Driver; + begin + Split (Path, FS, Idx); + + if FS = null then + return No_Such_Path; + end if; + + return Convert (FS.Unlink (Path (Idx .. Path'Last))); + end Unlink; + + ---------------------- + -- Remove_Directory -- + ---------------------- + + function Remove_Directory (Path : String) return Status_Code is + Idx : Natural; + FS : Any_Filesystem_Driver; + begin + Split (Path, FS, Idx); + + if FS = null then + return No_Such_Path; + end if; + + return Convert (FS.Remove_Directory (Path (Idx .. Path'Last))); + end Remove_Directory; + + --------------- + -- Copy_File -- + --------------- + + function Copy_File (Source_Path, Destination_Path : String; + Buffer_Size : Positive := 512) + return Status_Code + is + Src, Dst : File_Descriptor; + Status : Status_Code; + Buffer : HAL.UInt8_Array (1 .. Buffer_Size); + Src_Len, Dst_Len : File_Size; + begin + Status := Open (Src, Source_Path, Read_Mode); + if Status /= OK then + return Status; + end if; + + Status := Open (Dst, Destination_Path, Write_Mode); + if Status /= OK then + Close (Src); + return Status; + end if; + + loop + Src_Len := Read (Src, Buffer'Address, Buffer'Length); + Dst_Len := Write (Dst, Buffer'Address, Src_Len); + + if Dst_Len /= Src_Len then + Close (Src); + Close (Dst); + return Input_Output_Error; + end if; + + exit when Src_Len /= Buffer'Length; + end loop; + Close (Src); + Close (Dst); + return OK; + end Copy_File; + + ---------- + -- Name -- + ---------- + + function Name (Point : Mount_Record) return Mount_Path + is (Point.Name (1 .. Point.Name_Len)); + + -------------- + -- Set_Name -- + -------------- + + procedure Set_Name (Point : in out Mount_Record; + Path : Mount_Path) + is + begin + Point.Name (1 .. Path'Length) := Path; + Point.Name_Len := Path'Length; + end Set_Name; + + ----------- + -- Split -- + ----------- + + procedure Split + (Path : String; + FS : out Any_Filesystem_Driver; + Start_Index : out Natural) + is + begin + if Path (Path'First) /= '/' then + FS := null; + Start_Index := 0; + + return; + end if; + + Start_Index := Path'Last + 1; + + for J in Path'First + 1 .. Path'Last loop + if Path (J) = '/' then + Start_Index := J; + + exit; + end if; + end loop; + + for M of Mount_Points loop + if not M.Is_Free + and then Name (M) = Path (Path'First + 1 .. Start_Index - 1) + then + FS := M.FS; + + return; + end if; + end loop; + + FS := null; + Start_Index := 0; + end Split; + + ------------------ + -- Mount_Volume -- + ------------------ + + function Mount_Volume + (Mount_Point : Mount_Path; + FS : Any_Filesystem_Driver) return Status_Code + is + Idx : Natural := 0; + begin + for P in Mount_Points'Range loop + if not Mount_Points (P).Is_Free + and then Name (Mount_Points (P)) = Mount_Point + then + return Already_Exists; + + elsif Idx = 0 and then Mount_Points (P).Is_Free then + Idx := P; + end if; + end loop; + + if Idx = 0 then + return Too_Many_Open_Files; + end if; + + Mount_Points (Idx).Is_Free := False; + Mount_Points (Idx).FS := FS; + Set_Name (Mount_Points (Idx), Mount_Point); + + return OK; + end Mount_Volume; + + ----------------- + -- Mount_Drive -- + ----------------- + + function Mount_Drive + (Mount_Point : Mount_Path; + Device : HAL.Block_Drivers.Any_Block_Driver) + return Status_Code + is + MBR : Master_Boot_Record; + Status : Status_Code; + FAT_FS : access FAT_Filesystem; + begin + Status := Read (Device, MBR); + + if Status /= OK then + return Status; + end if; + + for P in Partition_Number'Range loop + if Valid (MBR, P) + and then Get_Type (MBR, P) in 6 | 11 .. 12 + then + Status := OK; + FAT_FS := new FAT_Filesystem; + Status := Convert (Open (Controller => Device, + LBA => LBA (MBR, P), + FS => FAT_FS.all)); + return Mount_Volume (Mount_Point, FAT_FS); + end if; + end loop; + + return No_Filesystem; + end Mount_Drive; + + ------------- + -- Unmount -- + ------------- + + function Unmount (Mount_Point : Mount_Path) return Status_Code + is + begin + for P in Mount_Points'Range loop + if Name (Mount_Points (P)) = Mount_Point then + Mount_Points (P).FS.Close; + Mount_Points (P).Is_Free := True; + + return OK; + end if; + end loop; + + return Not_Mounted; + end Unmount; + + ------------ + -- Get_FS -- + ------------ + + overriding function Get_FS + (Dir : VFS_Directory_Handle) return Any_Filesystem_Driver + is + pragma Unreferenced (Dir); + begin + return null; + end Get_FS; + + ---------- + -- Read -- + ---------- + + overriding function Read + (Dir : in out VFS_Directory_Handle; + Handle : out Any_Node_Handle) + return HALFS.Status_Code + is + begin + loop + if Dir.Mount_Id = Mount_Points'Last then + Handle := null; + return No_More_Entries; + end if; + + Dir.Mount_Id := Dir.Mount_Id + 1; + + if not Mount_Points (Dir.Mount_Id).Is_Free then + return Mount_Points (Dir.Mount_Id).FS.Root_Node + (Name (Mount_Points (Dir.Mount_Id)), + Handle); + end if; + end loop; + end Read; + + ----------- + -- Reset -- + ----------- + + overriding procedure Reset (Dir : in out VFS_Directory_Handle) + is + begin + Dir.Mount_Id := 0; + end Reset; + + ----------- + -- Close -- + ----------- + + overriding procedure Close (Dir : in out VFS_Directory_Handle) + is + begin + Dir.Is_Free := True; + end Close; + + ---------- + -- Open -- + ---------- + + function Open + (Path : String; + Mode : File_Mode; + Handle : out Any_File_Handle) + return Status_Code + is + Idx : Natural; + FS : Any_Filesystem_Driver; + begin + Split (Path, FS, Idx); + + if FS = null then + Handle := null; + return No_Such_Path; + end if; + + return Convert (FS.Open (Path (Idx .. Path'Last), + Convert (Mode), + Handle)); + end Open; + + ---------- + -- Open -- + ---------- + + function Open + (Path : String; + Handle : out Any_Directory_Handle) + return Status_Code + is + Idx : Natural; + FS : Any_Filesystem_Driver; + begin + if Path = "/" then + for J in Handles'Range loop + if Handles (J).Is_Free then + Handles (J).Is_Free := False; + Handles (J).Mount_Id := 0; + Handle := Handles (J)'Access; + return OK; + end if; + end loop; + + Handle := null; + return Too_Many_Open_Files; + end if; + + Split (Path, FS, Idx); + + if FS = null then + Handle := null; + return No_Such_Path; + end if; + + if Idx > Path'Last then + return Convert (FS.Open ("/", Handle)); + else + return Convert (FS.Open (Path (Idx .. Path'Last), Handle)); + end if; + end Open; + +end File_IO; diff --git a/middleware/src/filesystem/file_io.ads b/middleware/src/filesystem/file_io.ads new file mode 100644 index 000000000..be1033bc2 --- /dev/null +++ b/middleware/src/filesystem/file_io.ads @@ -0,0 +1,246 @@ +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2015-2017, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ + +with System; +with HAL.Block_Drivers; + +with HAL.Filesystem; + +package File_IO is + + MAX_PATH_LENGTH : constant := 1024; + -- Maximum size of a path name length + + type Status_Code is + (OK, + Non_Empty_Directory, + Disk_Error, -- A hardware error occurred in the low level disk I/O + Disk_Full, + Internal_Error, + Drive_Not_Ready, + No_Such_File, + No_Such_Path, + Not_Mounted, -- The mount point is invalid + Invalid_Name, + Access_Denied, + Already_Exists, + Invalid_Object_Entry, + Write_Protected, + Invalid_Drive, + No_Filesystem, -- The volume is not a FAT volume + Locked, + Too_Many_Open_Files, -- All available handles are used + Invalid_Parameter, + Input_Output_Error, + No_MBR_Found, + No_Partition_Found, + No_More_Entries, + Read_Only_File_System, + Operation_Not_Permitted); + + type File_Mode is (Read_Mode, Write_Mode, Read_Write_Mode); + type Seek_Mode is + ( + -- Seek from the beginning of the file, forward + From_Start, + -- Seek from the end of the file, backward + From_End, + -- Seek from the current position, forward + Forward, + -- Seek from the current position, backward + Backward); + + type File_Size is new HAL.UInt64; + -- Modern fs all support 64-bit file size. Only old or limited ones support + -- max 32-bit (FAT in particular). So let's see big and not limit ourselves + -- in this API with 32-bit only. + + + type File_Descriptor is limited private; + + function Open + (File : in out File_Descriptor; + Name : String; + Mode : File_Mode) + return Status_Code; + + procedure Close (File : in out File_Descriptor); + + function Is_Open (File : File_Descriptor) + return Boolean; + + function Flush (File : File_Descriptor) + return Status_Code; + + function Size (File : File_Descriptor) + return File_Size; + + function Read (File : File_Descriptor; + Addr : System.Address; + Length : File_Size) + return File_Size; + + function Write (File : File_Descriptor; + Addr : System.Address; + Length : File_Size) + return File_Size; + + function Offset (File : File_Descriptor) + return File_Size; + + function Seek + (File : in out File_Descriptor; + Origin : Seek_Mode; + Amount : in out File_Size) return Status_Code; + + generic + type T is private; + function Generic_Write + (File : File_Descriptor; + Value : T) return Status_Code; + + generic + type T is private; + function Generic_Read + (File : File_Descriptor; + Value : out T) return Status_Code; + + type Directory_Descriptor is limited private; + + function Open + (Dir : in out Directory_Descriptor; + Name : String) + return Status_Code; + + procedure Close (Dir : in out Directory_Descriptor); + + type Directory_Entry (Name_Length : Natural) is record + Name : String (1 .. Name_Length); + Subdirectory : Boolean; + Read_Only : Boolean; + Hidden : Boolean; + Symlink : Boolean; + Size : File_Size; + end record; + + Invalid_Dir_Entry : constant Directory_Entry; + + function Read (Dir : in out Directory_Descriptor) + return Directory_Entry; + + procedure Reset (Dir : in out Directory_Descriptor); + + function Unlink (Path : String) return Status_Code; + + function Remove_Directory (Path : String) return Status_Code; + + function Copy_File (Source_Path, Destination_Path : String; + Buffer_Size : Positive := 512) + return Status_Code; + + -------------- + -- Mounting -- + -------------- + + MAX_MOUNT_POINTS : constant := 2; + MAX_MOUNT_NAME_LENGTH : constant := 128; + + subtype Mount_Path is String + with Dynamic_Predicate => Mount_Path'Length <= MAX_MOUNT_NAME_LENGTH; + + function Mount_Volume + (Mount_Point : Mount_Path; + FS : HAL.Filesystem.Any_Filesystem_Driver) return Status_Code; + + function Mount_Drive + (Mount_Point : Mount_Path; + Device : HAL.Block_Drivers.Any_Block_Driver) return Status_Code; + + function Unmount (Mount_Point : Mount_Path) return Status_Code; + +private + + type File_Descriptor is limited record + Handle : HAL.Filesystem.Any_File_Handle := null; + end record; + + type Directory_Descriptor is limited record + Handle : HAL.Filesystem.Any_Directory_Handle := null; + end record; + + Invalid_Dir_Entry : constant Directory_Entry (Name_Length => 0) := + (Name_Length => 0, + Name => "", + Subdirectory => False, + Read_Only => False, + Hidden => False, + Symlink => False, + Size => 0); + + for Status_Code use + (OK => HAL.Filesystem.OK'Enum_Rep, + Non_Empty_Directory => HAL.Filesystem.Non_Empty_Directory'Enum_Rep, + Disk_Error => HAL.Filesystem.Disk_Error'Enum_Rep, + Disk_Full => HAL.Filesystem.Disk_Full'Enum_Rep, + Internal_Error => HAL.Filesystem.Internal_Error'Enum_Rep, + Drive_Not_Ready => HAL.Filesystem.Drive_Not_Ready'Enum_Rep, + No_Such_File => HAL.Filesystem.No_Such_File'Enum_Rep, + No_Such_Path => HAL.Filesystem.No_Such_Path'Enum_Rep, + Not_Mounted => HAL.Filesystem.Not_Mounted'Enum_Rep, + Invalid_Name => HAL.Filesystem.Invalid_Name'Enum_Rep, + Access_Denied => HAL.Filesystem.Access_Denied'Enum_Rep, + Already_Exists => HAL.Filesystem.Already_Exists'Enum_Rep, + Invalid_Object_Entry => HAL.Filesystem.Invalid_Object_Entry'Enum_Rep, + Write_Protected => HAL.Filesystem.Write_Protected'Enum_Rep, + Invalid_Drive => HAL.Filesystem.Invalid_Drive'Enum_Rep, + No_Filesystem => HAL.Filesystem.No_Filesystem'Enum_Rep, + Locked => HAL.Filesystem.Locked'Enum_Rep, + Too_Many_Open_Files => HAL.Filesystem.Too_Many_Open_Files'Enum_Rep, + Invalid_Parameter => HAL.Filesystem.Invalid_Parameter'Enum_Rep, + Input_Output_Error => HAL.Filesystem.Input_Output_Error'Enum_Rep, + No_MBR_Found => HAL.Filesystem.No_MBR_Found'Enum_Rep, + No_Partition_Found => HAL.Filesystem.No_Partition_Found'Enum_Rep, + No_More_Entries => HAL.Filesystem.No_More_Entries'Enum_Rep, + Read_Only_File_System => HAL.Filesystem.Read_Only_File_System'Enum_Rep, + Operation_Not_Permitted => HAL.Filesystem.Operation_Not_Permitted'Enum_Rep); + + for File_Mode use + (Read_Mode => HAL.Filesystem.Read_Mode'Enum_Rep, + Write_Mode => HAL.Filesystem.Write_Mode'Enum_Rep, + Read_Write_Mode => HAL.Filesystem.Read_Write_Mode'Enum_Rep); + + for Seek_Mode use + (From_Start => HAL.Filesystem.From_Start'Enum_Rep, + From_End => HAL.Filesystem.From_End'Enum_Rep, + Forward => HAL.Filesystem.Forward'Enum_Rep, + Backward => HAL.Filesystem.Backward'Enum_Rep); + +end File_IO; diff --git a/middleware/src/filesystem/filesystem.adb b/middleware/src/filesystem/filesystem.adb deleted file mode 100644 index 9b4dfb1c7..000000000 --- a/middleware/src/filesystem/filesystem.adb +++ /dev/null @@ -1,62 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- Copyright (C) 2015-2017, AdaCore -- --- -- --- Redistribution and use in source and binary forms, with or without -- --- modification, are permitted provided that the following conditions are -- --- met: -- --- 1. Redistributions of source code must retain the above copyright -- --- notice, this list of conditions and the following disclaimer. -- --- 2. Redistributions in binary form must reproduce the above copyright -- --- notice, this list of conditions and the following disclaimer in -- --- the documentation and/or other materials provided with the -- --- distribution. -- --- 3. Neither the name of the copyright holder nor the names of its -- --- contributors may be used to endorse or promote products derived -- --- from this software without specific prior written permission. -- --- -- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- --- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- --- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- --- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- --- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- --- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- --- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- --- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- --- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- --- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- --- -- ------------------------------------------------------------------------------- - -with System; -with HAL.Filesystem; use HAL.Filesystem; - -package body Filesystem is - - ------------------ - -- Generic_Read -- - ------------------ - - function Generic_Read - (This : Any_File_Handle; - Value : out T) return Status_Code - is - L : File_Size := T'Size / System.Storage_Unit; - begin - return This.Read (Value'Address, L); - end Generic_Read; - - ------------------- - -- Generic_Write -- - ------------------- - - function Generic_Write - (This : Any_File_Handle; - Value : T) return Status_Code - is - begin - return This.Write (Value'Address, T'Size / System.Storage_Unit); - end Generic_Write; - -end Filesystem; diff --git a/middleware/src/filesystem/filesystem.ads b/middleware/src/filesystem/filesystem.ads index 5756f09e8..f6e15ae55 100644 --- a/middleware/src/filesystem/filesystem.ads +++ b/middleware/src/filesystem/filesystem.ads @@ -36,48 +36,6 @@ package Filesystem is MAX_PATH_LENGTH : constant := 1024; -- Maximum size of a path name length - type Status_Code is - (OK, - Non_Empty_Directory, - Disk_Error, -- A hardware error occurred in the low level disk I/O - Disk_Full, - Internal_Error, - Drive_Not_Ready, - No_Such_File, - No_Such_Path, - Not_Mounted, -- The mount point is invalid - Invalid_Name, - Access_Denied, - Already_Exists, - Invalid_Object_Entry, - Write_Protected, - Invalid_Drive, - No_Filesystem, -- The volume is not a FAT volume - Locked, - Too_Many_Open_Files, -- All available handles are used - Invalid_Parameter, - Input_Output_Error, - No_MBR_Found, - No_Partition_Found, - No_More_Entries); - - type File_Mode is (Read_Mode, Write_Mode, Read_Write_Mode); - type Seek_Mode is - ( - -- Seek from the beginning of the file, forward - From_Start, - -- Seek from the end of the file, backward - From_End, - -- Seek from the current position, forward - Forward, - -- Seek from the current position, backward - Backward); - - type File_Size is new HAL.UInt64; - -- Modern fs all support 64-bit file size. Only old or limited ones support - -- max 32-bit (FAT in particular). So let's see big and not limit ourselves - -- in this API with 32-bit only. - subtype Block_Number is HAL.UInt64; -- To account GUID partitions, and large disks, we need a 64-bit -- representation diff --git a/middleware/src/filesystems/pathname_manipulation.ads b/middleware/src/filesystems/pathname_manipulation.ads index 1c483a0d2..25e8c2980 100644 --- a/middleware/src/filesystems/pathname_manipulation.ads +++ b/middleware/src/filesystems/pathname_manipulation.ads @@ -29,8 +29,6 @@ -- -- ------------------------------------------------------------------------------ -with HAL.Filesystem; use HAL.Filesystem; - package Pathname_Manipulation is procedure Root_Dir (Path : String; diff --git a/middleware/src/utils/file_block_drivers.adb b/middleware/src/utils/file_block_drivers.adb index 117554a42..4ab35c9fc 100644 --- a/middleware/src/utils/file_block_drivers.adb +++ b/middleware/src/utils/file_block_drivers.adb @@ -31,6 +31,28 @@ package body File_Block_Drivers is + ---------- + -- Open -- + ---------- + + function Open (This : in out File_Block_Driver; + Path : String) + return Boolean + is + begin + return Open (This.FD, Path, Read_Write_Mode) = OK; + end Open; + + ----------- + -- Close -- + ----------- + + procedure Close (This : in out File_Block_Driver) is + begin + Close (This.FD); + end Close; + + ---------- -- Read -- ---------- @@ -45,12 +67,12 @@ package body File_Block_Drivers is Amount : File_Size := File_Size (Block_Number * 512); begin - if This.File.Seek (From_Start, Amount) /= OK then + if Seek (This.FD, From_Start, Amount) /= OK then return False; end if; Amount := Data'Length; - return This.File.Read (Data'Address, Amount) = OK; + return Read (This.FD, Data'Address, Amount) = Amount; end Read; ---------- @@ -67,12 +89,12 @@ package body File_Block_Drivers is Amount : File_Size := File_Size (Block_Number * 512); begin - if This.File.Seek (From_Start, Amount) /= OK then + if Seek (This.FD, From_Start, Amount) /= OK then return False; end if; Amount := Data'Length; - return This.File.Write (Data'Address, Amount) = OK; + return Write (This.FD, Data'Address, Amount) = Amount; end Write; end File_Block_Drivers; diff --git a/middleware/src/utils/file_block_drivers.ads b/middleware/src/utils/file_block_drivers.ads index 756279c5a..9da5012c9 100644 --- a/middleware/src/utils/file_block_drivers.ads +++ b/middleware/src/utils/file_block_drivers.ads @@ -32,12 +32,19 @@ -- Simulate a disk by readind into a file with HAL.Block_Drivers; use HAL.Block_Drivers; -with HAL.Filesystem; use HAL.Filesystem; with HAL; use HAL; +with File_IO; use File_IO; package File_Block_Drivers is - type File_Block_Driver (File : not null Any_File_Handle) is new Block_Driver with private; + type File_Block_Driver is + limited new Block_Driver with private; + + function Open (This : in out File_Block_Driver; + Path : String) + return Boolean; + + procedure Close (This : in out File_Block_Driver); overriding function Read @@ -54,5 +61,8 @@ package File_Block_Drivers is return Boolean; private - type File_Block_Driver (File : not null Any_File_Handle) is new Block_Driver with null record; + type File_Block_Driver is + limited new Block_Driver with record + FD : File_Descriptor; + end record; end File_Block_Drivers; diff --git a/testsuite/tests/bitmap_drawing/src/tc_bitmap_drawing.adb b/testsuite/tests/bitmap_drawing/src/tc_bitmap_drawing.adb index 22eb2b031..ee3b64019 100644 --- a/testsuite/tests/bitmap_drawing/src/tc_bitmap_drawing.adb +++ b/testsuite/tests/bitmap_drawing/src/tc_bitmap_drawing.adb @@ -1,11 +1,10 @@ with Test_Directories; use Test_Directories; with Ada.Text_IO; use Ada.Text_IO; -with Native.Filesystem; use Native.Filesystem; with HAL; use HAL; -with HAL.Filesystem; use HAL.Filesystem; with HAL.Bitmap; use HAL.Bitmap; with Memory_Mapped_Bitmap; use Memory_Mapped_Bitmap; with Bitmap_File_Output; use Bitmap_File_Output; +with File_IO; use File_IO; with Compare_Files; procedure TC_Bitmap_Drawing is @@ -32,30 +31,21 @@ procedure TC_Bitmap_Drawing is return Any_Bitmap_Buffer (BM); end Allocate_Bitmap; - FS : Native_FS_Driver; - BMP_File : Any_File_Handle; + BMP_File : File_Descriptor; Status : Status_Code; BM : constant not null Any_Bitmap_Buffer := Allocate_Bitmap; - Filename : constant String := "test.bmp"; + Filename : constant String := "/" & Test_Dir_Mount_Name & "/test.bmp"; begin - if FS.Create (Root_Dir => Test_Dir) /= OK then - raise Program_Error with "Cannot create native file system at '" & - Test_Dir & "'"; - end if; - Status := FS.Create_Node (Filename, Regular_File); + Test_Directories.Mount_Test_Directory; + + Status := Open (BMP_File, Filename, Read_Write_Mode); if Status /= OK then raise Program_Error with "Cannot Create BMP file"; end if; - Status := FS.Open (Filename, Write_Mode, BMP_File); - - if Status /= OK or else BMP_File = null then - raise Program_Error with "Cannot open BMP file"; - end if; - BM.Set_Source (Black); BM.Fill; @@ -107,7 +97,7 @@ begin Write_BMP_File (BMP_File, BM.all); - BMP_File.Close; + Close (BMP_File); if not Compare_Files.Binnary_Equal (Test_Dir & "/" & Filename, Test_Dir & "/ref.bmp") diff --git a/testsuite/tests/fat_driver/src/tc_fat_read.adb b/testsuite/tests/fat_driver/src/tc_fat_read.adb index e0db91f49..7991fa3f2 100644 --- a/testsuite/tests/fat_driver/src/tc_fat_read.adb +++ b/testsuite/tests/fat_driver/src/tc_fat_read.adb @@ -1,17 +1,15 @@ with Ada.Text_IO; use Ada.Text_IO; -with Native.Filesystem; use Native.Filesystem; -with HAL.Filesystem; use HAL.Filesystem; +with Filesystem.Native; use Filesystem.Native; with Test_Directories; use Test_Directories; with File_Block_Drivers; use File_Block_Drivers; - -with Filesystem.VFS; use Filesystem.VFS; +with File_IO; use File_IO; with Filesystem.FAT; use Filesystem.FAT; +with HAL.Filesystem; use HAL.Filesystem; with Compare_Files; procedure TC_FAT_Read is - function Check_Dir (Dirname : String) return Boolean; function Check_File (Basename : String; Dirname : String) @@ -25,12 +23,11 @@ procedure TC_FAT_Read is --------------- function Check_Dir (Dirname : String) return Boolean is - Handle : Any_Directory_Handle; - Status : Status_Code; - Node : Any_Node_Handle; + DD : Directory_Descriptor; + Status : File_IO.Status_Code; begin Put_Line ("Checking directory: '" & Dirname & "'"); - Status := Filesystem.VFS.Open (Dirname, Handle); + Status := Open (DD, Dirname); if Status /= OK then Put_Line ("Cannot open directory: '" & Dirname & "'"); @@ -39,22 +36,26 @@ procedure TC_FAT_Read is end if; loop - if Handle.Read (Node) = OK and then Node /= null then - if Node.Basename = "." or else Node.Basename = ".." then - null; -- do nothing - elsif Node.Is_Subdirectory then - - if not Check_Dir (Dirname & "/" & Node.Basename) then - return False; - end if; - elsif not Node.Is_Symlink then - if not Check_File (Node.Basename, Dirname) then - return False; + declare + Ent : constant Directory_Entry := Read (DD); + begin + if Ent /= Invalid_Dir_Entry then + if Ent.Name = "." or else Ent.Name = ".." then + null; -- do nothing + elsif Ent.Subdirectory then + + if not Check_Dir (Dirname & "/" & Ent.Name) then + return False; + end if; + elsif not Ent.Symlink then + if not Check_File (Ent.Name, Dirname) then + return False; + end if; end if; + else + exit; end if; - else - exit; - end if; + end; end loop; return True; @@ -68,11 +69,11 @@ procedure TC_FAT_Read is Dirname : String) return Boolean is - Handle : Any_File_Handle; - Status : Status_Code; + FD : File_Descriptor; + Status : File_IO.Status_Code; Path : constant String := Dirname & "/" & Basename; begin - Status := Filesystem.VFS.Open (Path, Read_Mode, Handle); + Status := Open (FD, Path, Read_Mode); if Status /= OK then Put_Line ("Cannot open file: '" & Path & "'"); @@ -81,7 +82,7 @@ procedure TC_FAT_Read is end if; declare - Hash_Str : constant String := Compare_Files.Compute_Hash (Handle); + Hash_Str : constant String := Compare_Files.Compute_Hash (FD); begin if Hash_Str /= Basename then Put_Line ("Error: Hash is different than filename"); @@ -98,13 +99,13 @@ procedure TC_FAT_Read is --------------------------- function Check_Expected_Number return Boolean is - Handle : Any_File_Handle; - Status : Status_Code; + FD : File_Descriptor; + Status : File_IO.Status_Code; Path : constant String := "/disk_img/number_of_files_to_check"; C : Character; - Amount : File_Size; + Amount : File_IO.File_Size; begin - Status := Filesystem.VFS.Open (Path, Read_Mode, Handle); + Status := Open (FD, Path, Read_Mode); if Status /= OK then Put_Line ("Cannot open file: '" & Path & "'"); @@ -113,9 +114,7 @@ procedure TC_FAT_Read is end if; Amount := 1; - Status := Handle.Read (C'Address, Amount); - - if Status /= OK then + if Read (FD, C'Address, Amount) /= Amount then Put_Line ("Cannot read file: '" & Path & "'"); Put_Line ("Status: " & Status'Img); return False; @@ -132,52 +131,44 @@ procedure TC_FAT_Read is end if; end Check_Expected_Number; - FS : aliased Native_FS_Driver; - Disk_Img : HAL.Filesystem.Any_File_Handle; - Disk_Img_Path : constant String := "fat.fs"; - - Status : Status_Code; + Disk_Img_Path : constant String := "/test_dir/fat.fs"; + Disk : aliased File_Block_Driver; + FAT_FS : access FAT_Filesystem; + FIO_Status : File_IO.Status_Code; + HALFS_Status : HAL.Filesystem.Status_Code; begin - if FS.Create (Root_Dir => Test_Dir) /= OK then - raise Program_Error with "Cannot create native file system at '" & - Test_Dir & "'"; - end if; + Test_Directories.Mount_Test_Directory ("test_dir"); - if FS.Open (Disk_Img_Path, Read_Mode, Disk_Img) /= OK then + if not Disk.Open (Disk_Img_Path) then Put_Line ("Cannot open disk image '" & Disk_Img_Path & "'"); return; end if; - declare - Disk : aliased File_Block_Driver (Disk_Img); - FAT_FS : access FAT_Filesystem; - begin - FAT_FS := new FAT_Filesystem; - Status := Open (Controller => Disk'Unchecked_Access, - LBA => 0, - FS => FAT_FS.all); + FAT_FS := new FAT_Filesystem; + HALFS_Status := Open (Controller => Disk'Unchecked_Access, + LBA => 0, + FS => FAT_FS.all); - if Status /= OK then - Put_Line ("Cannot open FAT FS - Status:" & Status'Img); - return; - end if; + if HALFS_Status /= OK then + Put_Line ("Cannot open FAT FS - Status:" & HALFS_Status'Img); + return; + end if; - Status := Filesystem.VFS.Mount_Volume (Mount_Point => "disk_img", - FS => FAT_FS); - if Status /= OK then - Put_Line ("Cannot mount volume - Status: " & Status'Img); - return; - end if; + FIO_Status := File_IO.Mount_Volume (Mount_Point => "disk_img", + FS => FAT_FS); + if FIO_Status /= OK then + Put_Line ("Cannot mount volume - Status: " & FIO_Status'Img); + return; + end if; - if Check_Dir ("/disk_img/read_test") - and then - Check_Expected_Number - then - Put_Line ("PASS"); - else - Put_Line ("FAIL"); - end if; + if Check_Dir ("/disk_img/read_test") + and then + Check_Expected_Number + then + Put_Line ("PASS"); + else + Put_Line ("FAIL"); + end if; - end; end TC_FAT_Read; diff --git a/testsuite/tests/fat_driver/src/tc_fat_write.adb b/testsuite/tests/fat_driver/src/tc_fat_write.adb index 27ab991b8..227b707aa 100644 --- a/testsuite/tests/fat_driver/src/tc_fat_write.adb +++ b/testsuite/tests/fat_driver/src/tc_fat_write.adb @@ -1,20 +1,20 @@ with Ada.Text_IO; use Ada.Text_IO; -with Native.Filesystem; use Native.Filesystem; -with HAL.Filesystem; use HAL.Filesystem; +with Filesystem.Native; use Filesystem.Native; with Test_Directories; use Test_Directories; with File_Block_Drivers; use File_Block_Drivers; - -with Filesystem.VFS; use Filesystem.VFS; +with File_IO; use File_IO; with Filesystem.FAT; use Filesystem.FAT; +with HAL.Filesystem; with GNAT.MD5; use GNAT.MD5; with Ada.Streams; with Compare_Files; -with Copy_Files; procedure TC_FAT_Write is + use type HAL.Filesystem.Status_Code; + package Hash renames GNAT.MD5; Test_File_Size : constant := 2000; @@ -28,7 +28,7 @@ procedure TC_FAT_Write is ---------------- function Write_File (Filename : String) return String is - Handle : Any_File_Handle; + FD : File_Descriptor; Status : Status_Code; Context : aliased GNAT.MD5.Context := GNAT.MD5.Initial_Context; @@ -39,7 +39,7 @@ procedure TC_FAT_Write is use type Ada.Streams.Stream_Element_Offset; begin - Status := Filesystem.VFS.Open (Filename, Write_Mode, Handle); + Status := Open (FD, Filename, Write_Mode); if Status /= OK then Put_Line ("Cannot open file: '" & Filename & "'"); @@ -51,16 +51,14 @@ procedure TC_FAT_Write is Buffer := (others => 42); Last := Ada.Streams.Stream_Element_Offset (Size); Hash.Update (Context, Buffer (1 .. Last)); - Status := Handle.Write (Addr => Buffer'Address, - Length => Size); - if Status /= OK then + if Write (FD, Buffer'Address, Size) /= Size then Put_Line ("Cannot write file: '" & Filename & "'"); Put_Line ("Status: " & Status'Img); return ""; end if; - Handle.Close; + Close (FD); return Hash.Digest (Context); end Write_File; @@ -72,10 +70,10 @@ procedure TC_FAT_Write is Md5 : String) return Boolean is - Handle : Any_File_Handle; + FD : File_Descriptor; Status : Status_Code; begin - Status := Filesystem.VFS.Open (Filename, Read_Mode, Handle); + Status := Open (FD, Filename, Read_Mode); if Status /= OK then Put_Line ("Cannot open file: '" & Filename & "'"); @@ -83,13 +81,13 @@ procedure TC_FAT_Write is return False; end if; - if Handle.Size /= Test_File_Size then - Put_Line ("Error: wrong file size: " & Handle.Size'Img & + if Size (FD) /= Test_File_Size then + Put_Line ("Error: wrong file size: " & Size (FD)'Img & " (expected " & Test_File_Size'Img & ")"); end if; declare - Hash_Str : constant String := Compare_Files.Compute_Hash (Handle); + Hash_Str : constant String := Compare_Files.Compute_Hash (FD); begin if Hash_Str /= Md5 then Put_Line ("Error: Hash is different than filename"); @@ -105,11 +103,10 @@ procedure TC_FAT_Write is ----------------- function Delete_Tree (Filename : String) return Boolean is - Handle : Any_Directory_Handle; + Dir : Directory_Descriptor; Status : Status_Code; - Node : Any_Node_Handle; begin - Status := Filesystem.VFS.Open (Filename, Handle); + Status := Open (Dir, Filename); if Status /= OK then Put_Line ("Cannot open directory: '" & Filename & "'"); @@ -118,31 +115,36 @@ procedure TC_FAT_Write is end if; loop - if Handle.Read (Node) = OK and then Node /= null then - declare - Sub : constant String := Filename & "/" & Node.Basename; - begin - if Node.Basename = "." or else Node.Basename = ".." then - null; -- do nothing - elsif Node.Is_Subdirectory then - if not Delete_Tree (Sub) then - return False; + declare + Ent : constant Directory_Entry := Read (Dir); + begin + + if Ent /= Invalid_Dir_Entry then + declare + Sub : constant String := Filename & "/" & Ent.Name; + begin + if Ent.Name = "." or else Ent.Name = ".." then + null; -- do nothing + elsif Ent.Subdirectory then + if not Delete_Tree (Sub) then + return False; + end if; + elsif not Ent.Symlink then + Status := Unlink (Sub); + if Status /= OK then + Put_Line ("Cannot delete file: '" & Sub & "' :" & + Status'Img); + return False; + end if; end if; - elsif not Node.Is_Symlink then - Status := Filesystem.VFS.Unlink (Sub); - if Status /= OK then - Put_Line ("Cannot delete file: '" & Sub & "' :" & - Status'Img); - return False; - end if; - end if; - end; - else - exit; - end if; + end; + else + exit; + end if; + end; end loop; - Status := Filesystem.VFS.Remove_Directory (Filename); + Status := Remove_Directory (Filename); if Status /= OK then Put_Line ("Cannot delete dir: '" & Filename & "' :" & Status'Img); return False; @@ -151,48 +153,43 @@ procedure TC_FAT_Write is end if; end Delete_Tree; - FS : aliased Native_FS_Driver; - Disk_Img : HAL.Filesystem.Any_File_Handle; - Disk_Img_Path : constant String := "fat.fs"; - Copy_Disk_Img_Path : constant String := "obj/fat.fs.copy"; + Disk_Img_Path : constant String := "/" & Test_Dir_Mount_Name & "/fat.fs"; + Copy_Disk_Img_Path : constant String := "/" & Test_Dir_Mount_Name & "/obj/fat.fs.copy"; + Disk : aliased File_Block_Driver; + FAT_FS : access FAT_Filesystem; - Status : Status_Code; + Status : Status_Code; + HALFS_Status : HAL.Filesystem.Status_Code; begin + Test_Directories.Mount_Test_Directory; + -- Make a copy of the disk image - if not Copy_Files.Copy (Test_Dir & "/" & Disk_Img_Path, - Test_Dir & "/" & Copy_Disk_Img_Path) - then + if Copy_File (Disk_Img_Path, Copy_Disk_Img_Path) /= OK then raise Program_Error with "Cannot copy disk image"; end if; - if FS.Create (Root_Dir => Test_Dir) /= OK then - raise Program_Error with "Cannot create native file system at '" & - Test_Dir & "'"; - end if; - if FS.Open (Copy_Disk_Img_Path, Read_Write_Mode, Disk_Img) /= OK then + if not Disk.Open (Copy_Disk_Img_Path) then Put_Line ("Cannot open disk image '" & Copy_Disk_Img_Path & "'"); return; end if; declare - Disk : aliased File_Block_Driver (Disk_Img); - FAT_FS : access FAT_Filesystem; begin FAT_FS := new FAT_Filesystem; - Status := Open (Controller => Disk'Unchecked_Access, - LBA => 0, - FS => FAT_FS.all); + HALFS_Status := Open (Controller => Disk'Unchecked_Access, + LBA => 0, + FS => FAT_FS.all); - if Status /= OK then - Put_Line ("Cannot open FAT FS - Status:" & Status'Img); + if HALFS_Status /= HAL.Filesystem.OK then + Put_Line ("Cannot open FAT FS - Status:" & HALFS_Status'Img); return; end if; - Status := Filesystem.VFS.Mount_Volume (Mount_Point => "disk_img", - FS => FAT_FS); + Status := Mount_Volume (Mount_Point => "disk_img", + FS => FAT_FS); if Status /= OK then Put_Line ("Cannot mount volume - Status: " & Status'Img); return; diff --git a/testsuite/utils/src/compare_files.adb b/testsuite/utils/src/compare_files.adb index 0eb0d0159..7d2aad3c9 100644 --- a/testsuite/utils/src/compare_files.adb +++ b/testsuite/utils/src/compare_files.adb @@ -31,7 +31,7 @@ with Ada.Streams; with Ada.Streams.Stream_IO; - +with File_IO; use File_IO; with GNAT.MD5; use GNAT.MD5; package body Compare_Files is @@ -42,7 +42,7 @@ package body Compare_Files is -- Compute_Hash -- ------------------ - function Compute_Hash (Handle : Any_File_Handle) + function Compute_Hash (FD : in out File_IO.File_Descriptor) return String is Context : aliased GNAT.MD5.Context := GNAT.MD5.Initial_Context; @@ -56,8 +56,9 @@ package body Compare_Files is begin loop Size := Buffer'Length; - Status := Handle.Read (Addr => Buffer'Address, - Length => Size); + Size := Read (FD, + Addr => Buffer'Address, + Length => Size); Last := Ada.Streams.Stream_Element_Offset (Size); Hash.Update (Context, Buffer (1 .. Last)); exit when Last < Buffer'Last; diff --git a/testsuite/utils/src/compare_files.ads b/testsuite/utils/src/compare_files.ads index bcaffc7f1..5114eb072 100644 --- a/testsuite/utils/src/compare_files.ads +++ b/testsuite/utils/src/compare_files.ads @@ -29,11 +29,11 @@ -- -- ------------------------------------------------------------------------------ -with HAL.Filesystem; use HAL.Filesystem; +with File_IO; package Compare_Files is - function Compute_Hash (Handle : Any_File_Handle) + function Compute_Hash (FD : in out File_IO.File_Descriptor) return String; function Binnary_Equal (A_Path, B_Path : String) return Boolean; diff --git a/testsuite/utils/src/copy_files.ads b/testsuite/utils/src/copy_files.ads deleted file mode 100644 index b0c8bd825..000000000 --- a/testsuite/utils/src/copy_files.ads +++ /dev/null @@ -1,38 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- Copyright (C) 2017, AdaCore -- --- -- --- Redistribution and use in source and binary forms, with or without -- --- modification, are permitted provided that the following conditions are -- --- met: -- --- 1. Redistributions of source code must retain the above copyright -- --- notice, this list of conditions and the following disclaimer. -- --- 2. Redistributions in binary form must reproduce the above copyright -- --- notice, this list of conditions and the following disclaimer in -- --- the documentation and/or other materials provided with the -- --- distribution. -- --- 3. Neither the name of the copyright holder nor the names of its -- --- contributors may be used to endorse or promote products derived -- --- from this software without specific prior written permission. -- --- -- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- --- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- --- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- --- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- --- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- --- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- --- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- --- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- --- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- --- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- --- -- ------------------------------------------------------------------------------- - -with HAL.Filesystem; use HAL.Filesystem; - -package Copy_Files is - - function Copy (A_Path, B_Path : String) return Boolean; - -end Copy_Files; diff --git a/testsuite/utils/src/copy_files.adb b/testsuite/utils/src/test_directories.adb similarity index 75% rename from testsuite/utils/src/copy_files.adb rename to testsuite/utils/src/test_directories.adb index 47e70acec..8e95bc5dd 100644 --- a/testsuite/utils/src/copy_files.adb +++ b/testsuite/utils/src/test_directories.adb @@ -29,18 +29,32 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Directories; +with File_IO; use File_IO; +with HAL.Filesystem; -package body Copy_Files is +package body Test_Directories is - ---------- - -- Copy -- - ---------- + use type HAL.Filesystem.Status_Code; - function Copy (A_Path, B_Path : String) return Boolean is + FS : aliased Native_FS_Driver; + + -------------------------- + -- Mount_Test_Directory -- + -------------------------- + + procedure Mount_Test_Directory + (Mount_Name : String := Test_Dir_Mount_Name) + is begin - Ada.Directories.Copy_File (A_Path, B_Path); - return True; - end Copy; + if FS.Create (Root_Dir => Test_Dir) /= HAL.Filesystem.OK then + raise Program_Error with "Cannot create native file system at '" & + Test_Dir & "'"; + end if; + + if Mount_Volume (Mount_Name, FS'Access) /= OK then + raise Program_Error with "Cannot mount native file system at '" & + Mount_Name & "'"; + end if; + end Mount_Test_Directory; -end Copy_Files; +end Test_Directories; diff --git a/testsuite/utils/src/test_directories.ads b/testsuite/utils/src/test_directories.ads index 8c6ab520b..c1248bd0a 100644 --- a/testsuite/utils/src/test_directories.ads +++ b/testsuite/utils/src/test_directories.ads @@ -31,15 +31,18 @@ with Ada.Command_Line; with Ada.Directories; -with HAL.Filesystem; use HAL.Filesystem; -with Native.Filesystem; use Native.Filesystem; +with Filesystem.Native; use Filesystem.Native; package Test_Directories is - Program_Abspath : constant String := Native.Filesystem.Join + Program_Abspath : constant String := Filesystem.Native.Join (Ada.Directories.Current_Directory, Ada.Command_Line.Command_Name, False); -- Absolute path of the test executable Test_Dir : constant String := Ada.Directories.Containing_Directory (Ada.Directories.Containing_Directory (Program_Abspath)); -- Absolute path to the test directory + + Test_Dir_Mount_Name : constant String := "test_dir"; + + procedure Mount_Test_Directory (Mount_Name : String := Test_Dir_Mount_Name); end Test_Directories;