diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -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 Fri, 01 Nov 2013 18:00:16 -0400 + github-backup (1.20131006) unstable; urgency=low * Ported to Windows. diff --git a/debian/control b/debian/control --- a/debian/control +++ b/debian/control @@ -4,6 +4,7 @@ Build-Depends: debhelper (>= 9), ghc, + git, libghc-github-dev (>= 0.5.1), libghc-missingh-dev, libghc-hslogger-dev, diff --git a/github-backup.1 b/github-backup.1 --- a/github-backup.1 +++ b/github-backup.1 @@ -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 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.20131006 +Version: 1.20131101 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess diff --git a/github-backup.hs b/github-backup.hs --- a/github-backup.hs +++ b/github-backup.hs @@ -1,6 +1,6 @@ {- github-backup - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - 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