diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2011, Maximilian Bolingbroke +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted +provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this list of + conditions and the following disclaimer. + * 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. + * Neither the name of Maximilian Bolingbroke nor the names of other 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 OWNER 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. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/System/Directory/AccessTime.hs b/System/Directory/AccessTime.hs new file mode 100644 --- /dev/null +++ b/System/Directory/AccessTime.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} +module System.Directory.AccessTime ( + getAccessTime, getAccessTimeResolution + ) where + +import System.Time + +#ifdef UNIX + +import Data.Time.Clock.POSIX + +import System.Posix.Types +import System.Posix.Files + +getAccessTime fp = fmap (epochTimeToClockTime . accessTime) $ getFileStatus fp + +epochTimeToClockTime :: EpochTime -> ClockTime +epochTimeToClockTime x = TOD whole_secs (round fractional_picosecs) + where (whole_secs, fractional_sec) = properFraction (toRational x) + fractional_picosecs = 1000000000000 * fractional_sec + +-- See : time_t provides times accurate to 1 second +getAccessTimeResolution _ = return $ noTimeDiff { tdSec = 1 } + +#elif defined(WINDOWS) + +import Data.Bits +import Data.List (genericReplicate) + +import Foreign.Ptr + +import Control.Exception (bracket) + +import System.FilePath.Windows + +import System.Win32.File +import System.Win32.Time +import System.Win32.Types + +-- TODO: I don't think CreateFile is throwing the right exceptions +getAccessTime fp = bracket (createFile fp gENERIC_READ (fILE_SHARE_WRITE .|. fILE_SHARE_READ) Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing) closeHandle $ \h -> do + (_creation_time, access_time, _write_time) <- getFileTime h + fmap systemTimeToClockTime $ fileTimeToSystemTime access_time + +systemTimeToClockTime :: SYSTEMTIME -> ClockTime +systemTimeToClockTime time = toClockTime $ CalendarTime { + ctYear = fromIntegral (wYear time), + ctMonth = toEnum (fromIntegral (wMonth time)), + ctDay = fromIntegral (wDay time), + ctHour = fromIntegral (wHour time), + ctMin = fromIntegral (wMinute time), + ctSec = fromIntegral (wSecond time), + ctPicosec = fromIntegral (wMilliseconds time) * 1000000000, + ctWDay = error "Documented as ignored: ctWDay", + ctYDay = error "Documented as ignored: ctYDay", + ctTZName = error "Documented as ignored: ctTZName", + ctTZ = 0, -- UTC has no variation from UTC! + ctIsDST = error "Documented as ignored: ctIsDST" + } + +-- See : FAT access time has a resolution of 1 day, +-- NTFS access time has a resolution of one hour. +-- +-- If neither of those cases seem to apply, we assume a 1 second resolution +getAccessTimeResolution fp = do + fs <- getVolumeFileSystem (takeDrive fp) + return $ case fs of "NTFS" -> noTimeDiff { tdHour = 1 } + 'F':'A':'T':_ -> noTimeDiff { tdDay = 1 } + _ -> noTimeDiff { tdSec = 1 } + +-- See http://msdn.microsoft.com/en-us/library/aa364993(v=VS.85).aspx +foreign import stdcall "Windows.h GetVolumeInformationW" c_getVolumeInformationW :: LPCTSTR -- ^ lpRootPathName: A pointer to a string that contains the root directory of the volume to be described + -> LPTSTR -- ^ lpVolumeNameBuffer: A pointer to a buffer that receives the name of a specified volume + -> DWORD -- ^ nVolumeNameSize: The length of a volume name buffer, in TCHARs + -> LPDWORD -- ^ lpVolumeSerialNumber: A pointer to a variable that receives the volume serial number + -> LPDWORD -- ^ lpMaximumComponentLength: A pointer to a variable that receives the maximum length, in TCHARs, of a file name component that a specified file system supports + -> LPDWORD -- ^ lpFileSystemFlags: A pointer to a variable that receives flags associated with the specified file system + -> LPTSTR -- ^ lpFileSystemNameBuffer: A pointer to a buffer that receives the name of the file system, for example, the FAT file system or the NTFS file system + -> DWORD -- ^ nFileSystemNameSize: The length of the file system name buffer, in TCHARs + -> IO BOOL -- ^ If all the requested information is retrieved, the return value is nonzero. To get extended error information, call GetLastError. + +getVolumeFileSystem :: FilePath -> IO String +getVolumeFileSystem fp = withTString fp $ \fp_tstr -> withTString (genericReplicate fs_len ' ') $ \fs_tstr -> do + failIfFalse_ ("GetVolumeInformation " ++ show fp) $ c_getVolumeInformationW fp_tstr nullPtr 0 nullPtr nullPtr nullPtr fs_tstr fs_len + peekTString fs_tstr + where + -- The documentation states that the file system name will never exceed this length + fs_len = mAX_PATH + 1 + mAX_PATH = 260 -- See + +#else + +#error Unsupported platform + +#endif + + +-- | The 'getAccessTime' operation returns the clock time at which the file or directory was last accessed. +-- +-- The operation may fail with: +-- +-- * 'System.IO.Error.isPermissionError' if the user is not permitted to obtain the access time; or +-- +-- * 'System.IO.Error.isDoesNotExistError' if the file or directory does not exist. +getAccessTime :: FilePath -> IO ClockTime + +-- | Approximate resolution of access times on your system for the given file or directory. +-- Presently this will not attempt to determine whether access times are enabled on the relevant file system. +getAccessTimeResolution :: FilePath -> IO TimeDiff diff --git a/access-time.cabal b/access-time.cabal new file mode 100644 --- /dev/null +++ b/access-time.cabal @@ -0,0 +1,30 @@ +Name: access-time +Version: 0.1 +Cabal-Version: >= 1.6 +Category: System +Synopsis: Cross-platform support for retrieving file access times +Description: Just a simple library that provides cross-platform support (Windows and Unix) for retrieving file access times +License: BSD3 +License-File: LICENSE +Author: Max Bolingbroke +Maintainer: Max Bolingbroke +Homepage: http://www.github.com/batterseapower/access-time +Build-Type: Simple + +Source-Repository head + type: git + location: git://github.com/batterseapower/access-time.git + +Library + Exposed-Modules: System.Directory.AccessTime + + if os(windows) + Build-Depends: Win32 >= 2.0 && < 2.3 + Cpp-Options: -DWINDOWS + Extra-Libraries: "kernel32" + else + -- We assume any non-Windows platform is Unix + Build-Depends: unix >= 2.3 && < 2.5 + Cpp-Options: -DUNIX + + Build-Depends: base >= 3 && < 5, old-time >= 1.0 && < 1.1, time >= 1.1 && < 1.3, filepath >= 1.1 && < 1.3