aura 3.1.9 → 3.2.0
raw patch · 24 files changed
+379/−493 lines, 24 filesdep ~aurdep ~versionsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aur, versions
API changes (from Hackage documentation)
- Aura.Types: newtype Failure
+ Aura.Packages.AUR: sortAurInfo :: Settings -> [AurInfo] -> [AurInfo]
+ Aura.Settings: NoCheck :: Makepkg
+ Aura.Types: FailMsg :: (Language -> Doc AnsiStyle) -> FailMsg
+ Aura.Types: Silent :: Failure
+ Aura.Types: data Failure
+ Aura.Types: instance GHC.Exception.Type.Exception Aura.Types.FailMsg
+ Aura.Types: instance GHC.Show.Show Aura.Types.FailMsg
+ Aura.Types: newtype FailMsg
- Aura.Types: Failure :: (Language -> Doc AnsiStyle) -> Failure
+ Aura.Types: Failure :: FailMsg -> Failure
- Aura.Types: [failure] :: Failure -> Language -> Doc AnsiStyle
+ Aura.Types: [failure] :: FailMsg -> Language -> Doc AnsiStyle
Files
- CHANGELOG.md +35/−0
- aura.cabal +3/−3
- doc/aura.8 +18/−12
- doc/completions/bashcompletion.sh +86/−315
- exec/Aura/Commands/A.hs +33/−13
- exec/Aura/Commands/C.hs +2/−2
- exec/Aura/Commands/P.hs +3/−3
- exec/Aura/Flags.hs +40/−37
- exec/Aura/Settings/Runtime.hs +2/−2
- exec/aura.hs +19/−12
- lib/Aura/Build.hs +54/−21
- lib/Aura/Core.hs +2/−2
- lib/Aura/Dependencies.hs +4/−4
- lib/Aura/IO.hs +2/−2
- lib/Aura/Install.hs +25/−18
- lib/Aura/Languages.hs +12/−21
- lib/Aura/MakePkg.hs +2/−2
- lib/Aura/Packages/AUR.hs +15/−14
- lib/Aura/Pacman.hs +2/−2
- lib/Aura/Security.hs +1/−1
- lib/Aura/Settings.hs +3/−1
- lib/Aura/State.hs +2/−2
- lib/Aura/Types.hs +12/−4
- test/Test.hs +2/−0
CHANGELOG.md view
@@ -1,5 +1,40 @@ # Aura Changelog +## 3.2.0 (2020-10-27)++With this release, Aura has passed 2,000 commits. Thank you for your ongoing support!++#### Changed++- *Breaking:* `-As` and `-Ai` will yield an exit code of `1` if no results were+ found. This matches `pacman`.+- `-As` now accepts multiple search terms to narrow in on specific packages.++#### Added++- `--nocheck` will be passed down to `makepkg` to avoid calling the `check()`+ function during the build process. [#647]+- `--hotedit` now has a short variant: `-e`. [#643]+- `-Ars <term>` or `-As <term> --both` can be used to yield results from both+ the AUR and official repos at the same time. [#644]++#### Fixed++- `-Sl` and `-Qil` now work as expected. [#636] [#642]+- Aura no longer displays the misleading `Please check your input.` message. [#639]+- File permission issues when building `*-git` packages. [#651] [#634]+- Bash completions are now possible again for Pacman commands. [#641]++[#647]: https://github.com/fosskers/aura/pull/647+[#643]: https://github.com/fosskers/aura/issues/643+[#636]: https://github.com/fosskers/aura/issues/636+[#642]: https://github.com/fosskers/aura/issues/642+[#639]: https://github.com/fosskers/aura/issues/639+[#644]: https://github.com/fosskers/aura/issues/644+[#651]: https://github.com/fosskers/aura/issues/651+[#634]: https://github.com/fosskers/aura/issues/634+[#641]: https://github.com/fosskers/aura/issues/641+ ## 3.1.9 (2020-09-11) #### Added
aura.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: aura-version: 3.1.9+version: 3.2.0 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@@ -46,12 +46,12 @@ , megaparsec >=7 && <10 , rio ^>=0.1.17 , text ^>=1.2- , versions ^>=3.5.4+ , versions ^>=4.0.1 common libexec build-depends: , aeson >=1.2 && <1.6- , aur ^>=7.0.4+ , aur ^>=7.0.5 , http-client >=0.5 && <0.8 , prettyprinter >=1.2 && <1.8 , prettyprinter-ansi-terminal ^>=1.1
doc/aura.8 view
@@ -118,11 +118,13 @@ Search the AUR via a word only (no regex). Results are sorted by vote. Suboptions: .RS 4-\fI\-\-abc\fR : Sorts results alphabetically.+\fI\-\-abc\fR : Sorts results alphabetically. .P-\fI\-\-head\=n\fR : Only show the first n results. Default n = 10+\fI\-\-head\=n\fR : Only show the first n results. Default n = 10 .P-\fI\-\-tail\=n\fR : Only show the last n results. Default n = 10+\fI\-\-tail\=n\fR : Only show the last n results. Default n = 10+.P+\fI\-r\fR, \fI\-\-both\fR : Show results from the official repos as well. .RE .RE .P@@ -131,6 +133,11 @@ Upgrade all installed AUR packages. \fI\-Au\fR is \fI\-Su\fR for AUR packages. .RE .P+\fB\-w\fR, \-\-downloadonly <package(s)>+.RS 4+Download a package tarball.+.RE+.P \fB\-x\fR, \-\-unsuppress .RS 4 Unsuppress \fImakepkg\fR output during building. By default this output is@@ -182,15 +189,14 @@ \fB\-\-hotedit\fR .RS 4 Prompt the user before building to ask if they wish to view/edit the PKGBUILD,-as well as any .install or .patch files. This is not default behavior and thus-does not have a single\-letter option. Research into packages (and by extension,-their PKGBUILDs) should be done before any building occurs. Please use-\fI\-Ap\fR and \fI\-Ad\fR for this, as they will be much faster at presenting-information than searching the AUR website manually. Note that, since aura is-run through sudo, your local value of $EDITOR may not be preserved. Run as "sudo-\fI\-E\fR aura -A --hotedit ..." to preserve your environment. To always allow-environment variables to be passed, have a look at the \fIenv_reset\fR and-\fIenv_keep\fR options in \fBsudoers\fR(5).+as well as any .install or .patch files. However, research into packages (and by+extension, their PKGBUILDs) should be done by the user before any building+occurs. Please use \fI\-Ap\fR and \fI\-Ad\fR for this, as they will be much+faster at presenting information than searching the AUR website manually. Note+that, since aura is run through sudo, your local value of $EDITOR may not be+preserved. Run as "sudo \fI\-E\fR aura -A --hotedit ..." to preserve your+environment. To always allow environment variables to be passed, have a look at+the \fIenv_reset\fR and \fIenv_keep\fR options in \fBsudoers\fR(5). .RE .P \fB\-\-skipdepcheck\fR
doc/completions/bashcompletion.sh view
@@ -1,333 +1,104 @@-# Bash completion for Aura+# This file is in the public domain. -# generates completion line _aura_compgen() {- local i r- COMPREPLY=($( compgen -W "$1" -- "$cur" ))- for (( i=1; i < ${#COMP_WORDS[@]}-1; i++ )); do- for r in ${!COMPREPLY[@]}; do- if [[ ${COMP_WORDS[i]} = ${COMPREPLY[r]} ]]; then- unset 'COMPREPLY[r]'; break- fi- done+ local i r+ COMPREPLY=($(compgen -W '$*' -- "$cur"))+ for ((i=1; i < ${#COMP_WORDS[@]}-1; i++)); do+ for r in ${!COMPREPLY[@]}; do+ if [[ ${COMP_WORDS[i]} = ${COMPREPLY[r]} ]]; then+ unset 'COMPREPLY[r]'; break+ fi done- return 0+ done } -# check if COMP_LINE contains a given string+_aura_ptr2comp() {+ local list= x y+ for x; do+ for y in '0 --' '1 -'; do+ eval 'set -- ${'$x'[${y% *}]}'+ list+=\ ${@/#/${y#* }}+ done+ done+ _aura_compgen $list+}+ _aura_incomp() {- if [[ $COMP_LINE =~ $1 ]]; then- return 0- fi- return 1+ local r="[[:space:]]-(-${1#* }[[:space:]]|[[:alnum:]_]*${1% *})"; [[ $COMP_LINE =~ $r ]] } -# deal with options that have an equal sign at the end-# NOTE: regex for username might need tweaking to match-# Arch Linux username requirements-_aura_has_equal() {- # to make sure these options haven't been used already- local b_reg=--build=[^\0]+[[:blank:]]- local bu_reg=--builduser=[a-z_][-a-z0-9_]*[[:blank:]]- if [[ $cur == *=* ]]; then- prev=${cur%%=*}- cur=${cur#*=}- fi- if ! _aura_incomp "$b_reg"; then- if _aura_incomp --build=; then- _filedir -d- return 0- fi- fi- if ! _aura_incomp "$bu_reg"; then- if _aura_incomp --builduser=; then- _usergroup- return 0- fi+_aura_pkg() {+ _aura_compgen "$(+ if [[ $2 ]]; then+ \pacman -$1 2>/dev/null | \cut -d' ' -f1 | \sort -u+ else+ \pacman -$1 2>/dev/null fi- return 1+ )" } -# these common pacman options require directory or file completion-_aura_pac_common_opts() {- local c status regex dir_comm file_comm- status="1"- # to make sure these options haven't been used already- regex=($c[[:blank:]][^\0]+[[:blank:]])- dir_comm="--cachedir --dbpath --gpgdir --root -b -r"- file_comm="--config --logfile"- for c in $dir_comm $file_comm; do- if [[ $dir_comm == *$c* ]]; then- if ! _aura_incomp "$regex" && _aura_incomp $c ; then- _filedir -d- status="0"- break- fi- elif [[ $file_comm == *$c* ]]; then- if ! _aura_incomp "$regex" && _aura_incomp $c ; then- _filedir- status="0"- break- fi- fi- done- return "$status"+_aura_repo_list() {+ _aura_compgen "$(pacman-conf --repo-list)" } -# sends list of ABS packages to compgen-_aura_pac_pkg() {- _aura_compgen "$(- if [[ $2 ]]; then- \aura -"$1" 2>/dev/null | \cut -d' ' -f1 | \sort -u- else- \aura -"$1" 2>/dev/null- fi- )"- return 0-}+_aura() {+ compopt -o default+ local common core database files query remove sync upgrade o+ local cur prev words cword+ _init_completion || return+ database=('asdeps asexplicit')+ files=('list machinereadable refresh regex' 'l x y')+ query=('changelog check deps explicit file foreign groups info list native owns+ search unrequired upgrades' 'c e g i k l m n o p s t u')+ remove=('cascade dbonly nodeps assume-installed nosave print recursive unneeded' 'c n p s u')+ sync=('asdeps asexplicit clean dbonly downloadonly groups ignore ignoregroup+ info list needed nodeps assume-installed print refresh recursive search sysupgrade'+ 'c g i l p s u w y')+ upgrade=('asdeps asexplicit needed nodeps assume-installed print recursive' 'p')+ common=('arch cachedir color config confirm dbpath debug gpgdir help hookdir logfile+ noconfirm noprogressbar noscriptlet quiet root verbose' 'b d h q r v')+ core=('aursync save downgrade database files viewlog help orphans analysis query remove sync upgrade version' 'A B C D F L O P Q R S U V h') -# complete pacman package files-_aura_pac_file() {- compopt -o filenames- _filedir 'pkg.tar*'- return 0+ for o in 'D database' 'F files' 'Q query' 'R remove' 'S sync' 'U upgrade'; do+ _aura_incomp "$o" && break+ done++ if [[ $? != 0 ]]; then+ _aura_ptr2comp core+ elif [[ ! $prev =~ ^-[[:alnum:]_]*[Vbhr] &&+ ! $prev = --@(cachedir|color|config|dbpath|help|hookdir|gpgdir|logfile|root|version) ]]+ then+ [[ $cur = -* ]] && _aura_ptr2comp ${o#* } common ||+ case ${o% *} in+ # Pacman Commands+ D|R)+ _aura_pkg Qq;;+ F)+ { _aura_incomp 'l list' && _aura_pkg Slq ; } ||+ compopt +o default;;+ Q)+ { _aura_incomp 'g groups' && _aura_pkg Qg sort; } ||+ { _aura_incomp 'p file' && _aura_file; } ||+ { _aura_incomp 's search' && compopt +o default; } ||+ { _aura_incomp 'u upgrades' && compopt +o default; } ||+ _aura_incomp 'o owns' ||+ _aura_pkg Qq;;+ S)+ { _aura_incomp 'g groups' && _aura_pkg Sg; } ||+ { _aura_incomp 'l list' && _aura_repo_list; } ||+ { _aura_incomp 's search' && compopt +o default; } ||+ _aura_pkg Slq;;+ U)+ _aura_file;;+ esac+ fi+ true } -_aura()-{- local cur prev core pcommon o showopts opts- COMPREPLY=()- _init_completion || return- _get_comp_words_by_ref cur prev- core="-A --aursync -B --save -C --downgrade -L --viewlog -M --abssync \- -O --orphans -D --database -Q --query -R --remove -S --sync \- -T --deptest -U --upgrade --auradebug --languages --noconfirm --no-pp \- -V --version -h --help"- # options common to all pacman functions- pcommon="--arch --cachedir --color --config --dbpath --debug --gpgdir \- --help --logfile --noconfirm --root --verbose -b -h -r -v"+_aura_file() {+ compopt -o filenames; _filedir 'pkg.tar*'+} - # check if base option has been selected- for o in $core; do- _aura_incomp $o && break- done+complete -F _aura aura - # if no core option entered- if [[ $? != 0 ]]; then- _aura_compgen "$core"- else- # show options for core selection when dash typed- if [[ "$cur" = -* ]]; then- showopts=true- else- showopts=false- fi- # main option handling- case ${o} in- ##### Aura Options #####- -A|--aursync)- if $showopts; then- opts="-a --delmakedeps -d --deps -i --info -k --diff -p \- --pkgbuild -q --quiet -s --search -u --sysupgrade -w \- --downloadonly -x --unsuppress -y --refresh \- --aurignore= --build= --builduser= -custom --devel \- --hotedit --ignorearch --absdeps --dryrun"- # include suboptions when searching- local a search_opts="--abc --head --tail"- for a in '-As' '-s' '--search'; do- if _aura_incomp $a; then- _aura_compgen "$opts $search_opts"- return 0- fi- done- _aura_compgen "$opts"- return 0- else- _aura_has_equal- return 0- fi- ;;- -B|--save)- opts="-c --clean -r --restore"- _aura_compgen "$opts"- return 0- ;;- -C|--downgrade)- if $showopts; then- opts="-b --backup -c --clean -s --search"- _aura_compgen "$opts"- return 0- else- local c- # complete for dir to backup cache- for c in '-Cb' 'b' '--backup'; do- if _aura_incomp $c; then- _filedir- return 0- fi- done- fi- ;;- -L|--viewlog)- opts="-i --info -s --search"- _aura_compgen "$opts"- return 0- ;;- -M|--abssync)- if $showopts; then- opts="-a --delmakedeps -c --clean -d --deps -i --info \- -k --diff -p --pkgbuild -s --search -t --treesync \- -x --unsuppress -y --refresh --absdeps"- _aura_compgen "$opts"- return 0- else- # offer ABS pkg selection- _aura_pac_pkg Slq- return 0- fi- ;;- -O|--orphans)- if $showopts; then- opts="-j --abandon"- _aura_compgen "$opts"- return 0- else- # use self generated orphan list- local o=$( aura -O )- if [[ $o != "" ]]; then- _aura_compgen "$o"- return 0- fi- fi- ;;- ##### Pacman Options #####- -D|--database)- if $showopts; then- opts="--asdeps --asexplicit $pcommon"- _aura_compgen "$opts"- return 0- else- if _aura_pac_common_opts; then- return 0- fi- _aura_pac_pkg Qq- return 0- fi- ;;- -Q|--query)- if $showopts; then- opts="--changelog --check --deps --explicit --file \- --foreign --groups --info --list --native --owns \- --quiet --search --unrequired --upgrades -c -d -e -g \- -i -k -l -m -n -o -p -q -s -t -u $pcommon"- _aura_compgen "$opts"- return 0- else- local q- local ary=('-Qg' '-g' '--groups' '-Qp' '-p' '--file'- '-Qo' '-o' '--owns')- for q in ${ary[@]}; do- if _aura_incomp $q; then- case $q in- -Qg|-g|--groups)- _aura_pac_pkg Qg sort- ;;- -Qp|-p|--file)- _aura_pac_file- ;;- -Qo|-o|--owns)- _filedir- ;;- esac- return 0- fi- done- if _aura_pac_common_opts; then- return 0- fi- _aura_pac_pkg Qq- return 0- fi- ;;- -R|--remove)- if $showopts; then- opts="--cascade --dbonly --nodeps --noprogressbar --nosave \- --noscriptlet --print --print-format --recursive \- --unneeded -c -d -n -p -s -u $pcommon"- _aura_compgen "$opts"- return 0- else- if _aura_pac_common_opts; then- return 0- fi- _aura_pac_pkg Qq- return 0- fi- ;;- -S|--sync)- if $showopts; then- opts="--asdeps --asexplicit --clean --dbonly --downloadonly \- --force --groups --ignore --ignoregroup --info --list \- --needed --nodeps --noprogressbar --noscriptlet --print \- --print-format --quiet --refresh --recursive --search \- --sysupgrade -c -d -g -i -l -p -q -s -u -w -y $pcommon"- _aura_compgen "$opts"- return 0- else- local s ary- local ary=('-Sg' '-g' '--groups' '-Sl' '-l' '--list')- for s in ${ary[@]}; do- if _aura_incomp $s; then- case $s in- -Sg|-g|--groups)- _aura_pac_pkg Sg sort- ;;- -Sl|-l|--list)- _aura_pac_pkg Sl sort- ;;- esac- return 0- fi- done- if _aura_pac_common_opts; then- return 0- fi- _aura_pac_pkg Slq- return 0- fi- ;;- -T|--deptest)- if $showopts; then- _aura_compgen "$pcommon"- return 0- else- if _aura_pac_common_opts; then- return 0- fi- _aura_pac_pkg Slq- return 0- fi- ;;- -U|--upgrade)- if $showopts; then- opts="--asdeps --asexplicit --dbonly --force --ignore \- --ignoregroup --needed --nodeps --noprogressbar \- --noscriptlet --print --print-format --recursive \- -d -p $pcommon"- _aura_compgen "$opts"- return 0- else- if _aura_pac_common_opts; then- return 0- fi- _aura_pac_file- return 0- fi- ;;- *)- return 0- ;;- esac- fi-}-complete -F _aura -o nospace aura+# ex:et ts=2 sw=2 ft=sh
exec/Aura/Commands/A.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-} -- | -- Module : Aura.Commands.A@@ -32,6 +33,7 @@ import Aura.State (saveState) import Aura.Types import Aura.Utils+import Control.Scheduler (Comp(..), traverseConcurrently) import Data.Aeson import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.Terminal@@ -41,6 +43,7 @@ import RIO import qualified RIO.ByteString as B import qualified RIO.ByteString.Lazy as BL+import qualified RIO.HashSet as HS import qualified RIO.List as L import RIO.List.Partial (maximum) import qualified RIO.NonEmpty as NEL@@ -119,7 +122,10 @@ -- | The result of @-Ai@. aurPkgInfo :: NonEmpty PkgName -> RIO Env ()-aurPkgInfo = aurInfo >=> traverse_ displayAurPkgInfo+aurPkgInfo ps = do+ res <- aurInfo ps+ when (null res) $ throwM (Failure $ FailMsg packageNotFound_1)+ traverse_ displayAurPkgInfo res displayAurPkgInfo :: AurInfo -> RIO Env () displayAurPkgInfo ai = asks settings >>= \ss -> putTextLn $ renderAurPkgInfo ss ai <> "\n"@@ -142,20 +148,34 @@ , maybe "(null)" pretty $ aurDescriptionOf ai ] -- | The result of @-As@.-aurPkgSearch :: Text -> RIO Env ()-aurPkgSearch regex = do+aurPkgSearch :: NonEmpty Text -> RIO Env ()+aurPkgSearch (NEL.map T.toLower -> terms) = do ss <- asks settings 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- Tail n -> reverse . take (fromIntegral n) . reverse- results <- fmap (\x -> (x, aurNameOf x `S.member` db)) . t- <$> aurSearch regex- traverse_ (putTextLn . renderSearch ss regex) results+ infoSet <- HS.filter matched . HS.fromList . fold <$> traverseConcurrently Par' aurSearch terms+ when (null infoSet) $ throwM Silent+ let sorted = sortAurInfo ss $ HS.toList infoSet+ truncated = map (\ai -> (ai, aurNameOf ai `S.member` db)) $ trunc ss sorted+ traverse_ (putTextLn . renderSearch ss terms) truncated+ where+ -- | Reduce the number of the results to show.+ trunc :: Settings -> ([a] -> [a])+ trunc ss = case truncationOf $ buildConfigOf ss of -- Can't this go anywhere else?+ None -> id+ Head n -> take $ fromIntegral n+ Tail n -> reverse . take (fromIntegral n) . reverse -renderSearch :: Settings -> Text -> (AurInfo, Bool) -> Text-renderSearch ss r (i, e) = searchResult+ -- | Keep only results that contained every search term in either their name+ -- or their description.+ matched :: AurInfo -> Bool+ matched ai = all (\t -> t `T.isInfixOf` aurNameOf ai) terms+ || maybe False descMatch (aurDescriptionOf ai)++ descMatch :: Text -> Bool+ descMatch (T.toLower -> d) = all (\t -> t `T.isInfixOf` d) terms++renderSearch :: Settings -> NonEmpty Text -> (AurInfo, Bool) -> Text+renderSearch ss (r :| _) (i, e) = searchResult where searchResult = if switch ss LowVerbosity then sparseInfo else dtot $ colourCheck ss verboseInfo sparseInfo = aurNameOf i verboseInfo = repo <> n <+> v <+> "(" <> l <+> "|" <+> p <>@@ -184,7 +204,7 @@ aurJson :: NonEmpty PkgName -> RIO Env () aurJson ps = do m <- asks (managerOf . settings)- infos <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ f m ps+ infos <- liftMaybeM (Failure $ FailMsg connectFailure_1) . fmap hush . liftIO $ f m ps traverse_ (BL.putStrLn . encode) infos where f :: Manager -> NonEmpty PkgName -> IO (Either AurError [AurInfo])
exec/Aura/Commands/C.hs view
@@ -62,7 +62,7 @@ getDowngradeChoice :: Cache -> PkgName -> RIO Env PackagePath getDowngradeChoice cache pkg = case NEL.nonEmpty $ getChoicesFromCache cache pkg of- Nothing -> throwM . Failure $ reportBadDowngradePkgs_2 pkg+ Nothing -> throwM . Failure . FailMsg $ reportBadDowngradePkgs_2 pkg Just choices -> do ss <- asks settings notify ss $ getDowngradeChoice_1 pkg@@ -83,7 +83,7 @@ backupCache dir = do exists <- liftIO $ doesDirectoryExist dir if not exists- then throwM $ Failure backupCache_3+ then throwM . Failure $ FailMsg backupCache_3 else confirmBackup dir >>= backup dir confirmBackup :: FilePath -> RIO Env Cache
exec/Aura/Commands/P.hs view
@@ -48,7 +48,7 @@ pbs <- catMaybes <$> liftIO (traverseConcurrently Par' (getPkgbuild m . spName) $ S.toList ps) mapMaybeA f pbs >>= \case [] -> notify ss security_14- _ -> throwM $ Failure security_12+ _ -> throwM . Failure $ FailMsg security_12 where f :: Pkgbuild -> RIO Env (Maybe Pkgbuild) f pb = case parsedPB pb of@@ -62,10 +62,10 @@ findExploits :: Pkgbuild -> RIO Env () findExploits pb = case parsedPB pb of- Nothing -> throwM $ Failure security_11+ Nothing -> throwM . Failure $ FailMsg security_11 Just l -> case bannedTerms l of [] -> pure () bts -> do ss <- asks settings liftIO $ traverse_ (displayBannedTerms ss) bts- throwM $ Failure security_12+ throwM . Failure $ FailMsg security_12
exec/Aura/Flags.hs view
@@ -2,7 +2,7 @@ module Aura.Flags ( Program(..), opts- , PacmanOp( Sync ), SyncOp( SyncUpgrade ), SyncSwitch(..), MiscOp+ , PacmanOp( Sync ), SyncOp( SyncUpgrade, SyncSearch ), SyncSwitch(..), MiscOp , AuraOp(..), AurSwitch(..), _AurSync, _AurIgnore, _AurIgnoreGroup , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..), AnalysisOp(..) ) where@@ -41,7 +41,7 @@ data PacmanOp = Database !(Either DatabaseOp (NonEmpty PkgName)) | Files !(Set FilesOp)- | Query !(Either QueryOp (Set QueryFilter, Set PkgName))+ | Query !(Either (Set QueryOp, Set Text) (Set QueryFilter, Set PkgName)) | Remove !(Set RemoveOp) !(NonEmpty PkgName) | Sync !(Either (NonEmpty SyncOp) (Set PkgName)) !(Set SyncSwitch) | TestDeps !(NonEmpty Text)@@ -52,7 +52,7 @@ asFlag (Database (Left o)) = "-D" : asFlag o asFlag (Database (Right fs)) = "-D" : asFlag fs asFlag (Files os) = "-F" : asFlag os- asFlag (Query (Left o)) = "-Q" : asFlag o+ asFlag (Query (Left (os, as))) = "-Q" : asFlag os ++ asFlag as asFlag (Query (Right (fs, ps))) = "-Q" : asFlag ps ++ asFlag fs asFlag (Remove os ps) = "-R" : asFlag os ++ asFlag ps asFlag (Sync (Left o) ss) = "-S" : asFlag ss ++ asFlag o@@ -89,25 +89,25 @@ asFlag FilesMachineReadable = ["--machinereadable"] data QueryOp- = QueryChangelog !(NonEmpty Text)- | QueryGroups !(NonEmpty Text)- | QueryInfo !(NonEmpty Text)- | QueryCheck !(NonEmpty Text)- | QueryList !(NonEmpty Text)- | QueryOwns !(NonEmpty Text)- | QueryFile !(NonEmpty Text)- | QuerySearch !Text- deriving (Show)+ = QueryChangelog+ | QueryGroups+ | QueryInfo+ | QueryCheck+ | QueryList+ | QueryOwns+ | QueryFile+ | QuerySearch+ deriving (Eq, Ord, Show) instance Flagable QueryOp where- asFlag (QueryChangelog ps) = "--changelog" : asFlag ps- asFlag (QueryGroups ps) = "--groups" : asFlag ps- asFlag (QueryInfo ps) = "--info" : asFlag ps- asFlag (QueryCheck ps) = "--check" : asFlag ps- asFlag (QueryList ps) = "--list" : asFlag ps- asFlag (QueryOwns ps) = "--owns" : asFlag ps- asFlag (QueryFile ps) = "--file" : asFlag ps- asFlag (QuerySearch t) = ["--search", t]+ asFlag QueryChangelog = ["--changelog"]+ asFlag QueryGroups = ["--groups"]+ asFlag QueryInfo = ["--info"]+ asFlag QueryCheck = ["--check"]+ asFlag QueryList = ["--list"]+ asFlag QueryOwns = ["--owns"]+ asFlag QueryFile = ["--file"]+ asFlag QuerySearch = ["--search"] data QueryFilter = QueryDeps@@ -143,7 +143,7 @@ = SyncClean | SyncGroups !(NonEmpty Text) | SyncInfo !(NonEmpty Text)- | SyncList !Text+ | SyncList !(Set Text) | SyncSearch !(NonEmpty Text) | SyncUpgrade !(Set Text) | SyncDownload !(NonEmpty Text)@@ -153,7 +153,7 @@ asFlag SyncClean = ["--clean"] asFlag (SyncGroups gs) = "--groups" : asFlag gs asFlag (SyncInfo ps) = "--info" : asFlag ps- asFlag (SyncList r) = ["--list", r]+ asFlag (SyncList rs) = "--list" : asFlag rs asFlag (SyncSearch s) = "--search" : asFlag s asFlag (SyncUpgrade ps) = "--sysupgrade" : asFlag ps asFlag (SyncDownload ps) = "--downloadonly" : asFlag ps@@ -243,7 +243,7 @@ = AurDeps !(NonEmpty PkgName) | AurInfo !(NonEmpty PkgName) | AurPkgbuild !(NonEmpty PkgName)- | AurSearch !Text+ | AurSearch !(NonEmpty Text) | AurUpgrade !(Set PkgName) | AurJson !(NonEmpty PkgName) | AurTarball !(NonEmpty PkgName)@@ -253,6 +253,7 @@ = AurIgnore !(Set PkgName) | AurIgnoreGroup !(Set PkgGroup) | AurRepoSync+ | AurWideSearch deriving (Eq, Ord, Show) _AurIgnore :: Traversal' AurSwitch (Set PkgName)@@ -317,16 +318,17 @@ ds = AurDeps <$> (flag' () (long "deps" <> short 'd' <> hidden <> help "View dependencies of an AUR package.") *> somePkgs') ainfo = AurInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View AUR package information.") *> somePkgs') pkgb = AurPkgbuild <$> (flag' () (long "pkgbuild" <> short 'p' <> hidden <> help "View an AUR package's PKGBUILD file.") *> somePkgs')- search = AurSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> hidden <> help "Search the AUR via a search string.")+ search = AurSearch <$> (flag' () (long "search" <> short 's' <> hidden <> help "Search the AUR via a search string.") *> someArgs') upgrade = AurUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade all installed AUR packages.") *> fmap (S.map PkgName) manyArgs') aur = AurJson <$> (flag' () (long "json" <> hidden <> help "Retrieve package JSON straight from the AUR.") *> somePkgs') tarball = AurTarball <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download a package tarball.") *> somePkgs')- switches = ign <|> igg <|> y+ switches = ign <|> igg <|> y <|> wide ign = AurIgnore . S.fromList . map PkgName . T.split (== ',') <$> strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") igg = AurIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") y = flag' AurRepoSync (short 'y' <> hidden <> help "Do an -Sy before continuing.")+ wide = flag' AurWideSearch (short 'r' <> long "both" <> hidden <> help "With -s: Search the official repos as well.") backups :: Parser AuraOp backups = bigB *> (Backup <$> optional mods)@@ -381,11 +383,12 @@ buildConfig :: Parser BuildConfig buildConfig = BuildConfig <$> makepkg <*> bp <*> bu <*> asp <*> vp <*> trunc <*> buildSwitches- where makepkg = S.fromList <$> many (ia <|> as <|> si <|> sp)+ where makepkg = S.fromList <$> many (ia <|> as <|> si <|> sp <|> nc) 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.") sp = flag' SkipPGP (long "skippgpcheck" <> hidden <> help "Skip all makepkg PGP checks.")+ nc = flag' NoCheck (long "nocheck" <> hidden <> help "Don't run the `check()` function, nor consider checkdeps.") 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.")@@ -400,7 +403,7 @@ dsm = flag' DontSuppressMakepkg (long "unsuppress" <> short 'x' <> hidden <> help "Unsuppress makepkg output.") dpb = flag' DiffPkgbuilds (long "diff" <> short 'k' <> hidden <> help "Show PKGBUILD diffs.") rbd = flag' RebuildDevel (long "devel" <> hidden <> help "Rebuild all git/hg/svn/darcs-based packages.")- he = flag' HotEdit (long "hotedit" <> hidden <> help "Edit a PKGBUILD before building.")+ he = flag' HotEdit (long "hotedit" <> short 'e' <> hidden <> help "Edit a PKGBUILD before building.") dr = flag' DryRun (long "dryrun" <> hidden <> help "Run dependency checks and PKGBUILD diffs, but don't build.") sa = flag' SortAlphabetically (long "abc" <> hidden <> help "Sort search results alphabetically.") lv = flag' LowVerbosity (long "quiet" <> short 'q' <> hidden <> help "Display less information.")@@ -457,15 +460,15 @@ queries = bigQ *> (Query <$> (fmap Right query <|> fmap Left mods)) where bigQ = flag' () (long "query" <> short 'Q' <> help "Interact with the local package database.") query = curry (second (S.map PkgName)) <$> queryFilters <*> manyArgs- mods = chl <|> gps <|> inf <|> lst <|> own <|> fls <|> sch <|> chk- chl = QueryChangelog <$> (flag' () (long "changelog" <> short 'c' <> hidden <> help "View a package's changelog.") *> someArgs')- gps = QueryGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View all members of a package group.") *> someArgs')- inf = QueryInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs')- lst = QueryList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List files owned by a package.") *> someArgs')- chk = QueryCheck <$> (flag' () (long "check" <> short 'k' <> hidden <> help "Check that package files exist.") *> someArgs')- own = QueryOwns <$> (flag' () (long "owns" <> short 'o' <> hidden <> help "Find the package some file belongs to.") *> someArgs')- fls = QueryFile <$> (flag' () (long "file" <> short 'p' <> hidden <> help "Query a package file.") *> someArgs')- sch = QuerySearch <$> strOption (long "search" <> short 's' <> metavar "REGEX" <> hidden <> help "Search the local database.")+ mods = (,) <$> (S.fromList <$> many (chl <|> gps <|> inf <|> lst <|> own <|> fls <|> sch <|> chk)) <*> manyArgs+ chl = flag' QueryChangelog (long "changelog" <> short 'c' <> hidden <> help "View a package's changelog.")+ gps = flag' QueryGroups (long "groups" <> short 'g' <> hidden <> help "View members of a package group.")+ inf = flag' QueryInfo (long "info" <> short 'i' <> hidden <> help "View package information.")+ lst = flag' QueryList (long "list" <> short 'l' <> hidden <> help "List files owned by a package.")+ chk = flag' QueryCheck (long "check" <> short 'k' <> hidden <> help "Check that package files exist.")+ own = flag' QueryOwns (long "owns" <> short 'o' <> hidden <> help "Find the package some file belongs to.")+ fls = flag' QueryFile (long "file" <> short 'p' <> hidden <> help "Query a package file.")+ sch = flag' QuerySearch (long "search" <> short 's' <> hidden <> help "Search the local database.") queryFilters :: Parser (Set QueryFilter) queryFilters = S.fromList <$> many (dps <|> exp <|> frg <|> ntv <|> urq <|> upg)@@ -493,7 +496,7 @@ cln = flag' SyncClean (long "clean" <> short 'c' <> hidden <> help "Remove old packages from the cache.") gps = SyncGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View members of a package group.") *> someArgs') inf = SyncInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs')- lst = SyncList <$> strOption (long "list" <> short 'l' <> metavar "REPO" <> hidden <> help "List the packages in a REPO.")+ lst = SyncList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List the packages in a REPO.") *> manyArgs') sch = SyncSearch <$> (flag' () (long "search" <> short 's' <> hidden <> help "Search the official package repos.") *> someArgs') upg = SyncUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade installed packages.") *> manyArgs') dnl = SyncDownload <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download package tarballs.") *> someArgs')
exec/Aura/Settings/Runtime.hs view
@@ -63,7 +63,7 @@ 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+ when (isNothing bu) . throwM . Failure $ FailMsg whoIsBuildUser_1 repos <- (<>) <$> pacmanRepo <*> aurRepo lopts <- setLogMinLevel ll . setLogUseLoc True <$> logOptionsHandle stderr True withLogFunc lopts $ \logFunc -> do@@ -75,7 +75,7 @@ , isTerminal = isTerm , ignoresOf = getIgnoredPkgs confFile <> fromGroups <> ign , commonConfigOf =- -- | These maintain the precedence order: flags, config file entry, default+ -- These maintain the precedence order: flags, config file entry, default co & cachePathOfL . _Left %~ (\x -> fromMaybe x $ getCachePath confFile) & logPathOfL . _Left %~ (\x -> fromMaybe x $ getLogFilePath confFile) , buildConfigOf =
exec/aura.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-} {- @@ -51,8 +52,6 @@ import Aura.Settings.Runtime import Aura.Types import Aura.Utils (nes)-import Data.Text.Prettyprint.Doc-import Data.Text.Prettyprint.Doc.Render.Terminal import Options.Applicative (execParser) import RIO import RIO.FilePath@@ -78,14 +77,13 @@ Right r -> pure r -- | Won't throw due to the `try`.-execute :: Env -> Program -> IO (Either (Doc AnsiStyle) ())-execute env p = first f <$> try (runRIO env . execOpts $ _operation p)- where- f (Failure fl) = fl $ langOf (settings env)+execute :: Env -> Program -> IO (Either Failure ())+execute env p = try (runRIO env . execOpts $ _operation p) -exit :: Settings -> Either (Doc AnsiStyle) () -> IO a-exit ss (Left e) = scold ss (const e) *> exitFailure-exit _ (Right _) = exitSuccess+exit :: Settings -> Either Failure () -> IO a+exit _ (Left Silent) = exitFailure+exit ss (Left (Failure (FailMsg e))) = scold ss e *> exitFailure+exit _ (Right _) = exitSuccess execOpts :: Either (PacmanOp, Set MiscOp) AuraOp -> RIO Env () execOpts ops = do@@ -116,7 +114,16 @@ Left (AurDeps ps) -> A.displayPkgDeps ps Left (AurInfo ps) -> A.aurPkgInfo ps Left (AurPkgbuild ps) -> A.displayPkgbuild ps- Left (AurSearch s) -> A.aurPkgSearch s+ Left (AurSearch s)+ | not (S.member AurWideSearch sws) -> A.aurPkgSearch s+ | otherwise -> do+ aur <- try @(RIO Env) @Failure $ A.aurPkgSearch s+ -- If the AUR lookup succeeded but the -S didn't, the exit code should still be success.+ let term = SyncSearch s :| []+ repo <- try @(RIO Env) @Failure $ p (Sync (Left term) S.empty, S.empty)+ case (aur, repo) of+ (Left _, Left e) -> throwM e+ (_, _) -> pure () Left (AurUpgrade ps) -> bool (trueRoot . sudo) id (switch ss DryRun) $ A.upgradeAURPkgs ps Left (AurJson ps) -> A.aurJson ps Left (AurTarball ps) -> A.fetchTarball ps
lib/Aura/Build.hs view
@@ -41,6 +41,13 @@ --- +-- | There are multiple outcomes to a single call to `makepkg`.+data BuildResult = AllSourced | Built !(NonEmpty PackagePath)++builtPPs :: BuildResult -> Maybe (NonEmpty PackagePath)+builtPPs (Built pps) = Just pps+builtPPs _ = Nothing+ -- | Storage location for "source" packages built with @--allsource@. -- Can be overridden in config or with @--allsourcepath@. srcPkgStore :: FilePath@@ -59,16 +66,16 @@ liftIO $ checkDBLock 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.+-- | All building occurs within temp directories, or in a location specified by+-- the user with flags. buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath] buildPackages bs = mapMaybeA build (NEL.toList bs) >>= \case- [] -> throwM $ Failure buildFail_10- built -> pure $ concat built+ [] -> throwM . Failure $ FailMsg buildFail_10+ built -> pure . foldMap toList $ mapMaybe builtPPs built -- | Handles the building of Packages. Fails nicely. -- Assumed: All dependencies are already installed.-build :: Buildable -> RIO Env (Maybe [PackagePath])+build :: Buildable -> RIO Env (Maybe BuildResult) build p = do logDebug $ "Building: " <> display (pnName $ bName p) ss <- asks settings@@ -76,8 +83,8 @@ result <- build' p either buildFail (pure . Just) result --- | Should never throw an IO Exception. In theory all errors--- will come back via the @Language -> String@ function.+-- | 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@@ -85,40 +92,63 @@ -- -- 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])+--+-- One `Buildable` can become multiple `PackagePath` due to "split packages".+-- i.e. a single call to `makepkg` can produce multiple related packages.+build' :: Buildable -> RIO Env (Either Failure BuildResult) build' b = do ss <- asks settings 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+ -- Create the build dir with open permissions so as to avoid issues involving git cloning.+ createWritableIfMissing pth+ -- Move into the final build dir. setCurrentDirectory pth buildDir <- liftIO $ getBuildDir b- createDirectoryIfMissing True buildDir+ createWritableIfMissing buildDir setCurrentDirectory buildDir+ -- Build the package. r <- runExceptT $ do 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+ when isDevel . ExceptT $ pullRepo usr+ logDebug "Potential hotediting..." liftIO $ overwritePkgbuild ss b liftIO $ overwriteInstall ss liftIO $ overwritePatches ss if S.member AllSource . makepkgFlagsOf $ buildConfigOf ss then do let !allsourcePath = fromMaybe srcPkgStore . allsourcePathOf $ buildConfigOf ss- liftIO (makepkgSource usr >>= traverse_ (moveToSourcePath allsourcePath)) $> []+ liftIO (makepkgSource usr >>= traverse_ (moveToSourcePath allsourcePath)) $> AllSourced else do- pNames <- ExceptT . liftIO . fmap (fmap NEL.toList) $ makepkg ss usr- liftIO $ traverse (moveToCachePath ss) pNames+ logDebug "Building package."+ pNames <- ExceptT . liftIO $ makepkg ss usr+ liftIO . fmap Built $ traverse (moveToCachePath ss) pNames when (switch ss DeleteBuildDir) $ do logDebug . fromString $ "Deleting build directory: " <> buildDir removeDirectoryRecursive buildDir pure r +createWritableIfMissing :: FilePath -> RIO e ()+createWritableIfMissing pth = do+ exists <- doesDirectoryExist pth+ if exists+ -- This is a migration strategy - it ensures that directories created with+ -- old versions of Aura automatically have their permissions fixed.+ then void . runProcess . setStderr closed . setStdout closed $ proc "chmod" ["755", pth]+ -- The library function `createDirectoryIfMissing` seems to obey umasks when+ -- creating directories, which can cause problem later during the build+ -- processes of git packages. By manually creating the directory with the+ -- expected permissions, we avoid this problem.+ else void . runProcess . setStderr closed . setStdout closed $ proc "mkdir" ["-p", "-m755", pth]++-- | A unique directory name (within the greater "parent" build dir) in which to+-- copy sources and actually build a package. getBuildDir :: Buildable -> IO FilePath getBuildDir b | isDevelPkg $ bName b = vcsBuildDir $ bName b@@ -146,21 +176,22 @@ currDir <- liftIO getCurrentDirectory logDebug $ "Currently in: " <> displayShow currDir scriptsDir <- liftIO $ chown usr currDir [] *> clone pkg+ logDebug "git: Initial cloning complete." case scriptsDir of- Nothing -> pure . Left . Failure . buildFail_7 $ bName pkg+ Nothing -> pure . Left . Failure . FailMsg. 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+pullRepo :: User -> RIO Env (Either Failure ())+pullRepo usr = do logDebug "git: Clearing worktree. " void . runProcess . setStderr closed . setStdout closed $ proc "git" ["reset", "--hard", "HEAD"] logDebug "git: Pulling repo." ec <- runProcess . setStderr closed . setStdout closed $ proc "git" ["pull"] case ec of- ExitFailure _ -> pure . Left $ Failure buildFail_12- ExitSuccess -> pure $ Right ()+ ExitFailure _ -> pure . Left . Failure $ FailMsg buildFail_12+ ExitSuccess -> liftIO (chown usr "." ["-R"]) $> Right () -- | Edit the PKGBUILD in-place, if the user wants to. overwritePkgbuild :: Settings -> Buildable -> IO ()@@ -193,9 +224,11 @@ -- | Inform the user that building failed. Ask them if they want to -- continue installing previous packages that built successfully. buildFail :: Failure -> RIO Env (Maybe a)-buildFail (Failure err) = do+buildFail err = do ss <- asks settings- scold ss err+ case err of+ Silent -> pure ()+ Failure (FailMsg fm) -> scold ss fm withOkay ss buildFail_6 buildFail_5 $ pure Nothing -- | Moves a file to the pacman package cache and returns its location.
lib/Aura/Core.hs view
@@ -114,14 +114,14 @@ -- | Action won't be allowed unless user is root, or using sudo. sudo :: RIO Env a -> RIO Env a-sudo act = asks (hasRootPriv . envOf . settings) >>= bool (throwM $ Failure mustBeRoot_1) act+sudo act = asks (hasRootPriv . envOf . settings) >>= bool (throwM . Failure $ FailMsg mustBeRoot_1) act -- | Stop the user if they are the true root. Building as root isn't allowed -- since makepkg v4.2. trueRoot :: RIO Env a -> RIO Env a trueRoot action = asks settings >>= \ss -> if not (isTrueRoot $ envOf ss) && buildUserOf (buildConfigOf ss) /= Just (User "root")- then action else throwM $ Failure trueRoot_3+ then action else throwM . Failure $ FailMsg trueRoot_3 -- | A list of non-prebuilt packages installed on the system. -- @-Qm@ yields a list of sorted values.
lib/Aura/Dependencies.hs view
@@ -58,11 +58,11 @@ logDebug "resolveDeps: Successful recursive dep lookup." unless (length ps == length m) $ putText "\n" let de = conflicts ss m s- unless (null de) . throwM . Failure $ missingPkg_2 de+ unless (null de) . throwM . Failure . FailMsg $ missingPkg_2 de either throwM pure $ sortInstall m where handleError :: SomeException -> RIO Env (Either Failure a)- handleError e = pure . Left . Failure . dependencyLookup_1 $ tshow e+ handleError e = pure . Left . Failure . FailMsg . dependencyLookup_1 $ tshow e -- | Solve dependencies for a set of `Package`s assumed to not be -- installed/satisfied.@@ -133,8 +133,8 @@ sortInstall :: Map PkgName Package -> Either Failure (NonEmpty (NonEmpty Package)) sortInstall m = case cycles depGraph of- [] -> note (Failure missingPkg_3) . NEL.nonEmpty . mapMaybe nes $ batch depGraph- cs -> Left . Failure . missingPkg_4 $ map (NEL.map pname . NAM.vertexList1) cs+ [] -> note (Failure $ FailMsg missingPkg_3) . NEL.nonEmpty . mapMaybe nes $ batch depGraph+ cs -> Left . Failure . FailMsg . missingPkg_4 $ map (NEL.map pname . NAM.vertexList1) cs where f :: Package -> [(Package, Package)] f (FromRepo _) = []
lib/Aura/IO.hs view
@@ -11,7 +11,7 @@ import Aura.Colour import Aura.Languages (whitespace, yesNoMessage, yesPattern) import Aura.Settings-import Aura.Types (Failure(..), Language)+import Aura.Types (FailMsg(..), Failure(..), Language) import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.Terminal import RIO@@ -87,7 +87,7 @@ -> RIO e a withOkay ss asking failed f = do okay <- liftIO $ optionalPrompt ss asking- bool (throwM $ Failure failed) f okay+ bool (throwM . Failure $ FailMsg failed) f okay -- | Given a number of selections, allows the user to choose one. getSelection :: Foldable f => (a -> Text) -> f a -> IO a
lib/Aura/Install.hs view
@@ -35,10 +35,12 @@ import Data.Text.Prettyprint.Doc.Render.Terminal import RIO import RIO.Directory (setCurrentDirectory)+import RIO.FilePath (takeFileName) import qualified RIO.List as L import qualified RIO.Map as M import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S+import Text.Printf (printf) --- @@ -75,14 +77,14 @@ Just toInstall -> do traverse_ (report yellow reportUnneededPackages_1) . NEL.nonEmpty $ toList unneeded- (nons, toBuild) <- liftMaybeM (Failure connectFailure_1) . liftIO+ (nons, toBuild) <- liftMaybeM (Failure $ FailMsg connectFailure_1) . liftIO $ aurLookup (managerOf ss) toInstall pkgbuildDiffs toBuild traverse_ (report red reportNonPackages_1) . NEL.nonEmpty $ toList nons let !explicits = bool (S.map (\b -> b { bIsExplicit = True }) toBuild) toBuild $ switch ss AsDeps case nes explicits of- Nothing -> throwM $ Failure install_2+ Nothing -> throwM . Failure $ FailMsg install_2 Just toBuild' -> do notify ss install_5 *> hFlush stdout allPkgs <- if switch ss SkipDepCheck@@ -144,14 +146,16 @@ let !pacOpts = asFlag $ commonConfigOf ss liftIO . pacman (envOf ss) $ ["-S", "--asdeps"] <> pacOpts <> asFlag (NEL.map pName ps) +-- | Try to build and install all packages. Requested packages that already have+-- a version in the cache will not be rebuilt unless `--force` was passed. buildAndInstall :: NonEmpty (NonEmpty Buildable) -> RIO Env () buildAndInstall bss = do- ss <- asks settings+ ss <- asks settings let !pth = either id id . cachePathOf $ commonConfigOf ss !allsource = S.member AllSource . makepkgFlagsOf $ buildConfigOf ss cache <- liftIO $ cacheContents pth when allsource $ notify ss buildPackages_2- traverse_ (f cache) bss+ traverse_ (f ss cache) bss when allsource $ do let !allsourcePath = fromMaybe srcPkgStore . allsourcePathOf $ buildConfigOf ss notify ss $ buildPackages_3 allsourcePath@@ -160,23 +164,26 @@ -- `built` and the `traverse_` line below don't run, but `annotateDeps` is -- called anyway. There is definitely a better way to manage the `NonEmpty`s -- here.- f :: Cache -> NonEmpty Buildable -> RIO Env ()- 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-+ f :: Settings -> Cache -> NonEmpty Buildable -> RIO Env ()+ f ss cache bs = do+ let (ps, cached) = fmapEither (g ss cache) $ NEL.toList bs+ when (switch ss HotEdit && not (null cached)) $ do+ warn ss buildPackages_4+ traverse_ (liftIO . printf " - %s\n" . takeFileName . ppPath) cached+ warn ss buildPackages_5 built <- traverse buildPackages $ NEL.nonEmpty ps traverse_ installPkgFiles $ (built <> Just cached) >>= NEL.nonEmpty liftIO $ annotateDeps (envOf ss) 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 :: Settings -> Cache -> Buildable -> Either Buildable PackagePath+ g ss (Cache cache) b = case bToSP b `M.lookup` cache of+ Just pp | not (switch ss ForceBuilding) -> Right pp+ _ -> Left b++ ------------ -- REPORTING ------------@@ -193,7 +200,7 @@ liftIO (aurLookup (managerOf ss) ps) >>= \case Nothing -> do logDebug "-Ad: Receiving `Nothing` from `aurLookup`."- throwM $ Failure connectFailure_1+ throwM . Failure $ FailMsg connectFailure_1 Just (_, goods) -> do logDebug "-Ad: Initial AUR lookup successful." traverse_ f $ nes goods
lib/Aura/Languages.hs view
@@ -222,6 +222,14 @@ Spanish -> "Todos los archivos .src.tar.gz fueron construidos y copiados a: " <> pretty fp _ -> "All .src.tar.gz files were built and copied to: " <> pretty fp +buildPackages_4 :: Language -> Doc AnsiStyle+buildPackages_4 = \case+ _ -> bt @Text "--hotedit" <+> "detected, but the following have cache entries and will be skipped for editing:"++buildPackages_5 :: Language -> Doc AnsiStyle+buildPackages_5 = \case+ _ -> "You can use" <+> bt @Text "--force" <+> "to override this behaviour."+ buildFail_5 :: Language -> Doc AnsiStyle buildFail_5 = \case Japanese -> "パッケージ作成に失敗しました。"@@ -1265,6 +1273,10 @@ -- Aura/AUR functions ------------------------------- +packageNotFound_1 :: Language -> Doc AnsiStyle+packageNotFound_1 = \case+ _ -> "No packages found."+ -- https://github.com/fosskers/aura/issues/498 connectFailure_1 :: Language -> Doc AnsiStyle connectFailure_1 = \case@@ -1464,27 +1476,6 @@ ------------------------ -- Aura/Pacman functions --------------------------- NEEDS TRANSLATION-pacmanFailure_1 :: Language -> Doc AnsiStyle-pacmanFailure_1 = \case- Japanese -> "入力を確認して下さい。"- Polish -> "Sprawdź swoje dane wejściowe"- Croatian -> "Molim vas, provjerite svoj unos."- German -> "Bitte überprüfen Sie Ihre Eingabe."- Spanish -> "Por favor comprueba los datos proporcionados."- Serbian -> "Молим Вас, проверите ваш унос."- Norwegian -> "Vennligst sjekk din oppføring."- Italian -> "Verificare ciò che è stato immesso come input."- Portuguese -> "Por favor, verifique os dados informados."- French -> "Merci de vérifier les donnés entrées."- Russian -> "Пожалуйста, проверьте ваши введенные данные."- Indonesia -> "Mohon periksa masukan anda."- Chinese -> "请检查你的输入。"- Swedish -> "Var god dubbelkolla indata."- Esperanto -> "Bonvolu kontroli vian enigon."- Dutch -> "Controleer alstublieft uw input."- _ -> "Please check your input."- confParsing_1 :: Language -> Doc AnsiStyle confParsing_1 = \case Polish -> "Nie udało się odczytać twojego pliku pacman.conf"
lib/Aura/MakePkg.hs view
@@ -40,12 +40,12 @@ runStyle usr . map T.unpack . foldMap asFlag . makepkgFlagsOf $ buildConfigOf ss g :: (ExitCode, LByteString, [a]) -> IO (Either Failure (NonEmpty a))- g (ExitSuccess, _, fs) = pure . note (Failure buildFail_9) $ NEL.nonEmpty fs+ g (ExitSuccess, _, fs) = pure . note (Failure $ FailMsg buildFail_9) $ NEL.nonEmpty fs g (ExitFailure _, se, _) = do unless (switch ss DontSuppressMakepkg) $ do showError <- optionalPrompt ss buildFail_11 when showError $ BL.putStrLn se- pure . Left $ Failure buildFail_8+ pure . Left . Failure $ FailMsg buildFail_8 overwrite :: [String] overwrite | switch ss ForceBuilding = ["-f"]
lib/Aura/Packages/AUR.hs view
@@ -17,6 +17,7 @@ -- * Single Querying , aurInfo , aurSearch+ , sortAurInfo -- * Source Retrieval , clone , pkgUrl@@ -113,7 +114,7 @@ ------------------- -- SOURCES FROM GIT ---------------------- | Attempt to clone a package source from the AUR.+-- | Attempt to freshly clone a package source from the AUR. clone :: Buildable -> IO (Maybe FilePath) clone b = do ec <- runProcess . setStderr closed . setStdout closed@@ -133,33 +134,33 @@ ------------ -- RPC CALLS -------------sortAurInfo :: Maybe BuildSwitch -> [AurInfo] -> [AurInfo]-sortAurInfo bs ai = L.sortBy compare' ai- where compare' = case bs of- Just SortAlphabetically -> compare `on` aurNameOf- _ -> \x y -> compare (aurVotesOf y) (aurVotesOf x)+sortAurInfo :: Settings -> [AurInfo] -> [AurInfo]+sortAurInfo ss ai = L.sortBy compare' ai+ where+ compare' :: AurInfo -> AurInfo -> Ordering+ compare' | switch ss SortAlphabetically = compare `on` aurNameOf+ | otherwise = \x y -> compare (aurVotesOf y) (aurVotesOf x) -- | Frontend to the `aur` library. For @-As@. aurSearch :: Text -> RIO Env [AurInfo] aurSearch regex = do ss <- asks settings- res <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ search (managerOf ss) regex- pure $ sortAurInfo (bool Nothing (Just SortAlphabetically) $ switch ss SortAlphabetically) res+ liftMaybeM (Failure $ FailMsg connectFailure_1) . fmap hush . liftIO $ search (managerOf ss) regex -- | Frontend to the `aur` library. For @-Ai@. aurInfo :: NonEmpty PkgName -> RIO Env [AurInfo] aurInfo pkgs = do logDebug $ "AUR: Looking up " <> display (length pkgs) <> " packages..."- m <- asks (managerOf . settings)- sortAurInfo (Just SortAlphabetically) . fold- <$> traverseConcurrently Par' (work m) (groupsOf 50 $ NEL.toList pkgs)+ ss <- asks settings+ let !m = managerOf ss+ sortAurInfo ss . fold <$> traverseConcurrently Par' (work m) (groupsOf 50 $ NEL.toList pkgs) where work :: Manager -> [PkgName] -> RIO Env [AurInfo] work m ps = liftIO (info m $ map pnName ps) >>= \case- Left (NotFound _) -> throwM (Failure connectFailure_1)- Left BadJSON -> throwM (Failure miscAURFailure_3)+ Left (NotFound _) -> throwM (Failure $ FailMsg connectFailure_1)+ Left BadJSON -> throwM (Failure $ FailMsg miscAURFailure_3) Left (OtherAurError e) -> do let !resp = display $ decodeUtf8Lenient e logDebug $ "Failed! Server said: " <> resp- throwM (Failure miscAURFailure_1)+ throwM (Failure $ FailMsg miscAURFailure_1) Right res -> pure res
lib/Aura/Pacman.hs view
@@ -61,7 +61,7 @@ getPacmanConf :: FilePath -> IO (Either Failure Config) getPacmanConf fp = do file <- decodeUtf8Lenient <$> BS.readFile fp- pure . first (const (Failure confParsing_1)) $ parse config "pacman config" file+ pure . first (const (Failure $ FailMsg confParsing_1)) $ parse config "pacman config" file -- | Fetches the @IgnorePkg@ entry from the config, if it's there. getIgnoredPkgs :: Config -> Set PkgName@@ -105,7 +105,7 @@ pacman :: Environment -> [Text] -> IO () pacman env (map T.unpack -> args) = do ec <- runProcess $ pacmanProc env args- unless (ec == ExitSuccess) $ throwM (Failure pacmanFailure_1)+ unless (ec == ExitSuccess) $ throwM Silent -- | Run some `pacman` process, but only care about whether it succeeded. pacmanSuccess :: Environment -> [T.Text] -> IO Bool
lib/Aura/Security.hs view
@@ -27,7 +27,7 @@ ss <- asks settings let f = do yes <- liftIO $ optionalPrompt ss security_6- when yes . throwM $ Failure security_7+ when yes . throwM . Failure $ FailMsg security_7 case parsedPB $ bPkgbuild b of Nothing -> warn ss (security_1 $ bName b) *> f Just l -> case bannedTerms l of
lib/Aura/Settings.hs view
@@ -39,13 +39,15 @@ data Truncation = None | Head !Word | Tail !Word deriving (Eq, Show) -- | CLI flags that will be passed down to @makepkg@ when building packages.-data Makepkg = IgnoreArch | AllSource | SkipInteg | SkipPGP deriving (Eq, Ord, Show)+data Makepkg = IgnoreArch | AllSource | SkipInteg | SkipPGP | NoCheck+ deriving (Eq, Ord, Show) instance Flagable Makepkg where asFlag IgnoreArch = ["--ignorearch"] asFlag AllSource = ["--allsource"] asFlag SkipInteg = ["--skipinteg"] asFlag SkipPGP = ["--skippgpcheck"]+ asFlag NoCheck = ["--nocheck"] -- | Flags that are common to both Aura and Pacman. -- Aura will react to them, but also pass them through to `pacman`
lib/Aura/State.hs view
@@ -130,14 +130,14 @@ -- | Does its best to restore a state chosen by the user. restoreState :: RIO Env () restoreState =- liftIO getStateFiles >>= maybe (throwM $ Failure restoreState_2) f . NEL.nonEmpty+ liftIO getStateFiles >>= maybe (throwM . Failure $ FailMsg restoreState_2) f . NEL.nonEmpty where f :: NonEmpty FilePath -> RIO Env () f sfs = do ss <- asks settings let pth = either id id . cachePathOf $ commonConfigOf ss mpast <- liftIO $ selectState sfs >>= readState case mpast of- Nothing -> throwM $ Failure readState_1+ Nothing -> throwM . Failure $ FailMsg readState_1 Just past -> do curr <- liftIO . currentState $ envOf ss Cache cache <- liftIO $ cacheContents pth
lib/Aura/Types.hs view
@@ -28,6 +28,7 @@ -- * Errors , DepError(..) , Failure(..)+ , FailMsg(..) -- * Language , Language(..) -- * Other Wrappers@@ -270,14 +271,21 @@ | Ignored !(Doc AnsiStyle) | BrokenProvides !PkgName !Provides !PkgName +-- | Failures that can occur during Aura processing. Could be a message, or a+-- silent failure that should print nothing to the console.+data Failure = Silent | Failure FailMsg+ deriving stock (Show)++instance Exception Failure+ -- | Some failure message that when given the current runtime `Language` -- will produce a human-friendly error.-newtype Failure = Failure { failure :: Language -> Doc AnsiStyle }+newtype FailMsg = FailMsg { failure :: Language -> Doc AnsiStyle } -instance Exception Failure+instance Exception FailMsg -instance Show Failure where- show (Failure _) = "There was some failure."+instance Show FailMsg where+ show _ = "There was some failure." -- | Shell environment variables. type Environment = Map Text Text
test/Test.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedLists #-}+ module Main ( main ) where import Aura.Languages