dnf-repo-0.7: src/Main.hs

{-# 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 Data.Tuple.Extra (fst3)
import Network.Curl (curlGetString, CurlCode(CurlOK))
import Safe (lastMay)
import SimpleCmd (cmdFull, cmdMaybe, error', warning, (+-+),
#if MIN_VERSION_simple_cmd(0,2,4)
                  filesWithExtension
#endif
                 )
import SimpleCmdArgs
import SimplePrompt (yesNo)
import System.Directory (doesDirectoryExist, 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 Text.EditDistance

import CoprRepo
import ExpireRepos
import KojiRepo
import Paths_dnf_repo (version)
import State
import Sudo
import TimeStamp
import Updates
import YumRepoFile

main :: IO ()
main = do
  checkSudo
  simpleCmdArgs' (Just version)
    "DNF wrapper repo tool"
    "see https://github.com/juhp/dnf-repo#readme ; 'updates' to show updates info" $
    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"
    <*> switchWith '4' "dnf4" "Use older dnf-3 (if available)"
    <*> 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 =
          -- FIXME handle copr url too
          serverAliases . replace "@" "group_" . replace "/" ":" . dropWhileEnd (== '/') . dropWhile (== '/') . handleCoprUrl

        serverAliases ('r':'e':'d':'h':'a':'t':':':copr) =
          "copr.devel.redhat.com:" ++ copr
        serverAliases copr = copr

        handleCoprUrl url =
          if "https:" `isPrefixOf` url
          then replace "coprs/" "" $ dropPrefix "https:" url
          else url

    modeOpt =
      DisableRepo <$> repoOptionWith 'd' "disable" "REPOPAT" "Disable repos" <|>
      EnableRepo <$> repoOptionWith 'e' "enable" "REPOPAT" "Enable repos" <|>
      OnlyRepo <$> repoOptionWith 'o' "only" "REPOPAT" "Only use matching repos" <|>
      ExpireRepo <$> repoOptionWith 'x' "expire" "REPOPAT" "Expire repo cache (dnf4)" <|>
      flagWith' ClearExpires 'X' "clear-expires" "Undo cache expirations (dnf4)" <|>
      DeleteRepo <$> repoOptionWith 'E' "delete-repofile" "REPOPAT" "Remove unwanted .repo file" <|>
      TimeStampRepo <$> repoOptionWith 'z' "timestamp" "REPOPAT" "Show repodata timestamps" <|>
      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" "[SERVER/]COPR/PROJECT|URL" "Install copr repo file (defaults to fedora server)"
      <*> optional (strOptionLongWith "osname" "OSNAME" "Specify OS Name to override (eg epel)")
      <*> optional (strOptionLongWith "copr-releasever" "RELEASEVER" "Specify OS Release Version to override (eg rawhide)") <|>
      AddKoji
      <$> repoOptionWith 'k' "add-koji" "REPO" "Create repo file for a Fedora koji repo (f40-build, rawhide, epel9-build, etc)" <|>
      AddRepo
      <$> strOptionWith 'r' "add-repofile" "REPOFILEURL" "Install repo file"
      <*> optional (strOptionLongWith "repo-releasever" "RELEASEVER" "Specify OS Release Version to override (eg rawhide)") <|>
      RepoURL
      <$> strOptionWith 'u' "repourl" "URL" "Use temporary repo from a baseurl"

yumReposD :: String
yumReposD = "/etc/yum.repos.d"

-- dnf5 repos.d order: the first definition of a repo id wins
dnf5RepoDirs :: [FilePath]
dnf5RepoDirs =
  [yumReposD, "/etc/distro.repos.d", "/usr/share/dnf5/repos.d"]

-- FIXME both enabling and disabled at the same time
-- FIXME confirm repos if many
-- FIXME --disable-non-cores (modular,testing,cisco, etc)
runMain :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe Bool -> Bool
        -> [Mode] -> [String] -> IO ()
runMain dryrun quiet debug listrepos save dnf4 mweakdeps exact modes args = do
  hSetBuffering stdout NoBuffering
  mpkgmgr <- detectPkgMgr quiet dnf4
  let repoDirs = if mpkgmgr == Just Dnf5 then dnf5RepoDirs else [yumReposD]
  unlessM (anyM doesDirectoryExist repoDirs) $
    error' $ yumReposD +-+ "not found!"
  (nameStates,actions) <-
    withCurrentDirectory yumReposD $ do
    forM_ modes $
      \case
        AddCopr copr mosname mrelease ->
          addCoprRepo dryrun debug mosname mrelease copr
        AddKoji repo ->
          addKojiRepo dryrun debug repo
        AddRepo repo mrelease ->
          addRepoFile dryrun debug mrelease repo
        _ -> return ()
    existing <- filterM doesDirectoryExist repoDirs
    loaded <- concatMapM readRepoDir existing
    when debug $ print modes
    unique <- dropDuplicateRepos loaded
    overridden <-
      if mpkgmgr == Just Dnf5
      then applyOverrideFiles unique
      else return unique
    let nameStates = sort overridden
    when debug $ mapM_ printRepo nameStates
    let actions = selectRepo exact nameStates modes
        moreoutput = not (null args) || null actions || listrepos
    when (debug && not (null modes)) $
      if null actions
      then putStrLn "no actions"
      else print actions
    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
        TimeStamp _repo mbaseurl True -> do
          whenJust mbaseurl $ timestampRepo "rawhide"
          return True
        _ -> return False
    when (or outputs && (save || moreoutput) && not quiet) $
      warning ""
    return (nameStates,actions)
  when save $
    if null actions
      then putStrLn "no changes to save"
      else do
      let named = mapMaybe saveAction actions
          confirmSave n =
            yesNo $ "Save changed repo" +-+ "enabled state" ++ ['s' | length n > 1]
      case mpkgmgr of
        Just Dnf5 ->
          let optvals = mapMaybe setoptVal named in
            unless (null optvals) $
            whenM (confirmSave optvals) $
            doSudo dryrun debug (pkgMgrCmd Dnf5) $
            ["config-manager", "setopt", "--create-missing-dir"] ++ optvals
        _ -> do
          let (etcrepos, outside) =
                partition (repoInYumReposD nameStates . fst) named
          unless (null outside) $
            warning $ "not saving" +-+ unwords (map fst outside) ++
              ": defined outside" +-+ yumReposD
          let changes = concatMap (saveRepo (mpkgmgr == Just Dnf4) . snd) etcrepos
          unless (null changes) $
            whenM (confirmSave changes) $
            if mpkgmgr == Just Dnf4
            then doSudo dryrun debug (pkgMgrCmd Dnf4) $ "config-manager" : changes
            else doSudo dryrun debug "sh" ["-c", unwords $ "sed" : "-i" : map show changes ++ ["/etc/yum.repos.d/*.repo"]]
  case args of
    [] ->
      when (null actions || listrepos) $ do
      when save $ putStrLn ""
      listRepos $ map (updateState actions) nameStates
    (c:as) -> do
      when save $ putStrLn ""
      case mpkgmgr of
        -- FIXME rpm-ostree install supports --enablerepo
        Nothing -> error' "missing dnf (rpm-ostree is not supported)"
        Just dnf ->
          let repoargs = mapMaybe 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)]
              extraargs =
                -- special case for "dnf-repo [-c owner/project|-e repo] install"
                case actions of
                  [action] ->
                    case action of
                      Enable repo True | args == ["install"] ->
                                           [takeWhileEnd (/= ':') repo]
                      _ -> []
                  _ -> []
          in
            if c `elem` ["updates","advisories","updateinfos"] && dnf == Dnf5
            then
              printUpdates as
            else do
              args' <-
                if null as && dnf == Dnf5
                then do
                  if c `elem` dnfCommands
                    then return args
                    else
                    let close = filter (\c' -> levenshteinDistance defaultEditCosts c c' < 3) dnfCommands in
                      if null close
                      then do
                        installed <- isInstalled c
                        if installed
                          then error' $ c +-+ "is already installed: missing command"
                          else do
                          ok <- yesNo $ "Do you want to install" +-+ c
                          if ok
                            then return $ "install" : args
                            else return args
                      else do
                        warning $ "Did you mean:" +-+ unwords close +-+ "?"
                        return args
                else return args
              doSudo dryrun debug (pkgMgrCmd dnf) $
                quietopt repoargs ++ cachedir ++ weakdeps ++ map mungeArg args'
                ++ extraargs
  where
    mungeArg :: String -> String
    mungeArg "distrosync" = "distro-sync"
    mungeArg arg =
      -- expand "libNAME.so.X" to "libNAME.so.X()(64bit)" etc
      if "lib" `isPrefixOf` arg && ".so." `isInfixOf` arg && lastMay arg /= Just ')'
      then arg ++ "()(64bit)"
      else arg

-- FIXME maybe handle string (vscode) or local file?
addRepoFile :: Bool -> Bool -> Maybe String -> String -> IO ()
addRepoFile dryrun debug mrelease url = do
  unless (".repo" `isExtensionOf` url) $
    error' $ url +-+ "does not appear to be a .repo file"
  let repofile = takeFileName url
  exists <- doesFileExist repofile
  if exists
    then warning $ "repo file already exists:" +-+ repofile
    else do
    (curlres,curlcontent) <- curlGetString url []
    unless (curlres == CurlOK) $
      error' $ "downloading failed of" +-+ url
    putStrLn $ "Setting up" +-+ repofile
    withTempDir $ \ tmpdir -> do
      let tmpfile = tmpdir </> repofile
      unless dryrun $ writeFile tmpfile $
        maybe id (replace "$releasever") mrelease $
        maybe id (replace "$releasever") mrelease $
        replace "enabled=1" "enabled=0" curlcontent
      doSudo dryrun debug "cp" [tmpfile, repofile]
      putStrLn ""

listRepos :: [RepoState] -> IO ()
listRepos repoStates = do
  let (on,off) =
        -- can't this be simplified?
        bimap (map repoName) (map repoName) $ partition (fst3 . repoState) 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", 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]

-- FIXME should default to system default
detectPkgMgr :: Bool -> Bool -> IO (Maybe PkgMgr)
detectPkgMgr quiet dnf4 =
  if dnf4
  then do
    mdnf3 <- checkSystemPathFile "dnf-3"
    case mdnf3 of
      Just _ -> return $ Just Dnf4
      Nothing -> error' "dnf-3 not found"
  else do
    mdnf5 <- checkSystemPathFile "dnf5"
    case mdnf5 of
      Just _ -> return $ Just Dnf5
      Nothing -> do
        mdnf3 <- checkSystemPathFile "dnf-3"
        case mdnf3 of
          Just _ -> return $ Just Dnf4
          Nothing -> return Nothing
  where
    checkSystemPathFile :: String -> IO (Maybe String)
    checkSystemPathFile prog = do
      mpath <- findExecutable prog
      case mpath of
        Nothing -> return Nothing
        Just path -> do
          let syspath = "/usr/bin" </> prog
          unless (path == syspath) $ do
            exists <- doesFileExist syspath
            when exists $
              unless quiet $
              warning $ path +-+ "overrides" +-+ syspath
          return $ Just path

readRepoDir :: FilePath -> IO [RepoState]
readRepoDir dir = do
  files <- filesWithExtension dir "repo"
  concatMapM (readRepos . (dir </>)) files

-- /etc file masks the same filename under /usr; then alphabetical order.
overrideDirs :: [FilePath]
overrideDirs =
  ["/usr/share/dnf5/repos.override.d", "/etc/dnf/repos.override.d"]

applyOverrideFiles :: [RepoState] -> IO [RepoState]
applyOverrideFiles states = do
  files <- overrideFiles
  ovs <- concatMapM readOverrides files
  return $ applyOverrides ovs states

overrideFiles :: IO [FilePath]
overrideFiles = do
  named <- concatMapM listRepoFiles overrideDirs
  return $ map snd $ sortOn fst $ foldl' mask [] named
  where
    -- later dir (/etc) replaces an earlier file of the same name
    mask acc (name, path) =
      (name, path) : filter ((/= name) . fst) acc

    listRepoFiles :: FilePath -> IO [(FilePath, FilePath)]
    listRepoFiles dir = do
      exists <- doesDirectoryExist dir
      if exists
        then map (\f -> (f, dir </> f)) <$> filesWithExtension dir "repo"
        else return []

-- First definition of a repo id wins, matching dnf5 reposdir order.
dropDuplicateRepos :: [RepoState] -> IO [RepoState]
dropDuplicateRepos = go []
  where
    go _ [] = return []
    go seen (rs@(RepoState name (_,file,_)):rest) =
      case lookup name seen of
        Just kept -> do
          warning $ name +-+ "already defined in" +-+ kept ++
            ", ignoring" +-+ file
          go seen rest
        Nothing -> (rs :) <$> go ((name,file):seen) rest

saveAction :: ChangeEnable -> Maybe (String, ChangeEnable)
saveAction a@(Enable r True) = Just (r, a)
saveAction a@(Disable r True) = Just (r, a)
saveAction _ = Nothing

setoptVal :: (String, ChangeEnable) -> Maybe String
setoptVal (r, Disable _ _) = Just $ r ++ ".enabled=0"
setoptVal (r, Enable _ _) = Just $ r ++ ".enabled=1"
setoptVal (_, _) = Nothing

repoInYumReposD :: [RepoState] -> String -> Bool
repoInYumReposD states name =
  case lookupRepo name states of
    Just (_, file, _) -> takeDirectory file == yumReposD
    Nothing -> False

#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*"

#if !MIN_VERSION_filepath(1,4,2)
isExtensionOf :: String -> FilePath -> Bool
isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
#endif

isInstalled :: String -> IO Bool
isInstalled pkg = do
  (ok,_,_) <- cmdFull "rpm" ["-q", pkg] ""
  return ok

-- generated by dnf5-commands.awk
-- FIXME could reverse map "onetwo" to "one-two" - would also allow dropping the hard coded "distrosync" hack
dnfCommands :: [String]
dnfCommands =
  -- dnf5-5.4.5.0
  ["do","install","upgrade","remove","distro-sync","downgrade","reinstall","debuginfo-install","swap","mark","autoremove","provides","replay","check-upgrade","check","leaves","repoquery","search","list","info","status","group","environment","module","history","repo","advisory","versionlock","system-upgrade","offline-distrosync","offline-upgrade","offline","config-manager","check-update","dg","dsync","grp","if","in","ls","mc","rei","repoinfo","repolist","rm","rq","se","up","update","updateinfo","upgrade-minimal","clean","download","makecache","builddep","changelog","copr","needs-restarting","repoclosure","repomanage","reposync","build-dep"]