From 46fe686ba0972f91e0906e1024831d6c69f9fc17 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 15 Feb 2016 11:13:26 -0400 Subject: [PATCH 1/3] remove Utility.Mounts et al; moved to mountpoints package --- Utility/Mounts.hs | 21 +++++++++ Utility/Mounts.hsc | 97 ----------------------------------------- Utility/libmounts.c | 103 -------------------------------------------- Utility/libmounts.h | 38 ---------------- debian/copyright | 45 ------------------- git-annex.cabal | 5 +-- 6 files changed, 23 insertions(+), 286 deletions(-) create mode 100644 Utility/Mounts.hs delete mode 100644 Utility/Mounts.hsc delete mode 100644 Utility/libmounts.c delete mode 100644 Utility/libmounts.h diff --git a/Utility/Mounts.hs b/Utility/Mounts.hs new file mode 100644 index 0000000000..192da31a1c --- /dev/null +++ b/Utility/Mounts.hs @@ -0,0 +1,21 @@ +{- portability shim for System.MountPoints + - + - Copyright 2016 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.Mounts (getMounts, Mntent(..)) where + +import qualified System.MountPoints +import System.MountPoints (Mntent(..)) + +getMounts :: IO [Mntent] +#ifndef __ANDROID__ +getMounts = System.MountPoints.getMounts +#else +getMounts = System.MountPoints.getProcMounts +#endif diff --git a/Utility/Mounts.hsc b/Utility/Mounts.hsc deleted file mode 100644 index 3f121233ab..0000000000 --- a/Utility/Mounts.hsc +++ /dev/null @@ -1,97 +0,0 @@ -{- Interface to mtab (and fstab) - - - - Deprecated; moving to mountpoints library on hackage. - - - - Derived from hsshellscript, originally written by - - Volker Wysk - - - - Modified to support BSD, Mac OS X, and Android by - - Joey Hess - - - - Licensed under the GNU LGPL version 2.1 or higher. - - - -} - -{-# LANGUAGE ForeignFunctionInterface #-} - -module Utility.Mounts ( - Mntent(..), - getMounts -) where - -#ifndef __ANDROID__ -import Control.Monad -import Foreign -import Foreign.C -#include "libmounts.h" -#else -import Utility.Exception -import Data.Maybe -import Control.Applicative -#endif -import Prelude - -{- This is a stripped down mntent, containing only - - fields available everywhere. -} -data Mntent = Mntent - { mnt_fsname :: String - , mnt_dir :: FilePath - , mnt_type :: String - } deriving (Show, Eq, Ord) - -#ifndef __ANDROID__ - -getMounts :: IO [Mntent] -getMounts = do - h <- c_mounts_start - when (h == nullPtr) $ - throwErrno "getMounts" - mntent <- getmntent h [] - _ <- c_mounts_end h - return mntent - - where - getmntent h c = do - ptr <- c_mounts_next h - if (ptr == nullPtr) - then return $ reverse c - else do - mnt_fsname_str <- #{peek struct mntent, mnt_fsname} ptr >>= peekCString - mnt_dir_str <- #{peek struct mntent, mnt_dir} ptr >>= peekCString - mnt_type_str <- #{peek struct mntent, mnt_type} ptr >>= peekCString - let ent = Mntent - { mnt_fsname = mnt_fsname_str - , mnt_dir = mnt_dir_str - , mnt_type = mnt_type_str - } - getmntent h (ent:c) - -{- Using unsafe imports because the C functions are belived to never block. - - Note that getmntinfo is called with MNT_NOWAIT to avoid possibly blocking; - - while getmntent only accesses a file in /etc (or /proc) that should not - - block. -} -foreign import ccall unsafe "libmounts.h mounts_start" c_mounts_start - :: IO (Ptr ()) -foreign import ccall unsafe "libmounts.h mounts_next" c_mounts_next - :: Ptr () -> IO (Ptr ()) -foreign import ccall unsafe "libmounts.h mounts_end" c_mounts_end - :: Ptr () -> IO CInt - -#else - -{- Android does not support getmntent (well, it's a no-op stub in Bionic). - - - - But, the linux kernel's /proc/mounts is available to be parsed. - -} -getMounts :: IO [Mntent] -getMounts = catchDefaultIO [] $ - mapMaybe (parse . words) . lines <$> readFile "/proc/mounts" - where - parse (device:mountpoint:fstype:_rest) = Just $ Mntent - { mnt_fsname = device - , mnt_dir = mountpoint - , mnt_type = fstype - } - parse _ = Nothing - -#endif diff --git a/Utility/libmounts.c b/Utility/libmounts.c deleted file mode 100644 index c469d77103..0000000000 --- a/Utility/libmounts.c +++ /dev/null @@ -1,103 +0,0 @@ -/* mounted filesystems, C mini-library - * - * Copyright (c) 1980, 1989, 1993, 1994 - * The Regents of the University of California. All rights reserved. - * Copyright (c) 2001 - * David Rufino - * Copyright 2012 - * Joey Hess - * - * 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 University 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 REGENTS 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 REGENTS 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. - */ - -#include "libmounts.h" - -#ifdef GETMNTENT -/* direct passthrough the getmntent */ -FILE *mounts_start (void) { - return setmntent("/etc/mtab", "r"); -} -int mounts_end (FILE *fp) { - return endmntent(fp); -} -struct mntent *mounts_next (FILE *fp) { - return getmntent(fp); -} -#endif - -#ifdef GETMNTINFO -/* getmntent emulation using getmntinfo */ -FILE *mounts_start (void) { - return ((FILE *)0x1); /* dummy non-NULL FILE pointer, not used */ -} -int mounts_end (FILE *fp) { - return 1; -} - -static struct mntent _mntent; - -static struct mntent *statfs_to_mntent (struct statfs *mntbuf) { - _mntent.mnt_fsname = mntbuf->f_mntfromname; - _mntent.mnt_dir = mntbuf->f_mntonname; - _mntent.mnt_type = mntbuf->f_fstypename; - - _mntent.mnt_opts = NULL; - _mntent.mnt_freq = 0; - _mntent.mnt_passno = 0; - - return (&_mntent); -} - -static int pos = -1; -static int mntsize = -1; -struct statfs *mntbuf = NULL; - -struct mntent *mounts_next (FILE *fp) { - - if (pos == -1 || mntsize == -1) - mntsize = getmntinfo(&mntbuf, MNT_NOWAIT); - ++pos; - if (pos == mntsize) { - pos = mntsize = -1; - mntbuf = NULL; - return NULL; - } - - return (statfs_to_mntent(&mntbuf[pos])); -} -#endif - -#ifdef UNKNOWN -/* dummy, do-nothing version */ -FILE *mounts_start (void) { - return ((FILE *)0x1); -} -int mounts_end (FILE *fp) { - return 1; -} -struct mntent *mounts_next (FILE *fp) { - return NULL; -} -#endif diff --git a/Utility/libmounts.h b/Utility/libmounts.h deleted file mode 100644 index 24df55f310..0000000000 --- a/Utility/libmounts.h +++ /dev/null @@ -1,38 +0,0 @@ -/* Include appropriate headers for the OS, and define what will be used. */ -#if defined (__FreeBSD__) || defined (__APPLE__) -# include -# include -# include -# define GETMNTINFO -#else -#if defined __ANDROID__ -/* Android is handled by the Haskell code, not here. */ -# define UNKNOWN -#else -#if defined (__linux__) || defined (__FreeBSD_kernel__) -/* Linux or Debian kFreeBSD */ -#include -# define GETMNTENT -#else -# warning mounts listing code not available for this OS -# define UNKNOWN -#endif -#endif -#endif - -#include - -#ifndef GETMNTENT -struct mntent { - char *mnt_fsname; - char *mnt_dir; - char *mnt_type; - char *mnt_opts; /* not filled in */ - int mnt_freq; /* not filled in */ - int mnt_passno; /* not filled in */ -}; -#endif - -FILE *mounts_start (void); -int mounts_end (FILE *fp); -struct mntent *mounts_next (FILE *fp); diff --git a/debian/copyright b/debian/copyright index 5f80d40507..4f89d811bc 100644 --- a/debian/copyright +++ b/debian/copyright @@ -35,51 +35,11 @@ Copyright: 2007 Henrik Nyh License: other Free to modify and redistribute with due credit, and obviously free to use. -Files: Utility/Mounts.hsc -Copyright: Volker Wysk -License: LGPL-2.1+ - Files: Annex/DirHashes.hs Copyright: 2001 Ian Lynagh 2010-2015 Joey Hess License: GPL-3+ -Files: Utility/libmounts.c -Copyright: 1980, 1989, 1993, 1994 The Regents of the University of California - 2001 David Rufino - 2012 Joey Hess -License: BSD-3-clause - * Copyright (c) 1980, 1989, 1993, 1994 - * The Regents of the University of California. All rights reserved. - * Copyright (c) 2001 - * David Rufino - * Copyright 2012 - * Joey Hess - * - * 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 University 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 REGENTS 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 REGENTS 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. - Files: static/jquery* Copyright: © 2005-2011 by John Resig, Branden Aaron & Jörn Zaefferer © 2011 The Dojo Foundation @@ -135,11 +95,6 @@ License: GPL-3+ this package's source, or in /usr/share/common-licenses/GPL-3 on Debian systems. -License: LGPL-2.1+ - The full text of version 2.1 of the LGPL is distributed as doc/license/LGPL - in this package's source, or in /usr/share/common-licenses/LGPL-2.1 - on Debian systems. - License: BSD-2-clause Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions diff --git a/git-annex.cabal b/git-annex.cabal index fa496d8e01..4edbd21c3b 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -144,9 +144,8 @@ Executable git-annex else Build-Depends: unix -- Need to list these because they're generated from .hsc files. - Other-Modules: Utility.Touch Utility.Mounts + Other-Modules: Utility.Touch Include-Dirs: Utility - C-Sources: Utility/libdiskfree.c Utility/libmounts.c CPP-Options: -DWITH_CLIBS if flag(TestSuite) @@ -163,7 +162,7 @@ Executable git-annex CPP-Options: -DWITH_WEBDAV if flag(Assistant) && ! os(solaris) - Build-Depends: dns + Build-Depends: dns, mountpoints CPP-Options: -DWITH_ASSISTANT if flag(Assistant) From a665f92b91cf970e5af01cca94b1971df80bec2d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 15 Feb 2016 11:29:27 -0400 Subject: [PATCH 2/3] switch from homegrown code to disk-free-space According to https://github.com/redneb/disk-free-space/issues/3 , disk-free-space should be at least as portable as my homegrown code was. One change I noticed is, getDiskSize was not implemented for windows in the old code, and should work now. --- Utility/DiskFree.hs | 63 +++++--------------------------- Utility/libdiskfree.c | 84 ------------------------------------------- Utility/libdiskfree.h | 1 - git-annex.cabal | 3 +- 4 files changed, 10 insertions(+), 141 deletions(-) delete mode 100644 Utility/libdiskfree.c delete mode 100644 Utility/libdiskfree.h diff --git a/Utility/DiskFree.hs b/Utility/DiskFree.hs index c4125d4f00..fe3a4577c1 100644 --- a/Utility/DiskFree.hs +++ b/Utility/DiskFree.hs @@ -1,70 +1,23 @@ -{- disk free space checking +{- disk free space checking shim - - - Copyright 2012, 2014 Joey Hess + - Copyright 2016 Joey Hess - - License: BSD-2-clause -} -{-# LANGUAGE ForeignFunctionInterface, CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.DiskFree ( getDiskFree, getDiskSize ) where -#ifdef WITH_CLIBS - -import Common - -import Foreign.C.Types -import Foreign.C.String -import Foreign.C.Error - -foreign import ccall safe "libdiskfree.h diskfree" c_diskfree - :: CString -> IO CULLong - -foreign import ccall safe "libdiskfree.h disksize" c_disksize - :: CString -> IO CULLong - -getVal :: (CString -> IO CULLong) -> FilePath -> IO (Maybe Integer) -getVal getter path = withFilePath path $ \c_path -> do - free <- getter c_path - ifM (safeErrno <$> getErrno) - ( return $ Just $ toInteger free - , return Nothing - ) - where - safeErrno (Errno v) = v == 0 +import System.DiskSpace +import Utility.Applicative +import Utility.Exception getDiskFree :: FilePath -> IO (Maybe Integer) -getDiskFree = getVal c_diskfree +getDiskFree = catchMaybeIO . getAvailSpace getDiskSize :: FilePath -> IO (Maybe Integer) -getDiskSize = getVal c_disksize - -#else -#ifdef mingw32_HOST_OS - -import Common - -import System.Win32.File - -getDiskFree :: FilePath -> IO (Maybe Integer) -getDiskFree path = catchMaybeIO $ do - (sectors, bytes, nfree, _ntotal) <- getDiskFreeSpace (Just path) - return $ toInteger sectors * toInteger bytes * toInteger nfree - -getDiskSize :: FilePath -> IO (Maybe Integer) -getDiskSize _ = return Nothing -#else - -#warning Building without disk free space checking support - -getDiskFree :: FilePath -> IO (Maybe Integer) -getDiskFree _ = return Nothing - -getDiskSize :: FilePath -> IO (Maybe Integer) -getDiskSize _ = return Nothing - -#endif -#endif +getDiskSize = fmap diskTotal <$$> catchMaybeIO . getDiskUsage diff --git a/Utility/libdiskfree.c b/Utility/libdiskfree.c deleted file mode 100644 index a682bb3bd3..0000000000 --- a/Utility/libdiskfree.c +++ /dev/null @@ -1,84 +0,0 @@ -/* disk free space checking, C mini-library - * - * Copyright 2012, 2014 Joey Hess - * - * License: BSD-2-clause - */ - -/* Include appropriate headers for the OS, and define what will be used to - * check the free space. */ -#if defined (__FreeBSD__) -# include -# include -# define STATCALL statfs /* statfs64 not yet tested on a real FreeBSD machine */ -# define STATSTRUCT statfs -# define BSIZE f_bsize -#else -#if defined __ANDROID__ -# warning free space checking code not available for Android -# define UNKNOWN -#else -#if defined (__linux__) || defined (__APPLE__) || defined (__FreeBSD_kernel__) || (defined (__SVR4) && defined (__sun)) -/* Linux or OSX or Debian kFreeBSD or Solaris */ -/* This is a POSIX standard, so might also work elsewhere too. */ -# include -# define STATCALL statvfs -# define STATSTRUCT statvfs -# define BSIZE f_frsize -#else -# warning free space checking code not available for this OS -# define UNKNOWN -#endif -#endif -#endif - -#include -#include - -unsigned long long int get(const char *path, int req) { -#ifdef UNKNOWN - errno = 1; - return 0; -#else - unsigned long long int v, blocksize; - struct STATSTRUCT buf; - - if (STATCALL(path, &buf) != 0) - return 0; /* errno is set */ - else - errno = 0; - - switch (req) { - case 0: - v = buf.f_blocks; - break; - case 1: - v = buf.f_bavail; - break; - default: - v = 0; - } - - blocksize = buf.BSIZE; - return v * blocksize; -#endif -} - -/* Checks the amount of disk that is available to regular (non-root) users. - * (If there's an error, or this is not supported, - * returns 0 and sets errno to nonzero.) - */ -unsigned long long int diskfree(const char *path) { - return get(path, 1); -} - -/* Gets the total size of the disk. */ -unsigned long long int disksize(const char *path) { - return get(path, 0); -} - -/* -main () { - printf("%lli\n", diskfree(".")); -} -*/ diff --git a/Utility/libdiskfree.h b/Utility/libdiskfree.h deleted file mode 100644 index e5b84754fe..0000000000 --- a/Utility/libdiskfree.h +++ /dev/null @@ -1 +0,0 @@ -unsigned long long int diskfree(const char *path); diff --git a/git-annex.cabal b/git-annex.cabal index 4edbd21c3b..8e6efbf592 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -111,7 +111,8 @@ Executable git-annex esqueleto, persistent-sqlite, persistent, persistent-template, aeson, feed, - regex-tdfa + regex-tdfa, + disk-free-space CC-Options: -Wall GHC-Options: -Wall -fno-warn-tabs Extensions: PackageImports From 40207b26ea81fbb50c455de3a4e0c1046ede8c23 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 15 Feb 2016 11:47:33 -0400 Subject: [PATCH 3/3] move old ghc compat code into separate module; eliminate WITH_CLIBS This avoids hsc2hs being run except when building for the old version of ghc. Should speed up builds. --- Annex/Ingest.hs | 12 +----- Assistant.hs | 4 +- Assistant/WebApp/Configurators/Local.hs | 6 --- Command/Fix.hs | 12 +----- Utility/Touch.hs | 52 +++++++++++++++++++++++++ Utility/{Touch.hsc => Touch/Old.hsc} | 26 +------------ git-annex.cabal | 6 +-- 7 files changed, 61 insertions(+), 57 deletions(-) create mode 100644 Utility/Touch.hs rename Utility/{Touch.hsc => Touch/Old.hsc} (82%) diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 0dd8b5967a..68db3eef08 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -5,8 +5,6 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} - module Annex.Ingest ( LockedDown(..), LockDownConfig(..), @@ -38,13 +36,9 @@ import Utility.InodeCache import Annex.ReplaceFile import Utility.Tmp import Utility.CopyFile +import Utility.Touch import Git.FilePath import Annex.InodeSentinal -#ifdef WITH_CLIBS -#ifndef __ANDROID__ -import Utility.Touch -#endif -#endif import Control.Exception (IOException) @@ -260,11 +254,7 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do -- touch symlink to have same time as the original file, -- as provided in the InodeCache case mcache of -#if defined(WITH_CLIBS) && ! defined(__ANDROID__) Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False -#else - Just _ -> noop -#endif Nothing -> noop return l diff --git a/Assistant.hs b/Assistant.hs index 265827a773..4dab6f162c 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -25,7 +25,7 @@ import Assistant.Threads.RemoteControl import Assistant.Threads.SanityChecker import Assistant.Threads.Cronner import Assistant.Threads.ProblemFixer -#ifdef WITH_CLIBS +#ifndef mingw32_HOST_OS import Assistant.Threads.MountWatcher #endif import Assistant.Threads.NetWatcher @@ -170,7 +170,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = , assist $ sanityCheckerDailyThread urlrenderer , assist sanityCheckerHourlyThread , assist $ problemFixerThread urlrenderer -#ifdef WITH_CLIBS +#ifndef mingw32_HOST_OS , assist $ mountWatcherThread urlrenderer #endif , assist netWatcherThread diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index a2a465b875..b3f5f6e782 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -24,9 +24,7 @@ import qualified Git.Branch import Config.Files import Utility.FreeDesktop import Utility.DiskFree -#ifdef WITH_CLIBS import Utility.Mounts -#endif import Utility.DataUnits import Remote (prettyUUID) import Annex.UUID @@ -359,7 +357,6 @@ driveList :: IO [RemovableDrive] -- Could use wmic, but it only works for administrators. driveList = mapM (\d -> genRemovableDrive $ d:":\\") ['A'..'Z'] #else -#ifdef WITH_CLIBS driveList = mapM (genRemovableDrive . mnt_dir) =<< filter sane <$> getMounts where -- filter out some things that are surely not removable drives @@ -379,9 +376,6 @@ driveList = mapM (genRemovableDrive . mnt_dir) =<< filter sane <$> getMounts | dir == "/sdcard" = False #endif | otherwise = True -#else -driveList = return [] -#endif #endif genRemovableDrive :: FilePath -> IO RemovableDrive diff --git a/Command/Fix.hs b/Command/Fix.hs index 5565a68372..d87bea3585 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -18,11 +18,7 @@ import Annex.Content import Annex.Perms import qualified Annex.Queue import qualified Database.Keys -#ifdef WITH_CLIBS -#ifndef __ANDROID__ import Utility.Touch -#endif -#endif cmd :: Command cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $ @@ -90,20 +86,16 @@ makeHardLink file key = do fixSymlink :: FilePath -> FilePath -> CommandPerform fixSymlink file link = do liftIO $ do -#ifdef WITH_CLIBS -#ifndef __ANDROID__ +#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__) -- preserve mtime of symlink mtime <- catchMaybeIO $ TimeSpec . modificationTime <$> getSymbolicLinkStatus file -#endif #endif createDirectoryIfMissing True (parentDir file) removeFile file createSymbolicLink link file -#ifdef WITH_CLIBS -#ifndef __ANDROID__ +#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__) maybe noop (\t -> touch file t False) mtime -#endif #endif next $ cleanupSymlink file diff --git a/Utility/Touch.hs b/Utility/Touch.hs new file mode 100644 index 0000000000..60b9cb928c --- /dev/null +++ b/Utility/Touch.hs @@ -0,0 +1,52 @@ +{- More control over touching a file. + - + - Copyright 2011 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE CPP #-} + +module Utility.Touch ( + TimeSpec(..), + touchBoth, + touch +) where + +#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__) + +#if MIN_VERSION_unix(2,7,0) + +import System.Posix.Files +import System.Posix.Types + +newtype TimeSpec = TimeSpec EpochTime + +{- Changes the access and modification times of an existing file. + Can follow symlinks, or not. Throws IO error on failure. -} +touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO () +touchBoth file (TimeSpec atime) (TimeSpec mtime) follow + | follow = setFileTimes file atime mtime + | otherwise = setSymbolicLinkTimesHiRes file (realToFrac atime) (realToFrac mtime) + +touch :: FilePath -> TimeSpec -> Bool -> IO () +touch file mtime = touchBoth file mtime mtime + +#else +import Utility.Touch.Old +#endif + +#else + +import System.PosixCompat + +newtype TimeSpec = TimeSpec EpochTime + +{- Noop for Windows -} +touchBoth FilePath -> TimeSpec -> TimeSpec -> Bool -> IO () +touchBoth _ _ _ _ = return () + +touch :: FilePath -> TimeSpec -> Bool -> IO () +touch _ _ = return () + +#endif diff --git a/Utility/Touch.hsc b/Utility/Touch/Old.hsc similarity index 82% rename from Utility/Touch.hsc rename to Utility/Touch/Old.hsc index e1b1e887e9..5345285f46 100644 --- a/Utility/Touch.hsc +++ b/Utility/Touch/Old.hsc @@ -1,4 +1,4 @@ -{- More control over touching a file. +{- Compatability interface for old version of unix, to be removed eventally. - - Copyright 2011 Joey Hess - @@ -7,32 +7,12 @@ {-# LANGUAGE ForeignFunctionInterface, CPP #-} -module Utility.Touch ( +module Utility.Touch.Old ( TimeSpec(..), touchBoth, touch ) where -#if MIN_VERSION_unix(2,7,0) - -import System.Posix.Files -import System.Posix.Types - -newtype TimeSpec = TimeSpec EpochTime - -{- Changes the access and modification times of an existing file. - Can follow symlinks, or not. Throws IO error on failure. -} -touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO () -touchBoth file (TimeSpec atime) (TimeSpec mtime) follow - | follow = setFileTimes file atime mtime - | otherwise = setSymbolicLinkTimesHiRes file (realToFrac atime) (realToFrac mtime) - -touch :: FilePath -> TimeSpec -> Bool -> IO () -touch file mtime = touchBoth file mtime mtime - -#else -{- Compatability interface for old version of unix, to be removed eventally. -} - #include #include #include @@ -141,5 +121,3 @@ touchBoth file atime mtime follow = touchBoth _ _ _ _ = return () #endif #endif - -#endif diff --git a/git-annex.cabal b/git-annex.cabal index 8e6efbf592..4a1e28f17a 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -144,10 +144,8 @@ Executable git-annex process (>= 1.3.0.0) else Build-Depends: unix - -- Need to list these because they're generated from .hsc files. - Other-Modules: Utility.Touch - Include-Dirs: Utility - CPP-Options: -DWITH_CLIBS + if impl(ghc <= 7.6.3) + Other-Modules: Utility.Touch.Old if flag(TestSuite) Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck, tasty-rerun,