github-backup 1.20150618 → 1.20150807

raw patch · 12 files changed

+124/−33 lines, 12 files

Files

CHANGELOG +17/−0
Makefile +2/−0
Utility/Directory.hs +21/−10
Utility/Path.hs +4/−3
debian/changelog +17/−0
debian/control +1/−1
debian/files +1/−0
debian/github-backup.debhelper.log +20/−0
debian/github-backup.substvars +3/−0
github-backup.1 +11/−1
github-backup.cabal +1/−1
github-backup.hs +26/−17

CHANGELOG view

@@ -1,3 +1,14 @@+github-backup (1.20150807) unstable; urgency=medium++  * Added bash completion.+  * Add --no-forks flag that turns off backing up forks.+    Thanks, Phil Ruffwind.+  * Avoid nonzero exit due to temporary failures that can be retried next+    time github-backup runs, so that it can be used in a cron job with eg,+    chronic.++ -- Joey Hess <id@joeyh.name>  Fri, 07 Aug 2015 12:50:02 -0400+ github-backup (1.20150618) unstable; urgency=medium    * Fix broken configure script.@@ -32,6 +43,12 @@     with git-annex.   -- Joey Hess <id@joeyh.name>  Mon, 22 Dec 2014 15:30:08 -0400++github-backup (1.20141204.1) unstable; urgency=medium++  * Set myself as maintainer.++ -- James McCoy <jamessan@debian.org>  Fri, 19 Jun 2015 21:32:18 -0400  github-backup (1.20141204) unstable; urgency=high

Makefile view

@@ -16,6 +16,8 @@ 	install github-backup gitriddance $(DESTDIR)$(PREFIX)/bin 	install -d $(DESTDIR)$(PREFIX)/share/man/man1 	install -m 0644 github-backup.1 gitriddance.1 $(DESTDIR)$(PREFIX)/share/man/man1+	install -d $(DESTDIR)$(PREFIX)/share/bash-completion/completions+	./github-backup --bash-completion-script github-backup > $(DESTDIR)$(PREFIX)/share/bash-completion/completions/github-backup  clean: 	rm -rf github-backup gitriddance dist configure Build/SysConfig.hs Setup tags

Utility/Directory.hs view

@@ -13,7 +13,6 @@ import System.IO.Error import System.Directory import Control.Monad-import Control.Monad.IfElse import System.FilePath import Control.Applicative import Control.Concurrent@@ -25,10 +24,11 @@ import qualified System.Win32 as Win32 #else import qualified System.Posix as Posix+import Utility.SafeCommand+import Control.Monad.IfElse #endif  import Utility.PosixFiles-import Utility.SafeCommand import Utility.Tmp import Utility.Exception import Utility.Monad@@ -107,21 +107,32 @@ 	onrename (Left e) 		| isPermissionError e = rethrow 		| isDoesNotExistError e = rethrow-		| otherwise = do-			-- copyFile is likely not as optimised as-			-- the mv command, so we'll use the latter.-			-- But, mv will move into a directory if-			-- dest is one, which is not desired.-			whenM (isdir dest) rethrow-			viaTmp mv dest ""+		| otherwise = viaTmp mv dest "" 	  where 		rethrow = throwM e+ 		mv tmp _ = do+		-- copyFile is likely not as optimised as+		-- the mv command, so we'll use the command.+		--+		-- But, while Windows has a "mv", it does not seem very+		-- reliable, so use copyFile there.+#ifndef mingw32_HOST_OS	+			-- If dest is a directory, mv would move the file+			-- into it, which is not desired.+			whenM (isdir dest) rethrow 			ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]+			let e' = e+#else+			r <- tryIO $ copyFile src tmp+			let (ok, e') = case r of+				Left err -> (False, err)+				Right _ -> (True, e)+#endif 			unless ok $ do 				-- delete any partial 				_ <- tryIO $ removeFile tmp-				rethrow+				throwM e'  	isdir f = do 		r <- tryIO $ getFileStatus f

Utility/Path.hs view

@@ -30,8 +30,8 @@ import Utility.Monad import Utility.UserInfo -{- Simplifies a path, removing any ".." or ".", and removing the trailing- - path separator.+{- Simplifies a path, removing any "." component, collapsing "dir/..", + - 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@@ -50,7 +50,8 @@  	norm c [] = reverse c 	norm c (p:ps)-		| p' == ".." = norm (drop 1 c) ps+		| p' == ".." && not (null c) && dropTrailingPathSeparator (c !! 0) /= ".." = +			norm (drop 1 c) ps 		| p' == "." = norm c ps 		| otherwise = norm (p:c) ps 	  where

debian/changelog view

@@ -1,3 +1,14 @@+github-backup (1.20150807) unstable; urgency=medium++  * Added bash completion.+  * Add --no-forks flag that turns off backing up forks.+    Thanks, Phil Ruffwind.+  * Avoid nonzero exit due to temporary failures that can be retried next+    time github-backup runs, so that it can be used in a cron job with eg,+    chronic.++ -- Joey Hess <id@joeyh.name>  Fri, 07 Aug 2015 12:50:02 -0400+ github-backup (1.20150618) unstable; urgency=medium    * Fix broken configure script.@@ -32,6 +43,12 @@     with git-annex.   -- Joey Hess <id@joeyh.name>  Mon, 22 Dec 2014 15:30:08 -0400++github-backup (1.20141204.1) unstable; urgency=medium++  * Set myself as maintainer.++ -- James McCoy <jamessan@debian.org>  Fri, 19 Jun 2015 21:32:18 -0400  github-backup (1.20141204) unstable; urgency=high

debian/control view

@@ -14,7 +14,7 @@ 	libghc-transformers-dev, 	libghc-unix-compat-dev, 	libghc-optparse-applicative-dev-Maintainer: Debian QA Group <packages@qa.debian.org>+Maintainer: James McCoy <jamessan@debian.org> Standards-Version: 3.9.5 Vcs-Git: git://github.com/joeyh/github-backup.git Homepage: http://github.com/joeyh/github-backup

+ debian/files view

@@ -0,0 +1,1 @@+github-backup_1.20150619_amd64.deb utils optional

+ debian/github-backup.debhelper.log view

@@ -0,0 +1,20 @@+dh_auto_configure+dh_auto_build+dh_auto_test+dh_prep+dh_auto_install+dh_installdocs+dh_installchangelogs+dh_installman+dh_perl+dh_link+dh_compress+dh_fixperms+dh_strip+dh_makeshlibs+dh_shlibdeps+dh_installdeb+dh_gencontrol+dh_md5sums+dh_builddeb+dh_builddeb

+ debian/github-backup.substvars view

@@ -0,0 +1,3 @@+shlibs:Depends=libc6 (>= 2.14), libffi6 (>= 3.0.4), libgmp10, zlib1g (>= 1:1.1.4)+misc:Depends=+misc:Pre-Depends=

github-backup.1 view

@@ -3,7 +3,7 @@ .SH NAME github-backup \- backs up data from GitHub .SH SYNOPSIS-.B github-backup [\fIusername\fP|\fIorganization\fP ...] [--exclude=username/repository ...]+.B github-backup [\fIusername\fP|\fIorganization\fP ...] [options] .SH DESCRIPTION .I github-backup is a simple tool you run in a git repository you cloned from@@ -20,5 +20,15 @@ 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 OPTIONS+.PP+.IP --exclude=username/repository+When backing up a user or an organization, this can be used to exclude+bacup of a particular repository belonging to the user or organization.+This option can be specified any number of time to exclude more than one+repository.+.PP+.IP --no-forks+Avoid backing up a repository's forks. .SH AUTHOR  Joey Hess <joey@kitenet.net>

github-backup.cabal view

@@ -1,5 +1,5 @@ Name: github-backup-Version: 1.20150618+Version: 1.20150807 Cabal-Version: >= 1.8 Maintainer: Joey Hess <joey@kitenet.net> Author: Joey Hess

github-backup.hs view

@@ -80,6 +80,7 @@ 	, gitHubAuth :: Maybe Github.GithubAuth 	, deferredBackups :: [Backup ()] 	, catFileHandle :: Maybe CatFileHandle+	, noForks :: Bool 	}  {- Our monad. -}@@ -407,10 +408,12 @@  gatherMetaData :: GithubUserRepo -> Backup () gatherMetaData repo = do+	noforks <- getState noForks 	liftIO $ putStrLn $ "Gathering metadata for " ++ repoUrl repo ++ " ..."-	mapM_ call toplevelApi+	mapM_ call (filter (forksfilter noforks) toplevelApi)   where 	call name = runRequest $ RequestSimple name repo+	forksfilter noforks name = not (noforks && name == "forks")  storeRetry :: [Request] -> Git.Repo -> IO () storeRetry [] r = void $ do@@ -465,15 +468,15 @@  showFailures :: [Request] -> IO () showFailures [] = noop-showFailures l = error $ unlines $+showFailures l = hPutStrLn stderr $ unlines $ 	["Backup may be incomplete; " ++  		show (length l) ++ " requests failed:" 	] ++ map ("  " ++) (summarizeRequests l) ++  	[ "Run again later." 	] -newState :: Git.Repo -> IO BackupState-newState r = BackupState+newState :: Bool -> Git.Repo -> IO BackupState+newState noforks r = BackupState 	<$> pure S.empty 	<*> pure S.empty 	<*> pure S.empty@@ -481,17 +484,18 @@ 	<*> getAuth 	<*> pure [] 	<*> pure Nothing+	<*> pure noforks  endState :: Backup () endState = liftIO . maybe noop catFileStop =<< getState catFileHandle -genBackupState :: Git.Repo -> IO BackupState-genBackupState repo = newState =<< Git.Config.read repo+genBackupState :: Bool -> Git.Repo -> IO BackupState+genBackupState noforks repo = newState noforks =<< 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) = -	genBackupState repo >>= evalStateT (runBackup go) >>= showFailures+backupRepo :: Bool -> (Maybe Git.Repo) -> IO ()+backupRepo _ Nothing = error "not in a git repository, and nothing specified to back up"+backupRepo noforks (Just repo) =+	genBackupState noforks repo >>= evalStateT (runBackup go) >>= showFailures   where 	go = do 		retry@@ -519,8 +523,8 @@ 		-- more actions to be deferred; run them too. 		runDeferred -backupOwner :: [GithubUserRepo] -> Owner -> IO ()-backupOwner exclude (Owner name) = do+backupOwner :: Bool -> [GithubUserRepo] -> Owner -> IO ()+backupOwner noforks exclude (Owner name) = do 	auth <- getAuth 	l <- sequence 	 	[ Github.userRepos' auth name Github.All@@ -566,11 +570,12 @@ 					, Param dir 					] 				unless ok $ error "clone failed"-			Just <$> (genBackupState =<< Git.Construct.fromPath dir)+			Just <$> (genBackupState noforks =<< Git.Construct.fromPath dir)  data Options = Options 	{ includeOwner :: [Owner] 	, excludeRepo :: [GithubUserRepo]+	, noForksOpt :: Bool 	} 	deriving (Show) @@ -578,7 +583,7 @@ 	deriving (Show)  options :: Parser Options-options = Options <$> many owneropt <*> many excludeopt+options = Options <$> many owneropt <*> many excludeopt <*> noforksopt   where 	owneropt = Owner <$> (argument str) 		( metavar "USERNAME|ORGANIZATION"@@ -589,6 +594,10 @@ 		<> metavar "USERNAME/REPOSITORY" 		<> help "Skip backing up a repository." 		))+	noforksopt = switch+		( long "no-forks"+		<> help "Do not backup forks."+		)  parseUserRepo :: String -> GithubUserRepo parseUserRepo s =@@ -608,6 +617,6 @@ 		, "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+	go (Options owner exclude noforks)+		| null owner = backupRepo noforks =<< Git.Construct.fromCwd+		| otherwise = mapM_ (backupOwner noforks exclude) owner