shave some 12 mb from the installed size

* git-annex now behaves as git-annex-shell if symlinked to and run by that
  name. The Makefile sets this up, saving some 8 mb of installed size.
* git-union-merge is a demo program, so it is no longer built by default.

6 files changed, 140 insertions, 119 deletions

diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs
new file mode 100644
index 000000000..3394bc477
--- /dev/null
+++ b/GitAnnexShell.hs
@@ -0,0 +1,116 @@
+{- git-annex-shell main program
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module GitAnnexShell where
+
+import System.Environment
+import System.Console.GetOpt
+
+import Common.Annex
+import qualified Git.Construct
+import CmdLine
+import Command
+import Annex.UUID
+import qualified Option
+
+import qualified Command.ConfigList
+import qualified Command.InAnnex
+import qualified Command.DropKey
+import qualified Command.RecvKey
+import qualified Command.SendKey
+import qualified Command.Commit
+
+cmds_readonly :: [Command]
+cmds_readonly = concat
+	[ Command.ConfigList.def
+	, Command.InAnnex.def
+	, Command.SendKey.def
+	]
+
+cmds_notreadonly :: [Command]
+cmds_notreadonly = concat
+	[ Command.RecvKey.def
+	, Command.DropKey.def
+	, Command.Commit.def
+	]
+
+cmds :: [Command]
+cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
+	where
+		adddirparam c = c
+			{ cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c
+			}
+
+options :: [OptDescr (Annex ())]
+options = Option.common ++
+	[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
+	]
+	where
+		checkuuid expected = getUUID >>= check
+			where
+				check u | u == toUUID expected = return ()
+				check NoUUID = unexpected "uninitialized repository"
+				check u = unexpected $ "UUID " ++ fromUUID u
+				unexpected s = error $
+					"expected repository UUID " ++
+					expected ++ " but found " ++ s
+
+header :: String
+header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]"
+
+run :: [String] -> IO ()
+run [] = failure
+-- skip leading -c options, passed by eg, ssh
+run ("-c":p) = run p
+-- a command can be either a builtin or something to pass to git-shell
+run c@(cmd:dir:params)
+	| cmd `elem` builtins = builtin cmd dir params
+	| otherwise = external c
+run c@(cmd:_)
+	-- Handle the case of being the user's login shell. It will be passed
+	-- a single string containing all the real parameters.
+	| "git-annex-shell " `isPrefixOf` cmd = run $ drop 1 $ shellUnEscape cmd
+	| cmd `elem` builtins = failure
+	| otherwise = external c
+
+builtins :: [String]
+builtins = map cmdname cmds
+
+builtin :: String -> String -> [String] -> IO ()
+builtin cmd dir params = do
+	checkNotReadOnly cmd
+	dispatch (cmd : filterparams params) cmds options header $
+		Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
+
+external :: [String] -> IO ()
+external params = do
+	checkNotLimited
+	unlessM (boolSystem "git-shell" $ map Param $ "-c":filterparams params) $
+		error "git-shell failed"
+
+-- Drop all args after "--".
+-- These tend to be passed by rsync and not useful.
+filterparams :: [String] -> [String]
+filterparams [] = []
+filterparams ("--":_) = []
+filterparams (a:as) = a:filterparams as
+
+failure :: IO ()
+failure = error $ "bad parameters\n\n" ++ usage header cmds options
+
+checkNotLimited :: IO ()
+checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
+
+checkNotReadOnly :: String -> IO ()
+checkNotReadOnly cmd
+	| cmd `elem` map cmdname cmds_readonly = return ()
+	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
+
+checkEnv :: String -> IO ()
+checkEnv var =
+	whenM (not . null <$> catchDefaultIO (getEnv var) "") $
+		error $ "Action blocked by " ++ var
diff --git a/Makefile b/Makefile
index fbdefc272..ddb5e3ff6 100644
--- a/Makefile
+++ b/Makefile
@@ -9,8 +9,8 @@ endif
 
 GHCMAKE=ghc $(GHCFLAGS) --make
 
-bins=git-annex git-annex-shell git-union-merge
-mans=git-annex.1 git-annex-shell.1 git-union-merge.1
+bins=git-annex
+mans=git-annex.1 git-annex-shell.1
 sources=Build/SysConfig.hs Utility/StatFS.hs Utility/Touch.hs
 
 all=$(bins) $(mans) docs
@@ -48,6 +48,7 @@ git-union-merge.1: doc/git-union-merge.mdwn
 install: all
 	install -d $(DESTDIR)$(PREFIX)/bin
 	install $(bins) $(DESTDIR)$(PREFIX)/bin
+	ln -sf git-annex $(DESTDIR)$(PREFIX)/bin/git-annex-shell
 	install -d $(DESTDIR)$(PREFIX)/share/man/man1
 	install -m 0644 $(mans) $(DESTDIR)$(PREFIX)/share/man/man1
 	install -d $(DESTDIR)$(PREFIX)/share/doc/git-annex
diff --git a/debian/changelog b/debian/changelog
index 0f8fc001e..cf957deb3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-git-annex (3.20120310) UNRELEASED; urgency=low
+git-annex (3.20120315) unstable; urgency=low
 
   * fsck: Fix up any broken links and misplaced content caused by the
     directory hash calculation bug fixed in the last release.
@@ -12,12 +12,15 @@ git-annex (3.20120310) UNRELEASED; urgency=low
   * Added annex.bloomcapacity and annex.bloomaccuracy, which can be
     adjusted as desired to tune the bloom filter.
   * status: Display amount of memory used by bloom filter, and
-    detect then it's too small for the number of keys in a repository.
+    detect when it's too small for the number of keys in a repository.
   * git-annex-shell: Runs hooks/annex-content after content is received
     or dropped.
   * Work around a bug in rsync (IMHO) introduced by openSUSE's SIP patch.
+  * git-annex now behaves as git-annex-shell if symlinked to and run by that
+    name. The Makefile sets this up, saving some 8 mb of installed size.
+  * git-union-merge is a demo program, so it is no longer built by default.
 
- -- Joey Hess <joeyh@debian.org>  Sat, 10 Mar 2012 14:03:22 -0400
+ -- Joey Hess <joeyh@debian.org>  Thu, 15 Mar 2012 11:05:28 -0400
 
 git-annex (3.20120309) unstable; urgency=low
 
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 396b7b790..08c1f9664 100644
--- a/git-annex-shell.hs
+++ b/git-annex-shell.hs
@@ -1,117 +1,13 @@
 {- git-annex-shell main program
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 import System.Environment
-import System.Console.GetOpt
 
-import Common.Annex
-import qualified Git.Construct
-import CmdLine
-import Command
-import Annex.UUID
-import qualified Option
-
-import qualified Command.ConfigList
-import qualified Command.InAnnex
-import qualified Command.DropKey
-import qualified Command.RecvKey
-import qualified Command.SendKey
-import qualified Command.Commit
-
-cmds_readonly :: [Command]
-cmds_readonly = concat
-	[ Command.ConfigList.def
-	, Command.InAnnex.def
-	, Command.SendKey.def
-	]
-
-cmds_notreadonly :: [Command]
-cmds_notreadonly = concat
-	[ Command.RecvKey.def
-	, Command.DropKey.def
-	, Command.Commit.def
-	]
-
-cmds :: [Command]
-cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
-	where
-		adddirparam c = c
-			{ cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c
-			}
-
-options :: [OptDescr (Annex ())]
-options = Option.common ++
-	[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
-	]
-	where
-		checkuuid expected = getUUID >>= check
-			where
-				check u | u == toUUID expected = return ()
-				check NoUUID = unexpected "uninitialized repository"
-				check u = unexpected $ "UUID " ++ fromUUID u
-				unexpected s = error $
-					"expected repository UUID " ++
-					expected ++ " but found " ++ s
-
-header :: String
-header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]"
+import GitAnnexShell
 
 main :: IO ()
-main = main' =<< getArgs
-
-main' :: [String] -> IO ()
-main' [] = failure
--- skip leading -c options, passed by eg, ssh
-main' ("-c":p) = main' p
--- a command can be either a builtin or something to pass to git-shell
-main' c@(cmd:dir:params)
-	| cmd `elem` builtins = builtin cmd dir params
-	| otherwise = external c
-main' c@(cmd:_)
-	-- Handle the case of being the user's login shell. It will be passed
-	-- a single string containing all the real parameters.
-	| "git-annex-shell " `isPrefixOf` cmd = main' $ drop 1 $ shellUnEscape cmd
-	| cmd `elem` builtins = failure
-	| otherwise = external c
-
-builtins :: [String]
-builtins = map cmdname cmds
-
-builtin :: String -> String -> [String] -> IO ()
-builtin cmd dir params = do
-	checkNotReadOnly cmd
-	dispatch (cmd : filterparams params) cmds options header $
-		Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
-
-external :: [String] -> IO ()
-external params = do
-	checkNotLimited
-	unlessM (boolSystem "git-shell" $ map Param $ "-c":filterparams params) $
-		error "git-shell failed"
-
--- Drop all args after "--".
--- These tend to be passed by rsync and not useful.
-filterparams :: [String] -> [String]
-filterparams [] = []
-filterparams ("--":_) = []
-filterparams (a:as) = a:filterparams as
-
-failure :: IO ()
-failure = error $ "bad parameters\n\n" ++ usage header cmds options
-
-checkNotLimited :: IO ()
-checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
-
-checkNotReadOnly :: String -> IO ()
-checkNotReadOnly cmd
-	| cmd `elem` map cmdname cmds_readonly = return ()
-	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
-
-checkEnv :: String -> IO ()
-checkEnv var =
-	whenM (not . null <$> catchDefaultIO (getEnv var) "") $
-		error $ "Action blocked by " ++ var
+main = run =<< getArgs
diff --git a/git-annex.cabal b/git-annex.cabal
index 7d69b9a91..881e4d212 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1,5 +1,5 @@
 Name: git-annex
-Version: 3.20120310
+Version: 3.20120315
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>
@@ -39,9 +39,6 @@ Executable git-annex-shell
   Main-Is: git-annex-shell.hs
   Other-Modules: Utility.StatFS
 
-Executable git-union-merge
-  Main-Is: git-union-merge.hs
-
 source-repository head
   type: git
   location: git://git-annex.branchable.com/
diff --git a/git-annex.hs b/git-annex.hs
index a53697cdb..f5f2f22d7 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -1,13 +1,21 @@
 {- git-annex main program stub
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 import System.Environment
+import System.FilePath
 
-import GitAnnex
+import qualified GitAnnex
+import qualified GitAnnexShell
 
 main :: IO ()
-main = run =<< getArgs
+main = run =<< getProgName
+	where
+		run n
+			| isshell n = go GitAnnexShell.run
+			| otherwise = go GitAnnex.run
+		isshell n = takeFileName n == "git-annex-shell"
+		go a = a =<< getArgs