{-# LANGUAGE CPP #-} module Cmd.Install ( installCmd, notInstalledCmd ) where import Data.RPM #if !MIN_VERSION_simple_cmd(0,2,7) import System.Posix.User (getEffectiveUserID) #endif import SimplePrompt (promptEnter) import Branches import Cmd.Merge import Common import Common.System import Git import Package import Repoquery import RpmBuild -- FIXME --nobuild -- FIXME --rpm to avoid dnf -- FIXME --force removal of existing incompatible dependent packages -- FIXME --subpackage to specify subpackage(s) to install/add -- FIXME --ignore-uninstalled subpackages -- FIXME --skip-unavailable -- FIXME --check any/all of package installed -- FIXME add --debug or respect --verbose for dnf commands installCmd :: Bool -> Bool -> Maybe Branch -> Maybe ForceShort -> [BCond] -> Bool -> Bool -> Bool -> (Maybe Branch,[String]) -> IO () installCmd verbose recurse mfrom mforceshort bconds reinstall nobuilddeps allsubpkgs (mbr, pkgs) = do when (recurse && isShortCircuit mforceshort) $ error' "cannot use --recurse and --shortcircuit" withPackagesMaybeBranch (boolHeader (recurse || length pkgs > 1)) True Nothing installPkg (mbr, 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 -- removing arch let nvras = map readNVRA rpms already <- filterM nvraInstalled nvras if isJust mforceshort || null already || reinstall then doInstallPkg mforceshort spec rpms already else putStrLn $ unlines (map showNVRA already) ++ "\nalready installed!\n" where doInstallPkg mforceshort' spec rpms already = do putStrLn $ (showNVR . dropArch . readNVRA) (head rpms) unless nobuilddeps $ 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 verbose recurse mfrom mforceshort bconds reinstall nobuilddeps allsubpkgs (mbr, [pkgdir]) >> putNewLn -- FIXME option to enable/disable installing missing deps -- FIXME --skip-missing-deps or prompt else installDeps True spec wasbuilt <- buildRPMs (not verbose) False False mforceshort' bconds rpms br spec unless (isShortCircuit mforceshort') $ do toinstalls <- if allsubpkgs then return rpms else do ps <- filterM (pkgInstalled . rpmName . readNVRA) rpms return $ if null ps then rpms else ps if reinstall || mforceshort' == Just ForceBuild then do let reinstalls = filter (\ f -> readNVRA f `elem` already) toinstalls unless (null reinstalls) $ sudoLog "/usr/bin/dnf" $ "reinstall" : "-q" : "-y" : reinstalls let remaining = filterDebug $ toinstalls \\ reinstalls unless (null remaining) $ sudoLog "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining else do let command = "/usr/bin/dnf" : "install" : "-q" : "-y" : filterDebug toinstalls cmdN "sudo" command ok <- cmdBool "sudo" command unless ok $ if wasbuilt then error' $ "error from:" +-+ unwords command else do promptEnter "Press Enter to rebuild package" doInstallPkg (Just ForceBuild) spec rpms already 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] filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"])) 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 nvraInstalled :: NVRA -> IO Bool nvraInstalled rpm = cmdBool "rpm" ["--quiet", "-q", showNVRA rpm] pkgInstalled :: String -> IO Bool pkgInstalled pkg = cmdBool "rpm" ["--quiet", "-q", pkg] #if !MIN_VERSION_simple_cmd(0,2,7) sudoLog :: String -- ^ command -> [String] -- ^ arguments -> IO () sudoLog = sudoInternal cmdLog where sudoInternal :: (String -> [String] -> IO a) -> String -> [String] -> IO a sudoInternal exc c args = do uid <- getEffectiveUserID sd <- if uid == 0 then return Nothing else findExecutable "sudo" let noSudo = isNothing sd when (uid /= 0 && noSudo) $ warning "'sudo' not found" exc (fromMaybe c sd) (if noSudo then args else c:args) #endif