diff --git a/src/os/gnatcoll-os-fsutil-copy_timestamps__unix.adb b/src/os/gnatcoll-os-fsutil-copy_timestamps__unix.adb index 46e73221..81a56bdb 100644 --- a/src/os/gnatcoll-os-fsutil-copy_timestamps__unix.adb +++ b/src/os/gnatcoll-os-fsutil-copy_timestamps__unix.adb @@ -21,14 +21,85 @@ -- -- ------------------------------------------------------------------------------ -with GNATCOLL.OS.Libc; use GNATCOLL.OS.Libc; +with Interfaces.C; use Interfaces.C; +with GNATCOLL.OS.FS; use GNATCOLL.OS.FS; +with GNATCOLL.OS.Stat; +with GNATCOLL.OS.Libc; use GNATCOLL.OS.Libc; +with GNATCOLL.OS.Libc.Utime; use GNATCOLL.OS.Libc.Utime; +with Ada.Calendar; use Ada.Calendar; +with Ada.Calendar.Conversions; use Ada.Calendar.Conversions; separate (GNATCOLL.OS.FSUtil) function Copy_Timestamps (Src : UTF8.UTF_8_String; Dst : UTF8.UTF_8_String) return Boolean is - pragma Warnings (Off, Src); - pragma Warnings (Off, Dst); + + function Set_Modif_And_Access_Time + (File : UTF8.UTF_8_String; Modification : Time; Last_Access : Time) + return Boolean; + -- Set last modification and last access timestamp of specified file. + -- Success is set to false if an error occurs + + function Set_Modif_And_Access_Time + (File : UTF8.UTF_8_String; Modification : Time; Last_Access : Time) + return Boolean + is + + function To_Timespec (T : Time) return Timespec; + -- Translate Time in Timespec + + function To_Timespec (T : Time) return Timespec is + Nano : constant := 1_000_000_000; + Unix_Time_Nano : constant Interfaces.C.long_long := + To_Unix_Nano_Time (T); + T_Spec : Timespec; + begin + T_Spec.TV_Sec := Interfaces.C.long (Unix_Time_Nano / Nano); + T_Spec.TV_NSec := Interfaces.C.long (Unix_Time_Nano mod Nano); + + return T_Spec; + end To_Timespec; + + Timespecs : Libc.Utime.Timespec_Array; + begin + + Timespecs (1) := To_Timespec (Last_Access); + Timespecs (2) := To_Timespec (Modification); + + declare + Status : Libc_Status; + FD : File_Descriptor; + begin + FD := Open (File, Read_Mode); + if FD = Invalid_FD then + return False; + end if; + + Status := Libc.Utime.Futimens (FD, Timespecs); + Close (FD); + if Status = Libc.Error then + return False; + end if; + end; + + return True; + + end Set_Modif_And_Access_Time; + + File_Attr : File_Attributes; begin - return False; + + File_Attr := GNATCOLL.OS.Stat.Stat (Src); + if not Exists (File_Attr) then + return False; + end if; + + declare + T : constant Time := Modification_Time (File_Attr); + begin + + -- Last modification and access are set to the same timestamp + + return Set_Modif_And_Access_Time (Dst, T, T); + end; end Copy_Timestamps; diff --git a/src/os/gnatcoll-os-fsutil-copy_timestamps__win32.adb b/src/os/gnatcoll-os-fsutil-copy_timestamps__win32.adb index 1b4dd816..9a1e9d98 100644 --- a/src/os/gnatcoll-os-fsutil-copy_timestamps__win32.adb +++ b/src/os/gnatcoll-os-fsutil-copy_timestamps__win32.adb @@ -21,12 +21,93 @@ -- -- ------------------------------------------------------------------------------ +with GNATCOLL.OS.Stat; +with GNATCOLL.OS.Win32; use GNATCOLL.OS.Win32; +with GNATCOLL.OS.Win32.Files; use GNATCOLL.OS.Win32.Files; +with GNATCOLL.OS.Win32.Process; use GNATCOLL.OS.Win32.Process; +with GNATCOLL.WString_Builders; + separate (GNATCOLL.OS.FSUtil) function Copy_Timestamps (Src : UTF8.UTF_8_String; Dst : UTF8.UTF_8_String) return Boolean is - pragma Warnings (Off, Src); - pragma Warnings (Off, Dst); + package SB renames GNATCOLL.WString_Builders; + package Win32 renames GNATCOLL.OS.Win32; + + use all type SB.Static_WString_Builder; + + Src_C_Path : SB.Static_WString_Builder (Src'Length + 1); + Dst_C_Path : SB.Static_WString_Builder (Dst'Length + 1); + + File_Handle : HANDLE; + Last_Access_FT : FILETIME; + Last_Write_FT : FILETIME; + + -- Ensure that Creation_FT fields are set to 0, as we do not + -- want to modify the creation timestamp + Creation_FT : FILETIME := (DwLowDateTime => 0, DwHighDateTime => 0); begin - return False; + + Append (Src_C_Path, Src); + Append (Dst_C_Path, Dst); + + File_Handle := + CreateFile + (Filename => As_C_WString (Src_C_Path), DesiredAccess => GENERIC_READ, + ShareMode => CF_FILE_SHARE_NONE, + CreationDisposition => CF_OPEN_EXISTING, + FlagsAndAttributes => + CF_FILE_ATTRIBUTE_NORMAL or CF_FILE_FLAG_BACKUP_SEMANTICS); + + if File_Handle = INVALID_HANDLE_VALUE then + return False; + end if; + + declare + -- Obtain source file timestamps + + Success : constant Win32.BOOL := + GetFileTime + (File_Handle, Creation_Time => Creation_FT, + Last_Access_Time => Last_Access_FT, + Last_Write_Time => Last_Write_FT); + begin + if CloseHandle (File_Handle) = BOOL_FALSE then + return False; + end if; + + if Success = BOOL_FALSE then + return False; + end if; + end; + + -- Copy timestamps to destination file + + File_Handle := + CreateFile + (Filename => As_C_WString (Dst_C_Path), DesiredAccess => GENERIC_WRITE, + ShareMode => CF_FILE_SHARE_NONE, + CreationDisposition => CF_OPEN_EXISTING, + FlagsAndAttributes => + CF_FILE_ATTRIBUTE_NORMAL or CF_FILE_FLAG_BACKUP_SEMANTICS); + + Creation_FT := (DwLowDateTime => 0, DwHighDateTime => 0); + + declare + Success : constant Win32.BOOL := + SetFileTime + (File_Handle, Creation_Time => Creation_FT, + Last_Access_Time => Last_Access_FT, + Last_Write_Time => Last_Write_FT); + begin + if CloseHandle (File_Handle) = BOOL_FALSE then + return False; + end if; + + if Success = BOOL_FALSE then + return False; + end if; + end; + + return True; end Copy_Timestamps; diff --git a/src/os/unix/gnatcoll-os-libc-utime.ads b/src/os/unix/gnatcoll-os-libc-utime.ads new file mode 100644 index 00000000..6d168277 --- /dev/null +++ b/src/os/unix/gnatcoll-os-libc-utime.ads @@ -0,0 +1,43 @@ +------------------------------------------------------------------------------ +-- G N A T C O L L -- +-- -- +-- Copyright (C) 2022-2023, AdaCore -- +-- -- +-- This library is free software; you can redistribute it and/or modify it -- +-- under terms of the GNU General Public License as published by the Free -- +-- Software Foundation; either version 3, or (at your option) any later -- +-- version. This library is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- +-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +-- Posix Interface to utime system call + +with GNATCOLL.OS.FS; use GNATCOLL.OS.FS; +package GNATCOLL.OS.Libc.Utime is + + type Timespec is record + TV_Sec : Interfaces.C.long; + TV_NSec : Interfaces.C.long; + end record; + + type Timespec_Array_Idx is range 1 .. 2; + type Timespec_Array is array (Timespec_Array_Idx) of Timespec; + + -- See Posix futimens documentation + function Futimens + (FD : File_Descriptor; Timespecs : in out Timespec_Array) + return Libc_Status with + Import => True, Convention => C, External_Name => "__gnatcoll_futimens"; + +end GNATCOLL.OS.Libc.Utime; diff --git a/src/os/unix/libc-wrappers.c b/src/os/unix/libc-wrappers.c index 0a52448d..f926af62 100644 --- a/src/os/unix/libc-wrappers.c +++ b/src/os/unix/libc-wrappers.c @@ -43,6 +43,7 @@ typedef unsigned long long int uint_64; typedef unsigned int uint_32; +typedef long int sint_32; typedef long long int sint_64; /* Simpler mapping of libc statvfs struct. This structure should stay @@ -195,6 +196,30 @@ int __gnatcoll_lstat(const char *path, struct gnatcoll_stat *buf) return status; } +/* + time_t may be implemented as a 32 or 64 bits signed integer. + The lower bound is taken, to avoid differences between systems. +*/ +struct gnatcoll_timespec { + sint_32 tv_sec; + sint_32 tv_nsec; +}; + +/* + Wrapper to standardize the required timespec. See struct gnatcoll_timespec + description. +*/ +int __gnatcoll_futimens(int fd, const struct gnatcoll_timespec times[2]) +{ + struct timespec fu_times[2]; + for (int i = 0 ; i < 2 ; i++) + { + fu_times[i].tv_sec = times[i].tv_sec; + fu_times[i].tv_nsec = times[i].tv_nsec; + } + return futimens(fd, fu_times); +} + int __gnatcoll_open(const char *path, int mode, int perm) { return open (path, mode, perm); diff --git a/src/os/win32/gnatcoll-os-win32-files.ads b/src/os/win32/gnatcoll-os-win32-files.ads index 6926f18a..c2fbba94 100644 --- a/src/os/win32/gnatcoll-os-win32-files.ads +++ b/src/os/win32/gnatcoll-os-win32-files.ads @@ -78,6 +78,12 @@ package GNATCOLL.OS.Win32.Files is FILE_OPEN_FOR_BACKUP_INTENT : constant OPEN_OPTION := 16#00004000#; FILE_SYNCHRONOUS_IO_NONALERT : constant OPEN_OPTION := 16#00000020#; + type FILETIME is record + DwLowDateTime : DWORD; + DwHighDateTime : DWORD; + end record with + Convention => C_Pass_By_Copy; + type OBJECT_ATTRIBUTES is record Length : ULONG; RootDirectory : HANDLE; @@ -356,4 +362,20 @@ package GNATCOLL.OS.Win32.Files is function DeleteFile (Path : C_WString) return BOOL with Import => True, Convention => Stdcall, External_Name => "DeleteFileW"; + function GetFileTime + (File : HANDLE; + Creation_Time : out FILETIME; + Last_Access_Time : out FILETIME; + Last_Write_Time : out FILETIME) + return BOOL with + Import => True, Convention => Stdcall, External_Name => "GetFileTime"; + + function SetFileTime + (File : HANDLE; + Creation_Time : in out FILETIME; + Last_Access_Time : in out FILETIME; + Last_Write_Time : in out FILETIME) + return BOOL with + Import => True, Convention => Stdcall, External_Name => "SetFileTime"; + end GNATCOLL.OS.Win32.Files; diff --git a/testsuite/tests/os/fsutil/test.adb b/testsuite/tests/os/fsutil/test.adb index 6fffc6c8..4129ed9c 100644 --- a/testsuite/tests/os/fsutil/test.adb +++ b/testsuite/tests/os/fsutil/test.adb @@ -1,5 +1,7 @@ with GNATCOLL.OS.FSUtil; use GNATCOLL.OS.FSUtil; with GNATCOLL.OS.FS; use GNATCOLL.OS.FS; +with GNATCOLL.OS.Stat; use GNATCOLL.OS.Stat; +with Ada.Calendar; use Ada.Calendar; with Test_Assert; with Ada.Text_IO; @@ -11,63 +13,133 @@ begin IO.Put_Line ("GNATCOLL.OS.FSUtil test"); declare - SHA1_Str : constant String := String (SHA1 ("./data.txt")); + SHA1_Str : constant String := String (SHA1 ("./data.txt")); SHA256_Str : constant String := String (SHA256 ("./data.txt")); begin A.Assert - (SHA1_Str, "0a963bb418c97dff49ec8d166834ee23a912a0e9", "Check sha1"); + (SHA1_Str, "0a963bb418c97dff49ec8d166834ee23a912a0e9", "Check sha1"); A.Assert - (SHA256_Str, - "93827371a7c9502512672999a530fb55999b054d4a05af3c2c02290bdded0d4c", - "Check sha256"); + (SHA256_Str, + "93827371a7c9502512672999a530fb55999b054d4a05af3c2c02290bdded0d4c", + "Check sha256"); end; -- Check file copying - declare - Src_Name : constant String := "from_file"; - Dst_Name : constant String := "to_file"; - FD : File_Descriptor; + function Check_File_Content + (File_Name : String; Expected_Content : String) return Boolean; + + function Check_File_Content + (File_Name : String; Expected_Content : String) return Boolean + is + FD : constant File_Descriptor := Open (File_Name, Mode => Read_Mode); + begin + declare + Content : constant String := Read (FD); + begin + Close (FD); + return Content = Expected_Content; + end; + end Check_File_Content; + + From_Name : constant String := "from_file"; + Creation_Delay : constant := 1.000_01; + -- Delay between timestamp test files, to ensure that timestamps + -- are not initially the same. Shall be at least 1 second, so we + -- do not have the same timestamp if nano second to second conversion + -- truncates. + + FD : File_Descriptor; + begin -- Create input file, and adds some content to it - FD := Open (Src_Name, Mode => Write_Mode); + FD := Open (From_Name, Mode => Write_Mode); Write (FD, "Input content"); Close (FD); - FD := Open (Src_Name, Mode => Read_Mode); + A.Assert (Check_File_Content (From_Name, "Input content")); + declare - File_Content : constant String := Read (FD); + To_Name : constant String := "to_file"; + Missing_File_Name : constant String := "missing_file"; begin - A.Assert (File_Content, "Input content"); - end; - Close (FD); + A.Assert (Copy_File (From_Name, To_Name)); - A.Assert (Copy_File (Src_Name, Dst_Name)); + -- Check that copy was successfull - -- Check that copy was successfull + A.Assert (Check_File_Content (To_Name, "Input content")); + + A.Assert (not Copy_File (Missing_File_Name, To_Name)); + end; - FD := Open (Dst_Name, Mode => Read_Mode); declare - File_Content : constant String := Read (FD); + To_Name : constant String := "timestamp_file"; + From_File_Attr : constant File_Attributes := + GNATCOLL.OS.Stat.Stat (From_Name); + begin - A.Assert (File_Content, "Input content"); - end; - Close (FD); + A.Assert (Exists (From_File_Attr)); + + -- Add a delay, to ensure that timestamps are not initially + -- the same. + delay (Creation_Delay); + A.Assert + (Copy_File (From_Name, To_Name, Preserve_Timestamps => True)); + + -- Check timestamps + + declare + To_File_Attr : constant File_Attributes := + GNATCOLL.OS.Stat.Stat (To_Name); + begin + A.Assert + (Modification_Time (From_File_Attr) = + Modification_Time (To_File_Attr)); + end; + + -- Ensure that copying with timestamps preservation does not + -- impact content copy. + A.Assert (Check_File_Content (From_Name, "Input content")); + A.Assert (Check_File_Content (To_Name, "Input content")); - A.Assert - (not Copy_File (Src_Name, Dst_Name, Preserve_Timestamps => True)); - A.Assert - (not Copy_File (Src_Name, Dst_Name, Preserve_Permissions => True)); - A.Assert - (not Copy_File - (Src_Name, Dst_Name, Preserve_Timestamps => True, - Preserve_Permissions => True)); + end; + -- Test timestamps copy alone, as Windows CopyFile copies + -- timestamps by default. declare - Missing_File_Name : constant String := "missing_file"; + To_Name : constant String := "another_timestamp_file"; + From_File_Attr : constant File_Attributes := + GNATCOLL.OS.Stat.Stat (From_Name); + begin - A.Assert (not Copy_File (Missing_File_Name, Dst_Name)); + A.Assert (Exists (From_File_Attr)); + + -- Add a delay, to ensure that timestamps are not initially + -- the same + delay (Creation_Delay); + FD := Open (To_Name, Mode => Write_Mode); + Close (FD); + + declare + To_File_Attr : File_Attributes := GNATCOLL.OS.Stat.Stat (To_Name); + begin + + -- Ensure that timestamps are initially different + A.Assert + (Modification_Time (From_File_Attr) /= + Modification_Time (To_File_Attr)); + + A.Assert (Copy_Timestamps (From_Name, To_Name)); + + To_File_Attr := GNATCOLL.OS.Stat.Stat (To_Name); + + A.Assert + (Modification_Time (From_File_Attr) = + Modification_Time (To_File_Attr)); + end; + + A.Assert (not Copy_Timestamps ("missing_file", To_Name)); end; end;