{-# LANGUAGE CPP, LambdaCase #-} -- SPDX-License-Identifier: BSD-3-Clause module Main (main) where import Control.Monad.Extra import Data.Bifunctor (bimap) import Data.Char (isDigit) import Data.List.Extra import Data.Maybe (isJust, mapMaybe, maybeToList) import Network.Curl import Network.HTTP.Directory (httpExists', (+/+)) import SimpleCmd import SimpleCmdArgs import SimplePrompt (yesNo) import System.Directory (doesFileExist, findExecutable, withCurrentDirectory, #if !MIN_VERSION_simple_cmd(0,2,4) listDirectory #endif ) import System.Environment (lookupEnv) import System.FilePath import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering)) import System.IO.Extra (withTempDir) import System.Time.Extra (sleep) import Paths_dnf_repo (getDataFileName, version) import ExpireRepos import Sudo import YumRepoFile main :: IO () main = do checkSudo simpleCmdArgs' (Just version) "DNF wrapper repo tool" "see https://github.com/juhp/dnf-repo#readme" $ runMain <$> switchWith 'n' "dryrun" "Dry run" <*> switchWith 'q' "quiet" "Suppress necessary output" <*> switchWith 'D' "debug" "Debug output" <*> switchWith 'l' "list" "List all repos" <*> switchWith 's' "save" "Save the repo enable/disable state" <*> optional (flagWith' True 'w' "weak-deps" "Use weak dependencies" <|> flagWith' False 'W' "no-weak-deps" "Disable weak dependencies") <*> switchLongWith "exact" "Match repo names exactly" <*> many modeOpt <*> many (strArg "DNFARGS") where repoOptionWith = (fmap . fmap . fmap . fmap) cleanupReponame . strOptionWith where cleanupReponame = dropWhileEnd (== '/') . dropWhile (== '/') . replace ":" "/" modeOpt = DisableRepo <$> repoOptionWith 'd' "disable" "REPOPAT" "Disable repos" <|> EnableRepo <$> repoOptionWith 'e' "enable" "REPOPAT" "Enable repos" <|> ExpireRepo <$> repoOptionWith 'x' "expire" "REPOPAT" "Expire repo cache" <|> flagWith' ClearExpires 'X' "clear-expires" "Undo cache expirations" <|> DeleteRepo <$> repoOptionWith 'E' "delete-repofile" "REPOPAT" "Remove unwanted .repo file" <|> flagWith' (Specific EnableTesting) 't' "enable-testing" "Enable testing repos" <|> flagWith' (Specific DisableTesting) 'T' "disable-testing" "Disable testing repos" <|> flagWith' (Specific EnableModular) 'm' "enable-modular" "Enable modular repos" <|> flagWith' (Specific DisableModular) 'M' "disable-modular" "Disable modular repos" <|> flagLongWith' (Specific EnableDebuginfo) "enable-debuginfo" "Enable debuginfo repos" <|> flagLongWith' (Specific DisableDebuginfo) "disable-debuginfo" "Disable debuginfo repos" <|> flagLongWith' (Specific EnableSource) "enable-source" "Enable source repos" <|> flagLongWith' (Specific DisableSource) "disable-source" "Disable source repos" <|> AddCopr <$> repoOptionWith 'c' "add-copr" "COPR" "Create repo file for copr repo" <*> optional (strOptionLongWith "osname" "OSNAME" "Specify OS Name to override (eg epel)") <*> optional (strOptionLongWith "releasever" "RELEASEVER" "Specify OS Release Version to override (eg rawhide)") <|> AddKoji <$> repoOptionWith 'k' "add-koji" "REPO" "Create repo file for koji repo (f40-build, rawhide, epel9-build, etc)" <|> RepoURL <$> strOptionWith 'u' "repourl" "URL" "Use temporary repo from a baseurl" fedoraCopr :: String fedoraCopr = "copr.fedorainfracloud.org" kojiRepoTemplate :: FilePath kojiRepoTemplate = "koji-REPO.repo" -- FIXME both enabling and disabled at the same time -- FIXME --enable-all-coprs (for updating etc) -- FIXME confirm repos if many -- FIXME --disable-non-cores (modular,testing,cisco, etc) runMain :: Bool -> Bool -> Bool -> Bool -> Bool -> Maybe Bool -> Bool -> [Mode] -> [String] -> IO () runMain dryrun quiet debug listrepos save mweakdeps exact modes args = do hSetBuffering stdout NoBuffering withCurrentDirectory "/etc/yum.repos.d" $ do forM_ modes $ \case AddCopr copr mosname mrelease -> addCoprRepo dryrun debug mosname mrelease copr AddKoji repo -> addKojiRepo dryrun debug repo _ -> return () repofiles <- filesWithExtension "." "repo" -- when debug $ print repofiles nameStates <- sort <$> concatMapM readRepos repofiles let actions = selectRepo exact nameStates modes moreoutput = not (null args) || null actions || listrepos unless (null actions || quiet) $ do mapM_ putStrLn $ reduceOutput $ mapMaybe (printAction save) actions when moreoutput $ warning "" outputs <- forM actions $ \case Expire repo _ -> do expireRepo dryrun debug repo return True UnExpire -> do clearExpired dryrun debug return True Delete repofile True -> do deleteRepo dryrun debug repofile return True _ -> return False when (or outputs && (save || moreoutput) && not quiet) $ warning "" when save $ if null actions then putStrLn "no changes to save" else do let changes = concatMap saveRepo actions unless (null changes) $ do ok <- yesNo $ "Save changed repo" ++ " enabled state" ++ ['s' | length changes > 1] when ok $ do mdnf3 <- findExecutable "dnf-3" case mdnf3 of -- FIXME cannot combine --disable and --enable Just dnf3 -> doSudo dryrun debug dnf3 $ "config-manager" : changes -- FIXME need to have repo files in changes Nothing -> doSudo dryrun debug "sed" $ "config-manager" : changes if null args then when (null actions || listrepos) $ do when save $ putStrLn "" listRepos $ map (updateState actions) nameStates else do sleep 1 when save $ putStrLn "" mdnf <- do mdnf5 <- findExecutable "dnf5" case mdnf5 of Just dnf5 -> return $ Just dnf5 Nothing -> findExecutable "dnf" case mdnf of Just dnf -> do when debug $ putStrLn dnf let repoargs = concatMap changeRepo actions weakdeps = maybe [] (\w -> ["--setopt=install_weak_deps=" ++ show w]) mweakdeps quietopt = if quiet then ("-q" :) else id cachedir = ["--setopt=cachedir=/var/cache/dnf" relver | relver <- maybeToList (maybeReleaseVer args)] in doSudo dryrun debug dnf $ quietopt repoargs ++ cachedir ++ weakdeps ++ map mungeArg args -- FIXME rpm-ostree install supports --enablerepo Nothing -> error' "rpm-ostree not supported" where mungeArg :: String -> String mungeArg "distrosync" = "distro-sync" mungeArg arg = arg addCoprRepo :: Bool -> Bool -> Maybe String -> Maybe String -> String -> IO () addCoprRepo dryrun debug mosname mrelease repo = do let (server,owner,project) = case splitOn "/" repo of [] -> error' "empty repo string" [_] -> error' $ "unqualified repo project:" +-+ repo [o,p] -> (fedoraCopr, o , p) [c,o,p] -> if c == "redhat" then ("copr.devel.redhat.com", o, p) else if '.' `elem` c then (c, o, p) else error' $ "unknown copr server:" +-+ repo _ -> error' $ "unknown copr:" +-+ repo repofile = "_copr:" ++ server ++ ':' : mungeGroupFile owner ++ ':' : project <.> "repo" whenM (doesFileExist repofile) $ error' $ "repo already defined: " ++ repofile osName <- maybe getRpmOSName return mosname osVersion <- maybe getRpmOsRelease return mrelease let repofileUrl = "https://" ++ server +/+ "coprs" +/+ mungeGroupUrl owner +/+ project +/+ "repo" +/+ osName ++ '-' : osVersion +/+ mungeGroupFile owner ++ '-' : project <.> "repo" (curlres,curlcontent) <- curlGetString repofileUrl [] unless (curlres == CurlOK) $ error' $ "downloading failed of" +-+ repofileUrl putStrLn $ "Setting up copr repo " ++ repo withTempDir $ \ tmpdir -> do let tmpfile = tmpdir repofile unless dryrun $ writeFile tmpfile $ maybe id (replace "$releasever") mrelease $ replace "enabled=1" "enabled=0" curlcontent doSudo dryrun debug "cp" [tmpfile, repofile] putStrLn "" where mungeGroupFile ('@':own) = "group_" ++ own mungeGroupFile own = own mungeGroupUrl ('@':own) = "g" +/+ own mungeGroupUrl own = own addKojiRepo :: Bool -> Bool -> String -> IO () addKojiRepo dryrun debug repo = do sysarch <- cmd "rpm" ["--eval", "%{_arch}"] -- FIXME repo validation/sanity: not "-k list" or other dnf command let repourl = "https://kojipkgs.fedoraproject.org/repos" +/+ repo +/+ "latest" +/+ sysarch ++ "/" unlessM (httpExists' repourl) $ error' $ "no such koji repo: " ++ repourl template <- getDataFileName kojiRepoTemplate repodef <- cmd "sed" ["-e", "s/@REPO@/" ++ repo ++ "/g", template] let repofile = replace "REPO" repo kojiRepoTemplate exists <- doesFileExist repofile if exists then error' $ "repo already defined: " ++ repofile else putStrLn $ "Setting up koji repo " ++ repo withTempDir $ \ tmpdir -> do let tmpfile = tmpdir repofile unless dryrun $ writeFile tmpfile repodef doSudo dryrun debug "cp" [tmpfile, repofile] putStrLn "" listRepos :: [RepoState] -> IO () listRepos repoStates = do let (on,off) = -- can't this be simplified? bimap (map fst) (map fst) $ partition (fst . snd) repoStates putStrLn "Enabled:" mapM_ putStrLn on putStrLn "" putStrLn "Disabled:" mapM_ putStrLn off deleteRepo :: Bool -> Bool -> FilePath -> IO () deleteRepo dryrun debug repofile = do mowned <- cmdMaybe "rpm" ["-qf", "/etc/yum.repos.d" repofile] case mowned of Just owner -> warning $ repofile +-+ "owned by" +-+ owner Nothing -> do ok <- yesNo $ "Remove " ++ takeFileName repofile when ok $ do doSudo dryrun debug "rm" [repofile] #if !MIN_VERSION_simple_cmd(0,2,4) filesWithExtension :: FilePath -> String -> IO [FilePath] filesWithExtension dir ext = filter (ext `isExtensionOf`) <$> listDirectory dir #endif maybeReleaseVer :: [String] -> Maybe String maybeReleaseVer args = let releaseverOpt = "--releasever" in case findIndices (releaseverOpt `isPrefixOf`) args of [] -> Nothing is -> let lst = last is opt = args !! lst relver = case dropPrefix releaseverOpt opt of "" -> if lst == length args then error' $ releaseverOpt +-+ "without version" else args !! (lst + 1) '=':rv -> rv _ -> error' $ "could not parse" +-+ opt -- still not sure if this fully makes sense in if all isDigit relver || relver `elem` ["rawhide","eln"] then Just relver else error' $ "unknown releasever:" +-+ relver checkSudo :: IO () checkSudo = do -- previously checked for euid (no username for termux-fedora) issudo <- isJust <$> lookupEnv "SUDO_USER" when issudo $ warning "*No need to run dnf-repo directly with sudo*" getRpmOsRelease :: IO String getRpmOsRelease = do -- not defined for fedora branches let systemReleaseVer = "system-release(releasever)" mReleaseVerPkg <- cmdMaybe "rpm" ["-q", "--whatprovides", systemReleaseVer] case mReleaseVerPkg of Just relverPkg -> do mreleasever <- find (systemReleaseVer `isPrefixOf`) <$> cmdLines "rpm" ["-q", "--provides", relverPkg] case mreleasever of Just releasever -> return $ last (words releasever) Nothing -> error' $ "failed to determine" +-+ systemReleaseVer Nothing -> do let systemRelease = "system-release" msysreleasepkg <- cmdMaybe "rpm" ["-q", "--whatprovides", systemRelease] case msysreleasepkg of Just sysrelpkg -> do let prefix = systemRelease ++ "(" msysrelease <- find (prefix `isPrefixOf`) <$> cmdLines "rpm" ["-q", "--provides", sysrelpkg] case msysrelease of Just sysrelease -> -- "system-release(40)" return $ init $ dropPrefix prefix sysrelease Nothing -> error' $ "failed to determine" +-+ systemRelease Nothing -> error' "failed to determine OS version" getRpmOSName :: IO String getRpmOSName = do let osrelease = "/etc/os-release" idkey = "ID=" osids <- grep ('^' : idkey) osrelease case osids of [] -> error' $ "failed to find ID in" +-+ osrelease [osid] -> return $ dropSuffix "\"" $ dropPrefix "\"" $ dropPrefix idkey osid oss -> error' $ "multiple IDs in" +-+ osrelease ++ ":" ++ unwords oss