diff options
author | Joey Hess <joey@kitenet.net> | 2010-12-31 21:22:03 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-12-31 21:22:03 -0400 |
commit | 14fe13dc2b0f39857eeccdc36483d0f4a0d81fdc (patch) | |
tree | 3350f51ed5a7894f4842f7c528d597fb42355f9d /GitRepo.hs | |
parent | ed593f1f3f810ae9e456dc233273da23608cea82 (diff) |
support ssh urls containing "~", and relative user:path
Diffstat (limited to 'GitRepo.hs')
-rw-r--r-- | GitRepo.hs | 36 |
1 files changed, 35 insertions, 1 deletions
diff --git a/GitRepo.hs b/GitRepo.hs index 9dfce0d35..07f243b66 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -43,6 +43,7 @@ module GitRepo ( encodeGitFile, typeChangedFiles, typeChangedStagedFiles, + absDir, prop_idempotent_deencode ) where @@ -50,6 +51,7 @@ module GitRepo ( import Control.Monad (unless) import System.Directory import System.Posix.Directory +import System.Posix.User import System.Path import System.Cmd.Utils import IO (bracket_) @@ -62,7 +64,7 @@ import Data.Char import Data.Word (Word8) import Codec.Binary.UTF8.String (encode) import Text.Printf -import Data.List (isInfixOf) +import Data.List (isInfixOf, isPrefixOf) import Utility @@ -444,6 +446,38 @@ encodeGitFile s = foldl (++) "\"" (map echar s) ++ "\"" prop_idempotent_deencode :: String -> Bool prop_idempotent_deencode s = s == decodeGitFile (encodeGitFile s) +{- Git ssh remotes can have a directory that is specified relative + - to a home directory. This converts such a directory to an absolute path. + - Note that it has to run on the remote system. + -} +absDir :: String -> IO String +absDir d + | isPrefixOf "/" d = expandt d + | otherwise = do + h <- myhomedir + return $ h ++ d + where + homedir u = (homeDirectory u) ++ "/" + myhomedir = do + uid <- getEffectiveUserID + u <- getUserEntryForID uid + return $ homedir u + expandt [] = return "" + expandt ('/':'~':'/':cs) = do + h <- myhomedir + return $ h ++ cs + expandt ('/':'~':cs) = do + let (name, rest) = findname "" cs + u <- getUserEntryForName name + return $ homedir u ++ rest + expandt (c:cs) = do + v <- expandt cs + return (c:v) + findname n [] = (n, "") + findname n (c:cs) + | c == '/' = (n, cs) + | otherwise = findname (n++[c]) cs + {- Finds the current git repository, which may be in a parent directory. -} repoFromCwd :: IO Repo repoFromCwd = do |