Persist VCS Sources

aura/CHANGELOG.md

@@ -4,14 +4,18 @@
 
 #### Added
 
-- Aura is now configurable via a conf file! Aura expects it at `/etc/aura.conf`,
-  but will not break if it's missing. If you install Aura via its AUR package,
-  this file will be installed for you automatically.
+- **Aura is now configurable via a conf file!** Aura expects it at
+  `/etc/aura.conf`, but will not break if it's missing. If you install Aura via
+  its AUR package, this file will be installed for you automatically.
+- A new flag `--vcspath` to accompany the new VCS build behaviour (see below).
 - A new flag `--allsourcepath` to accompany the restored `--allsource`
-  functionality, as mentioned below.
+  functionality (see below).
 
 #### Changed
 
+- VCS packages (e.g. `*-git`, `*-svn`, etc.) and their cloned sources are now
+  built and stored in `/var/cache/aura/vcs`. **Subsequent builds will no longer
+  reclone everything.** [#462](https://github.com/fosskers/aura/issues/462)
 - `--hotedit` will now offer to edit `.install` and `.patch` files. [#208](https://github.com/fosskers/aura/issues/208)
 - Some modules have been renamed and moved around, particularly on the `exec` side.
 

aura/doc/aura.conf

@@ -46,6 +46,7 @@
 # user = YOU
 # buildpath = /tmp
 # allsourcepath = /var/cache/aura/src
+# vcspath = /var/cache/aura/vcs
 
 # --- PKGBUILD Analysis --- #
 # Aura automatically scans PKGBUILDs for malicious bash usage and other "bad

aura/exec/Aura/Flags.hs

@@ -333,14 +333,15 @@ viewconf :: Parser AuraOp
 viewconf = flag' ViewConf (long "viewconf" <> help "View the Pacman config file.")
 
 buildConfig :: Parser BuildConfig
-buildConfig = BuildConfig <$> makepkg <*> bp <*> bu <*> asp <*> trunc <*> buildSwitches
+buildConfig = BuildConfig <$> makepkg <*> bp <*> bu <*> asp <*> vp <*> trunc <*> buildSwitches
   where makepkg = S.fromList <$> many (ia <|> as <|> si)
         ia      = flag' IgnoreArch (long "ignorearch" <> hidden <> help "Exposed makepkg flag.")
         as      = flag' AllSource (long "allsource" <> hidden <> help "Exposed makepkg flag.")
         si      = flag' SkipInteg (long "skipinteg" <> hidden <> help "Skip all makepkg integrity checks.")
         bp      = optional $ option (eitherReader absFilePath) (long "build" <> metavar "PATH" <> hidden <> help "Directory in which to build packages.")
         bu      = optional $ User <$> strOption (long "builduser" <> metavar "USER" <> hidden <> help "User account to build as.")
         asp     = optional $ option (eitherReader absFilePath) (long "allsourcepath" <> metavar "PATH" <> hidden <> help "Directory in which to store the output of --allsource.")
+        vp      = optional $ option (eitherReader absFilePath) (long "vcspath" <> metavar "PATH" <> hidden <> help "Directory in which to build and store VCS packages.")
         trunc   = fmap Head (option auto (long "head" <> metavar "N" <> hidden <> help "Only show top N search results."))
           <|> fmap Tail (option auto (long "tail" <> metavar "N" <> hidden <> help "Only show last N search results."))
           <|> pure None

aura/exec/Aura/Settings/Runtime.hs

@@ -83,6 +83,7 @@ withEnv (Program op co bc lng ll) f = do
               bc & buildUserOfL     .~ bu
                  & buildPathOfL     %~ (<|> acBuildPath auraConf)
                  & allsourcePathOfL %~ (<|> acASPath auraConf)
+                 & vcsPathOfL       %~ (<|> acVCSPath auraConf)
                  & buildSwitchesOfL <>~ maybe S.empty S.singleton (acAnalyse auraConf)
           , logLevelOf = ll
           , logFuncOf = logFunc }

aura/lib/Aura/Build.hs

@@ -13,6 +13,7 @@ module Aura.Build
   ( installPkgFiles
   , buildPackages
   , srcPkgStore
+  , vcsStore
   ) where
 
 import           Aura.Core
@@ -30,6 +31,7 @@ import           Data.Hashable (hash)
 import           RIO
 import           RIO.Directory
 import           RIO.FilePath
+import qualified RIO.List as L
 import qualified RIO.NonEmpty as NEL
 import           RIO.Partial (fromJust)
 import qualified RIO.Set as S
@@ -39,9 +41,17 @@ import           System.Process.Typed
 
 ---
 
+-- | Storage location for "source" packages built with @--allsource@.
+-- Can be overridden in config or with @--allsourcepath@.
 srcPkgStore :: FilePath
 srcPkgStore = "/var/cache/aura/src"
 
+-- | Storage/build location for VCS packages like @cool-retroterm-git@. Some of
+-- these packages are quite large (e.g. kernels), and so recloning them in their
+-- entirety upon each @-Au@ is wasteful.
+vcsStore :: FilePath
+vcsStore = "/var/cache/aura/vcs"
+
 -- | Expects files like: \/var\/cache\/pacman\/pkg\/*.pkg.tar.xz
 installPkgFiles :: NonEmpty PackagePath -> RIO Env ()
 installPkgFiles files = do
@@ -69,21 +79,31 @@ build p = do
 -- | Should never throw an IO Exception. In theory all errors
 -- will come back via the @Language -> String@ function.
 --
+-- If the package is a VCS package (i.e. ending in -git, etc.), it will be built
+-- and stored in a separate, deterministic location to prevent repeated clonings
+-- during subsequent builds.
+--
 -- If `--allsource` was given, then the package isn't actually built.
 -- Instead, a @.src.tar.gz@ file is produced and copied to `srcPkgStore`.
 build' :: Buildable -> RIO Env (Either Failure [PackagePath])
 build' b = do
   ss <- asks settings
-  let !pth = fromMaybe defaultBuildDir . buildPathOf $ buildConfigOf ss
+  let !isDevel = isDevelPkg $ bName b
+      !pth | isDevel = fromMaybe vcsStore . vcsPathOf $ buildConfigOf ss
+           | otherwise = fromMaybe defaultBuildDir . buildPathOf $ buildConfigOf ss
       !usr = fromMaybe (User "UNKNOWN") . buildUserOf $ buildConfigOf ss
   createDirectoryIfMissing True pth
   setCurrentDirectory pth
-  buildDir <- liftIO $ randomDirName b
+  buildDir <- liftIO $ getBuildDir b
   createDirectoryIfMissing True buildDir
   setCurrentDirectory buildDir
   runExceptT $ do
-    bs <- ExceptT $ cloneRepo b usr
+    bs <- ExceptT $ do
+      let !dir = buildDir </> T.unpack (pnName $ bName b)
+      pulled <- doesDirectoryExist dir
+      bool (cloneRepo b usr) (pure $ Right dir) pulled
     setCurrentDirectory bs
+    when isDevel $ ExceptT pullRepo
     liftIO $ overwritePkgbuild ss b
     liftIO $ overwriteInstall ss
     liftIO $ overwritePatches ss
@@ -93,8 +113,17 @@ build' b = do
         liftIO (makepkgSource usr >>= traverse_ (moveToSourcePath allsourcePath)) $> []
       else do
         pNames <- ExceptT . liftIO . fmap (fmap NEL.toList) $ makepkg ss usr
-        paths  <- liftIO $ traverse (moveToCachePath ss) pNames
-        pure paths
+        liftIO $ traverse (moveToCachePath ss) pNames
+
+getBuildDir :: Buildable -> IO FilePath
+getBuildDir b
+  | isDevelPkg $ bName b = vcsBuildDir $ bName b
+  | otherwise = randomDirName b
+
+vcsBuildDir :: PkgName -> IO FilePath
+vcsBuildDir (PkgName pn) = do
+  pwd <- getCurrentDirectory
+  pure $ pwd </> T.unpack pn
 
 -- | Create a temporary directory with a semi-random name based on
 -- the `Buildable` we're working with.
@@ -117,6 +146,15 @@ cloneRepo pkg usr = do
     Nothing -> pure . Left . Failure . buildFail_7 $ bName pkg
     Just sd -> chown usr sd ["-R"] $> Right sd
 
+-- | Assuming that we're already in a VCS-based package's build folder,
+-- just pull the latest instead of cloning.
+pullRepo :: RIO Env (Either Failure ())
+pullRepo = do
+  ec <- runProcess . setStderr closed . setStdout closed $ proc "git" ["pull"]
+  case ec of
+    ExitFailure _ -> pure . Left $ Failure buildFail_12
+    ExitSuccess   -> pure $ Right ()
+
 -- | Edit the PKGBUILD in-place, if the user wants to.
 overwritePkgbuild :: Settings -> Buildable -> IO ()
 overwritePkgbuild ss b = when (switch ss HotEdit) . liftIO $ do
@@ -127,7 +165,7 @@ overwritePkgbuild ss b = when (switch ss HotEdit) . liftIO $ do
 overwriteInstall :: Settings -> IO ()
 overwriteInstall ss = when (switch ss HotEdit) . liftIO $ do
   files <- getCurrentDirectory >>= listDirectory
-  case listToMaybe (filter ((== ".install") . takeFileName) files) of
+  case L.find ((== ".install") . takeFileName) files of
     Nothing -> pure ()
     Just _  -> do
       ans <- optionalPrompt ss hotEdit_2

aura/lib/Aura/Core.hs

@@ -17,7 +17,8 @@ module Aura.Core
     -- * User Privileges
   , sudo, trueRoot
     -- * Querying the Package Database
-  , foreignPackages, orphans, develPkgs
+  , foreignPackages, orphans
+  , develPkgs, isDevelPkg
   , Unsatisfied(..), Satisfied(..)
   , areSatisfied, isInstalled
   , checkDBLock
@@ -128,11 +129,17 @@ foreignPackages = S.fromList . mapMaybe simplepkg' <$> pacmanLines ["-Qm"]
 orphans :: IO (Set PkgName)
 orphans = S.fromList . map PkgName <$> pacmanLines ["-Qqdt"]
 
--- | Any package whose name is suffixed by git, hg, svn, darcs, cvs, or bzr.
+-- | Any installed package whose name is suffixed by git, hg, svn, darcs, cvs,
+-- or bzr.
 develPkgs :: IO (Set PkgName)
 develPkgs = S.filter isDevelPkg . S.map spName <$> foreignPackages
-  where isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes
-        suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"]
+
+-- | Is a package suffixed by git, hg, svn, darcs, cvs, or bzr?
+isDevelPkg :: PkgName -> Bool
+isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes
+  where
+    suffixes :: [Text]
+    suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"]
 
 -- | Returns what it was given if the package is already installed.
 -- Reasoning: Using raw bools can be less expressive.

aura/lib/Aura/Install.hs

@@ -185,11 +185,17 @@ buildAndInstall bss = do
     f (Cache cache) bs = do
       ss <- asks settings
       let (ps, cached) = fmapEither g $ NEL.toList bs
+
+          -- | If we used @--force@, then take the package as-is. Otherwise, try
+          -- to look it up in the package cache. If we find a match, we don't
+          -- need to build it.
+          g :: Buildable -> Either Buildable PackagePath
           g b = case bToSP b `M.lookup` cache of
             Just pp | not (switch ss ForceBuilding) -> Right pp
             _                                       -> Left b
+
       built <- traverse buildPackages $ NEL.nonEmpty ps
-      traverse_ installPkgFiles $ fmap (<> cached) built >>= NEL.nonEmpty
+      traverse_ installPkgFiles $ (built <> Just cached) >>= NEL.nonEmpty
       liftIO $ annotateDeps bs
 
 ------------

aura/lib/Aura/Languages.hs

@@ -327,6 +327,10 @@ buildFail_11 = \case
   Dutch      -> "Bouwen mislukt. Wilt U de fouten zien?"
   _          -> "Building failed. Would you like to see the error?"
 
+buildFail_12 :: Language -> Doc AnsiStyle
+buildFail_12 = \case
+  _ -> "Failed to 'git pull' the latest updates."
+
 ------------------------------
 -- Aura/Dependencies functions
 ------------------------------

aura/lib/Aura/MakePkg.hs

@@ -35,7 +35,7 @@ makepkgCmd = "/usr/bin/makepkg"
 -- | Given the current user name, build the package of whatever
 -- directory we're in.
 makepkg :: Settings -> User -> IO (Either Failure (NonEmpty FilePath))
-makepkg ss usr = make ss usr (proc cmd $ opts <> colour) >>= g
+makepkg ss usr = make ss usr (proc cmd $ opts <> overwrite <> colour) >>= g
   where
     (cmd, opts) =
       runStyle usr . map T.unpack . foldMap asFlag . makepkgFlagsOf $ buildConfigOf ss
@@ -48,6 +48,10 @@ makepkg ss usr = make ss usr (proc cmd $ opts <> colour) >>= g
         when showError $ BL.putStrLn se
       pure . Left $ Failure buildFail_8
 
+    overwrite :: [String]
+    overwrite | switch ss ForceBuilding = ["-f"]
+              | otherwise = []
+
     colour :: [String]
     colour | shared ss (Colour Never)  = ["--nocolor"]
            | shared ss (Colour Always) = []

aura/lib/Aura/Settings.hs

@@ -14,7 +14,7 @@ module Aura.Settings
   , logFuncOfL
     -- * Aura Configuration
   , BuildConfig(..), BuildSwitch(..)
-  , buildPathOfL, buildUserOfL, buildSwitchesOfL, allsourcePathOfL
+  , buildPathOfL, buildUserOfL, buildSwitchesOfL, allsourcePathOfL, vcsPathOfL
   , switch
   , Truncation(..)
   , defaultBuildDir
@@ -95,6 +95,7 @@ data BuildConfig = BuildConfig
   , buildPathOf     :: !(Maybe FilePath)
   , buildUserOf     :: !(Maybe User)
   , allsourcePathOf :: !(Maybe FilePath)
+  , vcsPathOf       :: !(Maybe FilePath)
   , truncationOf    :: !Truncation  -- For `-As`
   , buildSwitchesOf :: !(Set BuildSwitch) } deriving (Show)
 
@@ -110,6 +111,9 @@ buildSwitchesOfL f bc = (\bs -> bc { buildSwitchesOf = bs }) <$> f (buildSwitche
 allsourcePathOfL :: Lens' BuildConfig (Maybe FilePath)
 allsourcePathOfL f bc = (\pth -> bc { allsourcePathOf = pth }) <$> f (allsourcePathOf bc)
 
+vcsPathOfL :: Lens' BuildConfig (Maybe FilePath)
+vcsPathOfL f bc = (\pth -> bc { vcsPathOf = pth }) <$> f (vcsPathOf bc)
+
 -- | Extra options for customizing the build process.
 data BuildSwitch = DeleteMakeDeps
                  | DiffPkgbuilds

aura/lib/Aura/Settings/External.hs

@@ -41,6 +41,7 @@ data AuraConfig = AuraConfig
   , acUser      :: Maybe User
   , acBuildPath :: Maybe FilePath
   , acASPath    :: Maybe FilePath
+  , acVCSPath   :: Maybe FilePath
   , acAnalyse   :: Maybe BuildSwitch }
   deriving stock (Show)
 
@@ -63,6 +64,7 @@ auraConfig (Config m) = AuraConfig
   , acUser = User <$> one "user"
   , acBuildPath = T.unpack <$> one "buildpath"
   , acASPath = T.unpack <$> one "allsourcepath"
+  , acVCSPath = T.unpack <$> one "vcspath"
   , acAnalyse = one "analyse" >>= readMaybe . T.unpack >>= bool (Just NoPkgbuildCheck) Nothing
   }
   where

aura/lib/Aura/Utils.hs

@@ -25,7 +25,6 @@ module Aura.Utils
   , These(..)
   , these
     -- * Directory
-  , withTempDir
   , edit
     -- * Misc.
   , maybe'
@@ -39,7 +38,6 @@ import           Network.HTTP.Client
 import           Network.HTTP.Types.Status (statusCode)
 import           RIO
 import qualified RIO.ByteString.Lazy as BL
-import           RIO.Directory
 import qualified RIO.List as L
 import qualified RIO.NonEmpty as NEL
 import qualified RIO.Set as S
@@ -72,15 +70,6 @@ urlContents m url = f <$> httpLbs (parseRequest_ url) m
 --------------
 -- DIRECTORIES
 --------------
-withTempDir :: IO a -> IO a
-withTempDir f = do
-  here <- getCurrentDirectory
-  tmp  <- getTemporaryDirectory
-  setCurrentDirectory tmp
-  r <- f
-  setCurrentDirectory here
-  pure r
-
 -- | Edit some file in-place with the user's specified editor.
 edit :: FilePath -> FilePath -> IO ()
 edit editor p = void . runProcess $ proc editor [p]