packages feed

github-backup 1.20131101 → 1.20131203

raw patch · 11 files changed

+339/−142 lines, 11 filesdep ~githubsetup-changed

Dependency ranges changed: github

Files

+ Build/make-sdist.sh view
@@ -0,0 +1,21 @@+#!/bin/sh+#+# Workaround for `cabal sdist` requiring all included files to be listed+# in .cabal.++# Create target directory+sdist_dir=github-backup-$(grep '^Version:' github-backup.cabal | sed -re 's/Version: *//')+mkdir --parents dist/$sdist_dir++find . \( -name .git -or -name dist -or -name cabal-dev \) -prune \+	-or -not -name \\*.orig -not -type d -print \+| perl -ne "print unless length >= 100 - length q{$sdist_dir}" \+| xargs cp --parents --target-directory dist/$sdist_dir++cd dist+tar -caf $sdist_dir.tar.gz $sdist_dir++# Check that tarball can be unpacked by cabal.+# It's picky about tar longlinks etc.+rm -rf $sdist_dir+cabal unpack $sdist_dir.tar.gz
+ Git/CatFile.hs view
@@ -0,0 +1,108 @@+{- git cat-file interface+ -+ - Copyright 2011, 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Git.CatFile (+	CatFileHandle,+	catFileStart,+	catFileStart',+	catFileStop,+	catFile,+	catTree,+	catObject,+	catObjectDetails,+) where++import System.IO+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import Data.Tuple.Utils+import Numeric+import System.Posix.Types++import Common+import Git+import Git.Sha+import Git.Command+import Git.Types+import Git.FilePath+import qualified Utility.CoProcess as CoProcess++data CatFileHandle = CatFileHandle CoProcess.CoProcessHandle Repo++catFileStart :: Repo -> IO CatFileHandle+catFileStart = catFileStart' True++catFileStart' :: Bool -> Repo -> IO CatFileHandle+catFileStart' restartable repo = do+	coprocess <- CoProcess.rawMode =<< gitCoProcessStart restartable+		[ Param "cat-file"+		, Param "--batch"+		] repo+	return $ CatFileHandle coprocess repo++catFileStop :: CatFileHandle -> IO ()+catFileStop (CatFileHandle p _) = CoProcess.stop p++{- 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++{- 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+catObject h object = maybe L.empty fst3 <$> catObjectDetails h object++catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha, ObjectType))+catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive+  where+	query = show object+	send to = hPutStrLn to query+	receive from = do+		header <- hGetLine from+		case words header of+			[sha, objtype, size]+				| length sha == shaSize ->+					case (readObjectType objtype, reads size) of+						(Just t, [(bytes, "")]) -> readcontent t bytes from sha+						_ -> dne+				| otherwise -> dne+			_+				| header == show object ++ " missing" -> dne+				| otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)+	readcontent objtype bytes from sha = do+		content <- S.hGet from bytes+		eatchar '\n' from+		return $ Just (L.fromChunks [content], Ref sha, objtype)+	dne = return Nothing+	eatchar expected from = do+		c <- hGetChar from+		when (c /= expected) $+			error $ "missing " ++ (show expected) ++ " from git cat-file"++{- Gets a list of files and directories in a tree. (Not recursive.) -}+catTree :: CatFileHandle -> Ref -> IO [(FilePath, FileMode)]+catTree h treeref = go <$> catObjectDetails h treeref+  where+	go (Just (b, _, TreeObject)) = parsetree [] b+  	go _ = []++	parsetree c b = case L.break (== 0) b of+		(modefile, rest)+			| L.null modefile -> c+			| otherwise -> parsetree+				(parsemodefile modefile:c)+				(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 (== ' ') (encodeW8 $ L.unpack b)+		in (file, readmode modestr)+	readmode = fst . fromMaybe (0, undefined) . headMaybe . readOct
Github/Data/Readable.hs view
@@ -11,3 +11,4 @@ deriving instance Read GithubDate deriving instance Read GithubOwner deriving instance Read Repo+deriving instance Read RepoRef
Makefile view
@@ -23,7 +23,7 @@  # Upload to hackage. hackage: clean-	./make-sdist.sh+	./Build/make-sdist.sh 	@cabal upload dist/*.tar.gz  # hothasktags chokes on some template haskell etc, so ignore errors
README.md view
@@ -1,7 +1,7 @@ github-backup is a simple tool you run in a git repository you cloned from GitHub. It backs up everything GitHub publishes about the repository, including branches, tags, other forks, issues, comments, wikis, milestones,-pull requests, and watchers.+pull requests, watchers, and stars.  ## Installation @@ -22,10 +22,9 @@   Run `github-backup` with no parameters, inside a git repository cloned   from GitHub to back up that repository. -  Or, run `github-backup username` to clone and back up all of a GitHub-  user's repositories, as well as all the repositories watched by that-  user.  -  (Also works for organization names.)+  Or, if you have a GitHub account, run `github-backup username`+  to clone and back up your account's repositories, as well+  as the repositories you're watching and have starred.  ## Why backup GitHub repositories @@ -37,7 +36,7 @@  * In case someone takes down a repository that you were interested in.   If you run github-backup with your username, it will back up all -  the repositories you have watched.+  the repositories you have watched and starred.  * So you can keep working on your repository while on a plane, or   on a remote beach or mountaintop. Just like Linus intended.@@ -68,12 +67,6 @@  github-backup does not log into GitHub, so it cannot backup private repositories.--github-backup will find and backup forks of a repository, and all forks-of those forks, etc. However, it cannot go *up* the fork tree. So if-your GitHub repositoriy is a fork of something else, the something else-won't be backed up. There is an easy solution though. Just add the-parent as a git remote. Then github-backup will find it, and back it up.  Notes added to commits and lines of code don't get backed up yet. There is only recently API support for this.
Setup.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE NamedFieldPuns #-}- {- cabal setup file -}  import Distribution.Simple
debian/changelog view
@@ -1,3 +1,17 @@+github-backup (1.20131203) unstable; urgency=low++  * Now also backs up the repos a user has starred, when run with a user's+    name.+  * Now finds and backs up the parent repository that a repository got forked+    from.+  * Uses authentication for all API calls.+  * Fairer ordering of requests when backing up many repositories at once.+  * Avoid making requests for data that has already been backed up until+    after new data has been backed up. Handles API rate limiting much better.+    Closes: #723859++ -- Joey Hess <joeyh@debian.org>  Tue, 03 Dec 2013 12:45:18 -0400+ github-backup (1.20131101) unstable; urgency=low    * Now also backs up the repos a user is watching, when run with a user's
debian/control view
@@ -5,7 +5,7 @@ 	debhelper (>= 9), 	ghc, 	git,-	libghc-github-dev (>= 0.5.1),+	libghc-github-dev (>= 0.7.2), 	libghc-missingh-dev, 	libghc-hslogger-dev, 	libghc-pretty-show-dev,
github-backup.cabal view
@@ -1,5 +1,5 @@ Name: github-backup-Version: 1.20131101+Version: 1.20131203 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -18,9 +18,10 @@  Executable github-backup   Main-Is: github-backup.hs+  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.6.0+   base >= 4.5, base < 5, IfElse, pretty-show, text, process, github >= 0.7.2    if (! os(windows))     Build-Depends: unix
github-backup.hs view
@@ -25,6 +25,7 @@ import qualified Github.Repos.Forks as Github import qualified Github.PullRequests as Github import qualified Github.Repos.Watching as Github+import qualified Github.Repos.Starring as Github import qualified Github.Data.Definitions as Github () import qualified Github.Issues as Github import qualified Github.Issues.Comments@@ -42,17 +43,25 @@ import qualified Git.UpdateIndex import Git.HashObject import Git.FilePath+import Git.CatFile import Utility.Env  -- A github user and repo. data GithubUserRepo = GithubUserRepo String String 	deriving (Eq, Show, Read, Ord) -toGithubUserRepo :: Github.Repo -> GithubUserRepo-toGithubUserRepo r = GithubUserRepo -	(Github.githubOwnerLogin $ Github.repoOwner r)-	(Github.repoName r)+class ToGithubUserRepo a where+	toGithubUserRepo :: a -> GithubUserRepo +instance ToGithubUserRepo Github.Repo where+	toGithubUserRepo r = GithubUserRepo +		(Github.githubOwnerLogin $ Github.repoOwner r)+		(Github.repoName r)++instance ToGithubUserRepo Github.RepoRef where+	toGithubUserRepo (Github.RepoRef owner name) = +		GithubUserRepo (Github.githubOwnerLogin owner) name+ repoUrl :: GithubUserRepo -> String repoUrl (GithubUserRepo user remote) = 	"git://github.com/" ++ user ++ "/" ++ remote ++ ".git"@@ -80,8 +89,11 @@ data BackupState = BackupState 	{ failedRequests :: S.Set Request 	, retriedRequests :: S.Set Request+	, retriedFailed :: S.Set Request 	, gitRepo :: Git.Repo 	, gitHubAuth :: Maybe Github.GithubAuth+	, deferredBackups :: [Backup ()]+	, catFileHandle :: Maybe CatFileHandle 	}  {- Our monad. -}@@ -97,7 +109,7 @@ inRepo :: (Git.Repo -> IO a) -> Backup a inRepo a = liftIO . a =<< getState gitRepo -failedRequest :: Request -> Github.Error-> Backup ()+failedRequest :: Request -> Github.Error -> Backup () failedRequest req e = unless ignorable $ do 	set <- getState failedRequests 	changeState $ \s -> s { failedRequests = S.insert req set }@@ -115,15 +127,16 @@ type Storer = Request -> Backup () data ApiListItem = ApiListItem ApiName Storer Bool apiList :: [ApiListItem]-apiList = -	[ ApiListItem "userrepo" userrepoStore True-	, ApiListItem "watchers" watchersStore True+apiList =+	[ ApiListItem "watchers" watchersStore True+	, ApiListItem "stargazers" stargazersStore True 	, ApiListItem "pullrequests" pullrequestsStore True 	, ApiListItem "pullrequest" pullrequestStore False 	, ApiListItem "milestones" milestonesStore True 	, ApiListItem "issues" issuesStore True 	, ApiListItem "issuecomments" issuecommentsStore False-	-- comes last because it recurses on to the forks+	-- Recursive things last.+	, ApiListItem "userrepo" userrepoStore True 	, ApiListItem "forks" forksStore True 	] @@ -131,7 +144,7 @@ api :: M.Map ApiName Storer api = M.fromList $ map (\(ApiListItem n s _) -> (n, s)) apiList -{- List of toplevel api calls that are followed to get all data. -}+{- List of toplevel api calls that are followed to get data. -} toplevelApi :: [ApiName] toplevelApi = map (\(ApiListItem n _ _) -> n) $ 	filter (\(ApiListItem _ _ toplevel) -> toplevel) apiList@@ -142,35 +155,33 @@ 	name = requestName req 	bad = error $ "internal error: bad api call: " ++ name -userrepoStore :: Storer-userrepoStore = simpleHelper (noAuth Github.userRepo) $ \req r -> do-	when (Github.repoHasWiki r == Just True) $-		updateWiki $ toGithubUserRepo r-	store "repo" req r- watchersStore :: Storer-watchersStore = simpleHelper (noAuth Github.watchersFor) $+watchersStore = simpleHelper "watchers" Github.watchersFor' $ 	storeSorted "watchers" +stargazersStore :: Storer+stargazersStore = simpleHelper "stargazers" Github.stargazersFor $+	storeSorted "stargazers"+ pullrequestsStore :: Storer-pullrequestsStore = simpleHelper Github.pullRequestsFor' $+pullrequestsStore = simpleHelper "pullrequest" Github.pullRequestsFor' $ 	forValues $ \req r -> do 		let repo = requestRepo req 		let n = Github.pullRequestNumber r 		runRequest $ RequestNum "pullrequest" repo n  pullrequestStore :: Storer-pullrequestStore = numHelper Github.pullRequest' $ \n ->+pullrequestStore = numHelper "pullrequest" Github.pullRequest' $ \n -> 	store ("pullrequest" </> show n)  milestonesStore :: Storer-milestonesStore = simpleHelper Github.Issues.Milestones.milestones' $+milestonesStore = simpleHelper "milestone" Github.Issues.Milestones.milestones' $ 	forValues $ \req m -> do 		let n = Github.milestoneNumber m 		store ("milestone" </> show n) req m  issuesStore :: Storer-issuesStore = withHelper (\a u r y ->+issuesStore = withHelper "issue" (\a u r y -> 	Github.issuesForRepo' a u r (y <> [Github.Open]) 		>>= either (return . Left) 			(\xs -> Github.issuesForRepo' a u r@@ -186,18 +197,23 @@ 		runRequest (RequestNum "issuecomments" repo n)  issuecommentsStore :: Storer-issuecommentsStore = numHelper Github.Issues.Comments.comments' $ \n ->+issuecommentsStore = numHelper "issuecomments" Github.Issues.Comments.comments' $ \n -> 	forValues $ \req c -> do 		let i = Github.issueCommentId c 		store ("issue" </> show n ++ "_comment" </> show i) req c +userrepoStore :: Storer+userrepoStore = simpleHelper "repo" Github.userRepo' $ \req r -> do+	store "repo" req r+	when (Github.repoHasWiki r == Just True) $+		updateWiki $ toGithubUserRepo r+	maybe noop addFork $ Github.repoParent r+	maybe noop addFork $ Github.repoSource r+ forksStore :: Storer-forksStore = simpleHelper (noAuth Github.forksFor) $ \req fs -> do+forksStore = simpleHelper "forks" Github.forksFor' $ \req fs -> do 	storeSorted "forks" req fs-	mapM_ (traverse . toGithubUserRepo) fs-  where-	traverse fork = whenM (addFork fork) $-		gatherMetaData fork+	mapM_ addFork fs  forValues :: (Request -> v -> Backup ()) -> Request -> [v] -> Backup () forValues handle req vs = forM_ vs (handle req)@@ -208,39 +224,66 @@ type Handler v = Request -> v -> Backup () type Helper = Request -> Backup () -noAuth :: (String -> String -> IO a) -> Maybe Github.GithubAuth -> String -> String -> IO a-noAuth a _auth user repo = a user repo--simpleHelper :: ApiCall v -> Handler v -> Helper-simpleHelper call handle req@(RequestSimple _ (GithubUserRepo user repo)) = do-	auth <- getState gitHubAuth-	either (failedRequest req) (handle req) =<< liftIO (call auth user repo)-simpleHelper _ _ r = badRequest r+simpleHelper :: FilePath -> ApiCall v -> Handler v -> Helper+simpleHelper dest call handle req@(RequestSimple _ (GithubUserRepo user repo)) =+	deferOn dest req $ do+		auth <- getState gitHubAuth+		either (failedRequest req) (handle req) =<< liftIO (call auth user repo)+simpleHelper _ _ _ r = badRequest r -withHelper :: ApiWith v b -> b -> Handler v -> Helper-withHelper call b handle req@(RequestSimple _ (GithubUserRepo user repo)) = do-	auth <- getState gitHubAuth-	either (failedRequest req) (handle req) =<< liftIO (call auth user repo b)-withHelper _ _ _ r = badRequest r+withHelper :: FilePath -> ApiWith v b -> b -> Handler v -> Helper+withHelper dest call b handle req@(RequestSimple _ (GithubUserRepo user repo)) =+	deferOn dest req $ do+		auth <- getState gitHubAuth+		either (failedRequest req) (handle req) =<< liftIO (call auth user repo b)+withHelper _ _ _ _ r = badRequest r -numHelper :: ApiNum v -> (Int -> Handler v) -> Helper-numHelper call handle req@(RequestNum _ (GithubUserRepo user repo) num) = do-	auth <- getState gitHubAuth-	either (failedRequest req) (handle num req) =<< liftIO (call auth user repo num)-numHelper _ _ r = badRequest r+numHelper :: FilePath -> ApiNum v -> (Int -> Handler v) -> Helper+numHelper dest call handle req@(RequestNum _ (GithubUserRepo user repo) num) =+	deferOn dest req $ do+		auth <- getState gitHubAuth+		either (failedRequest req) (handle num req) =<< liftIO (call auth user repo num)+numHelper _ _ _ r = badRequest r  badRequest :: Request -> a badRequest r = error $ "internal error: bad request type " ++ show r +{- When the specified file or directory already exists in git, the action+ - is deferred until later. -}+deferOn :: FilePath -> Request -> Backup () -> Backup ()+deferOn f req a = ifM (ingit $ storeLocation f req)+	( changeState $ \s -> s { deferredBackups = a : deferredBackups s }+	, a+	)+  where+	ingit f' = do+		h <- getCatFileHandle+		liftIO $ isJust <$> catObjectDetails h+			(Git.Types.Ref $ show branchname ++ ":" ++ f')++getCatFileHandle :: Backup CatFileHandle+getCatFileHandle = go =<< getState catFileHandle+  where+  	go (Just h) = return h+	go Nothing = do+		h <- withIndex $ inRepo catFileStart+		changeState $ \s -> s { catFileHandle = Just h }+		return h+ store :: Show a => FilePath -> Request -> a -> Backup () store filebase req val = do-	file <- location (requestRepo req) <$> workDir+	file <- (</>)+		<$> workDir+		<*> pure (storeLocation filebase req) 	liftIO $ do 		createDirectoryIfMissing True (parentDir file) 		writeFile file (ppShow val)++storeLocation :: FilePath -> Request -> FilePath+storeLocation filebase = location . requestRepo   where-	location (GithubUserRepo user repo) workdir =-		workdir </> user ++ "_" ++ repo </> filebase+	location (GithubUserRepo user repo) =+		user ++ "_" ++ repo </> filebase  workDir :: Backup FilePath workDir = (</>)@@ -307,13 +350,13 @@ 				-- Stage workDir files into the index. 				h <- hashObjectStart r 				Git.UpdateIndex.streamUpdateIndex r-					[genstream r dir h]+					[genstream dir h] 				hashObjectStop h 				-- Commit 				void $ Git.Branch.commit "github-backup" fullname [branchref] r 				removeDirectoryRecursive dir   where-  	genstream r dir h streamer = do+  	genstream dir h streamer = do 		fs <- filter (not . dirCruft) <$> dirContentsRecursive dir 		forM_ fs $ \f -> do 			sha <- hashFile h f@@ -375,16 +418,16 @@ 	remoteFor (GithubUserRepo user repo) = 		"github_" ++ user ++ "_" ++ repo ++ ".wiki" -addFork :: GithubUserRepo -> Backup Bool-addFork fork =-	ifM (elem fork <$> gitHubRemotes)-		( return False-		, do-			liftIO $ putStrLn $ "New fork: " ++ repoUrl fork-			_ <- addRemote (remoteFor fork) (repoUrl fork)-			return True-		)+addFork :: ToGithubUserRepo a => a -> Backup ()+addFork forksource = unlessM (elem fork <$> gitHubRemotes) $ do+	liftIO $ putStrLn $ "New fork: " ++ repoUrl fork+	void $ addRemote (remoteFor fork) (repoUrl fork)+	gitRepo' <- inRepo $ Git.Config.reRead+	changeState $ \s -> s { gitRepo = gitRepo' }++	gatherMetaData fork   where+  	fork = toGithubUserRepo forksource 	remoteFor (GithubUserRepo user repo) = "github_" ++ user ++ "_" ++ repo  {- Adds a remote, also fetching from it. -}@@ -412,8 +455,6 @@ fetchRepo repo = inRepo $ Git.Command.runBool 	[Param "fetch", Param $ fromJust $ Git.Types.remoteName repo] -{- Gathers metadata for the repo. Retuns a list of files written- - and a list that may contain requests that need to be retried later. -} gatherMetaData :: GithubUserRepo -> Backup () gatherMetaData repo = do 	liftIO $ putStrLn $ "Gathering metadata for " ++ repoUrl repo ++ " ..."@@ -433,7 +474,7 @@ retryFile :: Git.Repo -> FilePath retryFile r = Git.localGitDir r </> "github-backup.todo" -retry :: Backup (S.Set Request)+retry :: Backup () retry = do 	todo <- inRepo loadRetry 	unless (null todo) $ do@@ -441,12 +482,11 @@ 			"Retrying " ++ show (length todo) ++ 			" requests that failed last time..." 		mapM_ runRequest todo-	retriedfailed <- getState failedRequests 	changeState $ \s -> s-		{ failedRequests = S.empty+		{ retriedFailed = failedRequests s+		, failedRequests = S.empty 		, retriedRequests = S.fromList todo 		}-	return retriedfailed  summarizeRequests :: [Request] -> [String] summarizeRequests = go M.empty@@ -460,77 +500,119 @@  - Requests that failed are saved for next time. Requests that were retried  - this time and failed are ordered last, to ensure that we don't get stuck  - retrying the same requests and not making progress when run again.+ -+ - Returns any requests that failed.  -}-save :: S.Set Request -> Backup ()-save retriedfailed = do+save :: Backup [Request]+save = do 	commitWorkDir 	failed <- getState failedRequests+	retriedfailed <- getState retriedFailed 	let toretry = S.toList failed ++ S.toList retriedfailed 	inRepo $ storeRetry toretry-	unless (null toretry) $-		error $ unlines $-			["Backup may be incomplete; " ++ -				show (length toretry) ++ " requests failed:"-			] ++ map ("  " ++) (summarizeRequests toretry) ++ -			[ "Run again later."-			]+	endState+	return toretry +showFailures :: [Request] -> IO ()+showFailures [] = noop+showFailures l = error $ unlines $+	["Backup may be incomplete; " ++ +		show (length l) ++ " requests failed:"+	] ++ map ("  " ++) (summarizeRequests l) ++ +	[ "Run again later."+	]+ newState :: Git.Repo -> IO BackupState newState r = BackupState 	<$> pure S.empty 	<*> pure S.empty+	<*> pure S.empty 	<*> pure r-	<*> getauth+	<*> getAuth+	<*> pure []+	<*> pure Nothing++endState :: Backup ()+endState = liftIO . maybe noop catFileStop =<< getState catFileHandle++getAuth :: IO (Maybe Github.GithubAuth)+getAuth = do+	user <- getEnv "GITHUB_USER"+	password <- getEnv "GITHUB_PASSWORD"+	return $ case (user, password) of+		(Just u, Just p) -> Just $ +			Github.GithubBasicAuth (tobs u) (tobs p)+		_ -> Nothing   where-	getauth = do-		user <- getEnv "GITHUB_USER"-		password <- getEnv "GITHUB_PASSWORD"-		return $ case (user, password) of-			(Just u, Just p) -> Just $ -				Github.GithubBasicAuth (tobs u) (tobs p)-			_ -> Nothing 	tobs = encodeUtf8 . T.pack +genBackupState :: Git.Repo -> IO BackupState+genBackupState repo = newState =<< Git.Config.read repo+ backupRepo :: (Maybe Git.Repo) -> IO () backupRepo Nothing = error "not in a git repository, and nothing specified to back up"-backupRepo (Just repo) = evalStateT (runBackup go) =<< newState =<< Git.Config.read repo+backupRepo (Just repo) = +	genBackupState repo >>= evalStateT (runBackup go) >>= showFailures   where 	go = do-		retriedfailed <- retry-		remotes <- gitHubPairs <$> getState gitRepo-		when (null remotes) $-			error "no github remotes found"-		forM_ remotes $ \(r, remote) -> do-			_ <- fetchRepo r-			gatherMetaData remote-		save retriedfailed+		retry+		mainBackup+		runDeferred+		save +mainBackup :: Backup ()+mainBackup = do+	remotes <- gitHubPairs <$> getState gitRepo+	when (null remotes) $+		error "no github remotes found"+	forM_ remotes $ \(r, remote) -> do+		void $ fetchRepo r+		gatherMetaData remote++runDeferred :: Backup ()+runDeferred = go =<< getState deferredBackups+  where+	go [] = noop+	go l = do+		changeState $ \s -> s { deferredBackups = [] }+		void $ sequence l+		-- Running the deferred actions could cause+		-- more actions to be deferred; run them too.+		runDeferred+ backupName :: String -> IO () backupName name = do+	auth <- getAuth 	l <- sequence-	 	[ Github.userRepos name Github.All-		, Github.reposWatchedBy name-		, Github.organizationRepos name+	 	[ Github.userRepos' auth name Github.All+		, Github.reposWatchedBy' auth name+		, Github.reposStarredBy auth name+		, Github.organizationRepos' auth name 		]-	let repos = concat $ rights l-	when (null repos) $+	let nameurls = nub $ map (\repo -> (Github.repoName repo, Github.repoGitUrl repo)) $ concat $ rights l+	when (null nameurls) $ 		if (null $ rights l) 			then error $ unlines $ "Failed to query github for repos:" : map show (lefts l) 			else error $ "No GitHub repositories found for " ++ name-	status <- forM repos $ \repo -> do-		let dir = Github.repoName repo+	-- 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 (Github.repoGitUrl repo)+				, Param url 				, Param dir 				] 			unless ok $ error "clone failed"-		try (backupRepo . Just =<< Git.Construct.fromPath dir)-			:: IO (Either SomeException ())-	unless (null $ lefts status) $-		error "Failed to successfully back everything up. Run again later."+		genBackupState =<< Git.Construct.fromPath dir+	-- First pass only retries things that failed before, so the+	-- retried actions will run in each repo before too much API is+	-- used up.+	states' <- forM states (execStateT . runBackup $ retry)+	states'' <- forM states' (execStateT . runBackup $ mainBackup)+	forM states'' (evalStateT . runBackup $ runDeferred >> save)+		>>= showFailures . concat  usage :: String usage = "usage: github-backup [username|organization]"
− make-sdist.sh 
@@ -1,21 +0,0 @@-#!/bin/sh-#-# Workaround for `cabal sdist` requiring all included files to be listed-# in .cabal.--# Create target directory-sdist_dir=github-backup-$(grep '^Version:' github-backup.cabal | sed -re 's/Version: *//')-mkdir --parents dist/$sdist_dir--find . \( -name .git -or -name dist -or -name cabal-dev \) -prune \-	-or -not -name \\*.orig -not -type d -print \-| perl -ne "print unless length >= 100 - length q{$sdist_dir}" \-| xargs cp --parents --target-directory dist/$sdist_dir--cd dist-tar -caf $sdist_dir.tar.gz $sdist_dir--# Check that tarball can be unpacked by cabal.-# It's picky about tar longlinks etc.-rm -rf $sdist_dir-cabal unpack $sdist_dir.tar.gz