Pass PATH down to pacman

aura/CHANGELOG.md

@@ -1,5 +1,13 @@
 # Aura Changelog
 
+## Unreleased
+
+#### Fixed
+
+- `PATH` is now passed down to all internal `pacman` calls. This fixes the
+  inability to install DKMS packages.
+  [#584](https://github.com/fosskers/aura/issues/584)
+
 ## 3.1.2 (2020-06-10)
 
 This release fixes a regression in `3.1.1`. Please update as soon as possible.

aura/exec/Aura/Commands/A.hs

@@ -62,7 +62,7 @@ upgradeAURPkgs pkgs = do
 -- | Foreign packages to consider for upgrading, after "ignored packages" have
 -- been taken into consideration.
 foreigns :: Settings -> IO (Set SimplePkg)
-foreigns ss = S.filter (notIgnored . spName) <$> foreignPackages
+foreigns ss = S.filter (notIgnored . spName) <$> foreignPackages (envOf ss)
   where notIgnored p = not . S.member p $ ignoresOf ss
 
 upgrade :: Set PkgName -> NonEmpty SimplePkg -> RIO Env ()
@@ -115,7 +115,7 @@ auraUpgrade = I.install . pure
 
 develPkgCheck :: RIO Env (Set PkgName)
 develPkgCheck = asks settings >>= \ss ->
-  if switch ss RebuildDevel then liftIO develPkgs else pure S.empty
+  if switch ss RebuildDevel then liftIO (develPkgs $ envOf ss) else pure S.empty
 
 -- | The result of @-Ai@.
 aurPkgInfo :: NonEmpty PkgName -> RIO Env ()
@@ -145,7 +145,7 @@ renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries
 aurPkgSearch :: Text -> RIO Env ()
 aurPkgSearch regex = do
   ss <- asks settings
-  db <- S.map (pnName . spName) <$> liftIO foreignPackages
+  db <- S.map (pnName . spName) <$> liftIO (foreignPackages $ envOf ss)
   let t = case truncationOf $ buildConfigOf ss of  -- Can't this go anywhere else?
             None   -> id
             Head n -> take $ fromIntegral n

aura/exec/Aura/Commands/C.hs

@@ -50,7 +50,7 @@ downgradePackages pkgs = do
   unless (null reals) $ do
     cache   <- liftIO $ cacheContents cachePath
     choices <- traverse (getDowngradeChoice cache) $ toList reals
-    liftIO . pacman $ "-U" : asFlag (commonConfigOf ss) <> map (T.pack . ppPath) choices
+    liftIO . pacman (envOf ss) $ "-U" : asFlag (commonConfigOf ss) <> map (T.pack . ppPath) choices
   where
     pkgsSet :: Set PkgName
     pkgsSet = S.fromList $ NEL.toList pkgs
@@ -116,7 +116,7 @@ cleanCache toSave
   | toSave == 0 = do
       ss <- asks settings
       warn ss cleanCache_2
-      liftIO $ pacman ["-Scc"]
+      liftIO $ pacman (envOf ss) ["-Scc"]
   | otherwise = do
       ss <- asks settings
       let cachePath = either id id . cachePathOf $ commonConfigOf ss

aura/exec/Aura/Commands/O.hs

@@ -11,15 +11,18 @@ module Aura.Commands.O ( displayOrphans, adoptPkg ) where
 import Aura.Core (Env(..), orphans, sudo)
 import Aura.IO (putTextLn)
 import Aura.Pacman (pacman)
+import Aura.Settings
 import Aura.Types
 import RIO
 
 ---
 
 -- | Print the result of @pacman -Qqdt@
-displayOrphans :: IO ()
-displayOrphans = orphans >>= traverse_ (putTextLn . pnName)
+displayOrphans :: Environment -> IO ()
+displayOrphans env = orphans env >>= traverse_ (putTextLn . pnName)
 
 -- | Identical to @-D --asexplicit@.
 adoptPkg :: NonEmpty PkgName -> RIO Env ()
-adoptPkg pkgs = sudo . liftIO . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs
+adoptPkg pkgs = do
+  env <- asks (envOf . settings)
+  sudo . liftIO . pacman env $ ["-D", "--asexplicit"] <> asFlag pkgs

aura/exec/Aura/Commands/P.hs

@@ -43,7 +43,7 @@ audit :: RIO Env ()
 audit = do
   ss <- asks settings
   let !m = managerOf ss
-  ps <- liftIO foreignPackages
+  ps <- liftIO . foreignPackages $ envOf ss
   warn ss . security_13 . fromIntegral $ S.size ps
   pbs <- catMaybes <$> liftIO (traverseConcurrently Par' (getPkgbuild m . spName) $ S.toList ps)
   mapMaybeA f pbs >>= \case

aura/exec/Aura/Settings/Runtime.hs

@@ -61,7 +61,7 @@ withEnv (Program op co bc lng ll) f = do
   environment <- M.fromList . map (bimap T.pack T.pack) <$> getEnvironment
   manager     <- newManager tlsManagerSettings
   isTerm      <- hIsTerminalDevice stdout
-  fromGroups  <- maybe (pure S.empty) groupPackages . nes
+  fromGroups  <- maybe (pure S.empty) (groupPackages environment) . nes
     $ getIgnoredGroups confFile <> igg
   let !bu = buildUserOf bc <|> acUser auraConf <|> getTrueUser environment
   when (isNothing bu) . throwM $ Failure whoIsBuildUser_1

aura/exec/aura.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP          #-}
 
 {-
 
@@ -91,13 +92,14 @@ execOpts :: Either (PacmanOp, Set MiscOp) AuraOp -> RIO Env ()
 execOpts ops = do
   logDebug "Interpreting CLI options."
   ss <- asks settings
+  let !env = envOf ss
   when (logLevelOf ss == LevelDebug) $ do
     logDebug $ displayShow ops
     logDebug . displayShow $ buildConfigOf ss
     logDebug . displayShow $ commonConfigOf ss
 
   let p :: (PacmanOp, Set MiscOp) -> RIO Env ()
-      p (ps, ms) = liftIO . pacman $
+      p (ps, ms) = liftIO . pacman env $
         asFlag ps
         ++ foldMap asFlag ms
         ++ asFlag (commonConfigOf ss)
@@ -135,15 +137,15 @@ execOpts ops = do
       Just (LogInfo ps)  -> L.logInfoOnPkg ps
       Just (LogSearch s) -> asks settings >>= liftIO . flip L.searchLogFile s
     Right (Orphans o) -> case o of
-      Nothing               -> liftIO O.displayOrphans
-      Just OrphanAbandon    -> sudo $ liftIO orphans >>= traverse_ removePkgs . nes
+      Nothing               -> liftIO $ O.displayOrphans env
+      Just OrphanAbandon    -> sudo $ liftIO (orphans env) >>= traverse_ removePkgs . nes
       Just (OrphanAdopt ps) -> O.adoptPkg ps
     Right (Analysis o) -> case o of
       Nothing                -> P.exploitsFromStdin
       Just (AnalysisFile fp) -> P.exploitsFromFile fp
       Just (AnalysisDir fp)  -> P.exploitsFromFile $ fp </> "PKGBUILD"
       Just AnalysisAudit     -> P.audit
-    Right Version   -> liftIO $ versionInfo >>= animateVersionMsg ss auraVersion
+    Right Version   -> liftIO $ (versionInfo env) >>= animateVersionMsg ss auraVersion
     Right Languages -> displayOutputLanguages
     Right ViewConf  -> viewConfFile
 

aura/lib/Aura/Build.hs

@@ -57,7 +57,7 @@ installPkgFiles :: NonEmpty PackagePath -> RIO Env ()
 installPkgFiles files = do
   ss <- asks settings
   liftIO $ checkDBLock ss
-  liftIO . pacman $ ["-U"] <> map (T.pack . ppPath) (toList files) <> asFlag (commonConfigOf ss)
+  liftIO . pacman (envOf ss) $ ["-U"] <> map (T.pack . ppPath) (toList files) <> asFlag (commonConfigOf ss)
 
 -- | All building occurs within temp directories,
 -- or in a location specified by the user with flags.

aura/lib/Aura/Core.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns       #-}
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE DerivingStrategies #-}
 
@@ -125,17 +126,17 @@ trueRoot action = asks settings >>= \ss ->
 
 -- | A list of non-prebuilt packages installed on the system.
 -- @-Qm@ yields a list of sorted values.
-foreignPackages :: IO (Set SimplePkg)
-foreignPackages = S.fromList . mapMaybe simplepkg' <$> pacmanLines ["-Qm"]
+foreignPackages :: Environment -> IO (Set SimplePkg)
+foreignPackages env = S.fromList . mapMaybe simplepkg' <$> pacmanLines env ["-Qm"]
 
 -- | Packages marked as a dependency, yet are required by no other package.
-orphans :: IO (Set PkgName)
-orphans = S.fromList . map PkgName <$> pacmanLines ["-Qqdt"]
+orphans :: Environment -> IO (Set PkgName)
+orphans env = S.fromList . map PkgName <$> pacmanLines env ["-Qqdt"]
 
 -- | 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
+develPkgs :: Environment -> IO (Set PkgName)
+develPkgs env = S.filter isDevelPkg . S.map spName <$> foreignPackages env
 
 -- | Is a package suffixed by git, hg, svn, darcs, cvs, or bzr?
 isDevelPkg :: PkgName -> Bool
@@ -146,14 +147,16 @@ isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes
 
 -- | Returns what it was given if the package is already installed.
 -- Reasoning: Using raw bools can be less expressive.
-isInstalled :: PkgName -> IO (Maybe PkgName)
-isInstalled pkg = bool Nothing (Just pkg) <$> pacmanSuccess ["-Qq", pnName pkg]
+isInstalled :: Environment -> PkgName -> IO (Maybe PkgName)
+isInstalled env pkg = bool Nothing (Just pkg) <$> pacmanSuccess env ["-Qq", pnName pkg]
 
 -- | An @-Rsu@ call.
 removePkgs :: NonEmpty PkgName -> RIO Env ()
 removePkgs pkgs = do
-  pacOpts <- asks (commonConfigOf . settings)
-  liftIO . pacman $ ["-Rsu"] <> asFlag pkgs <> asFlag pacOpts
+  ss <- asks settings
+  let !pacOpts = commonConfigOf ss
+      !env = envOf ss
+  liftIO . pacman env $ ["-Rsu"] <> asFlag pkgs <> asFlag pacOpts
 
 -- | Depedencies which are not installed, or otherwise provided by some
 -- installed package.
@@ -164,13 +167,13 @@ newtype Satisfied = Satisfied (NonEmpty Dep)
 
 -- | Similar to `isSatisfied`, but dependencies are checked in a batch, since
 -- @-T@ can accept multiple inputs.
-areSatisfied :: NonEmpty Dep -> IO (These Unsatisfied Satisfied)
-areSatisfied ds = do
+areSatisfied :: Environment -> NonEmpty Dep -> IO (These Unsatisfied Satisfied)
+areSatisfied env ds = do
   unsats <- S.fromList . mapMaybe parseDep <$> unsat
   pure . bimap Unsatisfied Satisfied $ partNonEmpty (f unsats) ds
   where
     unsat :: IO [Text]
-    unsat = pacmanLines $ "-T" : map renderedDep (toList ds)
+    unsat = pacmanLines env $ "-T" : map renderedDep (toList ds)
 
     f :: Set Dep -> Dep -> These Dep Dep
     f unsats d | S.member d unsats = This d

aura/lib/Aura/Dependencies.hs

@@ -88,7 +88,7 @@ resolveDeps' ss repo ps = resolve (Resolution mempty mempty) ps
     -- | Consider only "unsatisfied" deps.
     satisfy :: Resolution -> NonEmpty Buildable -> IO Resolution
     satisfy r bs = maybe' (pure r) (nes . freshDeps r $ allDeps bs) $
-      areSatisfied >=> these (lookups r) (pure . r') (\uns sat -> lookups (r' sat) uns)
+      areSatisfied (envOf ss) >=> these (lookups r) (pure . r') (\uns sat -> lookups (r' sat) uns)
       where
         r' :: Satisfied -> Resolution
         r' (Satisfied sat) = r & satisfiedL %~ (<> f sat)

aura/lib/Aura/Install.hs

@@ -48,19 +48,20 @@ install pkgs = do
   if not $ switch ss DeleteMakeDeps
     then install' pkgs
     else do -- `-a` was used.
-      orphansBefore <- liftIO orphans
+      orphansBefore <- liftIO . orphans $ envOf ss
       install' pkgs
-      orphansAfter <- liftIO orphans
+      orphansAfter <- liftIO . orphans $ envOf ss
       let makeDeps = nes $ orphansAfter S.\\ orphansBefore
       traverse_ (\mds -> liftIO (notify ss removeMakeDepsAfter_1) *> removePkgs mds) makeDeps
 
 install' :: NonEmpty PkgName -> RIO Env ()
 install' pkgs = do
   rpstry   <- asks repository
   ss       <- asks settings
+  let !env = envOf ss
   unneeded <- bool
               (pure S.empty)
-              (S.fromList . catMaybes <$> liftIO (traverseConcurrently Par' isInstalled $ toList pkgs))
+              (S.fromList . catMaybes <$> liftIO (traverseConcurrently Par' (isInstalled env) $ toList pkgs))
               $ shared ss NeededOnly
   let !pkgs' = S.fromList $ NEL.toList pkgs
   if shared ss NeededOnly && unneeded == pkgs'
@@ -98,8 +99,8 @@ install' pkgs = do
 
 -- | Give anything that was installed as a dependency the /Install Reason/ of
 -- "Installed as a dependency for another package".
-annotateDeps :: NonEmpty Buildable -> IO ()
-annotateDeps bs = unless (null bs') . void . pacmanSuccess
+annotateDeps :: Environment -> NonEmpty Buildable -> IO ()
+annotateDeps env bs = unless (null bs') . void . pacmanSuccess env
   $ ["-D", "--asdeps"] <> asFlag (map bName bs')
   where
     bs' :: [Buildable]
@@ -138,8 +139,9 @@ depsToInstall repo bs = resolveDeps repo $ NEL.map FromAUR bs
 
 repoInstall :: NonEmpty Prebuilt -> RIO Env ()
 repoInstall ps = do
-  pacOpts <- asks (asFlag . commonConfigOf . settings)
-  liftIO . pacman $ ["-S", "--asdeps"] <> pacOpts <> asFlag (NEL.map pName ps)
+  ss <- asks settings
+  let !pacOpts = asFlag $ commonConfigOf ss
+  liftIO . pacman (envOf ss) $ ["-S", "--asdeps"] <> pacOpts <> asFlag (NEL.map pName ps)
 
 buildAndInstall :: NonEmpty (NonEmpty Buildable) -> RIO Env ()
 buildAndInstall bss = do
@@ -172,7 +174,7 @@ buildAndInstall bss = do
 
       built <- traverse buildPackages $ NEL.nonEmpty ps
       traverse_ installPkgFiles $ (built <> Just cached) >>= NEL.nonEmpty
-      liftIO $ annotateDeps bs
+      liftIO $ annotateDeps (envOf ss) bs
 
 ------------
 -- REPORTING

aura/lib/Aura/MakePkg.hs

@@ -22,7 +22,6 @@ import           RIO
 import qualified RIO.ByteString.Lazy as BL
 import           RIO.Directory
 import           RIO.FilePath
-import           RIO.Lens (_2)
 import qualified RIO.NonEmpty as NEL
 import qualified RIO.Text as T
 import           System.Process.Typed
@@ -68,9 +67,12 @@ make :: MonadIO m
 make ss (User usr) pc = do
   -- Perform the actual building.
   (ec, se) <- runIt ss pc
+  -- TESTING --
+  (_, foo, _) <- readProcess $ proc "sudo" ["-u", T.unpack usr, "env"]
+  BL.putStrLn foo
   -- Fetch the filenames of the built tarballs.
-  res <- readProcess $ proc "sudo" ["-u", T.unpack usr, makepkgCmd, "--packagelist"]
-  let fs = map T.unpack . T.lines . decodeUtf8Lenient . BL.toStrict $ res ^. _2
+  (_, out, _) <- readProcess $ proc "sudo" ["-u", T.unpack usr, makepkgCmd, "--packagelist"]
+  let fs = map T.unpack . T.lines . decodeUtf8Lenient $ BL.toStrict out
   pure (ec, se, fs)
 
 runIt :: MonadIO m

aura/lib/Aura/Packages/Repository.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns  #-}
 {-# LANGUAGE TupleSections #-}
 
 -- |
@@ -48,15 +49,16 @@ pacmanRepo = do
         --- Lookup uncached Packages ---
         bgs <- traverseConcurrently Par' (resolveName mv ss) uncached
         let (bads, goods) = partitionEithers bgs
-        (bads', goods') <- traverseEither f goods  -- TODO Should also be made concurrent?
+        let !env = envOf ss
+        (bads', goods') <- traverseEither (f env) goods  -- TODO Also make concurrent?
         --- Update Cache ---
         let m = M.fromList $ map (pname &&& id) goods'
         atomically $ modifyTVar' tv (<> m)
         pure $ Just (S.fromList $ bads <> bads', S.fromList $ cached <> goods')
 
   pure $ Repository tv g
   where
-    f (r, p) = fmap (FromRepo . packageRepo r p) <$> mostRecent r
+    f env (r, p) = fmap (FromRepo . packageRepo r p) <$> mostRecent env r
 
 packageRepo :: PkgName -> Provides -> Versioning -> Prebuilt
 packageRepo pn pro ver = Prebuilt { pName     = pn
@@ -69,7 +71,7 @@ packageRepo pn pro ver = Prebuilt { pName     = pn
 -- | If given a virtual package, try to find a real package to install.
 resolveName :: MVar () -> Settings -> PkgName -> IO (Either PkgName (PkgName, Provides))
 resolveName mv ss pn = do
-  provs <- map PkgName <$> pacmanLines ["-Ssq", "^" <> escape (pnName pn) <> "$"]
+  provs <- map PkgName <$> pacmanLines (envOf ss) ["-Ssq", "^" <> escape (pnName pn) <> "$"]
   case provs of
     [] -> pure $ Left pn
     _  -> Right . (, Provides pn) <$> chooseProvider mv ss pn provs
@@ -89,8 +91,10 @@ chooseProvider :: MVar () -> Settings -> PkgName -> [PkgName] -> IO PkgName
 chooseProvider _ _ pn []          = pure pn
 chooseProvider _ _ _ [p]          = pure p
 chooseProvider mv ss pn ps@(a:as) =
-  traverseConcurrently Par' isInstalled ps >>= maybe f pure . listToMaybe . catMaybes
+  traverseConcurrently Par' (isInstalled env) ps >>= maybe f pure . listToMaybe . catMaybes
   where
+    env = envOf ss
+
     f :: IO PkgName
     f | shared ss NoConfirm = pure . bool a pn $ pn `elem` ps
       | otherwise = do
@@ -101,8 +105,8 @@ chooseProvider mv ss pn ps@(a:as) =
           pure r
 
 -- | The most recent version of a package, if it exists in the respositories.
-mostRecent :: PkgName -> IO (Either PkgName Versioning)
-mostRecent p@(PkgName s) = note p . extractVersion . decodeUtf8Lenient <$> pacmanOutput ["-Si", s]
+mostRecent :: Environment -> PkgName -> IO (Either PkgName Versioning)
+mostRecent env p@(PkgName s) = note p . extractVersion . decodeUtf8Lenient <$> pacmanOutput env ["-Si", s]
 
 -- | Parses the version number of a package from the result of a
 -- @pacman -Si@ call.