From 48b8f04c0c885c541fb642322a80383a2c4d30c5 Mon Sep 17 00:00:00 2001 From: Colin Woodbury Date: Thu, 11 Jun 2020 10:11:23 -0700 Subject: [PATCH 1/2] [aura] Pass `PATH` down to `pacman` --- aura/exec/Aura/Commands/A.hs | 6 ++--- aura/exec/Aura/Commands/C.hs | 4 ++-- aura/exec/Aura/Commands/O.hs | 9 +++++--- aura/exec/Aura/Commands/P.hs | 2 +- aura/exec/Aura/Settings/Runtime.hs | 2 +- aura/exec/aura.hs | 12 ++++++---- aura/lib/Aura/Build.hs | 2 +- aura/lib/Aura/Core.hs | 29 +++++++++++++----------- aura/lib/Aura/Dependencies.hs | 2 +- aura/lib/Aura/Install.hs | 18 ++++++++------- aura/lib/Aura/MakePkg.hs | 8 ++++--- aura/lib/Aura/Packages/Repository.hs | 16 ++++++++----- aura/lib/Aura/Pacman.hs | 34 ++++++++++++++++------------ aura/lib/Aura/State.hs | 18 +++++++-------- 14 files changed, 91 insertions(+), 71 deletions(-) diff --git a/aura/exec/Aura/Commands/A.hs b/aura/exec/Aura/Commands/A.hs index 4507b66c3..dab5fe364 100644 --- a/aura/exec/Aura/Commands/A.hs +++ b/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 diff --git a/aura/exec/Aura/Commands/C.hs b/aura/exec/Aura/Commands/C.hs index 59dd19ff8..4993cf126 100644 --- a/aura/exec/Aura/Commands/C.hs +++ b/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 diff --git a/aura/exec/Aura/Commands/O.hs b/aura/exec/Aura/Commands/O.hs index 2b49df45a..e4aff6488 100644 --- a/aura/exec/Aura/Commands/O.hs +++ b/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 diff --git a/aura/exec/Aura/Commands/P.hs b/aura/exec/Aura/Commands/P.hs index 682167fd9..2c297f70a 100644 --- a/aura/exec/Aura/Commands/P.hs +++ b/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 diff --git a/aura/exec/Aura/Settings/Runtime.hs b/aura/exec/Aura/Settings/Runtime.hs index 68c4b1313..9ea8f0549 100644 --- a/aura/exec/Aura/Settings/Runtime.hs +++ b/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 diff --git a/aura/exec/aura.hs b/aura/exec/aura.hs index 0d074e1bc..c1cbe896f 100644 --- a/aura/exec/aura.hs +++ b/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 diff --git a/aura/lib/Aura/Build.hs b/aura/lib/Aura/Build.hs index fc48affb5..bd342ea68 100644 --- a/aura/lib/Aura/Build.hs +++ b/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. diff --git a/aura/lib/Aura/Core.hs b/aura/lib/Aura/Core.hs index 854294d3c..8743c01ac 100644 --- a/aura/lib/Aura/Core.hs +++ b/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 diff --git a/aura/lib/Aura/Dependencies.hs b/aura/lib/Aura/Dependencies.hs index 625abfe14..cb08b0db2 100644 --- a/aura/lib/Aura/Dependencies.hs +++ b/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) diff --git a/aura/lib/Aura/Install.hs b/aura/lib/Aura/Install.hs index d902a0844..1de7f5346 100644 --- a/aura/lib/Aura/Install.hs +++ b/aura/lib/Aura/Install.hs @@ -48,9 +48,9 @@ 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 @@ -58,9 +58,10 @@ 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 diff --git a/aura/lib/Aura/MakePkg.hs b/aura/lib/Aura/MakePkg.hs index e6f4f0090..3cb494560 100644 --- a/aura/lib/Aura/MakePkg.hs +++ b/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 diff --git a/aura/lib/Aura/Packages/Repository.hs b/aura/lib/Aura/Packages/Repository.hs index 0b91086c7..9223da207 100644 --- a/aura/lib/Aura/Packages/Repository.hs +++ b/aura/lib/Aura/Packages/Repository.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TupleSections #-} -- | @@ -48,7 +49,8 @@ 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) @@ -56,7 +58,7 @@ pacmanRepo = do 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. diff --git a/aura/lib/Aura/Pacman.hs b/aura/lib/Aura/Pacman.hs index d94076b22..7765be194 100644 --- a/aura/lib/Aura/Pacman.hs +++ b/aura/lib/Aura/Pacman.hs @@ -73,8 +73,8 @@ getIgnoredGroups :: Config -> Set PkgGroup getIgnoredGroups (Config c) = maybe S.empty (S.fromList . map PkgGroup) $ M.lookup "IgnoreGroup" c -- | Given a `Set` of package groups, yield all the packages they contain. -groupPackages :: NonEmpty PkgGroup -> IO (Set PkgName) -groupPackages igs = fmap (f . decodeUtf8Lenient) . pacmanOutput $ "-Qg" : asFlag igs +groupPackages :: Environment -> NonEmpty PkgGroup -> IO (Set PkgName) +groupPackages env igs = fmap (f . decodeUtf8Lenient) . pacmanOutput env $ "-Qg" : asFlag igs where f :: Text -> Set PkgName f = S.fromList . map (PkgName . (!! 1) . T.words) . T.lines @@ -96,30 +96,34 @@ getLogFilePath (Config c) = do ---------- -- | Create a pacman process to run. -pacmanProc :: [String] -> ProcessConfig () () () -pacmanProc args = setEnv [("LC_ALL", "C")] $ proc "pacman" args +pacmanProc :: Environment -> [String] -> ProcessConfig () () () +pacmanProc env args = setEnv vars $ proc "pacman" args + where + vars :: [(String, String)] + vars = ("LC_ALL", "C") : maybe [] (\p -> [("PATH", T.unpack p)]) (M.lookup "PATH" env) -- | Run a pacman action that may fail. -pacman :: [Text] -> IO () -pacman (map T.unpack -> args) = do - ec <- runProcess $ pacmanProc args +pacman :: Environment -> [Text] -> IO () +pacman env (map T.unpack -> args) = do + ec <- runProcess $ pacmanProc env args unless (ec == ExitSuccess) $ throwM (Failure pacmanFailure_1) -- | Run some `pacman` process, but only care about whether it succeeded. -pacmanSuccess :: [T.Text] -> IO Bool -pacmanSuccess = fmap (== ExitSuccess) . runProcess . setStderr closed . setStdout closed . pacmanProc . map T.unpack +pacmanSuccess :: Environment -> [T.Text] -> IO Bool +pacmanSuccess env i = fmap (== ExitSuccess) . runProcess . setStderr closed . setStdout closed . pacmanProc env $ map T.unpack i -- | Runs pacman silently and returns only the stdout. -pacmanOutput :: [Text] -> IO ByteString -pacmanOutput = fmap (^. _2 . to BL.toStrict) . readProcess . pacmanProc . map T.unpack +pacmanOutput :: Environment -> [Text] -> IO ByteString +pacmanOutput env i = + fmap (^. _2 . to BL.toStrict) . readProcess . pacmanProc env $ map T.unpack i -- | Runs pacman silently and returns the stdout as UTF8-decoded `Text` lines. -pacmanLines :: [Text] -> IO [Text] -pacmanLines s = T.lines . decodeUtf8Lenient <$> pacmanOutput s +pacmanLines :: Environment -> [Text] -> IO [Text] +pacmanLines env s = T.lines . decodeUtf8Lenient <$> pacmanOutput env s -- | Yields the lines given by `pacman -V` with the pacman image stripped. -versionInfo :: IO [Text] -versionInfo = map (T.drop verMsgPad) <$> pacmanLines ["-V"] +versionInfo :: Environment -> IO [Text] +versionInfo env = map (T.drop verMsgPad) <$> pacmanLines env ["-V"] -- | The amount of whitespace before text in the lines given by `pacman -V` verMsgPad :: Int diff --git a/aura/lib/Aura/State.hs b/aura/lib/Aura/State.hs index ed25a04c2..5b8edaf7f 100644 --- a/aura/lib/Aura/State.hs +++ b/aura/lib/Aura/State.hs @@ -74,12 +74,12 @@ stateCache = "/var/cache/aura/states" inState :: SimplePkg -> PkgState -> Bool inState (SimplePkg n v) s = (Just v ==) . M.lookup n $ pkgsOf s -rawCurrentState :: IO [SimplePkg] -rawCurrentState = mapMaybe simplepkg' <$> pacmanLines ["-Q"] +rawCurrentState :: Environment -> IO [SimplePkg] +rawCurrentState env = mapMaybe simplepkg' <$> pacmanLines env ["-Q"] -currentState :: IO PkgState -currentState = do - pkgs <- rawCurrentState +currentState :: Environment -> IO PkgState +currentState env = do + pkgs <- rawCurrentState env time <- getZonedTime pure . PkgState time False . M.fromAscList $ map (\(SimplePkg n v) -> (n, v)) pkgs @@ -109,7 +109,7 @@ getStateFiles = do -- In writing the first state file, the `states` directory is created automatically. saveState :: Settings -> IO () saveState ss = do - state <- currentState + state <- currentState $ envOf ss let filename = stateCache dotFormat (timeOf state) <.> "json" createDirectoryIfMissing True stateCache BL.writeFile filename $ encode state @@ -139,7 +139,7 @@ restoreState = case mpast of Nothing -> throwM $ Failure readState_1 Just past -> do - curr <- liftIO currentState + curr <- liftIO . currentState $ envOf ss Cache cache <- liftIO $ cacheContents pth let StateDiff rein remo = compareStates past curr (okay, nope) = L.partition (`M.member` cache) rein @@ -162,5 +162,5 @@ reinstallAndRemove down remo | null down = remove | otherwise = reinstall *> remove where - remove = liftIO . pacman $ "-R" : asFlag remo - reinstall = liftIO . pacman $ "-U" : map (T.pack . ppPath) down + remove = asks (envOf . settings) >>= \env -> liftIO . pacman env $ "-R" : asFlag remo + reinstall = asks (envOf . settings) >>= \env -> liftIO . pacman env $ "-U" : map (T.pack . ppPath) down From dfe5399f80105148cf6aaffa8318fe873d6c0e14 Mon Sep 17 00:00:00 2001 From: Colin Woodbury Date: Thu, 11 Jun 2020 10:14:12 -0700 Subject: [PATCH 2/2] [aura] Update CHANGELOG --- aura/CHANGELOG.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/aura/CHANGELOG.md b/aura/CHANGELOG.md index 8dfd0153f..265b41fb1 100644 --- a/aura/CHANGELOG.md +++ b/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.