windows: hack to ensure HOME is always set

3 files changed, 48 insertions, 5 deletions

diff --git a/debian/changelog b/debian/changelog
index f6d2dffad..2da215d19 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,6 +8,7 @@ git-annex (5.20140211) UNRELEASED; urgency=medium
   * Add progress display for transfers to/from external special remotes.
   * Windows webapp: Can set up box.com, Amazon S3 remotes.
   * Windows webapp: Can create repos on removable drives.
+  * Windows: Ensure HOME is set, as needed by bundled cygwin utilities.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 10 Feb 2014 21:33:03 -0400
 
diff --git a/doc/todo/windows_support.mdwn b/doc/todo/windows_support.mdwn
index 520588e59..6b2177caa 100644
--- a/doc/todo/windows_support.mdwn
+++ b/doc/todo/windows_support.mdwn
@@ -38,8 +38,11 @@ now! --[[Joey]]
   Should try to get rid of the console, but only once ssh passwords
   (and possibly gpg) are not prompted there anymore.
 * Local pairing seems to fail, after acking on Linux box, it stalls.
-* rsync.net setup failed. Seems to have generated a hostname including
-  the directory somehow.
+* rsync.net setup failed. Ssh seems to not be looking for the config file
+  where git-annex puts it. Probably confusion over where the home directory
+  is.
+* remote ssh server fails; password prompt appears but user input
+  seems not connected to it.
 * gcrypt is not ported to windows (and as a shell script, may need
   to be rewritten)
 * webapp lets user choose to encrypt repo, and generate gpg key,
diff --git a/git-annex.hs b/git-annex.hs
index aeb2b0867..2174965fd 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -1,13 +1,13 @@
-{- git-annex main program stub
+{- git-annex main program dispatch
  -
- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 {-# LANGUAGE CPP #-}
 
-import System.Environment
+import System.Environment (getArgs, getProgName)
 import System.FilePath
 
 import qualified CmdLine.GitAnnex
@@ -16,6 +16,14 @@ import qualified CmdLine.GitAnnexShell
 import qualified Test
 #endif
 
+#ifdef mingw32_HOST_OS
+import Utility.UserInfo
+import Utility.Env
+import Config.Files
+import System.Process
+import System.Exit
+#endif
+
 main :: IO ()
 main = do
 	ps <- getArgs
@@ -29,6 +37,37 @@ main = do
 				("test":ps') -> Test.main ps'
 				_ -> CmdLine.GitAnnex.run ps
 #else
+#ifdef mingw32_HOST_OS
+			winEnv CmdLine.GitAnnex.run ps
+#else
+#endif
 			CmdLine.GitAnnex.run ps
 #endif
 	isshell n = takeFileName n == "git-annex-shell"
+
+#ifdef mingw32_HOST_OS
+{- On Windows, if HOME is not set, probe it and set it, re-execing
+ - git-annex with the new environment.
+ - 
+ - This is a workaround for some Cygwin commands needing HOME to be set,
+ - and for there being no known way to set environment variables on
+ - Windows, except by passing an environment in each call to a program.
+ - While ugly, this workaround is easier than trying to ensure HOME is set
+ - in all calls to the affected programs.
+ -}
+winEnv :: ([String] -> IO ()) -> [String] -> IO ()
+winEnv a ps = go =<< getEnv "HOME"
+  where
+	go (Just _) = a ps
+	go Nothing = do
+		home <- myHomeDir
+		e <- getEnvironment
+		let eoverride =
+			[ ("HOME", home)
+			, ("CYGWIN", "nodosfilewarning")
+			]
+		cmd <- readProgramFile
+		(_, _, _, proc) <- createProcess (proc cmd ps)
+			{ env = Just $ e ++ eoverride }
+		exitWith =<< waitForProcess proc
+#endif