diff --git a/Cabal/src/Distribution/Make.hs b/Cabal/src/Distribution/Make.hs
index aaa63a94bdbbfdab3c3f1229bde58d761339c673..82334d550f081a7d24d214420792d11693947b3a 100644
--- a/Cabal/src/Distribution/Make.hs
+++ b/Cabal/src/Distribution/Make.hs
@@ -91,7 +91,6 @@ defaultMainHelper :: [String] -> IO ()
 defaultMainHelper args = do
   command <- commandsRun (globalCommand commands) commands args
   case command of
-    CommandDelegate -> pure ()
     CommandHelp help -> printHelp help
     CommandList opts -> printOptionsList opts
     CommandErrors errs -> printErrors errs
@@ -100,7 +99,6 @@ defaultMainHelper args = do
         _
           | fromFlag (globalVersion flags) -> printVersion
           | fromFlag (globalNumericVersion flags) -> printNumericVersion
-        CommandDelegate -> pure ()
         CommandHelp help -> printHelp help
         CommandList opts -> printOptionsList opts
         CommandErrors errs -> printErrors errs
diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs
index 0649a08526007b2fa1154883b3f322887b493f96..c52a02c0f965989a0bce9489f6ca7a746ec955ff 100644
--- a/Cabal/src/Distribution/Simple.hs
+++ b/Cabal/src/Distribution/Simple.hs
@@ -170,7 +170,6 @@ defaultMainHelper hooks args = topHandler $ do
   args' <- expandResponse args
   command <- commandsRun (globalCommand commands) commands args'
   case command of
-    CommandDelegate -> pure ()
     CommandHelp help -> printHelp help
     CommandList opts -> printOptionsList opts
     CommandErrors errs -> printErrors errs
@@ -179,7 +178,6 @@ defaultMainHelper hooks args = topHandler $ do
         _
           | fromFlag (globalVersion flags) -> printVersion
           | fromFlag (globalNumericVersion flags) -> printNumericVersion
-        CommandDelegate -> pure ()
         CommandHelp help -> printHelp help
         CommandList opts -> printOptionsList opts
         CommandErrors errs -> printErrors errs
diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs
index dc2be1a698b4131d555a68f2f1588a67708b6d47..2da6486cba679e9bf845e1ecee55073c66134e93 100644
--- a/Cabal/src/Distribution/Simple/Command.hs
+++ b/Cabal/src/Distribution/Simple/Command.hs
@@ -47,6 +47,8 @@ module Distribution.Simple.Command
 
     -- ** Running commands
   , commandsRun
+  , commandsRunWithFallback
+  , defaultCommandFallback
 
     -- * Option Fields
   , OptionField (..)
@@ -85,15 +87,12 @@ module Distribution.Simple.Command
 import Distribution.Compat.Prelude hiding (get)
 import Prelude ()
 
-import Control.Exception (try)
 import qualified Data.Array as Array
 import qualified Data.List as List
 import Distribution.Compat.Lens (ALens', (#~), (^#))
 import qualified Distribution.GetOpt as GetOpt
 import Distribution.ReadE
 import Distribution.Simple.Utils
-import System.Directory (findExecutable)
-import System.Process (callProcess)
 
 data CommandUI flags = CommandUI
   { commandName :: String
@@ -599,13 +598,11 @@ data CommandParse flags
   | CommandList [String]
   | CommandErrors [String]
   | CommandReadyToGo flags
-  | CommandDelegate
 instance Functor CommandParse where
   fmap _ (CommandHelp help) = CommandHelp help
   fmap _ (CommandList opts) = CommandList opts
   fmap _ (CommandErrors errs) = CommandErrors errs
   fmap f (CommandReadyToGo flags) = CommandReadyToGo (f flags)
-  fmap _ CommandDelegate = CommandDelegate
 
 data CommandType = NormalCommand | HiddenCommand
 data Command action
@@ -632,27 +629,62 @@ commandAddAction command action =
       let flags = mkflags (commandDefaultFlags command)
        in action flags args
 
+-- Print suggested command if edit distance is < 5
+badCommand :: [Command action] -> String -> CommandParse a
+badCommand commands' cname =
+  case eDists of
+    [] -> CommandErrors [unErr]
+    (s : _) ->
+      CommandErrors
+        [ unErr
+        , "Maybe you meant `" ++ s ++ "`?\n"
+        ]
+  where
+    eDists =
+      map fst . List.sortBy (comparing snd) $
+        [ (cname', dist)
+        | -- Note that this is not commandNames, so close suggestions will show
+        -- hidden commands
+        (Command cname' _ _ _) <- commands'
+        , let dist = editDistance cname' cname
+        , dist < 5
+        ]
+    unErr = "unrecognised command: " ++ cname ++ " (try --help)"
+
 commandsRun
   :: CommandUI a
   -> [Command action]
   -> [String]
   -> IO (CommandParse (a, CommandParse action))
 commandsRun globalCommand commands args =
+  commandsRunWithFallback globalCommand commands defaultCommandFallback args
+
+defaultCommandFallback
+  :: [Command action]
+  -> String
+  -> [String]
+  -> IO (CommandParse action)
+defaultCommandFallback commands' name _cmdArgs = pure $ badCommand commands' name
+
+commandsRunWithFallback
+  :: CommandUI a
+  -> [Command action]
+  -> ([Command action] -> String -> [String] -> IO (CommandParse action))
+  -> [String]
+  -> IO (CommandParse (a, CommandParse action))
+commandsRunWithFallback globalCommand commands defaultCommand args =
   case commandParseArgs globalCommand True args of
-    CommandDelegate -> pure CommandDelegate
     CommandHelp help -> pure $ CommandHelp help
     CommandList opts -> pure $ CommandList (opts ++ commandNames)
     CommandErrors errs -> pure $ CommandErrors errs
     CommandReadyToGo (mkflags, args') -> case args' of
-      ("help" : cmdArgs) -> pure $ handleHelpCommand cmdArgs
+      ("help" : cmdArgs) -> handleHelpCommand flags cmdArgs
       (name : cmdArgs) -> case lookupCommand name of
         [Command _ _ action _] ->
           pure $ CommandReadyToGo (flags, action cmdArgs)
         _ -> do
-          mCommand <- findExecutable $ "cabal-" <> name
-          case mCommand of
-            Just exec -> callExternal flags exec cmdArgs
-            Nothing -> pure $ CommandReadyToGo (flags, badCommand name)
+          final_cmd <- defaultCommand commands' name cmdArgs
+          return $ CommandReadyToGo (flags, final_cmd)
       [] -> pure $ CommandReadyToGo (flags, noCommand)
       where
         flags = mkflags (commandDefaultFlags globalCommand)
@@ -661,55 +693,29 @@ commandsRun globalCommand commands args =
       [ cmd | cmd@(Command cname' _ _ _) <- commands', cname' == cname
       ]
 
-    callExternal :: a -> String -> [String] -> IO (CommandParse (a, CommandParse action))
-    callExternal flags exec cmdArgs = do
-      result <- try $ callProcess exec cmdArgs
-      case result of
-        Left ex -> pure $ CommandErrors ["Error executing external command: " ++ show (ex :: SomeException)]
-        Right _ -> pure $ CommandReadyToGo (flags, CommandDelegate)
-
     noCommand = CommandErrors ["no command given (try --help)\n"]
 
-    -- Print suggested command if edit distance is < 5
-    badCommand :: String -> CommandParse a
-    badCommand cname =
-      case eDists of
-        [] -> CommandErrors [unErr]
-        (s : _) ->
-          CommandErrors
-            [ unErr
-            , "Maybe you meant `" ++ s ++ "`?\n"
-            ]
-      where
-        eDists =
-          map fst . List.sortBy (comparing snd) $
-            [ (cname', dist)
-            | (Command cname' _ _ _) <- commands'
-            , let dist = editDistance cname' cname
-            , dist < 5
-            ]
-        unErr = "unrecognised command: " ++ cname ++ " (try --help)"
-
     commands' = commands ++ [commandAddAction helpCommandUI undefined]
     commandNames = [name | (Command name _ _ NormalCommand) <- commands']
 
     -- A bit of a hack: support "prog help" as a synonym of "prog --help"
     -- furthermore, support "prog help command" as "prog command --help"
-    handleHelpCommand cmdArgs =
+    handleHelpCommand flags cmdArgs =
       case commandParseArgs helpCommandUI True cmdArgs of
-        CommandDelegate -> CommandDelegate
-        CommandHelp help -> CommandHelp help
-        CommandList list -> CommandList (list ++ commandNames)
-        CommandErrors _ -> CommandHelp globalHelp
-        CommandReadyToGo (_, []) -> CommandHelp globalHelp
+        CommandHelp help -> pure $ CommandHelp help
+        CommandList list -> pure $ CommandList (list ++ commandNames)
+        CommandErrors _ -> pure $ CommandHelp globalHelp
+        CommandReadyToGo (_, []) -> pure $ CommandHelp globalHelp
         CommandReadyToGo (_, (name : cmdArgs')) ->
           case lookupCommand name of
             [Command _ _ action _] ->
               case action ("--help" : cmdArgs') of
-                CommandHelp help -> CommandHelp help
-                CommandList _ -> CommandList []
-                _ -> CommandHelp globalHelp
-            _ -> badCommand name
+                CommandHelp help -> pure $ CommandHelp help
+                CommandList _ -> pure $ CommandList []
+                _ -> pure $ CommandHelp globalHelp
+            _ -> do
+              fall_back <- defaultCommand commands' name ("--help" : cmdArgs')
+              return $ CommandReadyToGo (flags, fall_back)
       where
         globalHelp = commandHelp globalCommand
 
diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs
index 9114102f2bf90c87e29a6c5546c2a711a7b89508..dc196a66864c8d4942b021526e145977945a952b 100644
--- a/cabal-install/src/Distribution/Client/Main.hs
+++ b/cabal-install/src/Distribution/Client/Main.hs
@@ -205,7 +205,8 @@ import Distribution.Simple.Command
   , commandAddAction
   , commandFromSpec
   , commandShowOptions
-  , commandsRun
+  , commandsRunWithFallback
+  , defaultCommandFallback
   , hiddenCommand
   )
 import Distribution.Simple.Compiler (PackageDBStack)
@@ -221,6 +222,8 @@ import Distribution.Simple.PackageDescription (readGenericPackageDescription)
 import Distribution.Simple.Program
   ( configureAllKnownPrograms
   , defaultProgramDb
+  , defaultProgramSearchPath
+  , findProgramOnSearchPath
   , getProgramInvocationOutput
   , simpleProgramInvocation
   )
@@ -261,7 +264,7 @@ import System.Directory
   , getCurrentDirectory
   , withCurrentDirectory
   )
-import System.Environment (getProgName)
+import System.Environment (getEnvironment, getExecutablePath, getProgName)
 import System.FilePath
   ( dropExtension
   , splitExtension
@@ -276,6 +279,7 @@ import System.IO
   , stderr
   , stdout
   )
+import System.Process (createProcess, env, proc)
 
 -- | Entry point
 --
@@ -334,9 +338,8 @@ warnIfAssertionsAreEnabled =
 mainWorker :: [String] -> IO ()
 mainWorker args = do
   topHandler $ do
-    command <- commandsRun (globalCommand commands) commands args
+    command <- commandsRunWithFallback (globalCommand commands) commands delegateToExternal args
     case command of
-      CommandDelegate -> pure ()
       CommandHelp help -> printGlobalHelp help
       CommandList opts -> printOptionsList opts
       CommandErrors errs -> printErrors errs
@@ -347,7 +350,6 @@ mainWorker args = do
                 printVersion
             | fromFlagOrDefault False (globalNumericVersion globalFlags) ->
                 printNumericVersion
-          CommandDelegate -> pure ()
           CommandHelp help -> printCommandHelp help
           CommandList opts -> printOptionsList opts
           CommandErrors errs -> do
@@ -366,6 +368,27 @@ mainWorker args = do
             warnIfAssertionsAreEnabled
             action globalFlags
   where
+    delegateToExternal
+      :: [Command Action]
+      -> String
+      -> [String]
+      -> IO (CommandParse Action)
+    delegateToExternal commands' name cmdArgs = do
+      mCommand <- findProgramOnSearchPath normal defaultProgramSearchPath ("cabal-" <> name)
+      case mCommand of
+        Just (exec, _) -> return (CommandReadyToGo $ \_ -> callExternal exec name cmdArgs)
+        Nothing -> defaultCommandFallback commands' name cmdArgs
+
+    callExternal :: String -> String -> [String] -> IO ()
+    callExternal exec name cmdArgs = do
+      cur_env <- getEnvironment
+      cabal_exe <- getExecutablePath
+      let new_env = ("CABAL", cabal_exe) : cur_env
+      result <- try $ createProcess ((proc exec (name : cmdArgs)){env = Just new_env})
+      case result of
+        Left ex -> printErrors ["Error executing external command: " ++ show (ex :: SomeException)]
+        Right _ -> return ()
+
     printCommandHelp help = do
       pname <- getProgName
       putStr (help pname)
diff --git a/cabal-install/src/Distribution/Client/SavedFlags.hs b/cabal-install/src/Distribution/Client/SavedFlags.hs
index 5fa417a8578ded768456fad3586d9ac66f88b2ee..1a598a58fd7d861c5bd7ef4244baa83ae9d6a7b7 100644
--- a/cabal-install/src/Distribution/Client/SavedFlags.hs
+++ b/cabal-install/src/Distribution/Client/SavedFlags.hs
@@ -51,7 +51,6 @@ readCommandFlags :: FilePath -> CommandUI flags -> IO flags
 readCommandFlags path command = do
   savedArgs <- fmap (fromMaybe []) (readSavedArgs path)
   case (commandParseArgs command True savedArgs) of
-    CommandDelegate -> error "CommandDelegate Flags evaluated, this should never occur"
     CommandHelp _ -> throwIO (SavedArgsErrorHelp savedArgs)
     CommandList _ -> throwIO (SavedArgsErrorList savedArgs)
     CommandErrors errs -> throwIO (SavedArgsErrorOther savedArgs errs)
diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs
index 850c8bfbcec25a11a20012503646c02ae05e48a7..d9535b60507a0f86a7cf1a194fd33d10235c8989 100644
--- a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs
@@ -8,19 +8,29 @@ import qualified Data.Time.Clock as Time
 import qualified Data.Time.Format as Time
 import Data.Maybe
 import System.Environment
+import System.FilePath
 
 main = do
   cabalTest $ do
     res <- cabalWithStdin "v2-build" ["all"] ""
     exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa"
-    env <- getTestEnv
-    path <- liftIO $ getEnv "PATH"
-    let newpath = takeDirectory exe_path ++ ":" ++ path
-    let new_env = (("PATH", Just newpath) : (testEnvironment env))
-    withEnv new_env $ do
+    addToPath (takeDirectory exe_path) $ do
+      -- Test that the thing works at all
       res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h)
       assertOutputContains "aaaa" res
 
+      -- Test that the extra arguments are passed on
+      res <- cabal_raw_action ["aaaa", "--foobaz"] (\h -> () <$ Process.waitForProcess h)
+      assertOutputContains "--foobaz" res
+
+      -- Test what happens with "global" flags
+      res <- cabal_raw_action ["aaaa", "--version"] (\h -> () <$ Process.waitForProcess h)
+      assertOutputContains "--version" res
+
+      -- Test what happens with "global" flags
+      res <- cabal_raw_action ["aaaa", "--config-file", "abc"] (\h -> () <$ Process.waitForProcess h)
+      assertOutputContains "--config-file" res
+
 
 cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result
 cabal_raw_action args action = do
diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs
index 5bee0ebbef119826187981ca2afd66fd3b850e0b..c2d121c9a3930a7511afc42155cfb462f0487135 100644
--- a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs
@@ -1,4 +1,5 @@
 module Main where
 
-main = do
-  putStrLn "aaaa"
+import System.Environment
+
+main = getArgs >>= print
diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs
index 891c9e43d4b9d09e3e16438962a0b7ce48232bab..4344076398a93202ba1558ef2b03aadf9cc2427a 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs
@@ -10,15 +10,12 @@ import Data.Maybe
 import System.Environment
 
 main = do
-  cabalTest $ expectBroken 9402 $ do
+  cabalTest $ do
     res <- cabalWithStdin "v2-build" ["all"] ""
     exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa"
     env <- getTestEnv
-    path <- liftIO $ getEnv "PATH"
-    let newpath = takeDirectory exe_path ++ ":" ++ path
-    let new_env = (("OTHER_VAR", Just "is set") : ("PATH", Just newpath) : (testEnvironment env))
-
-    withEnv new_env $ do
+    let new_env = (("OTHER_VAR", Just "is set") : (testEnvironment env))
+    withEnv new_env $ addToPath (takeDirectory exe_path) $ do
       res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h)
       assertOutputContains "cabal-install" res
       assertOutputContains "is set" res
diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out
index 0a3edf696f924f70728cc1a9eeb2722a4b9d4f35..1c4c24db55c1f7af2090527e26e4646dbab0a3e1 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out
+++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out
@@ -3,10 +3,6 @@ Resolving dependencies...
 Build profile: -w ghc-<GHCVER> -O1
 In order, the following will be built:
  - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run)
- - setup-test-0.1.0.0 (exe:setup) (first run)
 Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0...
 Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0...
 Building executable 'cabal-aaaa' for setup-test-0.1.0.0...
-Configuring executable 'setup' for setup-test-0.1.0.0...
-Preprocessing executable 'setup' for setup-test-0.1.0.0...
-Building executable 'setup' for setup-test-0.1.0.0...
diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs
index a3a8acfa5c740461f0866defce2ee8f3b4d2beeb..96e69bbbd6ebc98d4b4a4a3bdeb80939762f4765 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs
@@ -10,14 +10,10 @@ import Data.Maybe
 import System.Environment
 
 main = do
-  cabalTest $ expectBroken 9404 $ do
+  cabalTest $ do
     res <- cabalWithStdin "v2-build" ["all"] ""
     exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa"
-    env <- getTestEnv
-    path <- liftIO $ getEnv "PATH"
-    let newpath = takeDirectory exe_path ++ ":" ++ path
-    let new_env = (("PATH", Just newpath) : (testEnvironment env))
-    withEnv new_env $ do
+    addToPath (takeDirectory exe_path) $ do
       res <- cabal_raw_action ["help", "aaaa"] (\h -> () <$ Process.waitForProcess h)
       assertOutputContains "I am helping with the aaaa command" res
 
diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs
index 10fe05988d80a1ccfe8fd678c9ed66e374fd78a7..dd139b905da2e64507a65135bc6a3a7bca5d9d26 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs
@@ -5,5 +5,5 @@ import System.Environment
 main = do
   args <- getArgs
   case args of
-    ["--help"] -> putStrLn "I am helping with the aaaa command"
+    ["aaaa" , "--help"] -> putStrLn "I am helping with the aaaa command"
     _ -> putStrLn "aaaa"
diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs
index 7de624d45308db16e16b630f04e985997e45ad8b..d6bea04003f2f57e8dff9196ac3d35e8a312bc0e 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs
+++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs
@@ -1,17 +1,14 @@
 import Test.Cabal.Prelude
 import System.Environment
 
-main = setupTest $ expectBroken 9403 $ do
+main = setupTest $ do
         withPackageDb $ do
           withDirectory "aaaa" $ setup_install []
           r <- runInstalledExe' "cabal-aaaa" []
           env <- getTestEnv
-          path <- liftIO $ getEnv "PATH"
           let exe_path = testPrefixDir env </> "bin"
-          let newpath = exe_path ++ ":" ++ path
-          let new_env = (("PATH", Just newpath) : (testEnvironment env))
-          withEnv new_env $ do
-            res <- withDirectory "custom" $ setup' "aaaa" []
-            assertOutputContains "did you mean" res
+          addToPath exe_path $ do
+            res <- fails $ withDirectory "custom" $ setup' "aaaa" []
+            assertOutputContains "unrecognised command" res
 
 
diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out
index e234d5e2a484e0da024865e608e1abbb7f1af093..6600ad3ca2ffa0c01f42f3b6d87b99677f38e14a 100644
--- a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out
+++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out
@@ -1,22 +1,13 @@
 # Setup configure
 Configuring aaaa-0.1.0.0...
 # Setup build
-Preprocessing executable 'aaaa' for aaaa-0.1.0.0...
-Building executable 'aaaa' for aaaa-0.1.0.0...
+Preprocessing executable 'cabal-aaaa' for aaaa-0.1.0.0...
+Building executable 'cabal-aaaa' for aaaa-0.1.0.0...
 # Setup copy
-Installing executable aaaa in <PATH>
+Installing executable cabal-aaaa in <PATH>
 Warning: The directory <ROOT>/setup.dist/usr/bin is not in the system search path.
 # Setup register
 Package contains no library to register: aaaa-0.1.0.0...
-# aaaa
+# cabal-aaaa
 aaaa
-# Setup configure
-Warning: custom.cabal:19:3: Unknown field: "build-depends"
-Configuring custom-0.1.0.0...
-# Setup build
-Preprocessing library for custom-0.1.0.0...
-Building library for custom-0.1.0.0...
-# Setup copy
-Installing library in <PATH>
-# Setup register
-Registering library for custom-0.1.0.0...
+# Setup aaaa
diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs
index 2977a9270cc99341062bcd6e5f5556d16df4d9a2..c95a55988f8ae080d2a0f860b13b08f8d3236c2a 100644
--- a/cabal-testsuite/src/Test/Cabal/Prelude.hs
+++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -60,16 +60,16 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe (mapMaybe, fromMaybe)
 import System.Exit (ExitCode (..))
-import System.FilePath ((</>), takeExtensions, takeDrive, takeDirectory, normalise, splitPath, joinPath, splitFileName, (<.>), dropTrailingPathSeparator)
+import System.FilePath
 import Control.Concurrent (threadDelay)
 import qualified Data.Char as Char
-import System.Directory (canonicalizePath, copyFile, copyFile, doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getDirectoryContents, listDirectory)
+import System.Directory
 import Control.Retry (exponentialBackoff, limitRetriesByCumulativeDelay)
 import Network.Wait (waitTcpVerbose)
+import System.Environment
 
 #ifndef mingw32_HOST_OS
 import Control.Monad.Catch ( bracket_ )
-import System.Directory    ( removeFile )
 import System.Posix.Files  ( createSymbolicLink )
 import System.Posix.Resource
 #endif
@@ -113,6 +113,16 @@ withDirectory f = withReaderT
 withEnv :: [(String, Maybe String)] -> TestM a -> TestM a
 withEnv e = withReaderT (\env -> env { testEnvironment = testEnvironment env ++ e })
 
+-- | Prepend a directory to the PATH
+addToPath :: FilePath -> TestM a -> TestM a
+addToPath exe_dir action = do
+  env <- getTestEnv
+  path <- liftIO $ getEnv "PATH"
+  let newpath = exe_dir ++ [searchPathSeparator] ++ path
+  let new_env = (("PATH", Just newpath) : (testEnvironment env))
+  withEnv new_env action
+
+
 -- HACK please don't use me
 withEnvFilter :: (String -> Bool) -> TestM a -> TestM a
 withEnvFilter p = withReaderT (\env -> env { testEnvironment = filter (p . fst) (testEnvironment env) })
diff --git a/doc/external-commands.rst b/doc/external-commands.rst
index 047d8f4dca023a52b560ee22d6c74ab3ed5bc82b..e72495aa1603cbb58bfe64da00ea2df20ab78928 100644
--- a/doc/external-commands.rst
+++ b/doc/external-commands.rst
@@ -1,8 +1,22 @@
 External Commands
 =================
 
-Cabal provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``.
+``cabal-install`` provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``.
 
-If you execute ``cabal my-custom-command``, Cabal will search the path for an executable named ``cabal-my-custom-command`` and execute it, passing any remaining arguments to this external command. An error will be thrown in case the custom command is not found.
+If you execute ``cabal <cmd>``, ``cabal-install`` will search the path for an executable named ``cabal-<cmd>`` and execute it. The name of the command is passed as the first argument and
+the remaining arguments are passed afterwards. An error will be thrown in case the custom command is not found.
+
+The ``$CABAL`` environment variable is set to the path of the ``cabal-install`` executable
+which invoked the subcommand.
+
+It is strongly recommended that you implement your custom commands by calling the
+CLI via the ``$CABAL`` variable rather than linking against the ``Cabal`` library.
+There is no guarantee that the subcommand will link against the same version of the
+``Cabal`` library as ``cabal-install`` so it would lead to unexpected results and
+incompatibilities.
+
+``cabal-install`` can also display the help message of the external command.
+When ``cabal help <cmd>`` is invoked, then ``cabal-<cmd> <cmd> --help`` will be called so
+your external command can display a help message.
 
 For ideas or existing external commands, visit `this Discourse thread <https://discourse.haskell.org/t/an-external-command-system-for-cabal-what-would-you-do-with-it/7114>`_.