diff --git a/Build/make-sdist.sh b/Build/make-sdist.sh
--- a/Build/make-sdist.sh
+++ b/Build/make-sdist.sh
@@ -13,7 +13,7 @@
 | xargs cp --parents --target-directory dist/$sdist_dir
 
 cd dist
-tar -caf $sdist_dir.tar.gz $sdist_dir
+tar --format=ustar -caf $sdist_dir.tar.gz $sdist_dir
 
 # Check that tarball can be unpacked by cabal.
 # It's picky about tar longlinks etc.
diff --git a/Git.hs b/Git.hs
--- a/Git.hs
+++ b/Git.hs
@@ -13,6 +13,7 @@
 module Git (
 	Repo(..),
 	Ref(..),
+	fromRef,
 	Branch,
 	Sha,
 	Tag,
diff --git a/Git/Branch.hs b/Git/Branch.hs
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -13,7 +13,7 @@
 import Git
 import Git.Sha
 import Git.Command
-import Git.Ref (headRef)
+import qualified Git.Ref
 
 {- The currently checked out branch.
  -
@@ -28,7 +28,7 @@
 	case v of
 		Nothing -> return Nothing
 		Just branch -> 
-			ifM (null <$> pipeReadStrict [Param "show-ref", Param $ show branch] r)
+			ifM (null <$> pipeReadStrict [Param "show-ref", Param $ fromRef branch] r)
 				( return Nothing
 				, return v
 				)
@@ -36,7 +36,7 @@
 {- The current branch, which may not really exist yet. -}
 currentUnsafe :: Repo -> IO (Maybe Git.Ref)
 currentUnsafe r = parse . firstLine
-	<$> pipeReadStrict [Param "symbolic-ref", Param $ show headRef] r
+	<$> pipeReadStrict [Param "symbolic-ref", Param $ fromRef Git.Ref.headRef] r
   where
 	parse l
 		| null l = Nothing
@@ -51,10 +51,25 @@
   where
 	diffs = pipeReadStrict
 		[ Param "log"
-		, Param (show origbranch ++ ".." ++ show newbranch)
-		, Params "--oneline -n1"
+		, Param (fromRef origbranch ++ ".." ++ fromRef newbranch)
+		, Param "-n1"
+		, Param "--pretty=%H"
 		] repo
 
+{- Check if it's possible to fast-forward from the old
+ - ref to the new ref.
+ -
+ - This requires there to be a path from the old to the new. -}
+fastForwardable :: Ref -> Ref -> Repo -> IO Bool
+fastForwardable old new repo = not . null <$>
+	pipeReadStrict
+		[ Param "log"
+		, Param $ fromRef old ++ ".." ++ fromRef new
+		, Param "-n1"
+		, Param "--pretty=%H"
+		, Param "--ancestry-path"
+		] repo
+
 {- Given a set of refs that are all known to have commits not
  - on the branch, tries to update the branch by a fast-forward.
  -
@@ -74,7 +89,7 @@
   where
 	no_ff = return False
 	do_ff to = do
-		run [Param "update-ref", Param $ show branch, Param $ show to] repo
+		update branch to repo
 		return True
 	findbest c [] = return $ Just c
 	findbest c (r:rs)
@@ -88,20 +103,90 @@
 			(False, True) -> findbest c rs -- worse
 			(False, False) -> findbest c rs -- same
 
+{- The user may have set commit.gpgsign, indending all their manual
+ - commits to be signed. But signing automatic/background commits could
+ - easily lead to unwanted gpg prompts or failures.
+ -}
+data CommitMode = ManualCommit | AutomaticCommit
+	deriving (Eq)
+
+{- Commit via the usual git command. -}
+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" : ps')
+  where
+	ps'
+		| commitmode == AutomaticCommit = Param "--no-gpg-sign" : ps
+		| otherwise = ps
+
 {- Commits the index into the specified branch (or other ref), 
- - with the specified parent refs, and returns the committed sha -}
-commit :: String -> Branch -> [Ref] -> Repo -> IO Sha
-commit message branch parentrefs repo = do
+ - with the specified parent refs, and returns the committed sha.
+ -
+ - Without allowempy set, avoids making a commit if there is exactly
+ - one parent, and it has the same tree that would be committed.
+ -
+ - Unlike git-commit, does not run any hooks, or examine the work tree
+ - in any way.
+ -}
+commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
+commit commitmode allowempty message branch parentrefs repo = do
 	tree <- getSha "write-tree" $
 		pipeReadStrict [Param "write-tree"] repo
-	sha <- getSha "commit-tree" $ pipeWriteRead
-		(map Param $ ["commit-tree", show tree] ++ ps)
-		message repo
-	run [Param "update-ref", Param $ show branch, Param $ show sha] repo
-	return sha
+	ifM (cancommit tree)
+		( do
+			sha <- getSha "commit-tree" $ pipeWriteRead
+				(map Param $ ["commit-tree", fromRef tree] ++ ps)
+				(Just $ flip hPutStr message) repo
+			update branch sha repo
+			return $ Just sha
+		, return Nothing
+		)
   where
-	ps = concatMap (\r -> ["-p", show r]) parentrefs
+	ps = 
+		(if commitmode == AutomaticCommit then ["--no-gpg-sign"] else [])
+		++ 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
 
+commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha
+commitAlways commitmode message branch parentrefs repo = fromJust
+	<$> commit commitmode True message branch parentrefs repo
+
 {- 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 
+	[ Param "update-ref"
+	, Param $ fromRef branch
+	, Param $ fromRef sha
+	]
+
+{- Checks out a branch, creating it if necessary. -}
+checkout :: Branch -> Repo -> IO ()
+checkout branch = run
+	[ Param "checkout"
+	, Param "-q"
+	, Param "-B"
+	, Param $ fromRef $ Git.Ref.base branch
+	]
+
+{- Removes a branch. -}
+delete :: Branch -> Repo -> IO ()
+delete branch = run
+	[ Param "branch"
+	, Param "-q"
+	, Param "-D"
+	, Param $ fromRef $ Git.Ref.base branch
+	]
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -11,6 +11,7 @@
 	catFileStart',
 	catFileStop,
 	catFile,
+	catFileDetails,
 	catTree,
 	catObject,
 	catObjectDetails,
@@ -50,8 +51,12 @@
 {- Reads a file from a specified branch. -}
 catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
 catFile h branch file = catObject h $ Ref $
-	show branch ++ ":" ++ toInternalGitPath file
+	fromRef branch ++ ":" ++ toInternalGitPath file
 
+catFileDetails :: CatFileHandle -> Branch -> FilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))
+catFileDetails h branch file = catObjectDetails h $ Ref $
+	fromRef branch ++ ":" ++ toInternalGitPath file
+
 {- Uses a running git cat-file read the content of an object.
  - Objects that do not exist will have "" returned. -}
 catObject :: CatFileHandle -> Ref -> IO L.ByteString
@@ -60,7 +65,7 @@
 catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha, ObjectType))
 catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive
   where
-	query = show object
+	query = fromRef object
 	send to = hPutStrLn to query
 	receive from = do
 		header <- hGetLine from
@@ -72,8 +77,8 @@
 						_ -> dne
 				| otherwise -> dne
 			_
-				| header == show object ++ " missing" -> dne
-				| otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)
+				| header == fromRef object ++ " missing" -> dne
+				| otherwise -> error $ "unknown response from git cat-file " ++ show (header, query)
 	readcontent objtype bytes from sha = do
 		content <- S.hGet from bytes
 		eatchar '\n' from
@@ -103,6 +108,6 @@
 	dropsha = L.drop 21
 
 	parsemodefile b = 
-		let (modestr, file) = separate (== ' ') (encodeW8 $ L.unpack b)
+		let (modestr, file) = separate (== ' ') (decodeBS b)
 		in (file, readmode modestr)
 	readmode = fst . fromMaybe (0, undefined) . headMaybe . readOct
diff --git a/Git/Command.hs b/Git/Command.hs
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -1,13 +1,13 @@
 {- running git commands
  -
- - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Git.Command where
+{-# LANGUAGE CPP #-}
 
-import System.Process (std_out, env)
+module Git.Command where
 
 import Common
 import Git
@@ -16,7 +16,8 @@
 
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
-gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ params
+gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) =
+	setdir : settree ++ gitGlobalOpts r ++ params
   where
 	setdir = Param $ "--git-dir=" ++ gitdir l
 	settree = case worktree l of
@@ -27,9 +28,7 @@
 {- Runs git in the specified repo. -}
 runBool :: [CommandParam] -> Repo -> IO Bool
 runBool params repo = assertLocal repo $
-	boolSystemEnv "git"
-		(gitCommandLine params repo)
-		(gitEnv repo)
+	boolSystemEnv "git" (gitCommandLine params repo) (gitEnv repo)
 
 {- Runs git in the specified repo, throwing an error if it fails. -}
 run :: [CommandParam] -> Repo -> IO ()
@@ -72,13 +71,13 @@
   where
 	p  = gitCreateProcess params repo
 
-{- Runs a git command, feeding it input, and returning its output,
+{- Runs a git command, feeding it an input, and returning its output,
  - which is expected to be fairly small, since it's all read into memory
  - strictly. -}
-pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String
-pipeWriteRead params s repo = assertLocal repo $
+pipeWriteRead :: [CommandParam] -> Maybe (Handle -> IO ()) -> Repo -> IO String
+pipeWriteRead params writer repo = assertLocal repo $
 	writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) 
-		(gitEnv repo) s (Just adjusthandle)
+		(gitEnv repo) writer (Just adjusthandle)
   where
   	adjusthandle h = do
 		fileEncoding h
@@ -114,9 +113,14 @@
 
 {- Runs a git command as a coprocess. -}
 gitCoProcessStart :: Bool -> [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle
-gitCoProcessStart restartable params repo = CoProcess.start restartable "git"
+gitCoProcessStart restartable params repo = CoProcess.start numrestarts "git"
 	(toCommand $ gitCommandLine params repo)
 	(gitEnv repo)
+  where
+  	{- If a long-running git command like cat-file --batch
+	 - crashes, it will likely start up again ok. If it keeps crashing
+	 - 10 times, something is badly wrong. -}
+	numrestarts = if restartable then 10 else 0
 
 gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess
 gitCreateProcess params repo =
diff --git a/Git/Config.hs b/Git/Config.hs
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -9,7 +9,6 @@
 
 import qualified Data.Map as M
 import Data.Char
-import System.Process (cwd, env)
 import Control.Exception.Extensible
 
 import Common
@@ -110,8 +109,13 @@
  -}
 updateLocation :: Repo -> IO Repo
 updateLocation r@(Repo { location = LocalUnknown d })
-	| isBare r = updateLocation' r $ Local d Nothing
-	| otherwise = updateLocation' r $ Local (d </> ".git") (Just d)
+	| isBare r = ifM (doesDirectoryExist dotgit)
+			( updateLocation' r $ Local dotgit Nothing
+			, updateLocation' r $ Local d Nothing
+			)
+	| otherwise = updateLocation' r $ Local dotgit (Just d)
+  where
+	dotgit = (d </> ".git")
 updateLocation r@(Repo { location = l@(Local {}) }) = updateLocation' r l
 updateLocation r = return r
 
@@ -153,7 +157,10 @@
 boolConfig False = "false"
 
 isBare :: Repo -> Bool
-isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r
+isBare r = fromMaybe False $ isTrue =<< getMaybe coreBare r
+
+coreBare :: String
+coreBare = "core.bare"
 
 {- Runs a command to get the configuration of a repo,
  - and returns a repo populated with the configuration, as well as the raw
diff --git a/Git/Construct.hs b/Git/Construct.hs
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -33,6 +33,7 @@
 import Git.Types
 import Git
 import Git.Remote
+import Git.FilePath
 import qualified Git.Url as Url
 import Utility.UserInfo
 
@@ -57,7 +58,7 @@
  - specified. -}
 fromAbsPath :: FilePath -> IO Repo
 fromAbsPath dir
-	| isAbsolute dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt )
+	| absoluteGitPath dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt )
 	| otherwise =
 		error $ "internal error, " ++ dir ++ " is not absolute"
   where
@@ -104,14 +105,16 @@
 localToUrl reference r
 	| not $ repoIsUrl reference = error "internal error; reference repo not url"
 	| repoIsUrl r = r
-	| otherwise = r { location = Url $ fromJust $ parseURI absurl }
-  where
-	absurl = concat
-		[ Url.scheme reference
-		, "//"
-		, Url.authority reference
-		, repoPath r
-		]
+	| otherwise = case Url.authority reference of
+		Nothing -> r
+		Just auth -> 
+			let absurl = concat
+				[ Url.scheme reference
+				, "//"
+				, auth
+				, repoPath r
+				]
+			in r { location = Url $ fromJust $ parseURI absurl }
 
 {- Calculates a list of a repo's configured remotes, by parsing its config. -}
 fromRemotes :: Repo -> IO [Repo]
@@ -228,6 +231,7 @@
 	, remotes = []
 	, remoteName = Nothing
 	, gitEnv = Nothing
+	, gitGlobalOpts = []
 	}
 
 
diff --git a/Git/FilePath.hs b/Git/FilePath.hs
--- a/Git/FilePath.hs
+++ b/Git/FilePath.hs
@@ -14,20 +14,29 @@
 
 module Git.FilePath (
 	TopFilePath,
+	fromTopFilePath,
 	getTopFilePath,
 	toTopFilePath,
 	asTopFilePath,
 	InternalGitPath,
 	toInternalGitPath,
-	fromInternalGitPath
+	fromInternalGitPath,
+	absoluteGitPath
 ) where
 
 import Common
 import Git
 
+import qualified System.FilePath.Posix
+
 {- A FilePath, relative to the top of the git repository. -}
 newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
+	deriving (Show)
 
+{- Returns an absolute FilePath. -}
+fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
+fromTopFilePath p repo = absPathFrom (repoPath repo) (getTopFilePath p)
+
 {- The input FilePath can be absolute, or relative to the CWD. -}
 toTopFilePath :: FilePath -> Git.Repo -> IO TopFilePath
 toTopFilePath file repo = TopFilePath <$>
@@ -39,8 +48,12 @@
 asTopFilePath file = TopFilePath file
 
 {- Git may use a different representation of a path when storing
- - it internally. For example, on Windows, git uses '/' to separate paths
- - stored in the repository, despite Windows using '\' -}
+ - it internally. 
+ -
+ - On Windows, git uses '/' to separate paths stored in the repository,
+ - despite Windows using '\'.
+ -
+ -}
 type InternalGitPath = String
 
 toInternalGitPath :: FilePath -> InternalGitPath
@@ -56,3 +69,10 @@
 #else
 fromInternalGitPath = replace "/" "\\"
 #endif
+
+{- isAbsolute on Windows does not think "/foo" or "\foo" is absolute,
+ - so try posix paths.
+ -}
+absoluteGitPath :: FilePath -> Bool
+absoluteGitPath p = isAbsolute p ||
+	System.FilePath.Posix.isAbsolute (toInternalGitPath p)
diff --git a/Git/HashObject.hs b/Git/HashObject.hs
--- a/Git/HashObject.hs
+++ b/Git/HashObject.hs
@@ -1,6 +1,6 @@
 {- git hash-object interface
  -
- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,6 +13,7 @@
 import Git.Command
 import Git.Types
 import qualified Utility.CoProcess as CoProcess
+import Utility.Tmp
 
 type HashObjectHandle = CoProcess.CoProcessHandle
 
@@ -34,10 +35,24 @@
 	send to = hPutStrLn to file
 	receive from = getSha "hash-object" $ hGetLine from
 
-{- Injects some content into git, returning its Sha. -}
+{- Injects a blob into git. Unfortunately, the current git-hash-object
+ - interface does not allow batch hashing without using temp files. -}
+hashBlob :: HashObjectHandle -> String -> IO Sha
+hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do
+	hPutStr tmph s
+	hClose tmph
+	hashFile h tmp
+
+{- Injects some content into git, returning its Sha.
+ - 
+ - Avoids using a tmp file, but runs a new hash-object command each
+ - time called. -}
 hashObject :: ObjectType -> String -> Repo -> IO Sha
-hashObject objtype content repo = getSha subcmd $
-	pipeWriteRead (map Param params) content repo
+hashObject objtype content = hashObject' objtype (flip hPutStr content)
+
+hashObject' :: ObjectType -> (Handle -> IO ()) -> Repo -> IO Sha
+hashObject' objtype writer repo = getSha subcmd $
+	pipeWriteRead (map Param params) (Just writer) repo
   where
 	subcmd = "hash-object"
 	params = [subcmd, "-t", show objtype, "-w", "--stdin", "--no-filters"]
diff --git a/Git/Queue.hs b/Git/Queue.hs
--- a/Git/Queue.hs
+++ b/Git/Queue.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP, BangPatterns #-}
 
 module Git.Queue (
 	Queue,
@@ -17,16 +17,14 @@
 	flush,
 ) where
 
-import qualified Data.Map as M
-import System.IO
-import System.Process
-
 import Utility.SafeCommand
 import Common
 import Git
 import Git.Command
 import qualified Git.UpdateIndex
-	
+
+import qualified Data.Map as M
+
 {- Queable actions that can be performed in a git repository.
  -}
 data Action
@@ -84,16 +82,16 @@
  -}
 addCommand :: String -> [CommandParam] -> [FilePath] -> Queue -> Repo -> IO Queue
 addCommand subcommand params files q repo =
-	updateQueue action different (length newfiles) q repo
+	updateQueue action different (length files) q repo
   where
 	key = actionKey action
 	action = CommandAction
 		{ getSubcommand = subcommand
 		, getParams = params
-		, getFiles = newfiles
+		, getFiles = allfiles
 		}
-	newfiles = map File files ++ maybe [] getFiles (M.lookup key $ items q)
-		
+	allfiles = map File files ++ maybe [] getFiles (M.lookup key $ items q)
+	
 	different (CommandAction { getSubcommand = s }) = s /= subcommand
 	different _ = True
 
@@ -147,13 +145,21 @@
 runAction repo (UpdateIndexAction streamers) =
 	-- list is stored in reverse order
 	Git.UpdateIndex.streamUpdateIndex repo $ reverse streamers
-runAction repo action@(CommandAction {}) =
+runAction repo action@(CommandAction {}) = do
+#ifndef mingw32_HOST_OS
+	let p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
 	withHandle StdinHandle createProcessSuccess p $ \h -> do
 		fileEncoding h
 		hPutStr h $ intercalate "\0" $ toCommand $ getFiles action
 		hClose h
+#else
+	-- Using xargs on Windows is problimatic, so just run the command
+	-- once per file (not as efficient.)
+	if null (getFiles action)
+		then void $ boolSystemEnv "git" gitparams (gitEnv repo)
+		else forM_ (getFiles action) $ \f ->
+			void $ boolSystemEnv "git" (gitparams ++ [f]) (gitEnv repo)
+#endif
   where
-	p = (proc "xargs" params) { env = gitEnv repo }
-	params = "-0":"git":baseparams
-	baseparams = toCommand $ gitCommandLine
+	gitparams = gitCommandLine
 		(Param (getSubcommand action):getParams action) repo
diff --git a/Git/Ref.hs b/Git/Ref.hs
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -10,6 +10,8 @@
 import Common
 import Git
 import Git.Command
+import Git.Sha
+import Git.Types
 
 import Data.Char (chr)
 
@@ -18,28 +20,57 @@
 
 {- Converts a fully qualified git ref into a user-visible string. -}
 describe :: Ref -> String
-describe = show . base
+describe = fromRef . base
 
 {- Often git refs are fully qualified (eg: refs/heads/master).
  - Converts such a fully qualified ref into a base ref (eg: master). -}
 base :: Ref -> Ref
-base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show
+base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef
   where
 	remove prefix s
 		| prefix `isPrefixOf` s = drop (length prefix) s
 		| otherwise = s
 
+{- 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)
+
 {- 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,
  - such as refs/remotes/origin/master. -}
-under :: String -> Ref -> Ref
-under dir r = Ref $ dir </> show (base r)
+underBase :: String -> Ref -> Ref
+underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r)
 
+{- A Ref that can be used to refer to a file in the repository, as staged
+ - in the index.
+ -
+ - Prefixing the file with ./ makes this work even if in a subdirectory
+ - of a repo.
+ -}
+fileRef :: FilePath -> Ref
+fileRef f = Ref $ ":./" ++ f
+
+{- Converts a Ref to refer to the content of the Ref on a given date. -}
+dateRef :: Ref -> RefDate -> Ref
+dateRef (Ref r) (RefDate d) = Ref $ r ++ "@" ++ d
+
+{- A Ref that can be used to refer to a file in the repository as it
+ - appears in a given Ref. -}
+fileFromRef :: Ref -> FilePath -> Ref
+fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)
+
 {- Checks if a ref exists. -}
 exists :: Ref -> Repo -> IO Bool
 exists ref = runBool
-	[Param "show-ref", Param "--verify", Param "-q", Param $ show ref]
+	[Param "show-ref", Param "--verify", Param "-q", Param $ fromRef ref]
 
+{- The file used to record a ref. (Git also stores some refs in a
+ - packed-refs file.) -}
+file :: Ref -> Repo -> FilePath
+file ref repo = localGitDir repo </> fromRef ref
+
 {- Checks if HEAD exists. It generally will, except for in a repository
  - that was just created. -}
 headExists :: Repo -> IO Bool
@@ -53,17 +84,17 @@
   where
 	showref = pipeReadStrict [Param "show-ref",
 		Param "--hash", -- get the hash
-		Param $ show branch]
+		Param $ fromRef branch]
 	process [] = Nothing
 	process s = Just $ Ref $ firstLine s
 
 {- List of (shas, branches) matching a given ref or refs. -}
 matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
-matching refs repo =  matching' (map show refs) repo
+matching refs repo =  matching' (map fromRef refs) repo
 
 {- Includes HEAD in the output, if asked for it. -}
 matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
-matchingWithHEAD refs repo = matching' ("--head" : map show refs) repo
+matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo
 
 {- List of (shas, branches) matching a given ref or refs. -}
 matching' :: [String] -> Repo -> IO [(Sha, Branch)]
@@ -79,6 +110,11 @@
 matchingUniq refs repo = nubBy uniqref <$> matching refs repo
   where
 	uniqref (a, _) (b, _) = a == b
+
+{- Gets the sha of the tree a ref uses. -}
+tree :: Ref -> Repo -> IO (Maybe Sha)
+tree ref = extractSha <$$> pipeReadStrict
+	[ Param "rev-parse", Param (fromRef ref ++ ":") ]
 
 {- Checks if a String is a legal git ref name.
  -
diff --git a/Git/Remote.hs b/Git/Remote.hs
--- a/Git/Remote.hs
+++ b/Git/Remote.hs
@@ -11,6 +11,7 @@
 
 import Common
 import Git
+import Git.Types
 import qualified Git.Command
 import qualified Git.BuildVersion
 
@@ -21,8 +22,6 @@
 import Git.FilePath
 #endif
 
-type RemoteName = String
-
 {- Construct a legal git remote name out of an arbitrary input string.
  -
  - There seems to be no formal definition of this in the git source,
@@ -61,6 +60,10 @@
 remoteLocationIsUrl :: RemoteLocation -> Bool
 remoteLocationIsUrl (RemoteUrl _) = True
 remoteLocationIsUrl _ = False
+
+remoteLocationIsSshUrl :: RemoteLocation -> Bool
+remoteLocationIsSshUrl (RemoteUrl u) = "ssh://" `isPrefixOf` u
+remoteLocationIsSshUrl _ = False
 
 {- Determines if a given remote location is an url, or a local
  - path. Takes the repository's insteadOf configuration into account. -}
diff --git a/Git/Sha.hs b/Git/Sha.hs
--- a/Git/Sha.hs
+++ b/Git/Sha.hs
@@ -37,3 +37,7 @@
 
 nullSha :: Ref		
 nullSha = Ref $ replicate shaSize '0'
+
+{- Git's magic empty tree. -}
+emptyTree :: Ref
+emptyTree = Ref "4b825dc642cb6eb9a060e54bf8d69288fbee4904"
diff --git a/Git/Types.hs b/Git/Types.hs
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -9,6 +9,9 @@
 
 import Network.URI
 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.
  -
@@ -25,7 +28,7 @@
 	| LocalUnknown FilePath
 	| Url URI
 	| Unknown
-	deriving (Show, Eq)
+	deriving (Show, Eq, Ord)
 
 data Repo = Repo
 	{ location :: RepoLocation
@@ -34,23 +37,31 @@
 	, fullconfig :: M.Map String [String]
 	, remotes :: [Repo]
 	-- remoteName holds the name used for this repo in remotes
-	, remoteName :: Maybe String
+	, remoteName :: Maybe RemoteName
 	-- alternate environment to use when running git commands
 	, gitEnv :: Maybe [(String, String)]
-	} deriving (Show, Eq)
+	-- global options to pass to git when running git commands
+	, gitGlobalOpts :: [CommandParam]
+	} deriving (Show, Eq, Ord)
 
+type RemoteName = String
+
 {- A git ref. Can be a sha1, or a branch or tag name. -}
 newtype Ref = Ref String
-	deriving (Eq, Ord)
+	deriving (Eq, Ord, Read, Show)
 
-instance Show Ref where
-	show (Ref v) = v
+fromRef :: Ref -> String
+fromRef (Ref s) = s
 
 {- Aliases for Ref. -}
 type Branch = Ref
 type Sha = Ref
 type Tag = Ref
 
+{- A date in the format described in gitrevisions. Includes the
+ - braces, eg, "{yesterday}" -}
+newtype RefDate = RefDate String
+
 {- Types of objects that can be stored in git. -}
 data ObjectType = BlobObject | CommitObject | TreeObject
 	deriving (Eq)
@@ -81,3 +92,9 @@
 readBlobType "100755" = Just ExecutableBlob
 readBlobType "120000" = Just SymlinkBlob
 readBlobType _ = Nothing
+
+toBlobType :: FileMode -> Maybe BlobType
+toBlobType 0o100644 = Just FileBlob
+toBlobType 0o100755 = Just ExecutableBlob
+toBlobType 0o120000 = Just SymlinkBlob
+toBlobType _ = Nothing
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -11,8 +11,13 @@
 	Streamer,
 	pureStreamer,
 	streamUpdateIndex,
+	streamUpdateIndex',
+	startUpdateIndex,
+	stopUpdateIndex,
 	lsTree,
+	lsSubTree,
 	updateIndexLine,
+	stageFile,
 	unstageFile,
 	stageSymlink
 ) where
@@ -24,6 +29,8 @@
 import Git.FilePath
 import Git.Sha
 
+import Control.Exception (bracket)
+
 {- Streamers are passed a callback and should feed it lines in the form
  - read by update-index, and generated by ls-tree. -}
 type Streamer = (String -> IO ()) -> IO ()
@@ -34,17 +41,30 @@
 
 {- Streams content into update-index from a list of Streamers. -}
 streamUpdateIndex :: Repo -> [Streamer] -> IO ()
-streamUpdateIndex repo as = pipeWrite params repo $ \h -> do
+streamUpdateIndex repo as = bracket (startUpdateIndex repo) stopUpdateIndex $
+	(\h -> forM_ as $ streamUpdateIndex' h)
+
+data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle
+
+streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO ()
+streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do
+	hPutStr h s
+	hPutStr h "\0"
+
+startUpdateIndex :: Repo -> IO UpdateIndexHandle
+startUpdateIndex repo = do
+	(Just h, _, _, p) <- createProcess (gitCreateProcess params repo)
+		{ std_in = CreatePipe }
 	fileEncoding h
-	forM_ as (stream h)
-	hClose h
+	return $ UpdateIndexHandle p h
   where
 	params = map Param ["update-index", "-z", "--index-info"]
-	stream h a = a (streamer h)
-	streamer h s = do
-		hPutStr h s
-		hPutStr h "\0"
 
+stopUpdateIndex :: UpdateIndexHandle -> IO Bool
+stopUpdateIndex (UpdateIndexHandle p h) = do
+	hClose h
+	checkSuccessProcess p
+
 {- A streamer that adds the current tree for a ref. Useful for eg, copying
  - and modifying branches. -}
 lsTree :: Ref -> Repo -> Streamer
@@ -54,18 +74,30 @@
 	void $ cleanup
   where
 	params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]
+lsSubTree :: Ref -> FilePath -> Repo -> Streamer
+lsSubTree (Ref x) p repo streamer = do
+	(s, cleanup) <- pipeNullSplit params repo
+	mapM_ streamer s
+	void $ cleanup
+  where
+	params = map Param ["ls-tree", "-z", "-r", "--full-tree", x, p]
 
 {- Generates a line suitable to be fed into update-index, to add
  - a given file with a given sha. -}
 updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
 updateIndexLine sha filetype file =
-	show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file
+	show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file
 
+stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer
+stageFile sha filetype file repo = do
+	p <- toTopFilePath file repo
+	return $ pureStreamer $ updateIndexLine sha filetype p
+
 {- A streamer that removes a file from the index. -}
 unstageFile :: FilePath -> Repo -> IO Streamer
 unstageFile file repo = do
 	p <- toTopFilePath file repo
-	return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p
+	return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
 
 {- A streamer that adds a symlink to the index. -}
 stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
diff --git a/Git/Url.hs b/Git/Url.hs
--- a/Git/Url.hs
+++ b/Git/Url.hs
@@ -37,32 +37,33 @@
 	fixup x = x
 
 {- Hostname of an URL repo. -}
-host :: Repo -> String
+host :: Repo -> Maybe String
 host = authpart uriRegName'
 
 {- Port of an URL repo, if it has a nonstandard one. -}
 port :: Repo -> Maybe Integer
 port r = 
 	case authpart uriPort r of
-		":" -> Nothing
-		(':':p) -> readish p
-		_ -> Nothing
+		Nothing -> Nothing
+		Just ":" -> Nothing
+		Just (':':p) -> readish p
+		Just _ -> Nothing
 
 {- Hostname of an URL repo, including any username (ie, "user@host") -}
-hostuser :: Repo -> String
-hostuser r = authpart uriUserInfo r ++ authpart uriRegName' r
+hostuser :: Repo -> Maybe String
+hostuser r = (++)
+	<$> authpart uriUserInfo r
+	<*> authpart uriRegName' r
 
 {- The full authority portion an URL repo. (ie, "user@host:port") -}
-authority :: Repo -> String
+authority :: Repo -> Maybe String
 authority = authpart assemble
   where
 	assemble a = uriUserInfo a ++ uriRegName' a ++ uriPort a
 
 {- Applies a function to extract part of the uriAuthority of an URL repo. -}
-authpart :: (URIAuth -> a) -> Repo -> a
-authpart a Repo { location = Url u } = a auth
-  where
-	auth = fromMaybe (error $ "bad url " ++ show u) (uriAuthority u)
+authpart :: (URIAuth -> a) -> Repo -> Maybe a
+authpart a Repo { location = Url u } = a <$> uriAuthority u
 authpart _ repo = notUrl repo
 
 notUrl :: Repo -> a
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -9,7 +9,7 @@
     cd github-backup
     make
 
-(You will need ghc, hslogger, and MissingH installed first.)
+(You will need ghc and several haskell libraries installed first.)
 
 Or use cabal:
 
diff --git a/Utility/Applicative.hs b/Utility/Applicative.hs
--- a/Utility/Applicative.hs
+++ b/Utility/Applicative.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 module Utility.Applicative where
diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs
--- a/Utility/CoProcess.hs
+++ b/Utility/CoProcess.hs
@@ -3,7 +3,7 @@
  -
  - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
@@ -30,15 +30,15 @@
 	}
 
 data CoProcessSpec = CoProcessSpec
-	{ coProcessRestartable :: Bool
+	{ coProcessNumRestarts :: Int
 	, coProcessCmd :: FilePath
 	, coProcessParams :: [String]
 	, coProcessEnv :: Maybe [(String, String)]
 	}
 
-start :: Bool -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
-start restartable cmd params env = do
-	s <- start' $ CoProcessSpec restartable cmd params env
+start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
+start numrestarts cmd params environ = do
+	s <- start' $ CoProcessSpec numrestarts cmd params environ
 	newMVar s
 
 start' :: CoProcessSpec -> IO CoProcessState
@@ -62,11 +62,11 @@
 	s <- readMVar ch
 	restartable s (send $ coProcessTo s) $ const $
 		restartable s (hFlush $ coProcessTo s) $ const $
-			restartable s (receive $ coProcessFrom s) $
+			restartable s (receive $ coProcessFrom s)
 				return
   where
   	restartable s a cont
-		| coProcessRestartable (coProcessSpec s) =
+		| coProcessNumRestarts (coProcessSpec s) > 0 =
 			maybe restart cont =<< catchMaybeIO a
 		| otherwise = cont =<< a
 	restart = do
@@ -75,7 +75,8 @@
 			hClose $ coProcessTo s
 			hClose $ coProcessFrom s
 		void $ waitForProcess $ coProcessPid s
-		s' <- start' (coProcessSpec s)
+		s' <- start' $ (coProcessSpec s)
+			{ coProcessNumRestarts = coProcessNumRestarts (coProcessSpec s) - 1 }
 		putMVar ch s'
 		query ch send receive
 
diff --git a/Utility/Data.hs b/Utility/Data.hs
--- a/Utility/Data.hs
+++ b/Utility/Data.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2013 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 module Utility.Data where
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -1,8 +1,8 @@
 {- directory manipulation
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
@@ -10,7 +10,6 @@
 module Utility.Directory where
 
 import System.IO.Error
-import System.PosixCompat.Files
 import System.Directory
 import Control.Exception (throw)
 import Control.Monad
@@ -19,10 +18,12 @@
 import Control.Applicative
 import System.IO.Unsafe (unsafeInterleaveIO)
 
+import Utility.PosixFiles
 import Utility.SafeCommand
 import Utility.Tmp
 import Utility.Exception
 import Utility.Monad
+import Utility.Applicative
 
 dirCruft :: FilePath -> Bool
 dirCruft "." = True
@@ -35,17 +36,22 @@
 dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
 
 {- Gets files in a directory, and then its subdirectories, recursively,
- - and lazily. If the directory does not exist, no exception is thrown,
+ - and lazily.
+ -
+ - Does not follow symlinks to other subdirectories.
+ -
+ - When the directory does not exist, no exception is thrown,
  - instead, [] is returned. -}
 dirContentsRecursive :: FilePath -> IO [FilePath]
-dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) topdir
+dirContentsRecursive = dirContentsRecursiveSkipping (const False) True
 
-dirContentsRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
-dirContentsRecursiveSkipping skipdir topdir = go [topdir]
+{- Skips directories whose basenames match the skipdir. -}
+dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]
+dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
   where
   	go [] = return []
 	go (dir:dirs)
-		| skipdir dir = go dirs
+		| skipdir (takeFileName dir) = go dirs
 		| otherwise = unsafeInterleaveIO $ do
 			(files, dirs') <- collect [] []
 				=<< catchDefaultIO [] (dirContents dir)
@@ -55,10 +61,33 @@
 	collect files dirs' (entry:entries)
 		| dirCruft entry = collect files dirs' entries
 		| otherwise = do
-			ifM (doesDirectoryExist entry)
-				( collect files (entry:dirs') entries
-				, collect (entry:files) dirs' entries
-				)			
+			let skip = collect (entry:files) dirs' entries
+			let recurse = collect files (entry:dirs') entries
+			ms <- catchMaybeIO $ getSymbolicLinkStatus entry
+			case ms of
+				(Just s) 
+					| isDirectory s -> recurse
+					| isSymbolicLink s && followsubdirsymlinks ->
+						ifM (doesDirectoryExist entry)
+							( recurse
+							, skip
+							)
+				_ -> skip
+
+{- Gets the directory tree from a point, recursively and lazily,
+ - with leaf directories **first**, skipping any whose basenames
+ - match the skipdir. Does not follow symlinks. -}
+dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
+dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
+  where
+  	go c [] = return c
+	go c (dir:dirs)
+		| skipdir (takeFileName dir) = go c dirs
+		| otherwise = unsafeInterleaveIO $ do
+			subdirs <- go c
+				=<< filterM (isDirectory <$$> getSymbolicLinkStatus)
+				=<< catchDefaultIO [] (dirContents dir)
+			go (subdirs++[dir]) dirs
 
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
diff --git a/Utility/Env.hs b/Utility/Env.hs
--- a/Utility/Env.hs
+++ b/Utility/Env.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2013 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
@@ -61,3 +61,21 @@
 #else
 unsetEnv _ = return False
 #endif
+
+{- Adds the environment variable to the input environment. If already
+ - present in the list, removes the old value.
+ -
+ - This does not really belong here, but Data.AssocList is for some reason
+ - buried inside hxt.
+ -}
+addEntry :: Eq k => k -> v -> [(k, v)] -> [(k, v)]
+addEntry k v l = ( (k,v) : ) $! delEntry k l
+
+addEntries :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
+addEntries = foldr (.) id . map (uncurry addEntry) . reverse
+
+delEntry :: Eq k => k -> [(k, v)] -> [(k, v)]
+delEntry _ []   = []
+delEntry k (x@(k1,_) : rest)
+	| k == k1 = rest
+	| otherwise = ( x : ) $! delEntry k rest
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -18,7 +18,7 @@
 
 {- Catches IO errors and returns a Bool -}
 catchBoolIO :: IO Bool -> IO Bool
-catchBoolIO a = catchDefaultIO False a
+catchBoolIO = catchDefaultIO False
 
 {- Catches IO errors and returns a Maybe -}
 catchMaybeIO :: IO a -> IO (Maybe a)
diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
--- a/Utility/FileMode.hs
+++ b/Utility/FileMode.hs
@@ -2,22 +2,25 @@
  -
  - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
 
 module Utility.FileMode where
 
-import Common
-
+import System.IO
+import Control.Monad
 import Control.Exception (bracket)
 import System.PosixCompat.Types
+import Utility.PosixFiles
 #ifndef mingw32_HOST_OS
 import System.Posix.Files
 #endif
 import Foreign (complement)
 
+import Utility.Exception
+
 {- Applies a conversion function to a file's mode. -}
 modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
 modifyFileMode f convert = void $ modifyFileMode' f convert
@@ -56,6 +59,12 @@
 executeModes :: [FileMode]
 executeModes = [ownerExecuteMode, groupExecuteMode, otherExecuteMode]
 
+otherGroupModes :: [FileMode]
+otherGroupModes = 
+	[ groupReadMode, otherReadMode
+	, groupWriteMode, otherWriteMode
+	]
+
 {- Removes the write bits from a file. -}
 preventWrite :: FilePath -> IO ()
 preventWrite f = modifyFileMode f $ removeModes writeModes
@@ -64,13 +73,20 @@
 allowWrite :: FilePath -> IO ()
 allowWrite f = modifyFileMode f $ addModes [ownerWriteMode]
 
+{- Turns a file's owner read bit back on. -}
+allowRead :: FilePath -> IO ()
+allowRead f = modifyFileMode f $ addModes [ownerReadMode]
+
 {- Allows owner and group to read and write to a file. -}
-groupWriteRead :: FilePath -> IO ()
-groupWriteRead f = modifyFileMode f $ addModes
+groupSharedModes :: [FileMode]
+groupSharedModes =
 	[ ownerWriteMode, groupWriteMode
 	, ownerReadMode, groupReadMode
 	]
 
+groupWriteRead :: FilePath -> IO ()
+groupWriteRead f = modifyFileMode f $ addModes groupSharedModes
+
 checkMode :: FileMode -> FileMode -> Bool
 checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor
 
@@ -92,13 +108,20 @@
 #ifndef mingw32_HOST_OS
 noUmask mode a
 	| mode == stdFileMode = a
-	| otherwise = bracket setup cleanup go
+	| otherwise = withUmask nullFileMode a
+#else
+noUmask _ a = a
+#endif
+
+withUmask :: FileMode -> IO a -> IO a
+#ifndef mingw32_HOST_OS
+withUmask umask a = bracket setup cleanup go
   where
-	setup = setFileCreationMask nullFileMode
+	setup = setFileCreationMask umask
 	cleanup = setFileCreationMask
 	go _ = a
 #else
-noUmask _ a = a
+withUmask _ a = a
 #endif
 
 combineModes :: [FileMode] -> FileMode
@@ -120,16 +143,16 @@
 #endif
 
 {- Writes a file, ensuring that its modes do not allow it to be read
- - by anyone other than the current user, before any content is written.
+ - or written by anyone other than the current user,
+ - before any content is written.
  -
+ - When possible, this is done using the umask.
+ -
  - On a filesystem that does not support file permissions, this is the same
  - as writeFile.
  -}
 writeFileProtected :: FilePath -> String -> IO ()
-writeFileProtected file content = do
-	h <- openFile file WriteMode
-	void $ tryIO $
-		modifyFileMode file $
-			removeModes [groupReadMode, otherReadMode]
-	hPutStr h content
-	hClose h
+writeFileProtected file content = withUmask 0o0077 $
+	withFile file WriteMode $ \h -> do
+		void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
+		hPutStr h content
diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs
--- a/Utility/FileSystemEncoding.hs
+++ b/Utility/FileSystemEncoding.hs
@@ -1,14 +1,17 @@
 {- GHC File system encoding handling.
  -
- - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Utility.FileSystemEncoding (
 	fileEncoding,
 	withFilePath,
 	md5FilePath,
+	decodeBS,
 	decodeW8,
 	encodeW8,
 	truncateFilePath,
@@ -22,13 +25,24 @@
 import qualified Data.Hash.MD5 as MD5
 import Data.Word
 import Data.Bits.Utils
+import qualified Data.ByteString.Lazy as L
+#ifdef mingw32_HOST_OS
+import qualified Data.ByteString.Lazy.UTF8 as L8
+#endif
 
 {- Sets a Handle to use the filesystem encoding. This causes data
  - written or read from it to be encoded/decoded the same
  - as ghc 7.4 does to filenames etc. This special encoding
- - allows "arbitrary undecodable bytes to be round-tripped through it". -}
+ - allows "arbitrary undecodable bytes to be round-tripped through it".
+ -}
 fileEncoding :: Handle -> IO ()
+#ifndef mingw32_HOST_OS
 fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
+#else
+{- The file system encoding does not work well on Windows,
+ - and Windows only has utf FilePaths anyway. -}
+fileEncoding h = hSetEncoding h Encoding.utf8
+#endif
 
 {- Marshal a Haskell FilePath into a NUL terminated C string using temporary
  - storage. The FilePath is encoded using the filesystem encoding,
@@ -60,6 +74,16 @@
 md5FilePath :: FilePath -> MD5.Str
 md5FilePath = MD5.Str . _encodeFilePath
 
+{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
+decodeBS :: L.ByteString -> FilePath
+#ifndef mingw32_HOST_OS
+decodeBS = encodeW8 . L.unpack
+#else
+{- On Windows, we assume that the ByteString is utf-8, since Windows
+ - only uses unicode for filenames. -}
+decodeBS = L8.toString
+#endif
+
 {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
  -
  - w82c produces a String, which may contain Chars that are invalid
@@ -84,6 +108,7 @@
  - cost of efficiency when running on a large FilePath.
  -}
 truncateFilePath :: Int -> FilePath -> FilePath
+#ifndef mingw32_HOST_OS
 truncateFilePath n = go . reverse
   where
   	go f =
@@ -91,3 +116,17 @@
 		in if length bytes <= n
 			then reverse f
 			else go (drop 1 f)
+#else
+{- On Windows, count the number of bytes used by each utf8 character. -}
+truncateFilePath n = reverse . go [] n . L8.fromString
+  where
+	go coll cnt bs
+		| cnt <= 0 = coll
+		| otherwise = case L8.decode bs of
+			Just (c, x) | c /= L8.replacement_char ->
+				let x' = fromIntegral x
+				in if cnt - x' < 0
+					then coll
+					else go (c:coll) (cnt - x') (L8.drop 1 bs)
+			_ -> coll
+#endif
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
@@ -15,11 +15,15 @@
 import Data.Char
 import Data.List
 import Control.Applicative
+import System.Exit
 #ifndef mingw32_HOST_OS
 import System.Posix.Process (getAnyProcessStatus)
 import Utility.Exception
 #endif
 
+import Utility.FileSystemEncoding
+import Utility.Monad
+
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
 hGetContentsStrict :: Handle -> IO String
@@ -29,7 +33,21 @@
 readFileStrict :: FilePath -> IO String
 readFileStrict = readFile >=> \s -> length s `seq` return s
 
-{- Like break, but the character matching the condition is not included
+{-  Reads a file strictly, and using the FileSystemEncoding, so it will
+ -  never crash on a badly encoded file. -}
+readFileStrictAnyEncoding :: FilePath -> IO String
+readFileStrictAnyEncoding f = withFile f ReadMode $ \h -> do
+	fileEncoding h
+	hClose h `after` hGetContentsStrict h
+
+{- Writes a file, using the FileSystemEncoding so it will never crash
+ - on a badly encoded content string. -}
+writeFileAnyEncoding :: FilePath -> String -> IO ()
+writeFileAnyEncoding f content = withFile f WriteMode $ \h -> do
+	fileEncoding h
+	hPutStr h content
+
+{- Like break, but the item matching the condition is not included
  - in the second result list.
  -
  - separate (== ':') "foo:bar" = ("foo", "bar")
@@ -91,18 +109,6 @@
 			go (replacement:acc) vs (drop (length val) s)
 		| otherwise = go acc rest s
 
-{- Given two orderings, returns the second if the first is EQ and returns
- - the first otherwise.
- -
- - Example use:
- -
- - compare lname1 lname2 `thenOrd` compare fname1 fname2
- -}
-thenOrd :: Ordering -> Ordering -> Ordering
-thenOrd EQ x = x
-thenOrd x _ = x
-{-# INLINE thenOrd #-}
-
 {- Wrapper around hGetBufSome that returns a String.
  -
  - The null string is returned on eof, otherwise returns whatever
@@ -136,3 +142,7 @@
 #else
 reapZombies = return ()
 #endif
+
+exitBool :: Bool -> IO a
+exitBool False = exitFailure
+exitBool True = exitSuccess
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
--- a/Utility/Monad.hs
+++ b/Utility/Monad.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 module Utility.Monad where
diff --git a/Utility/Path.hs b/Utility/Path.hs
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -1,8 +1,8 @@
 {- path manipulation
  -
- - 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.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE PackageImports, CPP #-}
@@ -18,31 +18,62 @@
 import Control.Applicative
 
 #ifdef mingw32_HOST_OS
-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
 
-{- Makes a path absolute if it's not already.
+{- Simplifies a path, removing any ".." or ".", and removing the trailing
+ - path separator.
+ -
+ - On Windows, preserves whichever style of path separator might be used in
+ - the input FilePaths. This is done because some programs in Windows
+ - demand a particular path separator -- and which one actually varies!
+ -
+ - This does not guarantee that two paths that refer to the same location,
+ - and are both relative to the same location (or both absolute) will
+ - yeild the same result. Run both through normalise from System.FilePath
+ - to ensure that.
+ -}
+simplifyPath :: FilePath -> FilePath
+simplifyPath path = dropTrailingPathSeparator $ 
+	joinDrive drive $ joinPath $ norm [] $ splitPath path'
+  where
+	(drive, path') = splitDrive path
+
+	norm c [] = reverse c
+	norm c (p:ps)
+		| p' == ".." = norm (drop 1 c) ps
+		| p' == "." = norm c ps
+		| otherwise = norm (p:c) ps
+	  where
+		p' = dropTrailingPathSeparator p
+
+{- Makes a path absolute.
+ -
  - The first parameter is a base directory (ie, the cwd) to use if the path
  - is not already absolute.
  -
- - On Unix, collapses and normalizes ".." etc in the path. May return Nothing
- - if the path cannot be normalized.
- -
- - MissingH's absNormPath does not work on Windows, so on Windows
- - no normalization is done.
+ - Does not attempt to deal with edge cases or ensure security with
+ - untrusted inputs.
  -}
-absNormPath :: FilePath -> FilePath -> Maybe FilePath
+absPathFrom :: FilePath -> FilePath -> FilePath
+absPathFrom dir path = simplifyPath (combine dir path)
+
+{- On Windows, this converts the paths to unix-style, in order to run
+ - MissingH's absNormPath on them. Resulting path will use / separators. -}
+absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath
 #ifndef mingw32_HOST_OS
-absNormPath dir path = MissingH.absNormPath dir path
+absNormPathUnix dir path = MissingH.absNormPath dir path
 #else
-absNormPath dir path = Just $ combine dir path
+absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos path)
+  where
+	fromdos = replace "\\" "/"
+	todos = replace "/" "\\"
 #endif
 
 {- Returns the parent directory of a path.
@@ -72,13 +103,13 @@
  - are all equivilant.
  -}
 dirContains :: FilePath -> FilePath -> Bool
-dirContains a b = a == b || a' == b' || (a'++[pathSeparator]) `isPrefixOf` b'
+dirContains a b = a == b || a' == b' || (addTrailingPathSeparator a') `isPrefixOf` b'
   where
-	norm p = fromMaybe "" $ absNormPath p "."
 	a' = norm a
 	b' = norm b
+	norm = normalise . simplifyPath
 
-{- Converts a filename into a normalized, absolute path.
+{- Converts a filename into an absolute path.
  -
  - Unlike Directory.canonicalizePath, this does not require the path
  - already exists. -}
@@ -87,13 +118,6 @@
 	cwd <- getCurrentDirectory
 	return $ absPathFrom cwd file
 
-{- Converts a filename into a normalized, absolute path
- - from the specified cwd. -}
-absPathFrom :: FilePath -> FilePath -> FilePath
-absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
-  where
-	bad = error $ "unable to normalize " ++ file
-
 {- Constructs a relative path from the CWD to a file.
  -
  - For example, assuming CWD is /tmp/foo/bar:
@@ -105,7 +129,7 @@
 
 {- Constructs a relative path from a directory to a file.
  -
- - Both must be absolute, and normalized (eg with absNormpath).
+ - Both must be absolute, and cannot contain .. etc. (eg use absPath first).
  -}
 relPathDirToFile :: FilePath -> FilePath -> FilePath
 relPathDirToFile from to = join s $ dotdots ++ uncommon
@@ -242,13 +266,28 @@
  - was provided by a third party and is not to be trusted, returns the closest
  - sane FilePath.
  -
- - All spaces and punctuation are replaced with '_', except for '.'
- - "../" will thus turn into ".._", which is safe.
+ - All spaces and punctuation and other wacky stuff are replaced
+ - with '_', except for '.' "../" will thus turn into ".._", which is safe.
  -}
 sanitizeFilePath :: String -> FilePath
 sanitizeFilePath = map sanitize
   where
   	sanitize c
 		| c == '.' = c
-		| isSpace c || isPunctuation c || c == '/' = '_'
+		| isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_'
 		| otherwise = c
+
+{- Similar to splitExtensions, but knows that some things in FilePaths
+ - after a dot are too long to be extensions. -}
+splitShortExtensions :: FilePath -> (FilePath, [String])
+splitShortExtensions = splitShortExtensions' 5 -- enough for ".jpeg"
+splitShortExtensions' :: Int -> FilePath -> (FilePath, [String])
+splitShortExtensions' maxextension = go []
+  where
+	go c f
+		| len > 0 && len <= maxextension && not (null base) = 
+			go (ext:c) base
+		| otherwise = (f, c)
+	  where
+		(base, ext) = splitExtension f
+		len = length ext
diff --git a/Utility/PosixFiles.hs b/Utility/PosixFiles.hs
new file mode 100644
--- /dev/null
+++ b/Utility/PosixFiles.hs
@@ -0,0 +1,33 @@
+{- POSIX files (and compatablity wrappers).
+ -
+ - This is like System.PosixCompat.Files, except with a fixed rename.
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.PosixFiles (
+	module X,
+	rename
+) where
+
+import System.PosixCompat.Files as X hiding (rename)
+
+#ifndef mingw32_HOST_OS
+import System.Posix.Files (rename)
+#else
+import qualified System.Win32.File as Win32
+#endif
+
+{- System.PosixCompat.Files.rename on Windows calls renameFile,
+ - so cannot rename directories. 
+ -
+ - Instead, use Win32 moveFile, which can. It needs to be told to overwrite
+ - any existing file. -}
+#ifdef mingw32_HOST_OS
+rename :: FilePath -> FilePath -> IO ()
+rename src dest = Win32.moveFileEx src dest Win32.mOVEFILE_REPLACE_EXISTING
+#endif
diff --git a/Utility/Process.hs b/Utility/Process.hs
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -3,14 +3,14 @@
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP, Rank2Types #-}
 
 module Utility.Process (
 	module X,
-	CreateProcess,
+	CreateProcess(..),
 	StdHandle(..),
 	readProcess,
 	readProcessEnv,
@@ -22,15 +22,17 @@
 	createProcessChecked,
 	createBackgroundProcess,
 	processTranscript,
+	processTranscript',
 	withHandle,
 	withBothHandles,
 	withQuietOutput,
-	withNullHandle,
 	createProcess,
 	startInteractiveProcess,
 	stdinHandle,
 	stdoutHandle,
 	stderrHandle,
+	processHandle,
+	devNull,
 ) where
 
 import qualified System.Process
@@ -44,8 +46,10 @@
 import Control.Monad
 #ifndef mingw32_HOST_OS
 import System.Posix.IO
-import Data.Maybe
+#else
+import Control.Applicative
 #endif
+import Data.Maybe
 
 import Utility.Misc
 import Utility.Exception
@@ -72,17 +76,17 @@
 		, env = environ
 		}
 
-{- Writes a string to a process on its stdin, 
+{- Runs an action to write to a process on its stdin, 
  - returns its output, and also allows specifying the environment.
  -}
 writeReadProcessEnv
 	:: FilePath
 	-> [String]
 	-> Maybe [(String, String)]
-	-> String
 	-> (Maybe (Handle -> IO ()))
+	-> (Maybe (Handle -> IO ()))
 	-> IO String
-writeReadProcessEnv cmd args environ input adjusthandle = do
+writeReadProcessEnv cmd args environ writestdin adjusthandle = do
 	(Just inh, Just outh, _, pid) <- createProcess p
 
 	maybe (return ()) (\a -> a inh) adjusthandle
@@ -94,7 +98,7 @@
 	_ <- forkIO $ E.evaluate (length output) >> putMVar outMVar ()
 
 	-- now write and flush any input
-	when (not (null input)) $ do hPutStr inh input; hFlush inh
+	maybe (return ()) (\a -> a inh >> hFlush inh) writestdin
 	hClose inh -- done with stdin
 
 	-- wait on the output
@@ -160,8 +164,13 @@
  - returns a transcript combining its stdout and stderr, and
  - whether it succeeded or failed. -}
 processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
+processTranscript cmd opts input = processTranscript' cmd opts Nothing input
+
+processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)
+processTranscript' cmd opts environ input = do
 #ifndef mingw32_HOST_OS
-processTranscript cmd opts input = do
+{- This implementation interleves stdout and stderr in exactly the order
+ - the process writes them. -}
 	(readf, writef) <- createPipe
 	readh <- fdToHandle readf
 	writeh <- fdToHandle writef
@@ -170,34 +179,53 @@
 			{ std_in = if isJust input then CreatePipe else Inherit
 			, std_out = UseHandle writeh
 			, std_err = UseHandle writeh
+			, env = environ
 			}
 	hClose writeh
 
-	-- fork off a thread to start consuming the output
-	transcript <- hGetContents readh
-	outMVar <- newEmptyMVar
-	_ <- forkIO $ E.evaluate (length transcript) >> putMVar outMVar ()
+	get <- mkreader readh
+	writeinput input p
+	transcript <- get
 
-	-- now write and flush any input
-	case input of
-		Just s -> do
-			let inh = stdinHandle p
-			unless (null s) $ do
-				hPutStr inh s
-				hFlush inh
-			hClose inh
-		Nothing -> return ()
+	ok <- checkSuccessProcess pid
+	return (transcript, ok)
+#else
+{- This implementation for Windows puts stderr after stdout. -}
+	p@(_, _, _, pid) <- createProcess $
+		(proc cmd opts)
+			{ std_in = if isJust input then CreatePipe else Inherit
+			, std_out = CreatePipe
+			, std_err = CreatePipe
+			, env = environ
+			}
 
-	-- wait on the output
-	takeMVar outMVar
-	hClose readh
+	getout <- mkreader (stdoutHandle p)
+	geterr <- mkreader (stderrHandle p)
+	writeinput input p
+	transcript <- (++) <$> getout <*> geterr
 
 	ok <- checkSuccessProcess pid
 	return (transcript, ok)
-#else
-processTranscript = error "processTranscript TODO"
 #endif
+  where
+	mkreader h = do
+		s <- hGetContents h
+		v <- newEmptyMVar
+		void $ forkIO $ do
+			void $ E.evaluate (length s)
+			putMVar v ()
+		return $ do
+			takeMVar v
+			return s
 
+	writeinput (Just s) p = do
+		let inh = stdinHandle p
+		unless (null s) $ do
+			hPutStr inh s
+			hFlush inh
+		hClose inh
+	writeinput Nothing _ = return ()
+
 {- Runs a CreateProcessRunner, on a CreateProcess structure, that
  - is adjusted to pipe only from/to a single StdHandle, and passes
  - the resulting Handle to an action. -}
@@ -242,20 +270,18 @@
 	:: CreateProcessRunner
 	-> CreateProcess
 	-> IO ()
-withQuietOutput creator p = withNullHandle $ \nullh -> do
+withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
 	let p' = p
 		{ std_out = UseHandle nullh
 		, std_err = UseHandle nullh
 		}
 	creator p' $ const $ return ()
 
-withNullHandle :: (Handle -> IO a) -> IO a
-withNullHandle = withFile devnull WriteMode
-  where
+devNull :: FilePath
 #ifndef mingw32_HOST_OS
-	devnull = "/dev/null"
+devNull = "/dev/null"
 #else
-	devnull = "NUL"
+devNull = "NUL"
 #endif
 
 {- Extract a desired handle from createProcess's tuple.
@@ -276,6 +302,9 @@
 bothHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
 bothHandles (Just hin, Just hout, _, _) = (hin, hout)
 bothHandles _ = error "expected bothHandles"
+
+processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
+processHandle (_, _, _, pid) = pid
 
 {- Debugging trace for a CreateProcess. -}
 debugProcess :: CreateProcess -> IO ()
diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs
--- a/Utility/SafeCommand.hs
+++ b/Utility/SafeCommand.hs
@@ -2,14 +2,13 @@
  -
  - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 module Utility.SafeCommand where
 
 import System.Exit
 import Utility.Process
-import System.Process (env)
 import Data.String.Utils
 import Control.Applicative
 import System.FilePath
diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -2,19 +2,22 @@
  -
  - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Utility.Tmp where
 
 import Control.Exception (bracket)
 import System.IO
 import System.Directory
 import Control.Monad.IfElse
+import System.FilePath
 
 import Utility.Exception
-import System.FilePath
 import Utility.FileSystemEncoding
+import Utility.PosixFiles
 
 type Template = String
 
@@ -22,13 +25,20 @@
  - then moving it into place. The temp file is stored in the same
  - directory as the final file to avoid cross-device renames. -}
 viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
-viaTmp a file content = do
-	let (dir, base) = splitFileName file
-	createDirectoryIfMissing True dir
-	(tmpfile, handle) <- openTempFile dir (base ++ ".tmp")
-	hClose handle
-	a tmpfile content
-	renameFile tmpfile file
+viaTmp a file content = bracket setup cleanup use
+  where
+	(dir, base) = splitFileName file
+	template = base ++ ".tmp"
+	setup = do
+		createDirectoryIfMissing True dir
+		openTempFile dir template
+	cleanup (tmpfile, handle) = do
+		_ <- tryIO $ hClose handle
+		tryIO $ removeFile tmpfile
+	use (tmpfile, handle) = do
+		hClose handle
+		a tmpfile content
+		rename tmpfile file
 
 {- Runs an action with a tmp file located in the system's tmp directory
  - (or in "." if there is none) then removes the file. -}
@@ -61,8 +71,17 @@
 withTmpDirIn :: FilePath -> Template -> (FilePath -> IO a) -> IO a
 withTmpDirIn tmpdir template = bracket create remove
   where
-	remove d = whenM (doesDirectoryExist d) $
+	remove d = whenM (doesDirectoryExist d) $ do
+#if mingw32_HOST_OS
+		-- Windows will often refuse to delete a file
+		-- after a process has just written to it and exited.
+		-- Because it's crap, presumably. So, ignore failure
+		-- to delete the temp directory.
+		_ <- tryIO $ removeDirectoryRecursive d
+		return ()
+#else
 		removeDirectoryRecursive d
+#endif
 	create = do
 		createDirectoryIfMissing True tmpdir
 		makenewdir (tmpdir </> template) (0 :: Int)
diff --git a/Utility/URI.hs b/Utility/URI.hs
new file mode 100644
--- /dev/null
+++ b/Utility/URI.hs
@@ -0,0 +1,18 @@
+{- Network.URI
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - 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
diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs
--- a/Utility/UserInfo.hs
+++ b/Utility/UserInfo.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
diff --git a/debian/changelog b/debian/changelog
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,22 @@
+github-backup (1.20140707) unstable; urgency=medium
+
+  * Add --exclude to skip backing up a specific repository
+    when backing up a user or organization's repositories.
+    Closes: #754072
+  * Converted to using optparse-applicative.
+  * Multiple usernames can now be specified to back up at once.
+
+ -- Joey Hess <joeyh@debian.org>  Mon, 07 Jul 2014 23:01:03 -0400
+
+github-backup (1.20140704) unstable; urgency=medium
+
+  * Avoid making signed commits when committing to the github-backup branch
+    and the user has commit.gpgsign=true.
+    Closes: #753720
+  * Various updates to internal git and utility libraries shared with git-annex.
+
+ -- Joey Hess <joeyh@debian.org>  Fri, 04 Jul 2014 12:01:11 -0400
+
 github-backup (1.20131203) unstable; urgency=low
 
   * Now also backs up the repos a user has starred, when run with a user's
diff --git a/debian/control b/debian/control
--- a/debian/control
+++ b/debian/control
@@ -11,9 +11,10 @@
 	libghc-pretty-show-dev,
 	libghc-ifelse-dev,
 	libghc-extensible-exceptions-dev,
-	libghc-unix-compat-dev
+	libghc-unix-compat-dev,
+	libghc-optparse-applicative-dev
 Maintainer: Joey Hess <joeyh@debian.org>
-Standards-Version: 3.9.4
+Standards-Version: 3.9.5
 Vcs-Git: git://github.com/joeyh/github-backup.git
 Homepage: http://github.com/joeyh/github-backup
 
diff --git a/debian/copyright b/debian/copyright
--- a/debian/copyright
+++ b/debian/copyright
@@ -7,3 +7,29 @@
  The full text of version 3 of the GPL is distributed as doc/GPL in
  this package's source, or in /usr/share/common-licenses/GPL-3 on
  Debian systems.
+
+Files: Utility/*
+Copyright: 2012-2014 Joey Hess <joey@kitenet.net>
+License: BSD-2-clause
+
+License: BSD-2-clause
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in the
+    documentation and/or other materials provided with the distribution.
+ .
+ THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
diff --git a/github-backup.1 b/github-backup.1
--- a/github-backup.1
+++ b/github-backup.1
@@ -3,7 +3,7 @@
 .SH NAME
 github-backup \- backs up data from GitHub
 .SH SYNOPSIS
-.B github-backup [\fIusername\fP|\fIorganization\fP]
+.B github-backup [\fIusername\fP|\fIorganization\fP ...] [--exclude=username/repository ...]
 .SH DESCRIPTION
 .I github-backup
 is a simple tool you run in a git repository you cloned from
@@ -18,7 +18,7 @@
 .PP
 By default it runs without logging in to GitHub. To log in, set
 GITHUB_USER and GITHUB_PASSWORD environment variables. However note that
-this only works around API rate limiting, it does not allow private
+this only works around API rate limiting; it does not allow private
 repositories to be downloaded.
 .SH AUTHOR 
 Joey Hess <joey@kitenet.net>
diff --git a/github-backup.cabal b/github-backup.cabal
--- a/github-backup.cabal
+++ b/github-backup.cabal
@@ -1,5 +1,5 @@
 Name: github-backup
-Version: 1.20131203
+Version: 1.20140707
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>
@@ -21,7 +21,9 @@
   GHC-Options: -Wall
   Build-Depends: MissingH, hslogger, directory, filepath, containers, mtl,
    network, extensible-exceptions, unix-compat, bytestring,
-   base >= 4.5, base < 5, IfElse, pretty-show, text, process, github >= 0.7.2
+   IfElse, pretty-show, text, process, optparse-applicative,
+   github >= 0.7.2,
+   base >= 4.5, base < 5
 
   if (! os(windows))
     Build-Depends: unix
diff --git a/github-backup.hs b/github-backup.hs
--- a/github-backup.hs
+++ b/github-backup.hs
@@ -16,11 +16,10 @@
 import Data.Text.Encoding (encodeUtf8)
 import Data.Either
 import Data.Monoid
-import System.Environment (getArgs)
+import Options.Applicative
 import Control.Exception (try, SomeException)
 import Text.Show.Pretty
 import "mtl" Control.Monad.State.Strict
-import qualified Github.Data.Readable as Github
 import qualified Github.Repos as Github
 import qualified Github.Repos.Forks as Github
 import qualified Github.PullRequests as Github
@@ -353,7 +352,7 @@
 					[genstream dir h]
 				hashObjectStop h
 				-- Commit
-				void $ Git.Branch.commit "github-backup" fullname [branchref] r
+				void $ Git.Branch.commit Git.Branch.AutomaticCommit False "github-backup" fullname [branchref] r
 				removeDirectoryRecursive dir
   where
   	genstream dir h streamer = do
@@ -374,7 +373,7 @@
 		fromMaybe (error $ "failed to create " ++ show branchname)
 			<$> branchsha
 	create False = withIndex $
-		inRepo $ Git.Branch.commit "branch created" fullname []
+		inRepo $ Git.Branch.commitAlways Git.Branch.AutomaticCommit "branch created" fullname []
 	branchsha = inRepo $ Git.Ref.sha fullname
 
 {- Runs an action with a different index file, used for the github branch. -}
@@ -580,8 +579,8 @@
 		-- more actions to be deferred; run them too.
 		runDeferred
 
-backupName :: String -> IO ()
-backupName name = do
+backupOwner :: [GithubUserRepo] -> Owner -> IO ()
+backupOwner exclude (Owner name) = do
 	auth <- getAuth
 	l <- sequence
 	 	[ Github.userRepos' auth name Github.All
@@ -596,16 +595,7 @@
 			else error $ "No GitHub repositories found for " ++ name
 	-- Clone any missing repos, and get a BackupState for each repo
 	-- that is to be backed up.
-	states <- forM nameurls $ \(dir, url) -> do
-		unlessM (doesDirectoryExist dir) $ do
-			putStrLn $ "New repository: " ++ dir
-			ok <- boolSystem "git"
-				[ Param "clone"
-				, Param url
-				, Param dir
-				]
-			unless ok $ error "clone failed"
-		genBackupState =<< Git.Construct.fromPath dir
+	states <- catMaybes <$> forM nameurls prepare
 	-- First pass only retries things that failed before, so the
 	-- retried actions will run in each repo before too much API is
 	-- used up.
@@ -613,15 +603,62 @@
 	states'' <- forM states' (execStateT . runBackup $ mainBackup)
 	forM states'' (evalStateT . runBackup $ runDeferred >> save)
 		>>= showFailures . concat
+  where
+	excludeurls = map repoUrl exclude
+	prepare (dir, url)
+		| url `elem` excludeurls = return Nothing
+		| otherwise = do
+			print url
+			unlessM (doesDirectoryExist dir) $ do
+				putStrLn $ "New repository: " ++ dir
+				ok <- boolSystem "git"
+					[ Param "clone"
+					, Param url
+					, Param dir
+					]
+				unless ok $ error "clone failed"
+			Just <$> (genBackupState =<< Git.Construct.fromPath dir)
 
-usage :: String
-usage = "usage: github-backup [username|organization]"
+data Options = Options
+	{ includeOwner :: [Owner]
+	, excludeRepo :: [GithubUserRepo]
+	}
+	deriving (Show)
 
-main :: IO ()
-main = getArgs >>= go
+data Owner = Owner String
+	deriving (Show)
+
+options :: Parser Options
+options = Options <$> many owneropt <*> many excludeopt
   where
-	go (('-':_):_) = error usage
-	go [] = backupRepo =<< Git.Construct.fromCwd
-	go (name:[]) = backupName name
-	go _= error usage
+	owneropt = (argument (Just . Owner))
+		( metavar "USERNAME|ORGANIZATION"
+		<> help "Back up repositories owned by this entity."
+		)
+	excludeopt = parseUserRepo <$> (strOption
+		( long "exclude"
+		<> metavar "USERNAME/REPOSITORY"
+		<> help "Skip backing up a repository."
+		))
 
+parseUserRepo :: String -> GithubUserRepo
+parseUserRepo s =
+	let (user, repo) = separate (== '/') s
+	in GithubUserRepo user repo
+
+main :: IO ()
+main = execParser opts >>= go
+  where
+	opts = info (helper <*> options)
+		( fullDesc
+		<> progDesc desc
+		<> header "github-backup - backs up data from GitHub"
+		)
+	desc = unlines
+		[ "Backs up all forks, issues, etc of a GitHub repository."
+		, "Run without any parameters inside a clone of a repository to back it up."
+		, "Or, specify whose repositories to back up."
+		]
+	go (Options owner exclude)
+		| null owner = backupRepo =<< Git.Construct.fromCwd
+		| otherwise = mapM_ (backupOwner exclude) owner