distribution info file updater program

Build/DistributionUpdate.hs

@@ -0,0 +1,60 @@
+{- Builds distributon info files for each git-annex release in a directory
+ - tree, which must itself be part of a git-annex repository. Only files
+ - that are present have their info file created. -}
+
+import Common.Annex
+import Types.Distribution
+import Build.Version
+import Utility.UserInfo
+import Utility.Path
+import qualified Git.Construct
+import qualified Annex
+import Annex.Content
+import Backend
+import Git.Command
+
+import Data.Time.Clock
+
+main = do
+	state <- Annex.new =<< Git.Construct.fromPath =<< getRepoDir
+	Annex.eval state makeinfos
+
+makeinfos :: Annex ()
+makeinfos = do
+	basedir <- liftIO getRepoDir
+	version <- liftIO getChangelogVersion
+	now <- liftIO getCurrentTime
+	liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir
+	fs <- liftIO $ dirContentsRecursiveSkipping (== "info") (basedir </> "git-annex")
+	forM_ fs $ \f -> do
+		v <- lookupFile f
+		case v of
+			Nothing -> noop
+			Just (k, _b) -> whenM (inAnnex k) $ do
+				liftIO $ putStrLn f
+				{- The info file is in the same directory
+				 - as the annex release bundle file. This
+				 - relies on each such file being in its
+				 - own directory. -}
+				let infofile = (dropFileName f </> "info")
+				liftIO $ writeFile infofile $ show $ GitAnnexDistribution
+					{ distributionUrl = mkUrl basedir f
+					, distributionKey = k
+					, distributionVersion = version
+					, distributionReleasedate = now
+					, distributionUrgentUpgrade = Nothing
+					}
+				void $ inRepo $ runBool [Param "add", Param infofile]
+	void $ inRepo $ runBool 
+		[ Param "commit"
+		, Param "-m"
+		, Param "update distribution info files"
+		]
+
+getRepoDir :: IO FilePath
+getRepoDir = do
+	home <- liftIO myHomeDir
+	return $ home </> "lib" </> "downloads"
+
+mkUrl :: FilePath -> FilePath -> String
+mkUrl basedir f = "https://downloads.kitenet.net/" ++ relPathDirToFile basedir f

Makefile

@@ -77,7 +77,7 @@ clean:
 	rm -rf tmp dist git-annex $(mans) configure  *.tix .hpc \
 		doc/.ikiwiki html dist tags Build/SysConfig.hs build-stamp \
 		Setup Build/InstallDesktopFile Build/EvilSplicer \
-		Build/Standalone Build/OSXMkLibs \
+		Build/Standalone Build/OSXMkLibs Build/DistributionUpdate \
 		git-union-merge
 	find . -name \*.o -exec rm {} \;
 	find . -name \*.hi -exec rm {} \;
@@ -220,4 +220,8 @@ hdevtools:
 	hdevtools --stop-server || true
 	hdevtools check git-annex.hs -g -cpp -g -i -g -idist/build/git-annex/git-annex-tmp -g -i. -g -idist/build/autogen -g -Idist/build/autogen -g -Idist/build/git-annex/git-annex-tmp -g -IUtility -g -DWITH_TESTSUITE -g -DWITH_S3 -g -DWITH_ASSISTANT -g -DWITH_INOTIFY -g -DWITH_DBUS -g -DWITH_PAIRING -g -DWITH_XMPP -g -optP-include -g -optPdist/build/autogen/cabal_macros.h -g -odir -g dist/build/git-annex/git-annex-tmp -g -hidir -g dist/build/git-annex/git-annex-tmp -g -stubdir -g dist/build/git-annex/git-annex-tmp -g -threaded -g -Wall -g -XHaskell98 -g -XPackageImports
 
+distributionupdate:
+	ghc --make Build/DistributionUpdate
+	./Build/DistributionUpdate
+
 .PHONY: git-annex git-union-merge git-recover-repository tags build-stamp