OsPath transition Windows build fixes

This gets it building on Windows again, with 1 test suite failure
(addurl).

Sponsored-by: Kevin Mueller
This commit is contained in:
Joey Hess 2025-02-11 19:23:02 -08:00 committed by Joey Hess
parent 9dc43396b3
commit a149336a59
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
23 changed files with 58 additions and 62 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 <id@joeyh.name>
@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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.)

View file

@ -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

View file

@ -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

View file

@ -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)]

View file

@ -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

View file

@ -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.

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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]

View file

@ -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

View file

@ -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)