aura 3.1.2 → 3.1.3

raw patch · 16 files changed

+100/−72 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• aura.cabal +1/−1
• exec/Aura/Commands/A.hs +3/−3
• exec/Aura/Commands/C.hs +2/−2
• exec/Aura/Commands/O.hs +6/−3
• exec/Aura/Commands/P.hs +1/−1
• exec/Aura/Settings/Runtime.hs +1/−1
• exec/aura.hs +7/−5
• lib/Aura/Build.hs +1/−1
• lib/Aura/Core.hs +16/−13
• lib/Aura/Dependencies.hs +1/−1
• lib/Aura/Install.hs +10/−8
• lib/Aura/MakePkg.hs +5/−3
• lib/Aura/Packages/Repository.hs +10/−6
• lib/Aura/Pacman.hs +19/−15
• lib/Aura/State.hs +9/−9

@@ -1,5 +1,13 @@ # Aura Changelog +## 3.1.3 (2020-06-11)++#### 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.

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               aura-version:            3.1.2+version:            3.1.3 synopsis:           A secure package manager for Arch Linux and the AUR. description:   Aura is a package manager for Arch Linux. It connects to both the

@@ -62,7 +62,7 @@ -- | 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 @@  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 @@ 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

@@ -50,7 +50,7 @@   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 @@   | 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

@@ -11,15 +11,18 @@ 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

@@ -43,7 +43,7 @@ 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

@@ -61,7 +61,7 @@   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

@@ -1,4 +1,5 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP          #-}  {- @@ -91,13 +92,14 @@ 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 @@       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 

@@ -57,7 +57,7 @@ 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.

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns       #-} {-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE DerivingStrategies #-} @@ -125,17 +126,17 @@  -- | 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 @@  -- | 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 @@  -- | 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

@@ -88,7 +88,7 @@     -- | 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)

@@ -48,9 +48,9 @@   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' 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 @@  -- | 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 @@  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 @@        built <- traverse buildPackages $ NEL.nonEmpty ps       traverse_ installPkgFiles $ (built <> Just cached) >>= NEL.nonEmpty-      liftIO $ annotateDeps bs+      liftIO $ annotateDeps (envOf ss) bs  ------------ -- REPORTING

@@ -22,7 +22,6 @@ 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 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

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns  #-} {-# LANGUAGE TupleSections #-}  -- |@@ -48,7 +49,8 @@         --- 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 @@    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 @@ -- | 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 _ _ 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 @@           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.

@@ -73,8 +73,8 @@ 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 @@ ----------  -- | 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

@@ -74,12 +74,12 @@ 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 @@ -- 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 @@           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 @@   | 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