github-backup 1.20160511 → 1.20160522

raw patch · 27 files changed

+313/−78 lines, 27 files

Files

• Build/collect-ghc-options.sh +12/−0
• CHANGELOG +15/−0
• Git.hs +11/−2
• Git/Branch.hs +42/−21
• Git/CatFile.hs +48/−2
• Git/Command.hs +4/−2
• Git/Construct.hs +1/−0
• Git/FilePath.hs +4/−4
• Git/Index.hs +70/−0
• Git/Queue.hs +1/−1
• Git/Ref.hs +11/−2
• Git/Types.hs +22/−1
• Makefile +1/−1
• Utility/Exception.hs +5/−1
• Utility/FileMode.hs +2/−1
• Utility/FileSystemEncoding.hs +8/−0
• Utility/Path.hs +14/−8
• Utility/PosixFiles.hs +9/−1
• Utility/Process.hs +7/−5
• Utility/Tmp.hs +1/−1
• Utility/URI.hs +0/−18
• Utility/UserInfo.hs +1/−3
• debian/changelog +15/−0
• debian/control +1/−1
• debian/github-backup.lintian-overrides +1/−0
• github-backup.cabal +4/−1
• github-backup.hs +3/−2

@@ -0,0 +1,12 @@+#!/bin/sh+# Generate --ghc-options to pass LDFLAGS, CFLAGS, and CPPFLAGS through ghc+# and on to ld, cc, and cpp.+for w in $LDFLAGS; do+	printf -- "-optl%s\n" "$w"+done+for w in $CFLAGS; do+	printf -- "-optc%s\n" "$w"+done+for w in $CPPFLAGS; do+	printf -- "-optc-Wp,%s\n" "$w"+done

@@ -1,3 +1,18 @@+github-backup (1.20160522) unstable; urgency=medium++  * Work around git weirdness in handling of relative path to GIT_INDEX_FILE+    when in a subdirectory of the repository.+  * Various updates to internal git and utility libraries shared+    with git-annex.+  * debian: Add lintian overrides for rpath.+  * debian: Bump standards-version.+  * Makefile: Pass LDFLAGS, CFLAGS, and CPPFLAGS through ghc and on to +    ld, cc, and cpp. This lets the Debian package build with various+    hardening options. Although their benefit to a largely haskell program+    is unknown.++ -- Joey Hess <id@joeyh.name>  Sun, 22 May 2016 15:24:04 -0400+ github-backup (1.20160511) unstable; urgency=medium    * Fix build with directory-1.2.6.2.

@@ -26,8 +26,10 @@ 	repoDescribe, 	repoLocation, 	repoPath,+	repoWorkTree, 	localGitDir, 	attributes,+	attributesLocal, 	hookPath, 	assertLocal, 	adjustPath,@@ -72,6 +74,10 @@ repoPath Repo { location = LocalUnknown dir } = dir repoPath Repo { location = Unknown } = error "unknown repoPath" +repoWorkTree :: Repo -> Maybe FilePath+repoWorkTree Repo { location = Local { worktree = Just d } } = Just d+repoWorkTree _ = Nothing+ {- Path to a local repository's .git directory. -} localGitDir :: Repo -> FilePath localGitDir Repo { location = Local { gitdir = d } } = d@@ -125,8 +131,11 @@ {- Path to a repository's gitattributes file. -} attributes :: Repo -> FilePath attributes repo-	| repoIsLocalBare repo = repoPath repo ++ "/info/.gitattributes"-	| otherwise = repoPath repo ++ "/.gitattributes"+	| repoIsLocalBare repo = attributesLocal repo+	| otherwise = repoPath repo </> ".gitattributes"++attributesLocal :: Repo -> FilePath+attributesLocal repo = localGitDir repo </> "info" </> "attributes"  {- Path to a given hook script in a repository, only if the hook exists  - and is executable. -}

@@ -23,7 +23,7 @@  - branch is not created yet. So, this also looks at show-ref HEAD  - to double-check.  -}-current :: Repo -> IO (Maybe Git.Ref)+current :: Repo -> IO (Maybe Branch) current r = do 	v <- currentUnsafe r 	case v of@@ -35,7 +35,7 @@ 				)  {- The current branch, which may not really exist yet. -}-currentUnsafe :: Repo -> IO (Maybe Git.Ref)+currentUnsafe :: Repo -> IO (Maybe Branch) currentUnsafe r = parse . firstLine 	<$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r   where@@ -48,15 +48,25 @@ changed :: Branch -> Branch -> Repo -> IO Bool changed origbranch newbranch repo 	| origbranch == newbranch = return False-	| otherwise = not . null <$> diffs+	| otherwise = not . null+		<$> changed' origbranch newbranch [Param "-n1"] repo   where-	diffs = pipeReadStrict++changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String+changed' origbranch newbranch extraps repo = pipeReadStrict ps repo+  where+	ps = 		[ Param "log" 		, Param (fromRef origbranch ++ ".." ++ fromRef newbranch)-		, Param "-n1" 		, Param "--pretty=%H"-		] repo+		] ++ extraps +{- Lists commits that are in the second branch and not in the first branch. -}+changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha]+changedCommits origbranch newbranch extraps repo = +	catMaybes . map extractSha . lines+		<$> changed' origbranch newbranch extraps repo+	 {- Check if it's possible to fast-forward from the old  - ref to the new ref.  -@@ -90,7 +100,7 @@   where 	no_ff = return False 	do_ff to = do-		update branch to repo+		update' branch to repo 		return True 	findbest c [] = return $ Just c 	findbest c (r:rs)@@ -121,10 +131,6 @@ commitCommand :: CommitMode -> [CommandParam] -> Repo -> IO Bool commitCommand = commitCommand' runBool -{- Commit will fail when the tree is clean. This suppresses that error. -}-commitQuiet :: CommitMode -> [CommandParam] -> Repo -> IO ()-commitQuiet commitmode ps = void . tryIO . commitCommand' runQuiet commitmode ps- commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> [CommandParam] -> Repo -> IO a commitCommand' runner commitmode ps = runner $ 	Param "commit" : applyCommitMode commitmode ps@@ -144,36 +150,51 @@ 		pipeReadStrict [Param "write-tree"] repo 	ifM (cancommit tree) 		( do-			sha <- getSha "commit-tree" $-				pipeWriteRead ([Param "commit-tree", Param (fromRef tree)] ++ ps) sendmsg repo-			update branch sha repo+			sha <- commitTree commitmode message parentrefs tree repo+			update' branch sha repo 			return $ Just sha 		, return Nothing 		)   where-	ps = applyCommitMode commitmode $-		map Param $ concatMap (\r -> ["-p", fromRef r]) parentrefs 	cancommit tree 		| allowempty = return True 		| otherwise = case parentrefs of 			[p] -> maybe False (tree /=) <$> Git.Ref.tree p repo 			_ -> return True-	sendmsg = Just $ flip hPutStr message  commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha commitAlways commitmode message branch parentrefs repo = fromJust 	<$> commit commitmode True message branch parentrefs repo +commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha+commitTree commitmode message parentrefs tree repo =+	getSha "commit-tree" $+		pipeWriteRead ([Param "commit-tree", Param (fromRef tree)] ++ ps)+			sendmsg repo+  where+	ps = applyCommitMode commitmode $+		map Param $ concatMap (\r -> ["-p", fromRef r]) parentrefs+	sendmsg = Just $ flip hPutStr message+ {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String forcePush b = "+" ++ b -{- Updates a branch (or other ref) to a new Sha. -}-update :: Branch -> Sha -> Repo -> IO ()-update branch sha = run +{- Updates a branch (or other ref) to a new Sha or branch Ref. -}+update :: String -> Branch -> Ref -> Repo -> IO ()+update message branch r = run 	[ Param "update-ref"+	, Param "-m"+	, Param message 	, Param $ fromRef branch-	, Param $ fromRef sha+	, Param $ fromRef r+	]++update' :: Branch -> Ref -> Repo -> IO ()+update' branch r = run+	[ Param "update-ref"+	, Param $ fromRef branch+	, Param $ fromRef r 	]  {- Checks out a branch, creating it if necessary. -}

@@ -1,6 +1,6 @@ {- git cat-file interface  -- - Copyright 2011, 2013 Joey Hess <id@joeyh.name>+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -13,6 +13,7 @@ 	catFile, 	catFileDetails, 	catTree,+	catCommit, 	catObject, 	catObjectDetails, ) where@@ -20,6 +21,10 @@ import System.IO import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.Map as M+import Data.String+import Data.Char import Data.Tuple.Utils import Numeric import System.Posix.Types@@ -104,10 +109,51 @@ 				(dropsha rest)  	-- these 20 bytes after the NUL hold the file's sha-	-- TODO: convert from raw form to regular sha 	dropsha = L.drop 21  	parsemodefile b =  		let (modestr, file) = separate (== ' ') (decodeBS b) 		in (file, readmode modestr) 	readmode = fromMaybe 0 . fmap fst . headMaybe . readOct++catCommit :: CatFileHandle -> Ref -> IO (Maybe Commit)+catCommit h commitref = go <$> catObjectDetails h commitref+  where+	go (Just (b, _, CommitObject)) = parseCommit b+	go _ = Nothing++parseCommit :: L.ByteString -> Maybe Commit+parseCommit b = Commit+	<$> (extractSha . L8.unpack =<< field "tree")+	<*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent"))+	<*> (parsemetadata <$> field "author")+	<*> (parsemetadata <$> field "committer")+	<*> Just (L8.unpack $ L.intercalate (L.singleton nl) message)+  where+	field n = headMaybe =<< fields n+	fields n = M.lookup (fromString n) fieldmap+	fieldmap = M.fromListWith (++) ((map breakfield) header)+	breakfield l =+		let (k, sp_v) = L.break (== sp) l+		in (k, [L.drop 1 sp_v])+	(header, message) = separate L.null ls+	ls = L.split nl b++	-- author and committer lines have the form: "name <email> date"+	-- The email is always present, even if empty "<>"+	parsemetadata l = CommitMetaData+		{ commitName = whenset $ L.init name_sp+		, commitEmail = whenset email+		, commitDate = whenset $ L.drop 2 gt_sp_date+		}+	  where+		(name_sp, rest) = L.break (== lt) l+		(email, gt_sp_date) = L.break (== gt) (L.drop 1 rest)+		whenset v+			| L.null v = Nothing+			| otherwise = Just (L8.unpack v)++	nl = fromIntegral (ord '\n')+	sp = fromIntegral (ord ' ')+	lt = fromIntegral (ord '<')+	gt = fromIntegral (ord '>')

@@ -17,9 +17,11 @@ {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] gitCommandLine params r@(Repo { location = l@(Local { } ) }) =-	setdir : settree ++ gitGlobalOpts r ++ params+	setdir ++ settree ++ gitGlobalOpts r ++ params   where-	setdir = Param $ "--git-dir=" ++ gitdir l+	setdir+		| gitEnvOverridesGitDir r = []+		| otherwise = [Param $ "--git-dir=" ++ gitdir l] 	settree = case worktree l of 		Nothing -> [] 		Just t -> [Param $ "--work-tree=" ++ t]

@@ -236,6 +236,7 @@ 	, remotes = [] 	, remoteName = Nothing 	, gitEnv = Nothing+	, gitEnvOverridesGitDir = False 	, gitGlobalOpts = [] 	} 

@@ -14,8 +14,8 @@  module Git.FilePath ( 	TopFilePath,-	fromTopFilePath, 	getTopFilePath,+	fromTopFilePath, 	toTopFilePath, 	asTopFilePath, 	InternalGitPath,@@ -31,11 +31,11 @@  {- A FilePath, relative to the top of the git repository. -} newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }-	deriving (Show)+	deriving (Show, Eq, Ord) -{- Returns an absolute FilePath. -}+{- Path to a TopFilePath, within the provided git repo. -} fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath-fromTopFilePath p repo = absPathFrom (repoPath repo) (getTopFilePath p)+fromTopFilePath p repo = combine (repoPath repo) (getTopFilePath p)  {- The input FilePath can be absolute, or relative to the CWD. -} toTopFilePath :: FilePath -> Git.Repo -> IO TopFilePath

@@ -0,0 +1,70 @@+{- git index file stuff+ -+ - Copyright 2011 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Git.Index where++import Common+import Git+import Utility.Env++indexEnv :: String+indexEnv = "GIT_INDEX_FILE"++{- Gets value to set GIT_INDEX_FILE to. Input should be absolute path,+ - or relative to the CWD.+ -+ - When relative, GIT_INDEX_FILE is interpreted by git as being + - relative to the top of the work tree of the git repository,+ - not to the CWD. Worse, other environment variables (GIT_WORK_TREE)+ - or git options (--work-tree) or configuration (core.worktree)+ - can change what the relative path is interpreted relative to.+ -+ - So, an absolute path is the only safe option for this to return.+ -}+indexEnvVal :: FilePath -> IO String+indexEnvVal = absPath++{- Forces git to use the specified index file.+ -+ - Returns an action that will reset back to the default+ - index file.+ -+ - Warning: Not thread safe.+ -}+override :: FilePath -> Repo -> IO (IO ())+override index _r = do+	res <- getEnv var+	val <- indexEnvVal index+	setEnv var val True+	return $ reset res+  where+	var = "GIT_INDEX_FILE"+	reset (Just v) = setEnv indexEnv v True+	reset _ = unsetEnv var++indexFile :: Repo -> FilePath+indexFile r = localGitDir r </> "index"++{- Git locks the index by creating this file. -}+indexFileLock :: Repo -> FilePath+indexFileLock r = indexFile r ++ ".lock"++{- When the pre-commit hook is run, and git commit has been run with+ - a file or files specified to commit, rather than committing the staged+ - index, git provides the pre-commit hook with a "false index file".+ -+ - Changes made to this index will influence the commit, but won't+ - affect the real index file.+ -+ - This detects when we're in this situation, using a heuristic, which+ - might be broken by changes to git. Any use of this should have a test+ - case to make sure it works.+ -}+haveFalseIndex :: IO Bool+haveFalseIndex = maybe (False) check <$> getEnv indexEnv+  where+	check f = "next-index" `isPrefixOf` takeFileName f

@@ -137,7 +137,7 @@  {- Is a queue large enough that it should be flushed? -} full :: Queue -> Bool-full (Queue cur lim  _) = cur > lim+full (Queue cur lim  _) = cur >= lim  {- Runs a queue on a git repository. -} flush :: Queue -> Repo -> IO Queue

@@ -18,6 +18,12 @@ headRef :: Ref headRef = Ref "HEAD" +headFile :: Repo -> FilePath+headFile r = localGitDir r </> "HEAD"++setHeadRef :: Ref -> Repo -> IO ()+setHeadRef ref r = writeFile (headFile r) ("ref: " ++ fromRef ref)+ {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String describe = fromRef . base@@ -31,11 +37,14 @@ 		| prefix `isPrefixOf` s = drop (length prefix) s 		| otherwise = s +{- Gets the basename of any qualified ref. -}+basename :: Ref -> Ref+basename = Ref . reverse . takeWhile (/= '/') . reverse . fromRef+ {- Given a directory and any ref, takes the basename of the ref and puts  - it under the directory. -} under :: String -> Ref -> Ref-under dir r = Ref $ dir ++ "/" ++-	(reverse $ takeWhile (/= '/') $ reverse $ fromRef r)+under dir r = Ref $ dir ++ "/" ++ fromRef (basename r)  {- Given a directory such as "refs/remotes/origin", and a ref such as  - refs/heads/master, yields a version of that ref under the directory,

@@ -11,7 +11,6 @@ import qualified Data.Map as M import System.Posix.Types import Utility.SafeCommand-import Utility.URI ()  {- Support repositories on local disk, and repositories accessed via an URL.  -@@ -40,6 +39,7 @@ 	, remoteName :: Maybe RemoteName 	-- alternate environment to use when running git commands 	, gitEnv :: Maybe [(String, String)]+	, gitEnvOverridesGitDir :: Bool 	-- global options to pass to git when running git commands 	, gitGlobalOpts :: [CommandParam] 	} deriving (Show, Eq, Ord)@@ -98,3 +98,24 @@ toBlobType 0o100755 = Just ExecutableBlob toBlobType 0o120000 = Just SymlinkBlob toBlobType _ = Nothing++fromBlobType :: BlobType -> FileMode+fromBlobType FileBlob = 0o100644+fromBlobType ExecutableBlob = 0o100755+fromBlobType SymlinkBlob = 0o120000++data Commit = Commit+	{ commitTree :: Sha+	, commitParent :: [Sha]+	, commitAuthorMetaData :: CommitMetaData+	, commitCommitterMetaData :: CommitMetaData+	, commitMessage :: String+	}+	deriving (Show)++data CommitMetaData = CommitMetaData+	{ commitName :: Maybe String+	, commitEmail :: Maybe String+	, commitDate :: Maybe String -- In raw git form, "epoch -tzoffset"+	}+	deriving (Show)

@@ -9,7 +9,7 @@  Build/SysConfig.hs: configure.hs Build/TestConfig.hs Build/Configure.hs 	if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi-	$(CABAL) configure+	$(CABAL) configure --ghc-options="$(shell Build/collect-ghc-options.sh)"  install: build 	install -d $(DESTDIR)$(PREFIX)/bin

@@ -21,7 +21,8 @@ 	tryNonAsync, 	tryWhenExists, 	catchIOErrorType,-	IOErrorType(..)+	IOErrorType(..),+	catchPermissionDenied, ) where  import Control.Monad.Catch as X hiding (Handler)@@ -97,3 +98,6 @@ 	onlymatching e 		| ioeGetErrorType e == errtype = onmatchingerr e 		| otherwise = throwM e++catchPermissionDenied :: MonadCatch m => (IOException -> m a) -> m a -> m a+catchPermissionDenied = catchIOErrorType PermissionDenied

@@ -18,9 +18,10 @@ import Utility.PosixFiles #ifndef mingw32_HOST_OS import System.Posix.Files+import Control.Monad.IO.Class (liftIO) #endif+import Control.Monad.IO.Class (MonadIO) import Foreign (complement)-import Control.Monad.IO.Class (liftIO, MonadIO) import Control.Monad.Catch  import Utility.Exception

@@ -19,6 +19,7 @@ 	encodeW8NUL, 	decodeW8NUL, 	truncateFilePath,+	setConsoleEncoding, ) where  import qualified GHC.Foreign as GHC@@ -164,3 +165,10 @@ 					else go (c:coll) (cnt - x') (L8.drop 1 bs) 			_ -> coll #endif++{- This avoids ghc's output layer crashing on invalid encoded characters in+ - filenames when printing them out. -}+setConsoleEncoding :: IO ()+setConsoleEncoding = do+	fileEncoding stdout+	fileEncoding stderr

@@ -12,7 +12,6 @@  import Data.String.Utils import System.FilePath-import System.Directory import Data.List import Data.Maybe import Data.Char@@ -29,6 +28,7 @@ import qualified "MissingH" System.Path as MissingH import Utility.Monad import Utility.UserInfo+import Utility.Directory  {- Simplifies a path, removing any "." component, collapsing "dir/..",   - and removing the trailing path separator.@@ -60,7 +60,7 @@ {- Makes a path absolute.  -  - The first parameter is a base directory (ie, the cwd) to use if the path- - is not already absolute.+ - is not already absolute, and should itsef be absolute.  -  - Does not attempt to deal with edge cases or ensure security with  - untrusted inputs.@@ -252,15 +252,21 @@   where 	f = takeFileName file -{- Converts a DOS style path to a Cygwin style path. Only on Windows.- - Any trailing '\' is preserved as a trailing '/' -}-toCygPath :: FilePath -> FilePath+{- Converts a DOS style path to a msys2 style path. Only on Windows.+ - Any trailing '\' is preserved as a trailing '/' + - + - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i+ -+ - The virtual filesystem contains:+ -  /c, /d, ...	mount points for Windows drives+ -}+toMSYS2Path :: FilePath -> FilePath #ifndef mingw32_HOST_OS-toCygPath = id+toMSYS2Path = id #else-toCygPath p+toMSYS2Path p 	| null drive = recombine parts-	| otherwise = recombine $ "/cygdrive" : driveletter drive : parts+	| otherwise = recombine $ "/" : driveletter drive : parts   where 	(drive, p') = splitDrive p 	parts = splitDirectories p'

@@ -1,6 +1,6 @@ {- POSIX files (and compatablity wrappers).  -- - This is like System.PosixCompat.Files, except with a fixed rename.+ - This is like System.PosixCompat.Files, but with a few fixes.  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -@@ -21,6 +21,7 @@ import System.Posix.Files (rename) #else import qualified System.Win32.File as Win32+import qualified System.Win32.HardLink as Win32 #endif  {- System.PosixCompat.Files.rename on Windows calls renameFile,@@ -31,4 +32,11 @@ #ifdef mingw32_HOST_OS rename :: FilePath -> FilePath -> IO () rename src dest = Win32.moveFileEx src dest Win32.mOVEFILE_REPLACE_EXISTING+#endif++{- System.PosixCompat.Files.createLink throws an error, but windows+ - does support hard links. -}+#ifdef mingw32_HOST_OS+createLink :: FilePath -> FilePath -> IO ()+createLink = Win32.createHardLink #endif

@@ -18,6 +18,7 @@ 	readProcessEnv, 	writeReadProcessEnv, 	forceSuccessProcess,+	forceSuccessProcess', 	checkSuccessProcess, 	ignoreFailureProcess, 	createProcessSuccess,@@ -129,11 +130,12 @@ -- | Waits for a ProcessHandle, and throws an IOError if the process -- did not exit successfully. forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()-forceSuccessProcess p pid = do-	code <- waitForProcess pid-	case code of-		ExitSuccess -> return ()-		ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n+forceSuccessProcess p pid = waitForProcess pid >>= forceSuccessProcess' p++forceSuccessProcess' :: CreateProcess -> ExitCode -> IO ()+forceSuccessProcess' _ ExitSuccess = return ()+forceSuccessProcess' p (ExitFailure n) = fail $+	showCmd p ++ " exited " ++ show n  -- | Waits for a ProcessHandle and returns True if it exited successfully. -- Note that using this with createProcessChecked will throw away

@@ -11,9 +11,9 @@ module Utility.Tmp where  import System.IO-import System.Directory import Control.Monad.IfElse import System.FilePath+import System.Directory import Control.Monad.IO.Class #ifndef mingw32_HOST_OS import System.Posix.Temp (mkdtemp)

@@ -1,18 +0,0 @@-{- Network.URI- -- - Copyright 2014 Joey Hess <id@joeyh.name>- -- - License: BSD-2-clause- -}--{-# LANGUAGE CPP #-}--module Utility.URI where---- Old versions of network lacked an Ord for URI-#if ! MIN_VERSION_network(2,4,0)-import Network.URI--instance Ord URI where-	a `compare` b = show a `compare` show b-#endif

@@ -17,9 +17,7 @@ import Utility.Env  import System.PosixCompat-#ifndef mingw32_HOST_OS import Control.Applicative-#endif import Prelude  {- Current user's home directory.@@ -58,6 +56,6 @@ #ifndef mingw32_HOST_OS 	go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID) #else-	go [] = error $ "environment not set: " ++ show envvars+	go [] = extract <$> error ("environment not set: " ++ show envvars) #endif 	go (v:vs) = maybe (go vs) return =<< getEnv v

@@ -1,3 +1,18 @@+github-backup (1.20160522) unstable; urgency=medium++  * Work around git weirdness in handling of relative path to GIT_INDEX_FILE+    when in a subdirectory of the repository.+  * Various updates to internal git and utility libraries shared+    with git-annex.+  * debian: Add lintian overrides for rpath.+  * debian: Bump standards-version.+  * Makefile: Pass LDFLAGS, CFLAGS, and CPPFLAGS through ghc and on to +    ld, cc, and cpp. This lets the Debian package build with various+    hardening options. Although their benefit to a largely haskell program+    is unknown.++ -- Joey Hess <id@joeyh.name>  Sun, 22 May 2016 15:24:04 -0400+ github-backup (1.20160511) unstable; urgency=medium    * Fix build with directory-1.2.6.2.

@@ -17,7 +17,7 @@ 	libghc-vector-dev, 	libghc-utf8-string-dev, Maintainer: James McCoy <jamessan@debian.org>-Standards-Version: 3.9.5+Standards-Version: 3.9.8 Vcs-Git: git://github.com/joeyh/github-backup.git Homepage: http://github.com/joeyh/github-backup 

@@ -0,0 +1,1 @@+binary-or-shlib-defines-rpath

@@ -1,5 +1,5 @@ Name: github-backup-Version: 1.20160511+Version: 1.20160522 Cabal-Version: >= 1.8 Maintainer: Joey Hess <joey@kitenet.net> Author: Joey Hess@@ -59,6 +59,9 @@     Build-Depends: network-uri (>= 2.6), network (>= 2.6)   else     Build-Depends: network (< 2.6), network (>= 2.0)++custom-setup+  Setup-Depends: base (>= 4.5), hslogger, MissingH  source-repository head   type: git

@@ -50,6 +50,7 @@ import Git.HashObject import Git.FilePath import Git.CatFile+import Git.Index import Utility.Env  repoUrl :: GithubUserRepo -> String@@ -348,9 +349,9 @@ withIndex :: Backup a -> Backup a withIndex a = do 	r <- getState gitRepo-	let f = Git.localGitDir r </> "github-backup.index"+	f <- liftIO $ indexEnvVal $ Git.localGitDir r </> "github-backup.index" 	e <- liftIO getEnvironment-	let r' = r { Git.Types.gitEnv = Just $ ("GIT_INDEX_FILE", f):e }+	let r' = r { Git.Types.gitEnv = Just $ (indexEnv, f):e } 	changeState $ \s -> s { gitRepo = r' } 	v <- a 	changeState $ \s -> s { gitRepo = (gitRepo s) { Git.Types.gitEnv = Git.Types.gitEnv r } }