Implement offline mode for the 'install' command.

When in offline mode, 'cabal install' only installs packages from the local tarball cache. Offline mode can be enabled with the '--offline' flag. This is required to implement automatic rebuilding of source directories added with 'sandbox add-source'.
23Skidoo · Jan 1, 2013 · ac3b54a · ac3b54a
1 parent 037fed7
commit ac3b54a
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 6 deletions.
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
@@ -31,7 +31,7 @@ module Distribution.Client.Install (
 import Data.List
          ( unfoldr, nub, sort, (\\) )
 import Data.Maybe
-         ( isJust, fromMaybe, maybeToList )
+         ( isJust, isNothing, fromMaybe, maybeToList )
 import Control.Exception as Exception
          ( bracket, handleJust )
 #if MIN_VERSION_base(4,0,0)
@@ -46,7 +46,7 @@ import Control.Exception as Exception
 import Distribution.Compat.Exception
          ( SomeException, catchIO, catchExit )
 import Control.Monad
-         ( when, unless )
+         ( filterM, when, unless )
 import System.Directory
          ( getTemporaryDirectory, doesFileExist, createDirectoryIfMissing )
 import System.FilePath
@@ -441,6 +441,22 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb
       else unless dryRun $ warn verbosity
              "Note that reinstalls are always dangerous. Continuing anyway..."
 
+  -- If we are explicitly told to not download anything, check that all packages
+  -- are already fetched.
+  let offline = fromFlagOrDefault False (installOfflineMode installFlags)
+  when offline $ do
+    let pkgs = [ sourcePkg
+               | InstallPlan.Configured (ConfiguredPackage sourcePkg _ _ _)
+                 <- InstallPlan.toList installPlan ]
+    notFetched <- fmap (map packageInfoId)
+                  . filterM (fmap isNothing . checkFetched . packageSource)
+                  $ pkgs
+    unless (null notFetched) $
+      die $ "Can't download packages in offline mode. "
+      ++ "Must download the following packages to proceed:\n"
+      ++ intercalate ", " (map display notFetched)
+      ++ "\nTry running 'cabal install --only-dependencies'."
+
   where
     nothingToInstall = null (InstallPlan.ready installPlan)
 

diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
@@ -666,7 +666,8 @@ data InstallFlags = InstallFlags {
     installBuildReports     :: Flag ReportLevel,
     installSymlinkBinDir    :: Flag FilePath,
     installOneShot          :: Flag Bool,
-    installNumJobs          :: Flag (Maybe Int)
+    installNumJobs          :: Flag (Maybe Int),
+    installOfflineMode      :: Flag Bool
   }
 
 defaultInstallFlags :: InstallFlags
@@ -690,7 +691,8 @@ defaultInstallFlags = InstallFlags {
     installBuildReports    = Flag NoReports,
     installSymlinkBinDir   = mempty,
     installOneShot         = Flag False,
-    installNumJobs         = mempty
+    installNumJobs         = mempty,
+    installOfflineMode     = Flag False
   }
   where
     docIndexFile = toPathTemplate ("$datadir" </> "doc" </> "index.html")
@@ -851,6 +853,11 @@ installOptions showOrParseArgs =
         (optArg "NUM" (fmap Flag flagToJobs)
                       (Flag Nothing)
                       (map (Just . maybe "$ncpus" show) . flagToList))
+
+      , option [] ["offline"]
+          "Don't download packages from the Internet."
+          installOfflineMode (\v flags -> flags { installOfflineMode = v })
+          (yesNoOpt showOrParseArgs)
       ] ++ case showOrParseArgs of      -- TODO: remove when "cabal install" avoids
           ParseArgs ->
             [ option [] ["only"]
@@ -892,7 +899,8 @@ instance Monoid InstallFlags where
     installBuildReports    = mempty,
     installSymlinkBinDir   = mempty,
     installOneShot         = mempty,
-    installNumJobs         = mempty
+    installNumJobs         = mempty,
+    installOfflineMode     = mempty
   }
   mappend a b = InstallFlags {
     installDocumentation   = combine installDocumentation,
@@ -914,7 +922,8 @@ instance Monoid InstallFlags where
     installBuildReports    = combine installBuildReports,
     installSymlinkBinDir   = combine installSymlinkBinDir,
     installOneShot         = combine installOneShot,
-    installNumJobs         = combine installNumJobs
+    installNumJobs         = combine installNumJobs,
+    installOfflineMode     = combine installOfflineMode
   }
     where combine field = field a `mappend` field b