diff --git a/Annex/Link.hs b/Annex/Link.hs index 2f22143dd8..5ed296007b 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -468,12 +468,13 @@ isPointerFile f = catchDefaultIO Nothing $ - than .git to be used. -} isLinkToAnnex :: S.ByteString -> Bool -isLinkToAnnex s = p `OS.isInfixOf` (toOsPath s) +isLinkToAnnex s = p `OS.isInfixOf` s' #ifdef mingw32_HOST_OS -- '/' is used inside pointer files on Windows, not the native '\' - || p' `OS.isInfixOf` s + || p' `OS.isInfixOf` s' #endif where + s' = toOsPath s p = pathSeparator `OS.cons` objectDir #ifdef mingw32_HOST_OS p' = toInternalGitPath p diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs index d6c3fe8f12..d34c5ef600 100644 --- a/Annex/Proxy.hs +++ b/Annex/Proxy.hs @@ -36,7 +36,9 @@ import qualified Utility.FileIO as F import Utility.OpenFile #endif +#ifndef mingw32_HOST_OS import Control.Concurrent +#endif import Control.Concurrent.STM import Control.Concurrent.Async import qualified Data.ByteString as B diff --git a/Assistant.hs b/Assistant.hs index 41553c6949..3ad8926960 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -105,7 +105,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost listenport star ( liftIO $ withNullHandle $ \nullh -> do loghandle <- openLog (fromOsPath logfile) e <- getEnvironment - cmd <- programPath + cmd <- fromOsPath <$> programPath ps <- getArgs let p = (proc cmd ps) { env = Just (addEntry flag "1" e) @@ -116,7 +116,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost listenport star exitcode <- withCreateProcess p $ \_ _ _ pid -> waitForProcess pid exitWith exitcode - , start (Utility.Daemon.foreground (Just (fromOsPath pidfile))) $ + , start (Utility.Daemon.foreground (Just pidfile)) $ case startbrowser of Nothing -> Nothing Just a -> Just $ a Nothing Nothing diff --git a/Build/NullSoftInstaller.hs b/Build/NullSoftInstaller.hs index ca209076d3..8241ff8dd8 100644 --- a/Build/NullSoftInstaller.hs +++ b/Build/NullSoftInstaller.hs @@ -16,7 +16,7 @@ - A build of libmagic will also be included in the installer, if its files - are found in the current directory: - ./magic.mgc ./libmagic-1.dll ./libgnurx-0.dll - - To build git-annex to usse libmagic, it has to be built with the + - To build git-annex to use libmagic, it has to be built with the - magicmime build flag turned on. - - Copyright 2013-2020 Joey Hess @@ -27,7 +27,6 @@ {-# LANGUAGE OverloadedStrings, FlexibleContexts #-} import Development.NSIS -import System.FilePath import Control.Monad import Control.Applicative import Data.String @@ -42,27 +41,29 @@ import Utility.SafeCommand import Utility.Process import Utility.Exception import Utility.Directory +import Utility.SystemDirectory +import Utility.OsPath import Build.BundledPrograms main = do withTmpDir "nsis-build" $ \tmpdir -> do - let gitannex = tmpdir gitannexprogram + let gitannex = fromOsPath $ tmpdir toOsPath gitannexprogram mustSucceed "ln" [File "git-annex.exe", File gitannex] magicDLLs' <- installwhenpresent magicDLLs tmpdir magicShare' <- installwhenpresent magicShare tmpdir - let license = tmpdir licensefile + let license = fromOsPath $ tmpdir toOsPath licensefile mustSucceed "sh" [Param "-c", Param $ "zcat standalone/licences.gz > '" ++ license ++ "'"] webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git annex webapp" autostartscript <- vbsLauncher tmpdir "git-annex-autostart" "git annex assistant --autostart" - let htmlhelp = tmpdir "git-annex.html" + let htmlhelp = fromOsPath $ tmpdir literalOsPath "git-annex.html" writeFile htmlhelp htmlHelpText - let gitannexcmd = tmpdir "git-annex.cmd" + let gitannexcmd = fromOsPath $ tmpdir literalOsPath "git-annex.cmd" writeFile gitannexcmd "git annex %*" writeFile nsifile $ makeInstaller gitannex gitannexcmd license htmlhelp (winPrograms ++ magicDLLs') magicShare' [ webappscript, autostartscript ] mustSucceed "makensis" [File nsifile] - removeFile nsifile -- left behind if makensis fails + removeFile (toOsPath nsifile) -- left behind if makensis fails where nsifile = "git-annex.nsi" mustSucceed cmd params = do @@ -72,19 +73,19 @@ main = do False -> error $ cmd ++ " failed" installwhenpresent fs tmpdir = do fs' <- forM fs $ \f -> do - present <- doesFileExist f + present <- doesFileExist (toOsPath f) if present then do - mustSucceed "ln" [File f, File (tmpdir f)] + mustSucceed "ln" [File f, File (fromOsPath (tmpdir toOsPath f))] return (Just f) else return Nothing return (catMaybes fs') {- Generates a .vbs launcher which runs a command without any visible DOS - box. It expects to be passed the directory where git-annex is installed. -} -vbsLauncher :: FilePath -> String -> String -> IO String +vbsLauncher :: OsPath -> String -> String -> IO String vbsLauncher tmpdir basename cmd = do - let f = tmpdir basename ++ ".vbs" + let f = fromOsPath $ tmpdir toOsPath (basename ++ ".vbs") writeFile f $ unlines [ "Set objshell=CreateObject(\"Wscript.Shell\")" , "objShell.CurrentDirectory = Wscript.Arguments.item(0)" @@ -207,7 +208,7 @@ makeInstaller gitannex gitannexcmd license htmlhelp extrabins sharefiles launche removefilesFrom "$INSTDIR" [license, uninstaller] where addfile f = file [] (str f) - removefilesFrom d = mapM_ (\f -> delete [RebootOK] $ fromString $ d ++ "/" ++ takeFileName f) + removefilesFrom d = mapM_ (\f -> delete [RebootOK] $ fromString $ d ++ "/" ++ fromOsPath (takeFileName (toOsPath f))) winPrograms :: [FilePath] winPrograms = map (\p -> p ++ ".exe") bundledPrograms diff --git a/Git/Remote.hs b/Git/Remote.hs index b09aee6643..eb4d78e88d 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -122,8 +122,8 @@ parseRemoteLocation s knownurl repo = go #ifdef mingw32_HOST_OS -- git on Windows will write a path to .git/config with "drive:", -- which is not to be confused with a "host:" - dosstyle = hasDrive - dospath = fromRawFilePath . fromInternalGitPath . toRawFilePath + dosstyle = hasDrive . toOsPath + dospath = fromOsPath . fromInternalGitPath . toOsPath #endif insteadOfUrl :: String -> S.ByteString -> RepoFullConfig -> Maybe String diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 6acaf251f6..75e003d5a1 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -480,7 +480,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p = closeFd dupfd bracketIO open close $ \(h, dupfd) -> do #else - let open = openBinaryFile f' ReadMode + let open = F.openBinaryFile f ReadMode let close = hClose bracketIO open close $ \h -> do #endif diff --git a/Test.hs b/Test.hs index b66dd9b78e..0032e855e0 100644 --- a/Test.hs +++ b/Test.hs @@ -88,9 +88,9 @@ import qualified Utility.Aeson import qualified Utility.CopyFile import qualified Utility.MoveFile import qualified Utility.StatelessOpenPGP -import qualified Utility.OsString as OS import qualified Types.Remote #ifndef mingw32_HOST_OS +import qualified Utility.OsString as OS import qualified Remote.Helper.Encryptable import qualified Types.Crypto import qualified Utility.Gpg diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index 8fd142da36..6d5ea6c0bf 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -158,7 +158,7 @@ checkDaemon pidfile = maybe (return Nothing) (check . readish) where check Nothing = return Nothing check (Just pid) = do - v <- lockShared =<< winLockFile pid (fromOsPath pidfile) + v <- lockShared =<< winLockFile pid pidfile case v of Just h -> do dropLock h diff --git a/Utility/DirWatcher.hs b/Utility/DirWatcher.hs index f0805aa2c0..d7573d7475 100644 --- a/Utility/DirWatcher.hs +++ b/Utility/DirWatcher.hs @@ -134,7 +134,7 @@ watchDir dir prune scanevents hooks runstartup = #else #if WITH_WIN32NOTIFY type DirWatcherHandle = Win32Notify.WatchManager -watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle +watchDir :: OsPath -> Pruner -> Bool -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle watchDir dir prune scanevents hooks runstartup = runstartup $ Win32Notify.watchDir dir prune scanevents hooks #else diff --git a/Utility/DirWatcher/Win32Notify.hs b/Utility/DirWatcher/Win32Notify.hs index 5f53c13bf5..3291f4a77a 100644 --- a/Utility/DirWatcher/Win32Notify.hs +++ b/Utility/DirWatcher/Win32Notify.hs @@ -14,15 +14,15 @@ import qualified Utility.RawFilePath as R import System.Win32.Notify import System.PosixCompat.Files (isRegularFile) -watchDir :: FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO WatchManager +watchDir :: OsPath -> (OsPath -> Bool) -> Bool -> WatchHooks -> IO WatchManager watchDir dir ignored scanevents hooks = do scan dir wm <- initWatchManager - void $ watchDirectory wm dir True [Create, Delete, Modify, Move] dispatch + void $ watchDirectory wm (fromOsPath dir) True [Create, Delete, Modify, Move] dispatch return wm where dispatch evt - | ignoredPath ignored (filePath evt) = noop + | ignoredPath ignored (toOsPath (filePath evt)) = noop | otherwise = case evt of (Deleted _ _) | isDirectory evt -> runhook delDirHook Nothing @@ -40,11 +40,11 @@ watchDir dir ignored scanevents hooks = do runhook addHook Nothing runhook modifyHook Nothing where - runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks) + runhook h s = maybe noop (\a -> a (toOsPath (filePath evt)) s) (h hooks) scan d = unless (ignoredPath ignored d) $ - mapM_ (go . fromRawFilePath) =<< emptyWhenDoesNotExist - (dirContentsRecursiveSkipping (const False) False (toRawFilePath d)) + mapM_ go =<< emptyWhenDoesNotExist + (dirContentsRecursiveSkipping (const False) False d) where go f | ignoredPath ignored f = noop @@ -61,8 +61,8 @@ watchDir dir ignored scanevents hooks = do where runhook h s = maybe noop (\a -> a f s) (h hooks) - getstatus = catchMaybeIO . R.getFileStatus . toRawFilePath + getstatus = catchMaybeIO . R.getFileStatus . fromOsPath {- Check each component of the path to see if it's ignored. -} -ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool +ignoredPath :: (OsPath -> Bool) -> OsPath -> Bool ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath diff --git a/Utility/Directory/Stream.hs b/Utility/Directory/Stream.hs index 2dd975955c..8ae6b32e40 100644 --- a/Utility/Directory/Stream.hs +++ b/Utility/Directory/Stream.hs @@ -7,6 +7,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Directory.Stream ( @@ -24,7 +25,6 @@ import Prelude #ifdef mingw32_HOST_OS import qualified System.Win32 as Win32 -import System.FilePath #else import qualified Data.ByteString as B import qualified System.Posix.Directory.ByteString as Posix @@ -50,7 +50,7 @@ openDirectory path = do isopen <- newMVar () return (DirectoryHandle isopen dirp) #else - (h, fdat) <- Win32.findFirstFile (fromRawFilePath path "*") + (h, fdat) <- Win32.findFirstFile (fromOsPath (toOsPath path literalOsPath "*")) -- Indicate that the fdat contains a filename that readDirectory -- has not yet returned, by making the MVar be full. -- (There's always at least a "." entry.) diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs index e0cd546a28..f10cb20ffc 100644 --- a/Utility/FileIO.hs +++ b/Utility/FileIO.hs @@ -37,7 +37,6 @@ import System.File.OsPath -- https://github.com/haskell/file-io/issues/39 import Utility.Path.Windows import Utility.OsPath -import System.OsPath import System.IO (IO, Handle, IOMode) import Prelude (return) import qualified System.File.OsPath as O diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs index e275771d05..36f37889a6 100644 --- a/Utility/FileSize.hs +++ b/Utility/FileSize.hs @@ -18,12 +18,11 @@ module Utility.FileSize ( import Control.Exception (bracket) import System.IO import qualified Utility.FileIO as F -import Utility.OsPath #else import System.PosixCompat.Files (fileSize) +import qualified Utility.RawFilePath as R #endif import System.PosixCompat.Files (FileStatus) -import qualified Utility.RawFilePath as R import Utility.OsPath type FileSize = Integer diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 781b9a4a58..6c13392032 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -179,7 +179,7 @@ feedRead cmd params passphrase feeder reader = do go (passphrasefd ++ params) #else -- store the passphrase in a temp file for gpg - withTmpFile (toOsPath "gpg") $ \tmpfile h -> do + withTmpFile (literalOsPath "gpg") $ \tmpfile h -> do liftIO $ B.hPutStr h passphrase liftIO $ hClose h let passphrasefile = [Param "--passphrase-file", File (fromOsPath tmpfile)] diff --git a/Utility/LockFile/Windows.hs b/Utility/LockFile/Windows.hs index 8e6c6d2905..9b2248c0a8 100644 --- a/Utility/LockFile/Windows.hs +++ b/Utility/LockFile/Windows.hs @@ -21,11 +21,12 @@ import Control.Concurrent import Utility.Path.Windows import Utility.FileSystemEncoding +import Utility.OsPath #if MIN_VERSION_Win32(2,13,4) import Common (tryNonAsync) #endif -type LockFile = RawFilePath +type LockFile = OsPath type LockHandle = HANDLE @@ -60,7 +61,7 @@ lockExclusive = openLock fILE_SHARE_NONE -} openLock :: ShareMode -> LockFile -> IO (Maybe LockHandle) openLock sharemode f = do - f' <- convertToWindowsNativeNamespace f + f' <- convertToWindowsNativeNamespace (fromOsPath f) #if MIN_VERSION_Win32(2,13,4) r <- tryNonAsync $ createFile_NoRetry (fromRawFilePath f') gENERIC_READ sharemode Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs index 7bc0297532..54e156920b 100644 --- a/Utility/MoveFile.hs +++ b/Utility/MoveFile.hs @@ -21,6 +21,7 @@ import Prelude import System.PosixCompat.Files (isDirectory) import Control.Monad.IfElse import Utility.SafeCommand +import qualified Utility.RawFilePath as R #endif import Utility.SystemDirectory @@ -28,7 +29,6 @@ import Utility.Tmp import Utility.Exception import Utility.Monad import Utility.OsPath -import qualified Utility.RawFilePath as R import Author {- Moves one filename to another. diff --git a/Utility/Path.hs b/Utility/Path.hs index da30b2f917..18abcb250d 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -43,7 +43,6 @@ import qualified Utility.OsString as OS #ifdef mingw32_HOST_OS import Data.Char -import Utility.FileSystemEncoding #endif copyright :: Authored t => t @@ -230,11 +229,11 @@ relPathDirToFileAbs from to numcommon = length common #ifdef mingw32_HOST_OS normdrive = map toLower + . fromOsPath -- Get just the drive letter, removing any leading -- path separator, which takeDrive leaves on the drive -- letter. - . dropWhileEnd (isPathSeparator . fromIntegral . ord) - . fromOsPath + . OS.dropWhileEnd isPathSeparator . takeDrive #endif @@ -261,7 +260,7 @@ searchPath command indir d = check (d command') check f = firstM doesFileExist #ifdef mingw32_HOST_OS - [f, f <> ".exe"] + [f, f <> literalOsPath ".exe"] #else [f] #endif diff --git a/Utility/RawFilePath.hs b/Utility/RawFilePath.hs index e10f05d703..33d69230ac 100644 --- a/Utility/RawFilePath.hs +++ b/Utility/RawFilePath.hs @@ -60,11 +60,6 @@ createLink a b = do b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b P.createLink a' b' -{- On windows, removeLink is not available, so only remove files, - - not symbolic links. -} -removeLink :: RawFilePath -> IO () -removeLink = D.removeFile . fromRawFilePath - getFileStatus :: RawFilePath -> IO FileStatus getFileStatus p = P.getFileStatus . fromRawFilePath =<< convertToWindowsNativeNamespace p diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index e377eb965d..1a35aca09c 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -25,6 +25,7 @@ import Utility.Tuple #ifdef mingw32_HOST_OS import qualified System.FilePath.Posix as Posix +import qualified Utility.OsString as OS #endif import Data.Char @@ -102,7 +103,7 @@ rsyncUrlIsShell s rsyncUrlIsPath :: String -> Bool rsyncUrlIsPath s #ifdef mingw32_HOST_OS - | not (null (takeDrive s)) = True + | not (OS.null (takeDrive (toOsPath s))) = True #endif | rsyncUrlIsShell s = False | otherwise = ':' `notElem` s @@ -174,15 +175,15 @@ filterRsyncSafeOptions = fst3 . getOpt Permute #ifdef mingw32_HOST_OS toMSYS2Path :: FilePath -> FilePath toMSYS2Path p - | null drive = recombine parts - | otherwise = recombine $ "/" : driveletter drive : parts + | OS.null drive = recombine parts + | otherwise = recombine $ "/" : driveletter (fromOsPath drive) : parts where - (drive, p') = splitDrive p - parts = splitDirectories p' + (drive, p') = splitDrive (toOsPath p) + parts = map fromOsPath $ splitDirectories p' driveletter = map toLower . takeWhile (/= ':') recombine = fixtrailing . Posix.joinPath fixtrailing s - | hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s + | hasTrailingPathSeparator (toOsPath p) = Posix.addTrailingPathSeparator s | otherwise = s #endif diff --git a/Utility/Shell.hs b/Utility/Shell.hs index 5d45df434b..0d43994f98 100644 --- a/Utility/Shell.hs +++ b/Utility/Shell.hs @@ -21,10 +21,6 @@ import Utility.Exception import Utility.PartialPrelude #endif -#ifdef mingw32_HOST_OS -import System.FilePath -#endif - shellPath :: FilePath shellPath = "/bin/sh" @@ -46,13 +42,13 @@ findShellCommand f = do Just ('#':'!':rest) -> case words rest of [] -> defcmd (c:ps) -> do - let ps' = map Param ps ++ [File f] + let ps' = map Param ps ++ [File (fromOsPath f)] -- If the command is not inSearchPath, -- take the base of it, and run eg "sh" -- which in some cases on windows will work -- despite it not being inSearchPath. ok <- inSearchPath c - return (if ok then c else takeFileName c, ps') + return (if ok then c else fromOsPath (takeFileName (toOsPath c)), ps') _ -> defcmd #endif where diff --git a/Utility/StatelessOpenPGP.hs b/Utility/StatelessOpenPGP.hs index 290984c4cc..8740c6b3d4 100644 --- a/Utility/StatelessOpenPGP.hs +++ b/Utility/StatelessOpenPGP.hs @@ -159,7 +159,7 @@ feedRead cmd subcmd params password emptydirectory feeder reader = do go (Just emptydirectory) (passwordfd ++ params) #else -- store the password in a temp file - withTmpFile (toOsPath "sop") $ \tmpfile h -> do + withTmpFile (literalOsPath "sop") $ \tmpfile h -> do liftIO $ B.hPutStr h password liftIO $ hClose h let passwordfile = [Param $ "--with-password=" ++ fromOsPath tmpfile] diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index 11ee051c96..d442d8740d 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -136,5 +136,7 @@ relatedTemplate' _ = "t" - of openTempFile, and some extra has been added to make it longer - than any likely implementation. -} +#ifndef mingw32_HOST_OS templateAddedLength :: Int templateAddedLength = 20 +#endif diff --git a/Utility/Tmp/Dir.hs b/Utility/Tmp/Dir.hs index d6448ef749..4064e9bfae 100644 --- a/Utility/Tmp/Dir.hs +++ b/Utility/Tmp/Dir.hs @@ -32,8 +32,8 @@ withTmpDir :: (MonadMask m, MonadIO m) => Template -> (OsPath -> m a) -> m a withTmpDir template a = do topleveltmpdir <- liftIO $ catchDefaultIO (literalOsPath ".") getTemporaryDirectory - let p = fromOsPath $ topleveltmpdir template #ifndef mingw32_HOST_OS + let p = fromOsPath $ topleveltmpdir template -- Use mkdtemp to create a temp directory securely in /tmp. bracket (liftIO $ toOsPath <$> mkdtemp p)