{-# LANGUAGE CPP #-} module Cmd.Install ( installCmd, notInstalledCmd, Select(..), unInstallCmd ) where import Data.RPM import Safe (headMay) import SelectRPMs import Branches import Cmd.Merge import Common import Common.System import Git import Package import Repoquery import RpmBuild -- FIXME --rpm to avoid dnf -- FIXME --subpackage to specify subpackage(s) to install/add -- FIXME --exclude to specify subpackage(s) not to install -- FIXME --ignore-uninstalled subpackages -- FIXME --skip-unavailable -- FIXME --check any/all of package installed -- FIXME add --debug or respect --verbose for dnf commands -- FIXME handle subpackage renames (eg ghc-rpm-macros-no-prof to ghc-rpm-macros-quick) -- FIXME allow building an srpm installCmd :: Bool -> Bool -> Maybe Branch -> Maybe Natural -> Maybe ForceShort -> [BCond] -> Maybe PkgMgr -> Bool -> Bool -> Bool -> Bool -> Yes -> Select -> Maybe ExistingStrategy -> (Maybe Branch,[String]) -> IO () installCmd quiet recurse mfrom mjobs mforceshort bconds mmgr reinstall allowerasing nobuild nobuilddeps yes select mexisting (mbr, pkgs) = do when (recurse && isShortCircuit mforceshort) $ error' "cannot use --recurse and --shortcircuit" withPackagesMaybeBranch (boolHeader (recurse || length pkgs > 1)) True Nothing installPkg (mbr, filter (/= ":") pkgs) where installPkg :: Package -> AnyBranch -> IO () installPkg pkg br = do whenJust mbr $ gitSwitchBranch . RelBranch dead <- doesFileExist "dead.package" if dead then putStrLn "dead package" else do spec <- if isNothing mfrom then localBranchSpecFile pkg br else do mergeCmd False False True Nothing False mfrom (Branches [onlyRelBranch br], ["."]) localBranchSpecFile pkg br rpms <- builtRpms br spec let nvras = map readNVRA rpms -- FIXME can this be removed now? already <- filterM nvraInstalled nvras if isJust mforceshort || null already || reinstall || select /= selectDefault then doInstallRPMs spec rpms else putStrLn $ unlines (map showNVRA already) ++ "\nalready installed!\n" where doInstallRPMs spec rpms = do -- FIXME show source NVR (eg not pandoc-common) whenJust (headMay rpms) $ putStrLn . showNVR . dropArch . readNVRA unless (nobuilddeps || nobuild) $ do needBuild <- needToBuildRPMS True mforceshort rpms spec when needBuild $ do missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) unless (null missingdeps) $ if recurse then do -- srcs <- nub <$> mapM (derefSrcPkg topdir dist True) hmissing rbr <- anyBranchToRelease br forM_ missingdeps $ \ dep -> do -- FIXME check not metadep with parens mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of Nothing -> putStrLn $ dep +-+ "not known" Just pkgdir -> installCmd quiet recurse mfrom mjobs mforceshort bconds mmgr reinstall allowerasing nobuild nobuilddeps yes select mexisting (mbr, [pkgdir]) >> putNewLn -- FIXME option to enable/disable installing missing deps -- FIXME --skip-missing-deps or prompt else installDeps True spec -- FIXME unused _wasbuilt <- if nobuild then return True else buildRPMs quiet False False mjobs mforceshort bconds rpms br spec unless (isShortCircuit mforceshort) $ do let nvras = rpmsToNVRAs rpms -- FIXME: prefix = fromMaybe (nvrName nvr) mprefix decided <- decideRPMs yes False mexisting select (unPackage pkg) nvras -- FIXME dryrun and debug -- FIXME return Bool? installRPMsAllowErasing False False mmgr allowerasing yes $ groupOnArch "RPMS" decided lookForPkgDir :: Branch -> FilePath -> String -> IO (Maybe FilePath) lookForPkgDir rbr topdir p = do mdir <- checkForPkgDir p case mdir of Just dir -> return $ Just dir Nothing -> if '-' `elem` p then do -- FIXME check provides p mdir' <- checkForPkgDir (init (dropWhileEnd (/= '-') p)) case mdir' of Just dir' -> return $ Just dir' Nothing -> repoquerySrc >>= checkForPkgDir else repoquerySrc >>= checkForPkgDir where checkForPkgDir :: FilePath -> IO (Maybe FilePath) checkForPkgDir p' = do let pdir = topdir p' exists <- doesDirectoryExist pdir return $ if exists then Just pdir else Nothing repoquerySrc = do putStrLn $ "Repoquerying" +-+ p sysbr <- systemBranch repoquery sysbr rbr ["--qf=%{source_name}", "--whatprovides", p] notInstalledCmd :: (Maybe Branch,[String]) -> IO () notInstalledCmd = withPackagesMaybeBranchNoHeadergit notInstalledPkg where notInstalledPkg :: Package -> AnyBranch -> IO () notInstalledPkg pkg br = do dead <- doesFileExist "dead.package" unless dead $ do spec <- findSpecfile rpms <- builtRpms br spec let nvras = map readNVRA rpms installed <- filterM nvraInstalled nvras when (null installed) $ do let pkgnames = map rpmName nvras older <- filterM pkgInstalled pkgnames if null older then putStrLn $ unPackage pkg else putStrLn $ " " ++ unPackage pkg pkgInstalled :: String -> IO Bool pkgInstalled pkg = cmdBool "rpm" ["--quiet", "-q", pkg] unInstallCmd :: Yes -> (Maybe Branch,[String]) -> IO () unInstallCmd yes (mbr, pkgs) = do withPackagesMaybeBranch (boolHeader (length pkgs > 1)) True Nothing unInstallPkg (mbr, pkgs) where unInstallPkg :: Package -> AnyBranch -> IO () unInstallPkg pkg br = do whenJust mbr $ gitSwitchBranch . RelBranch dead <- doesFileExist "dead.package" if dead then putStrLn "dead package" else do spec <- localBranchSpecFile pkg br built <- builtRpms br spec let rpms = map (rpmName . readNVRA) built -- FIXME can this be removed now? installed <- filterM (\p -> cmdBool "rpm" ["--quiet", "-q", p]) rpms unless (null installed) $ do whenJust (headMay built) $ putStrLn . showNVR . dropArch . readNVRA unInstallRPMs False installed unInstallRPMs :: Bool -> [String] -> IO () unInstallRPMs debug rpms = unless (null rpms) $ do mgr <- do ostree <- doesDirectoryExist "/sysroot/ostree" if ostree then return OSTREE else do mdnf5 <- findExecutable "dnf5" return $ maybe DNF3 (const DNF5) mdnf5 let pkgmgr = case mgr of DNF3 -> "dnf-3" DNF5 -> "dnf5" RPM -> "rpm" OSTREE -> "rpm-ostree" com = unInstallCommand mgr in do when debug $ mapM_ putStrLn rpms (case mgr of OSTREE -> cmd_ _ -> if debug then sudoLog else sudo_) pkgmgr $ com ++ rpms ++ ["--assumeyes" | yes == Yes && mgr `elem` [DNF3,DNF5]] unInstallCommand :: PkgMgr -> [String] unInstallCommand mgr = case mgr of DNF3 -> ["remove"] DNF5 -> ["remove"] RPM -> ["-e"] OSTREE -> ["uninstall"] #if !MIN_VERSION_simple_cmd(0,2,7) sudoLog :: String -- ^ command -> [String] -- ^ arguments -> IO () sudoLog = sudo_ #endif