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

(cherry picked from commit 828a84ba3341d4b7a84292d8b9002a8095dd2382)

Conflicts:

	GitAnnex.hs
	Upgrade.hs
	Version.hs
	debian/changelog

7 files changed, 70 insertions, 6 deletions

diff --git a/Command/Version.hs b/Command/Version.hs
new file mode 100644
index 000000000..4d18469c6
--- /dev/null
+++ b/Command/Version.hs
@@ -0,0 +1,37 @@
+{- 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
+	let v' = case v of
+		Just s -> s
+		Nothing -> "unknown"
+	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 da91f6e74..f9bdec6ba 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -41,6 +41,7 @@ import qualified Command.Trust
 import qualified Command.Untrust
 import qualified Command.Semitrust
 import qualified Command.Map
+import qualified Command.Version
 
 cmds :: [Command]
 cmds = concat
@@ -70,6 +71,7 @@ cmds = concat
 	, Command.Whereis.command
 	, Command.Migrate.command
 	, Command.Map.command
+	, Command.Version.command
 	]
 
 options :: [Option]
diff --git a/Upgrade.hs b/Upgrade.hs
index 3c16bcc86..22120b093 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -24,6 +24,9 @@ import Messages
 import Version
 import Utility
 
+upgradableVersions :: [Version]
+upgradableVersions = ["0"]
+
 {- Uses the annex.version git config setting to automate upgrades. -}
 upgrade :: Annex Bool
 upgrade = do
@@ -31,7 +34,7 @@ upgrade = do
 	case version of
 		Just "0" -> upgradeFrom0
 		Nothing -> return True -- repo not initted yet, no version
-		Just v | v == currentVersion -> return True
+		Just v | v `elem` supportedVersions -> return True
 		Just _ -> error "this version of git-annex is too old for this git repository!"
 
 upgradeFrom0 :: Annex Bool
diff --git a/Version.hs b/Version.hs
index 9e31d3c9e..18a9e18f8 100644
--- a/Version.hs
+++ b/Version.hs
@@ -15,13 +15,18 @@ import qualified Annex
 import qualified GitRepo as Git
 import Locations
 
-currentVersion :: String
-currentVersion = "1"
+type Version = String
+
+defaultVersion :: Version
+defaultVersion = "1"
+
+supportedVersions :: [Version]
+supportedVersions = [defaultVersion]
 
 versionField :: String
 versionField = "annex.version"
 
-getVersion :: Annex (Maybe String)
+getVersion :: Annex (Maybe Version)
 getVersion = do
 	g <- Annex.gitRepo
 	let v = Git.configGet g versionField ""
@@ -38,4 +43,4 @@ getVersion = do
 				else return Nothing -- no version yet
 
 setVersion :: Annex ()
-setVersion = Annex.setConfig versionField currentVersion
+setVersion = Annex.setConfig versionField defaultVersion
diff --git a/configure.hs b/configure.hs
index 772ba5489..6ebaf00a8 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"]
@@ -48,6 +49,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 893b613be..bfde82af2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,8 @@ git-annex (0.25) 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 4998a6491..797b0f8a3 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.
 
 	git annex setkey --backend=WORM --key=1287765018:3 /tmp/file
 
+* version
+
+  Shows the version of git-annex, as well as repository version information.
+
 # OPTIONS
 
 * --force