Windows: Handle shebang in external special remote program.

CHANGELOG

@@ -1,3 +1,9 @@
+git-annex (6.20160809) UNRELEASED; urgency=medium
+
+  * Windows: Handle shebang in external special remote program.
+
+ -- Joey Hess <id@joeyh.name>  Mon, 05 Sep 2016 11:51:49 -0400
+
 git-annex (6.20160808) unstable; urgency=medium
 
   * metadata --json output format has changed, adding a inner json object

Git/Hook.hs

@@ -12,6 +12,7 @@ module Git.Hook where
 import Common
 import Git
 import Utility.Tmp
+import Utility.Shell
 #ifndef mingw32_HOST_OS
 import Utility.FileMode
 #endif
@@ -75,23 +76,5 @@ hookExists h r = do
 runHook :: Hook -> Repo -> IO Bool
 runHook h r = do
 	let f = hookFile h r
-	(c, ps) <- findcmd f
+	(c, ps) <- findShellCommand f
 	boolSystem c ps
-  where
-#ifndef mingw32_HOST_OS
-	findcmd = defcmd
-#else
-	{- Like git for windows, parse the first line of the hook file,
-	 - look for "#!", and dispatch the interpreter on the file. -}
-	findcmd f = do
-		l <- headMaybe . lines <$> catchDefaultIO "" (readFile f)
-		case l of
-			Just ('#':'!':rest) -> case words rest of
-				[] -> defcmd f
-				(c:ps) -> do
-					let ps' = map Param (ps ++ [f])
-					ok <- inPath c
-					return (if ok then c else takeFileName c, ps')
-			_ -> defcmd f
-#endif
-	defcmd f = return (f, [])

Remote/External.hs

@@ -21,6 +21,7 @@ import Remote.Helper.Special
 import Remote.Helper.ReadOnly
 import Remote.Helper.Messages
 import Utility.Metered
+import Utility.Shell
 import Messages.Progress
 import Types.Transfer
 import Logs.PreferredContent.Raw
@@ -374,7 +375,13 @@ startExternal externaltype = do
 	errrelayer <- mkStderrRelayer
 	g <- Annex.gitRepo
 	liftIO $ do
-		p <- propgit g cmdp
+		(cmd, ps) <- findShellCommand basecmd
+		let basep = (proc cmd (toCommand ps))
+			{ std_in = CreatePipe
+			, std_out = CreatePipe
+			, std_err = CreatePipe
+			}
+		p <- propgit g basep
 		(Just hin, Just hout, Just herr, pid) <- 
 			createProcess p `catchIO` runerr
 		fileEncoding hin
@@ -391,24 +398,20 @@ startExternal externaltype = do
 			, externalPrepared = Unprepared
 			}
   where
-	cmd = externalRemoteProgram externaltype
-	cmdp = (proc cmd [])
-		{ std_in = CreatePipe
-		, std_out = CreatePipe
-		, std_err = CreatePipe
-		}
+	basecmd = externalRemoteProgram externaltype
+
 	propgit g p = do
 		environ <- propGitEnv g
 		return $ p { env = Just environ }
 
-	runerr _ = error ("Cannot run " ++ cmd ++ " -- Make sure it's in your PATH and is executable.")
+	runerr _ = error ("Cannot run " ++ basecmd ++ " -- Make sure it's in your PATH and is executable.")
 
 	checkearlytermination Nothing = noop
-	checkearlytermination (Just exitcode) = ifM (inPath cmd)
-		( error $ unwords [ "failed to run", cmd, "(" ++ show exitcode ++ ")" ]
+	checkearlytermination (Just exitcode) = ifM (inPath basecmd)
+		( error $ unwords [ "failed to run", basecmd, "(" ++ show exitcode ++ ")" ]
 		, do
 			path <- intercalate ":" <$> getSearchPath
-			error $ cmd ++ " is not installed in PATH (" ++ path ++ ")"
+			error $ basecmd ++ " is not installed in PATH (" ++ path ++ ")"
 		)
 
 stopExternal :: External -> Annex ()

Utility/Shell.hs

@@ -9,6 +9,19 @@
 
 module Utility.Shell where
 
+import Utility.SafeCommand
+#ifdef mingw32_HOST_OS
+import Utility.Path
+import Utility.FileSystemEncoding
+import Utility.Exception
+import Utility.PartialPrelude
+#endif
+
+#ifdef mingw32_HOST_OS
+import System.IO
+import System.FilePath
+#endif
+
 shellPath_portable :: FilePath
 shellPath_portable = "/bin/sh"
 
@@ -24,3 +37,32 @@ shebang_portable = "#!" ++ shellPath_portable
 
 shebang_local :: String
 shebang_local = "#!" ++ shellPath_local
+
+-- | On Windows, shebang is not handled by the kernel, so to support
+-- shell scripts etc, have to look at the program being run and
+-- parse it for shebang.
+--
+-- This has no effect on Unix.
+findShellCommand :: FilePath -> IO (FilePath, [CommandParam])
+findShellCommand f = do
+#ifndef mingw32_HOST_OS
+	defcmd
+#else
+	l <- catchDefaultIO Nothing $ withFile f ReadMode $ \h -> do
+		fileEncoding h
+		headMaybe . lines <$> hGetContents h
+	case l of
+		Just ('#':'!':rest) -> case words rest of
+			[] -> defcmd
+			(c:ps) -> do
+				let ps' = map Param ps ++ [File f]
+				-- If the command is not inPath,
+				-- take the base of it, and run eg "sh"
+				-- which in some cases on windows will work
+				-- despite it not being inPath.
+				ok <- inPath c
+				return (if ok then c else takeFileName c, ps')
+		_ -> defcmd
+#endif
+  where
+	defcmd = return (f, [])

doc/todo/refactor_shebang_handling_code_for_wider_use.mdwn

@@ -5,3 +5,5 @@ When launching an external special remote, use the shebang handling code which c
 [joeyh] """Oh, git-annex already deals with this particular windows nonsense elsewhere. When it needs to run a git hook, it parses it for a shebang. Git for windows does the same.
 
 So, if you can please open a todo item in git-annex, I can refactor that existing code to be used in more places."""
+
+> [[done]] --[[Joey]]