stub out posix stuff for Windows

This is enough to let the configure program build.
This commit is contained in:
Joey Hess 2013-05-10 15:08:53 -05:00
parent 767a39bd42
commit a05b4619bb
8 changed files with 62 additions and 3 deletions

6
Build/DesktopFile.hs Normal file → Executable file
View file

@ -22,18 +22,24 @@ import Assistant.Install.Menu
import Control.Applicative import Control.Applicative
import System.Directory import System.Directory
import System.Environment import System.Environment
#if 0
import System.Posix.User import System.Posix.User
import System.Posix.Files import System.Posix.Files
#endif
import System.FilePath import System.FilePath
import Data.Maybe import Data.Maybe
systemwideInstall :: IO Bool systemwideInstall :: IO Bool
#if 0
systemwideInstall = isroot <||> destdirset systemwideInstall = isroot <||> destdirset
where where
isroot = do isroot = do
uid <- fromIntegral <$> getRealUserID uid <- fromIntegral <$> getRealUserID
return $ uid == (0 :: Int) return $ uid == (0 :: Int)
destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR") destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")
#else
systemwideInstall = return False
#endif
inDestDir :: FilePath -> IO FilePath inDestDir :: FilePath -> IO FilePath
inDestDir f = do inDestDir f = do

4
Common.hs Normal file → Executable file
View file

@ -1,4 +1,4 @@
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports, CPP #-}
module Common (module X) where module Common (module X) where
@ -16,8 +16,10 @@ import "MissingH" System.Path as X
import System.FilePath as X import System.FilePath as X
import System.Directory as X import System.Directory as X
import System.IO as X hiding (FilePath) import System.IO as X hiding (FilePath)
#if 0
import System.Posix.Files as X import System.Posix.Files as X
import System.Posix.IO as X import System.Posix.IO as X
#endif
import System.Exit as X import System.Exit as X
import Utility.Misc as X import Utility.Misc as X

8
Utility/Directory.hs Normal file → Executable file
View file

@ -5,10 +5,14 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Utility.Directory where module Utility.Directory where
import System.IO.Error import System.IO.Error
#if 0
import System.Posix.Files import System.Posix.Files
#endif
import System.Directory import System.Directory
import Control.Exception (throw) import Control.Exception (throw)
import Control.Monad import Control.Monad
@ -57,6 +61,7 @@ dirContentsRecursive' (dir:dirs) = unsafeInterleaveIO $ do
{- Moves one filename to another. {- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -} - First tries a rename, but falls back to moving across devices if needed. -}
moveFile :: FilePath -> FilePath -> IO () moveFile :: FilePath -> FilePath -> IO ()
#if 0
moveFile src dest = tryIO (rename src dest) >>= onrename moveFile src dest = tryIO (rename src dest) >>= onrename
where where
onrename (Right _) = noop onrename (Right _) = noop
@ -84,6 +89,9 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
case r of case r of
(Left _) -> return False (Left _) -> return False
(Right s) -> return $ isDirectory s (Right s) -> return $ isDirectory s
#else
moveFile = error "moveFile TODO"
#endif
{- Removes a file, which may or may not exist. {- Removes a file, which may or may not exist.
- -

7
Utility/Misc.hs Normal file → Executable file
View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Utility.Misc where module Utility.Misc where
import System.IO import System.IO
@ -13,7 +15,9 @@ import Foreign
import Data.Char import Data.Char
import Data.List import Data.List
import Control.Applicative import Control.Applicative
#if 0
import System.Posix.Process (getAnyProcessStatus) import System.Posix.Process (getAnyProcessStatus)
#endif
import Utility.Exception import Utility.Exception
@ -118,6 +122,7 @@ hGetSomeString h sz = do
peekbytes :: Int -> Ptr Word8 -> IO [Word8] peekbytes :: Int -> Ptr Word8 -> IO [Word8]
peekbytes len buf = mapM (peekElemOff buf) [0..pred len] peekbytes len buf = mapM (peekElemOff buf) [0..pred len]
#if 0
{- Reaps any zombie git processes. {- Reaps any zombie git processes.
- -
- Warning: Not thread safe. Anything that was expecting to wait - Warning: Not thread safe. Anything that was expecting to wait
@ -128,3 +133,5 @@ reapZombies = do
-- throws an exception when there are no child processes -- throws an exception when there are no child processes
catchDefaultIO Nothing (getAnyProcessStatus False True) catchDefaultIO Nothing (getAnyProcessStatus False True)
>>= maybe (return ()) (const reapZombies) >>= maybe (return ()) (const reapZombies)
#endif

9
Utility/Process.hs Normal file → Executable file
View file

@ -6,7 +6,7 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE CPP, Rank2Types #-}
module Utility.Process ( module Utility.Process (
module X, module X,
@ -42,7 +42,9 @@ import Control.Concurrent
import qualified Control.Exception as E import qualified Control.Exception as E
import Control.Monad import Control.Monad
import Data.Maybe import Data.Maybe
#if 0
import System.Posix.IO import System.Posix.IO
#endif
import Utility.Misc import Utility.Misc
@ -156,6 +158,7 @@ createBackgroundProcess p a = a =<< createProcess p
- returns a transcript combining its stdout and stderr, and - returns a transcript combining its stdout and stderr, and
- whether it succeeded or failed. -} - whether it succeeded or failed. -}
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
#if 0
processTranscript cmd opts input = do processTranscript cmd opts input = do
(readf, writef) <- createPipe (readf, writef) <- createPipe
readh <- fdToHandle readf readh <- fdToHandle readf
@ -189,7 +192,9 @@ processTranscript cmd opts input = do
ok <- checkSuccessProcess pid ok <- checkSuccessProcess pid
return (transcript, ok) return (transcript, ok)
#else
processTranscript = error "processTranscript TODO"
#endif
{- Runs a CreateProcessRunner, on a CreateProcess structure, that {- Runs a CreateProcessRunner, on a CreateProcess structure, that
- is adjusted to pipe only from/to a single StdHandle, and passes - is adjusted to pipe only from/to a single StdHandle, and passes

12
Utility/TempFile.hs Normal file → Executable file
View file

@ -5,11 +5,15 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Utility.TempFile where module Utility.TempFile where
import Control.Exception (bracket) import Control.Exception (bracket)
import System.IO import System.IO
#if 0
import System.Posix.Process import System.Posix.Process
#endif
import System.Directory import System.Directory
import Utility.Exception import Utility.Exception
@ -20,12 +24,16 @@ import System.FilePath
- then moving it into place. The temp file is stored in the same - then moving it into place. The temp file is stored in the same
- directory as the final file to avoid cross-device renames. -} - directory as the final file to avoid cross-device renames. -}
viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO () viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
#if 0
viaTmp a file content = do viaTmp a file content = do
pid <- getProcessID pid <- getProcessID
let tmpfile = file ++ ".tmp" ++ show pid let tmpfile = file ++ ".tmp" ++ show pid
createDirectoryIfMissing True (parentDir file) createDirectoryIfMissing True (parentDir file)
a tmpfile content a tmpfile content
renameFile tmpfile file renameFile tmpfile file
#else
viaTmp = error "viaTMP TODO"
#endif
type Template = String type Template = String
@ -44,6 +52,7 @@ withTempFile template a = bracket create remove use
{- Runs an action with a temp directory, then removes the directory and {- Runs an action with a temp directory, then removes the directory and
- all its contents. -} - all its contents. -}
withTempDir :: Template -> (FilePath -> IO a) -> IO a withTempDir :: Template -> (FilePath -> IO a) -> IO a
#if 0
withTempDir template = bracket create remove withTempDir template = bracket create remove
where where
remove = removeDirectoryRecursive remove = removeDirectoryRecursive
@ -56,3 +65,6 @@ withTempDir template = bracket create remove
let dir = tmpdir </> t ++ "." ++ show n let dir = tmpdir </> t ++ "." ++ show n
r <- tryIO $ createDirectory dir r <- tryIO $ createDirectory dir
either (const $ makedir tmpdir t $ n + 1) (const $ return dir) r either (const $ makedir tmpdir t $ n + 1) (const $ return dir) r
#else
withTempDir = error "withTempDir TODO"
#endif

16
Utility/UserInfo.hs Normal file → Executable file
View file

@ -14,29 +14,45 @@ module Utility.UserInfo (
) where ) where
import Control.Applicative import Control.Applicative
#if 0
import System.Posix.User import System.Posix.User
import System.Posix.Env import System.Posix.Env
#endif
{- Current user's home directory. {- Current user's home directory.
- -
- getpwent will fail on LDAP or NIS, so use HOME if set. -} - getpwent will fail on LDAP or NIS, so use HOME if set. -}
myHomeDir :: IO FilePath myHomeDir :: IO FilePath
#if 0
myHomeDir = myVal ["HOME"] homeDirectory myHomeDir = myVal ["HOME"] homeDirectory
#else
myHomeDir = error "myHomeDir TODO"
#endif
{- Current user's user name. -} {- Current user's user name. -}
myUserName :: IO String myUserName :: IO String
#if 0
myUserName = myVal ["USER", "LOGNAME"] userName myUserName = myVal ["USER", "LOGNAME"] userName
#else
myUserName = error "myUserName TODO"
#endif
myUserGecos :: IO String myUserGecos :: IO String
#ifdef __ANDROID__ #ifdef __ANDROID__
myUserGecos = return "" -- userGecos crashes on Android myUserGecos = return "" -- userGecos crashes on Android
#else #else
#if 0
myUserGecos = myVal [] userGecos myUserGecos = myVal [] userGecos
#else
myUserGecos = error "myUserGecos TODO"
#endif
#endif #endif
#if 0
myVal :: [String] -> (UserEntry -> String) -> IO String myVal :: [String] -> (UserEntry -> String) -> IO String
myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars
where where
check [] = return Nothing check [] = return Nothing
check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v
getpwent = getUserEntryForID =<< getEffectiveUserID getpwent = getUserEntryForID =<< getEffectiveUserID
#endif

View file

@ -86,6 +86,9 @@ Executable git-annex
if flag(Production) if flag(Production)
GHC-Options: -O2 GHC-Options: -O2
if os(windows)
CPP-Options: -D__WINDOWS__
if flag(TestSuite) if flag(TestSuite)
Build-Depends: HUnit Build-Depends: HUnit
CPP-Options: -DWITH_TESTSUITE CPP-Options: -DWITH_TESTSUITE