distribution info file updater program

1 files changed, 60 insertions, 0 deletions

diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs
new file mode 100644
index 000000000..35851fa34
--- /dev/null
+++ b/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