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. Fixes haskell#2566.
23Skidoo · May 5, 2015 · cf5604d · cf5604d
1 parent 609f449
commit cf5604d
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 7 deletions.
diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs
@@ -241,7 +241,8 @@ instance Monoid SavedConfig where
         installSymlinkBinDir         = combine installSymlinkBinDir,
         installOneShot               = combine installOneShot,
         installNumJobs               = combine installNumJobs,
-        installRunTests              = combine installRunTests
+        installRunTests              = combine installRunTests,
+        installOfflineMode           = combine installOfflineMode
         }
         where
           combine        = combine'        savedInstallFlags

diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
@@ -35,7 +35,7 @@ import Data.List
          ( isPrefixOf, unfoldr, nub, sort, (\\) )
 import qualified Data.Set as S
 import Data.Maybe
-         ( isJust, fromMaybe, mapMaybe, catMaybes )
+         ( catMaybes, isJust, isNothing, fromMaybe, mapMaybe, maybeToList )
 import Control.Exception as Exception
          ( Exception(toException), bracket, catches
          , Handler(Handler), handleJust, IOException, SomeException )
@@ -54,7 +54,7 @@ import Data.Traversable
          ( traverse )
 #endif
 import Control.Monad
-         ( forM_, when, unless )
+         ( filterM, forM_, when, unless )
 import System.Directory
          ( getTemporaryDirectory, doesDirectoryExist, doesFileExist,
            createDirectoryIfMissing, removeFile, renameDirectory )
@@ -509,6 +509,22 @@ checkPrintPlan verbosity comp 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
@@ -1154,7 +1154,8 @@ data InstallFlags = InstallFlags {
     installSymlinkBinDir    :: Flag FilePath,
     installOneShot          :: Flag Bool,
     installNumJobs          :: Flag (Maybe Int),
-    installRunTests         :: Flag Bool
+    installRunTests         :: Flag Bool,
+    installOfflineMode      :: Flag Bool
   }
 
 defaultInstallFlags :: InstallFlags
@@ -1181,7 +1182,8 @@ defaultInstallFlags = InstallFlags {
     installSymlinkBinDir   = mempty,
     installOneShot         = Flag False,
     installNumJobs         = mempty,
-    installRunTests        = mempty
+    installRunTests        = mempty,
+    installOfflineMode     = Flag False
   }
   where
     docIndexFile = toPathTemplate ("$datadir" </> "doc"
@@ -1392,6 +1394,10 @@ installOptions showOrParseArgs =
       , optionNumJobs
         installNumJobs (\v flags -> flags { installNumJobs = v })
 
+      , 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 ->
@@ -1426,7 +1432,8 @@ instance Monoid InstallFlags where
     installSymlinkBinDir   = mempty,
     installOneShot         = mempty,
     installNumJobs         = mempty,
-    installRunTests        = mempty
+    installRunTests        = mempty,
+    installOfflineMode     = mempty
   }
   mappend a b = InstallFlags {
     installDocumentation   = combine installDocumentation,
@@ -1451,7 +1458,8 @@ instance Monoid InstallFlags where
     installSymlinkBinDir   = combine installSymlinkBinDir,
     installOneShot         = combine installOneShot,
     installNumJobs         = combine installNumJobs,
-    installRunTests        = combine installRunTests
+    installRunTests        = combine installRunTests,
+    installOfflineMode     = combine installOfflineMode
   }
     where combine field = field a `mappend` field b