dnf-repo-0.6.4: 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 (cmdMaybe, error', warning, (+-+),
#if MIN_VERSION_simple_cmd(0,2,4)
                  filesWithExtension
#endif
                 )
import SimpleCmdArgs
import SimplePrompt (yesNo)
import System.Directory (doesDirectoryExist, doesFileExist, findFile,
                         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 Paths_dnf_repo (version)
import CoprRepo
import ExpireRepos
import KojiRepo
import State
import Sudo
import TimeStamp
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"
    <*> 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"

checkSystemPathFile :: String -> IO (Maybe String)
checkSystemPathFile prog = do
  let path = splitOn ":" "/usr/sbin:/usr/bin"
  fmap takeFileName <$> findFile path prog

-- FIXME both enabling and disabled at the same time
-- FIXME confirm repos if many
-- FIXME --disable-non-cores (modular,testing,cisco, etc)
-- FIXME support dnf5 /etc/dnf/repos.override.d/99-config_manager.repo
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
  unlessM (doesDirectoryExist yumReposD) $
    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 ()
    repofiles <- filesWithExtension "./" "repo"
    when debug $ print modes
    nameStates <- sort <$> concatMapM readRepos repofiles
    when debug $ mapM_ print 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)
  mpkgmgr <-
    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
  when save $
    if null actions
      then putStrLn "no changes to save"
      else do
      let changes = concatMap (saveRepo (mpkgmgr == Just Dnf4)) actions
      unless (null changes) $ do
        ok <- yesNo $ "Save changed repo" +-+ "enabled state" ++ ['s' | length changes > 1]
        when ok $
          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"]]
  if null args
    then
    when (null actions || listrepos) $ do
    when save $ putStrLn ""
    listRepos $ map (updateState actions) nameStates
    else do
    when save $ putStrLn ""
    case mpkgmgr of
      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]
                    _ -> []
                _ -> []
            -- FIXME default to "install" of no command?
        in doSudo dryrun debug (pkgMgrCmd dnf) $
           quietopt repoargs ++ cachedir ++ weakdeps ++ map mungeArg args ++
           extraargs
      -- FIXME rpm-ostree install supports --enablerepo
      Nothing -> error' "missing dnf (rpm-ostree is not supported)"
  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 fst) (map fst) $ partition (fst3 . 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", yumReposD </> 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*"

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