work around absNormPath not working on Windows

When making git-annex links, we want unix-style paths in the link targets.

5 files changed, 27 insertions, 5 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 45e1fa182..6e494ecf4 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -436,8 +436,8 @@ removeAnnex key = withObjectLoc key remove removedirect
 		l <- inRepo $ gitAnnexLink f key
 		top <- fromRepo Git.repoPath
 		cwd <- liftIO getCurrentDirectory
-		let top' = fromMaybe top $ absNormPath cwd top
-		let l' = relPathDirToFile top' (fromMaybe l $ absNormPath top' l)
+		let top' = fromMaybe top $ absNormPathUnix cwd top
+		let l' = relPathDirToFile top' (fromMaybe l $ absNormPathUnix top' l)
 		secureErase f
 		replaceFile f $ makeAnnexLink l'
 
diff --git a/Locations.hs b/Locations.hs
index 1173677cf..553104d95 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -137,7 +137,7 @@ gitAnnexLocation' key r crippled
 gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath
 gitAnnexLink file key r = do
 	cwd <- getCurrentDirectory
-	let absfile = fromMaybe whoops $ absNormPath cwd file
+	let absfile = fromMaybe whoops $ absNormPathUnix cwd file
 	loc <- gitAnnexLocation' key r False
 	return $ relPathDirToFile (parentDir absfile) loc
   where
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 44ac72f06..78d359bef 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -21,10 +21,10 @@ import Control.Applicative
 import Data.Char
 import qualified System.FilePath.Posix as Posix
 #else
-import qualified "MissingH" System.Path as MissingH
 import System.Posix.Files
 #endif
 
+import qualified "MissingH" System.Path as MissingH
 import Utility.Monad
 import Utility.UserInfo
 
@@ -42,7 +42,18 @@ absNormPath :: FilePath -> FilePath -> Maybe FilePath
 #ifndef mingw32_HOST_OS
 absNormPath dir path = MissingH.absNormPath dir path
 #else
-absNormPath dir path = Just $ combine dir path
+absNormPath dir path = MissingH.absNormPath dir path
+#endif
+
+{- On Windows, this converts the paths to unix-style, in order to run
+ - MissingH's absNormPath on them. Resulting path will use / separators. -}
+#ifndef mingw32_HOST_OS
+absNormPathUnix dir path = MissingH.absNormPath dir path
+#else
+absNormPathUnix dir path = Just $ combine dir path
+absNormPathUnix dir path = MissingH.absNormPath (fromdos dir) (fromdos path)
+  where
+	fromdos = replace "\\" "/"
 #endif
 
 {- Returns the parent directory of a path.
diff --git a/debian/changelog b/debian/changelog
index 5bfb26194..3c5d46de4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -28,6 +28,7 @@ git-annex (5.20140128) UNRELEASED; urgency=medium
     directories.
   * Windows: Fix deletion of repositories by test suite and webapp.
   * Windows: Test suite 100% passes again.
+  * Windows: Fix bug in symlink calculation code.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 28 Jan 2014 13:57:19 -0400
 
diff --git a/doc/bugs/On_Windows_the_Comitted_Symlinks_are_not_Relative.mdwn b/doc/bugs/On_Windows_the_Comitted_Symlinks_are_not_Relative.mdwn
index 159e48310..3ea44f857 100644
--- a/doc/bugs/On_Windows_the_Comitted_Symlinks_are_not_Relative.mdwn
+++ b/doc/bugs/On_Windows_the_Comitted_Symlinks_are_not_Relative.mdwn
@@ -90,3 +90,13 @@ The output of `git log -p` for me:
     @@ -0,0 +1 @@
     +.git/annex/objects/5X/qQ/SHA256E-s19915186--c6dc288ec8a77404c0ebc22cbe9b4ec911103fd022c3ca74eec582604dff80a7.exe/SHA256E-s19915186--c6dc288ec8a77404c0ebc22cbe9b4ec911103fd022c3ca74eec582604dff80a7.exe
     \ No newline at end of file
+
+> [[fixed|done]] -- I didn't notice this before because it happened to do
+> the right thing if you cd'd into the subdir before adding the file there.
+>
+> WRT the slow down issue, I don't see how it could matter to git-annex on
+> Windows whether the symlinks point to the right place. It only looks at
+> the basename of the symlink target to get the key. If you have a
+> repository that behaves poorly, you can probably use --debug to see if
+> git-annex is calling some expensive series of git commands somehow.
+> --[[Joey]]