packages feed

github-backup 1.20131006 → 1.20131101

raw patch · 7 files changed

+93/−32 lines, 7 files

Files

Makefile view
@@ -4,6 +4,7 @@ build: Build/SysConfig.hs 	$(CABAL) build 	ln -sf dist/build/github-backup/github-backup github-backup+	@$(MAKE) tags >/dev/null 2>&1 &  Build/SysConfig.hs: configure.hs Build/TestConfig.hs Build/Configure.hs 	if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi@@ -16,7 +17,7 @@ 	install -m 0644 github-backup.1 $(DESTDIR)$(PREFIX)/share/man/man1  clean:-	rm -rf github-backup dist configure Build/SysConfig.hs Setup+	rm -rf github-backup dist configure Build/SysConfig.hs Setup tags 	find -name \*.o -exec rm {} \; 	find -name \*.hi -exec rm {} \; @@ -24,3 +25,7 @@ hackage: clean 	./make-sdist.sh 	@cabal upload dist/*.tar.gz++# hothasktags chokes on some template haskell etc, so ignore errors+tags:+	find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags > tags 2>/dev/null
README.md view
@@ -23,7 +23,9 @@   from GitHub to back up that repository.    Or, run `github-backup username` to clone and back up all of a GitHub-  user's repositories. (Also works for organization names.)+  user's repositories, as well as all the repositories watched by that+  user.  +  (Also works for organization names.)  ## Why backup GitHub repositories @@ -33,6 +35,10 @@   keeping your data in the cloud *and* relying on the cloud to   back it up is foolish. +* 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.+ * So you can keep working on your repository while on a plane, or   on a remote beach or mountaintop. Just like Linus intended. @@ -60,7 +66,7 @@ information from GitHub. In particular, social network stuff, like users who are following you, is not backed up. -github-backup does not log into git, so it cannot backup private+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@@ -82,9 +88,13 @@  Bear in mind that this uses the GitHub API; don't run it every 5 minutes. GitHub [rate limits](http://developer.github.com/v3/#rate-limiting) the-API to 5000 requests per hour. However, github-backup *does* do an-incremental backup, picking up where it left off, so will complete the-backup eventually even if it's rate limited.+API to some small number of requests per hour when used without+authentication. To avoid this limit, you can set `GITHUB_USER` and+`GITHUB_PASSWORD` in the environment and it will log in when making +(most) API requests.++Anyway, github-backup *does* do an incremental backup, picking up where it+left off, so will complete the backup eventually even if it's rate limited.  ## Author
debian/changelog view
@@ -1,3 +1,17 @@+github-backup (1.20131101) unstable; urgency=low++  * Now also backs up the repos a user is watching, when run with a user's+    name. Useful if you want to back up repositories that you have not forked;+    just watch them and run github-backup.+  * Can now log in to github, to avoid increasingly small API rate limits.+    Set GITHUB_USER and GITHUB_PASSWORD environment to enable.+    Note that a few api calls don't use authentication; see+    https://github.com/fpco/github/issues/40+  * Build-Depend on git. Closes: #728481+  * Don't include tmp directory in files stored in the github branch.++ -- Joey Hess <joeyh@debian.org>  Fri, 01 Nov 2013 18:00:16 -0400+ github-backup (1.20131006) unstable; urgency=low    * Ported to Windows.
debian/control view
@@ -4,6 +4,7 @@ Build-Depends:  	debhelper (>= 9), 	ghc,+	git, 	libghc-github-dev (>= 0.5.1), 	libghc-missingh-dev, 	libghc-hslogger-dev,
github-backup.1 view
@@ -12,7 +12,13 @@ milestones, pull requests, and watchers. .PP Alternately, if you pass it the username of a GitHub user, it will check-out, and back up, all that user's repositories. (Also works to pass+out, and back up, all that user's repositories, as well as all the+repositories that user is watching. (Also works to pass the name of an organization using GitHub.)+.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+repositories to be downloaded. .SH AUTHOR  Joey Hess <joey@kitenet.net>
github-backup.cabal view
@@ -1,5 +1,5 @@ Name: github-backup-Version: 1.20131006+Version: 1.20131101 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>
github-backup.hs view
@@ -1,6 +1,6 @@ {- github-backup  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -12,9 +12,11 @@  import qualified Data.Map as M import qualified Data.Set as S+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8) import Data.Either import Data.Monoid-import System.Environment+import System.Environment (getArgs) import Control.Exception (try, SomeException) import Text.Show.Pretty import "mtl" Control.Monad.State.Strict@@ -40,6 +42,7 @@ import qualified Git.UpdateIndex import Git.HashObject import Git.FilePath+import Utility.Env  -- A github user and repo. data GithubUserRepo = GithubUserRepo String String@@ -78,6 +81,7 @@ 	{ failedRequests :: S.Set Request 	, retriedRequests :: S.Set Request 	, gitRepo :: Git.Repo+	, gitHubAuth :: Maybe Github.GithubAuth 	}  {- Our monad. -}@@ -139,36 +143,37 @@ 	bad = error $ "internal error: bad api call: " ++ name  userrepoStore :: Storer-userrepoStore = simpleHelper Github.userRepo $ \req r -> do+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 Github.watchersFor $ storeSorted "watchers"+watchersStore = simpleHelper (noAuth Github.watchersFor) $+	storeSorted "watchers"  pullrequestsStore :: Storer-pullrequestsStore = simpleHelper Github.pullRequestsFor $+pullrequestsStore = simpleHelper 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 Github.pullRequest' $ \n -> 	store ("pullrequest" </> show n)  milestonesStore :: Storer-milestonesStore = simpleHelper Github.Issues.Milestones.milestones $+milestonesStore = simpleHelper Github.Issues.Milestones.milestones' $ 	forValues $ \req m -> do 		let n = Github.milestoneNumber m 		store ("milestone" </> show n) req m  issuesStore :: Storer-issuesStore = withHelper (\u r y ->-	Github.issuesForRepo u r (y <> [Github.Open])+issuesStore = withHelper (\a u r y ->+	Github.issuesForRepo' a u r (y <> [Github.Open]) 		>>= either (return . Left)-			(\xs -> Github.issuesForRepo u r+			(\xs -> Github.issuesForRepo' a u r 				(y <> [Github.OnlyClosed]) 					>>= either (return . Left) 						(\ys -> return (Right (xs <> ys)))))@@ -181,13 +186,13 @@ 		runRequest (RequestNum "issuecomments" repo n)  issuecommentsStore :: Storer-issuecommentsStore = numHelper Github.Issues.Comments.comments $ \n ->+issuecommentsStore = numHelper Github.Issues.Comments.comments' $ \n -> 	forValues $ \req c -> do 		let i = Github.issueCommentId c 		store ("issue" </> show n ++ "_comment" </> show i) req c  forksStore :: Storer-forksStore = simpleHelper Github.forksFor $ \req fs -> do+forksStore = simpleHelper (noAuth Github.forksFor) $ \req fs -> do 	storeSorted "forks" req fs 	mapM_ (traverse . toGithubUserRepo) fs   where@@ -197,25 +202,31 @@ forValues :: (Request -> v -> Backup ()) -> Request -> [v] -> Backup () forValues handle req vs = forM_ vs (handle req) -type ApiCall v = String -> String -> IO (Either Github.Error v)-type ApiWith v b = String -> String -> b -> IO (Either Github.Error v)+type ApiCall v = Maybe Github.GithubAuth -> String -> String -> IO (Either Github.Error v)+type ApiWith v b = Maybe Github.GithubAuth -> String -> String -> b -> IO (Either Github.Error v) type ApiNum v = ApiWith v Int 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)) =-	either (failedRequest req) (handle req) =<< liftIO (call user repo)+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  withHelper :: ApiWith v b -> b -> Handler v -> Helper-withHelper call b handle req@(RequestSimple _ (GithubUserRepo user repo)) =-	either (failedRequest req) (handle req) =<< liftIO (call user repo b)+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  numHelper :: ApiNum v -> (Int -> Handler v) -> Helper-numHelper call handle req@(RequestNum _ (GithubUserRepo user repo) num) =-	either (failedRequest req) (handle num req) =<< liftIO (call user repo num)+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  badRequest :: Request -> a@@ -306,7 +317,7 @@ 		fs <- filter (not . dirCruft) <$> dirContentsRecursive dir 		forM_ fs $ \f -> do 			sha <- hashFile h f-			path <- toTopFilePath f r+			let path = asTopFilePath (relPathDirToFile dir f) 			streamer $ Git.UpdateIndex.updateIndexLine 				sha Git.Types.FileBlob path @@ -464,12 +475,25 @@ 			[ "Run again later." 			] -newState :: Git.Repo -> BackupState-newState = BackupState S.empty S.empty+newState :: Git.Repo -> IO BackupState+newState r = BackupState+	<$> pure S.empty+	<*> pure S.empty+	<*> pure r+	<*> getauth+  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  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) = evalStateT (runBackup go) =<< newState =<< Git.Config.read repo   where 	go = do 		retriedfailed <- retry@@ -485,6 +509,7 @@ backupName name = do 	l <- sequence 	 	[ Github.userRepos name Github.All+		, Github.reposWatchedBy name 		, Github.organizationRepos name 		] 	let repos = concat $ rights l