Add version command to show git-annex version as well as repository version information.

7 files changed, 68 insertions, 7 deletions

diff --git a/Command/Version.hs b/Command/Version.hs
new file mode 100644
index 000000000..480f2166b
--- /dev/null
+++ b/Command/Version.hs
@@ -0,0 +1,34 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Version where
+
+import Control.Monad.State (liftIO)
+import Data.String.Utils
+
+import Command
+import qualified SysConfig
+import Version
+import Upgrade
+
+command :: [Command]
+command = [Command "version" paramNothing seek "show versions"]
+
+seek :: [CommandSeek]
+seek = [withNothing start]
+
+start :: CommandStartNothing
+start = do
+	liftIO $ putStrLn $ "git-annex version: " ++ SysConfig.packageversion
+	v <- getVersion
+	liftIO $ putStrLn $ "local repository version: " ++ v
+	liftIO $ putStrLn $ "default repository version: " ++ defaultVersion
+	liftIO $ putStrLn $ "supported repository versions: " ++ vs supportedVersions
+	liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
+	return Nothing
+	where
+		vs l = join " " l
diff --git a/GitAnnex.hs b/GitAnnex.hs
index b9c22bdfb..adf07e5b3 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -42,6 +42,7 @@ import qualified Command.Untrust
 import qualified Command.Semitrust
 import qualified Command.Map
 import qualified Command.Upgrade
+import qualified Command.Version
 
 cmds :: [Command]
 cmds = concat
@@ -72,6 +73,7 @@ cmds = concat
 	, Command.Migrate.command
 	, Command.Map.command
 	, Command.Upgrade.command
+	, Command.Version.command
 	]
 
 options :: [Option]
diff --git a/Upgrade.hs b/Upgrade.hs
index 76dd156f8..d201cc73e 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -12,6 +12,9 @@ import Version
 import qualified Upgrade.V0
 import qualified Upgrade.V1
 
+upgradableVersions :: [Version]
+upgradableVersions = ["0", "1"]
+
 {- Uses the annex.version git config setting to automate upgrades. -}
 upgrade :: Annex Bool
 upgrade = do
@@ -19,5 +22,5 @@ upgrade = do
 	case version of
 		"0" -> Upgrade.V0.upgrade
 		"1" -> Upgrade.V1.upgrade
-		v | v == currentVersion -> return True
+		v | v `elem` supportedVersions -> return True
 		_ -> error "this version of git-annex is too old for this git repository!"
diff --git a/Version.hs b/Version.hs
index 5f414e93b..d4a58d77a 100644
--- a/Version.hs
+++ b/Version.hs
@@ -15,13 +15,18 @@ import qualified Annex
 import qualified GitRepo as Git
 import Locations
 
-currentVersion :: String
-currentVersion = "2"
+type Version = String
+
+defaultVersion :: Version
+defaultVersion = "2"
+
+supportedVersions :: [Version]
+supportedVersions = [defaultVersion]
 
 versionField :: String
 versionField = "annex.version"
 
-getVersion :: Annex String
+getVersion :: Annex Version
 getVersion = do
 	g <- Annex.gitRepo
 	let v = Git.configGet g versionField ""
@@ -42,7 +47,7 @@ getVersion = do
 				(True, True) -> return "1"
 				_ -> do
 					setVersion
-					return currentVersion
+					return defaultVersion
 
 setVersion :: Annex ()
-setVersion = Annex.setConfig versionField currentVersion
+setVersion = Annex.setConfig versionField defaultVersion
diff --git a/configure.hs b/configure.hs
index f5c295648..f8cd577e9 100644
--- a/configure.hs
+++ b/configure.hs
@@ -7,7 +7,8 @@ import TestConfig
 
 tests :: [TestCase]
 tests = [
-	  testCp "cp_a" "-a"
+	  TestCase "version" $ getVersion
+	, testCp "cp_a" "-a"
 	, testCp "cp_p" "-p"
 	, testCp "cp_reflink_auto" "--reflink=auto"
 	, TestCase "uuid generator" $ selectCmd "uuid" ["uuid", "uuidgen"]
@@ -49,6 +50,16 @@ unicodeFilePath = do
 	let file = head $ filter (isInfixOf "unicode-test") fs
 	return $ Config "unicodefilepath" (BoolConfig $ isInfixOf "ü" file)
 
+{- Pulls package version out of the changelog. -}
+getVersion :: Test
+getVersion = do
+	changelog <- readFile "debian/changelog"
+	let verline = head $ lines changelog
+	let version = middle (words verline !! 1)
+	return $ Config "packageversion" (StringConfig version)
+	where
+		middle s = drop 1 $ take (length s - 1) s
+
 setup :: IO ()
 setup = do
 	createDirectoryIfMissing True tmpDir
diff --git a/debian/changelog b/debian/changelog
index e1c0576e8..751fcaff9 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,8 @@ git-annex (0.20110317) UNRELEASED; urgency=low
 
   * Fix dropping of files using the URL backend.
   * Fix support for remotes with '.' in their names.
+  * Add version command to show git-annex version as well as repository
+    version information.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 17 Mar 2011 11:46:53 -0400
 
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index ee4019068..1e4af022f 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -267,6 +267,10 @@ Many git-annex commands will stage changes for later `git commit` by you.
   whenever a newer git annex encounters an old repository; this command
   allows explcitly starting an upgrade.
 
+* version
+
+  Shows the version of git-annex, as well as repository version information.
+
 # OPTIONS
 
 * --force