dnf-repo 0.6.1 → 0.6.2
raw patch · 13 files changed
+370/−221 lines, 13 filesdep +safe
Dependencies added: safe
Files
- ChangeLog.md +17/−0
- README.md +24/−22
- data/koji-REPO.repo +1/−1
- dnf-repo.cabal +11/−7
- src/Common.hs +51/−0
- src/CoprRepo.hs +58/−0
- src/ExpireRepos.hs +1/−0
- src/KojiRepo.hs +37/−0
- src/Main.hs +49/−138
- src/State.hs +84/−46
- src/TimeStamp.hs +20/−0
- src/YumRepoFile.hs +16/−6
- test/tests.hs +1/−1
ChangeLog.md view
@@ -1,5 +1,22 @@ # dnf-repo releases +## 0.6.2 (2026-03-15)+- `--save` now works without dnf using sed+- munge "libNAME.so.X" to "libNAME.so.X()(64bit)" (hardcoded)+- State: base-4.21 exports foldl'+- only look for programs in /usr/bin and /bin+- avoid head and last with safe+- `--save`: use dnf5 unless --dnf4+- disambiguate `-releasever`s to `--copr-releasever` and `--repo-releasever`+- add `--timestamp`: required big refactor to carry repourl+- fix `--koji` for other archs (.repo was hardcoded x86_64)+- `-4` short option for `--dnf4`+- move addCoprRepo to CoprRepo.hs+- move addKojiRepo to KojiRepo.hs+- use dnf-3 for `--dnf4`+- simplify koji template+- mark expiry options as dnf4-only+ ## 0.6.1 (2024-06-14) - add `--add-repofile URL` action - `--add-copr` can now also take an url
README.md view
@@ -12,7 +12,6 @@ This tool can temporarily enable/disable repo(s) selected by substring(s). Changes to repos' enabled states can be saved too.-It is also possible to expire repo caches individually. There are also smart options to enable/disable testing repos (and even source/debuginfo repos),@@ -23,26 +22,27 @@ `$ dnf-repo --version` ```-0.6.1+0.6.2 ``` `$ dnf-repo --help` ``` DNF wrapper repo tool -Usage: dnf-repo [--version] [-n|--dryrun] [-q|--quiet] [-D|--debug] [-l|--list]- [-s|--save] [--dnf4] [(-w|--weak-deps) | (-W|--no-weak-deps)]- [--exact]- [(-d|--disable REPOPAT) | (-e|--enable REPOPAT) |- (-o|--only REPOPAT) | (-x|--expire REPOPAT) |- (-X|--clear-expires) | (-E|--delete-repofile REPOPAT) |- (-t|--enable-testing) | (-T|--disable-testing) |- (-m|--enable-modular) | (-M|--disable-modular) |- --enable-debuginfo | --disable-debuginfo | --enable-source |- --disable-source | (-c|--add-copr [SERVER/]COPR/PROJECT|URL)- [--osname OSNAME] [--releasever RELEASEVER] |- (-k|--add-koji REPO) | (-r|--add-repofile REPOFILEURL)- [--releasever RELEASEVER] |+Usage: dnf-repo [--version] [-n|--dryrun] [-q|--quiet] [-D|--debug] [-l|--list] + [-s|--save] [-4|--dnf4] [(-w|--weak-deps) | (-W|--no-weak-deps)]+ [--exact] + [(-d|--disable REPOPAT) | (-e|--enable REPOPAT) | + (-o|--only REPOPAT) | (-x|--expire REPOPAT) | + (-X|--clear-expires) | (-E|--delete-repofile REPOPAT) | + (-z|--timestamp REPOPAT) | (-t|--enable-testing) | + (-T|--disable-testing) | (-m|--enable-modular) | + (-M|--disable-modular) | --enable-debuginfo | + --disable-debuginfo | --enable-source | --disable-source | + (-c|--add-copr [SERVER/]COPR/PROJECT|URL) [--osname OSNAME] + [--copr-releasever RELEASEVER] |+ (-k|--add-koji REPO) | (-r|--add-repofile REPOFILEURL) + [--repo-releasever RELEASEVER] | (-u|--repourl URL)] [DNFARGS] see https://github.com/juhp/dnf-repo#readme@@ -55,17 +55,18 @@ -D,--debug Debug output -l,--list List all repos -s,--save Save the repo enable/disable state- --dnf4 Use dnf4 (if dnf5 available)+ -4,--dnf4 Use older dnf-3 (if available) -w,--weak-deps Use weak dependencies -W,--no-weak-deps Disable weak dependencies --exact Match repo names exactly -d,--disable REPOPAT Disable repos -e,--enable REPOPAT Enable repos -o,--only REPOPAT Only use matching repos- -x,--expire REPOPAT Expire repo cache- -X,--clear-expires Undo cache expirations+ -x,--expire REPOPAT Expire repo cache (dnf4)+ -X,--clear-expires Undo cache expirations (dnf4) -E,--delete-repofile REPOPAT Remove unwanted .repo file+ -z,--timestamp REPOPAT Show repodata timestamps -t,--enable-testing Enable testing repos -T,--disable-testing Disable testing repos -m,--enable-modular Enable modular repos@@ -77,12 +78,14 @@ -c,--add-copr [SERVER/]COPR/PROJECT|URL Install copr repo file (defaults to fedora server) --osname OSNAME Specify OS Name to override (eg epel)- --releasever RELEASEVER Specify OS Release Version to override (eg rawhide)+ --copr-releasever RELEASEVER+ Specify OS Release Version to override (eg rawhide) -k,--add-koji REPO Create repo file for a Fedora koji repo (f40-build, rawhide, epel9-build, etc) -r,--add-repofile REPOFILEURL Install repo file- --releasever RELEASEVER Specify OS Release Version to override (eg rawhide)+ --repo-releasever RELEASEVER+ Specify OS Release Version to override (eg rawhide) -u,--repourl URL Use temporary repo from a baseurl ``` @@ -170,8 +173,7 @@ earlier settings. ## Installation-A copr repo is available:-<https://copr.fedorainfracloud.org/coprs/petersen/dnf-repo/>+`dnf-repo` is packaged in Fedora and EPEL ## Building Use {cabal,stack,cabal-rpm} install.
data/koji-REPO.repo view
@@ -1,7 +1,7 @@ [koji-@REPO@] name=Fedora - Koji @REPO@ failovermethod=priority-baseurl=https://kojipkgs.fedoraproject.org/repos/@REPO@/latest/x86_64/+baseurl=https://kojipkgs.fedoraproject.org/repos/@REPO@/latest/$basearch/ enabled=0 metadata_expire=1h repo_gpgcheck=0
dnf-repo.cabal view
@@ -1,5 +1,5 @@ name: dnf-repo-version: 0.6.1+version: 0.6.2 synopsis: A dnf wrapper with fine control of enabled repos description: A command-line wrapper of the dnf package manager to@@ -8,7 +8,7 @@ license-file: COPYING author: Jens Petersen <petersen@redhat.com> maintainer: Jens Petersen <petersen@redhat.com>-copyright: 2022-2024 Jens Petersen <petersen@redhat.com>+copyright: 2022-2026 Jens Petersen <petersen@redhat.com> category: Utility homepage: https://github.com/juhp/dnf-repo bug-reports: https://github.com/juhp/dnf-repo/issues@@ -16,14 +16,13 @@ extra-doc-files: README.md ChangeLog.md cabal-version: 2.0-tested-with: GHC == 8.6.5- || == 8.8.4- || == 8.10.7+tested-with: GHC == 8.10.7 || == 9.0.2 || == 9.2.7 || == 9.4.8- || == 9.6.5- || == 9.8.2+ || == 9.6.7+ || == 9.8.4+ || == 9.10.3 data-dir: data data-files: koji-REPO.repo @@ -34,9 +33,13 @@ executable dnf-repo main-is: Main.hs other-modules: Paths_dnf_repo+ Common+ CoprRepo ExpireRepos+ KojiRepo State Sudo+ TimeStamp YumRepoFile autogen-modules: Paths_dnf_repo hs-source-dirs: src@@ -47,6 +50,7 @@ filepath, Glob, http-directory >= 0.1.9,+ safe, simple-cmd >= 0.2.2, simple-cmd-args >= 0.1.8, simple-prompt >= 0.2
+ src/Common.hs view
@@ -0,0 +1,51 @@+module Common (+ getSysArch,+ getRpmOsRelease,+ getRpmOSName+ )+where++import Data.List.Extra (dropPrefix, dropSuffix, find, isPrefixOf)+import SimpleCmd (cmd, cmdLines, cmdMaybe, error', grep, (+-+))++getSysArch :: IO String+getSysArch =+ cmd "rpm" ["--eval", "%{_arch}"]++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
+ src/CoprRepo.hs view
@@ -0,0 +1,58 @@+module CoprRepo (+ addCoprRepo+ )+where++import Control.Monad.Extra+import Data.List.Extra+import Network.Curl (curlGetString, CurlCode(CurlOK))+import Network.HTTP.Directory ((+/+))+import SimpleCmd (error', warning, (+-+))+import System.Directory (doesFileExist)+import System.FilePath+import System.IO.Extra (withTempDir)++import Common+import Sudo++fedoraCopr :: String+fedoraCopr = "copr.fedorainfracloud.org"++addCoprRepo :: Bool -> Bool -> Maybe String -> Maybe String -> String -> IO ()+addCoprRepo dryrun debug mosname mrelease repo = do+ let (server,owner,project) = serverOwnerProject repo+ repofile =+ "_copr:" ++ server ++ ':' : owner ++ ':' : project <.> "repo"+ exists <- doesFileExist repofile+ if exists+ then warning $ "copr repo already defined:" +-+ repofile+ else do+ osName <- maybe getRpmOSName return mosname+ osVersion <- maybe getRpmOsRelease return mrelease+ let repofileUrl = "https://" ++ server +/+ "coprs" +/+ mungeGroupUrl owner +/+ project +/+ "repo" +/+ osName ++ '-' : osVersion +/+ 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+ mungeGroupUrl ('g':'r':'o':'u':'p':'_':own) = "g" +/+ own+ mungeGroupUrl own = own++ serverOwnerProject rpo =+ case splitOn ":" rpo of+ [] -> error' "empty repo string"+ [_] -> error' $ "unqualified repo project:" +-+ rpo+ [o,p] -> (fedoraCopr, o , p)+ [c,o,p] ->+ if '.' `elem` c+ then (c, o, p)+ else error' $ "unknown copr server:" +-+ rpo+ ["copr",_,_,_] -> serverOwnerProject $ dropPrefix "copr:" rpo+ _ -> error' $ "unknown copr:" +-+ rpo
src/ExpireRepos.hs view
@@ -13,6 +13,7 @@ expiredFile :: FilePath expiredFile = "/var/cache/dnf/expired_repos.json" +-- FIXME only works for dnf4 expireRepo :: Bool -> Bool -> String -> IO () expireRepo dryrun debug repo = do old <- read <$> readFile expiredFile :: IO [String]
+ src/KojiRepo.hs view
@@ -0,0 +1,37 @@+module KojiRepo (addKojiRepo)+where++import Control.Monad.Extra+import Data.List.Extra (replace)+import Network.HTTP.Directory (httpExists', (+/+))+import SimpleCmd (cmd, error', warning, (+-+))+import System.Directory (doesFileExist)+import System.FilePath+import System.IO.Extra (withTempDir)++import Paths_dnf_repo (getDataFileName)+import Common+import Sudo++kojiRepoTemplate :: FilePath+kojiRepoTemplate = "koji-REPO.repo"++addKojiRepo :: Bool -> Bool -> String -> IO ()+addKojiRepo dryrun debug repo = do+ sysarch <- getSysArch+ -- 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 warning $ "koji repo already defined:" +-+ repofile+ else do+ 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 ""
src/Main.hs view
@@ -9,9 +9,10 @@ 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 Network.HTTP.Directory (httpExists', (+/+))-import SimpleCmd (cmd, cmdLines, cmdMaybe, error', grep, warning, (+-+),+import Safe (lastMay)+import SimpleCmd (cmdMaybe, error', warning, (+-+), #if MIN_VERSION_simple_cmd(0,2,4) filesWithExtension #endif@@ -29,10 +30,13 @@ import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering)) import System.IO.Extra (withTempDir) -import Paths_dnf_repo (getDataFileName, version)+import Paths_dnf_repo (version)+import CoprRepo import ExpireRepos+import KojiRepo import State import Sudo+import TimeStamp import YumRepoFile main :: IO ()@@ -47,7 +51,7 @@ <*> switchWith 'D' "debug" "Debug output" <*> switchWith 'l' "list" "List all repos" <*> switchWith 's' "save" "Save the repo enable/disable state"- <*> switchLongWith "dnf4" "Use dnf4 (if dnf5 available)"+ <*> 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"@@ -74,9 +78,10 @@ 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" <|>- flagWith' ClearExpires 'X' "clear-expires" "Undo cache expirations" <|>+ 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" <|>@@ -88,27 +93,21 @@ 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 "releasever" "RELEASEVER" "Specify OS Release Version to override (eg rawhide)") <|>+ <*> 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 "releasever" "RELEASEVER" "Specify OS Release Version to override (eg rawhide)") <|>+ <*> optional (strOptionLongWith "repo-releasever" "RELEASEVER" "Specify OS Release Version to override (eg rawhide)") <|> RepoURL <$> strOptionWith 'u' "repourl" "URL" "Use temporary repo from a baseurl" -fedoraCopr :: String-fedoraCopr = "copr.fedorainfracloud.org"--kojiRepoTemplate :: FilePath-kojiRepoTemplate = "koji-REPO.repo"- yumReposD :: String yumReposD = "/etc/yum.repos.d" checkSystemPathFile :: String -> IO (Maybe String) checkSystemPathFile prog = do- let path = splitOn ":" "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin"+ let path = splitOn ":" "/usr/sbin:/usr/bin" fmap takeFileName <$> findFile path prog -- FIXME both enabling and disabled at the same time@@ -156,26 +155,36 @@ 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 ""+ mpkgmgr <-+ if dnf4+ then do+ mdnf3 <- checkSystemPathFile "dnf-3"+ case mdnf3 of+ Just _ -> return $ Just Dnf4+ Nothing -> error' "dnf-3 not found"+ else do+ mdnf <- maybeM (checkSystemPathFile "dnf") (return . Just) $+ checkSystemPathFile "dnf5"+ case mdnf of+ Just _ -> return $ Just Dnf5+ Nothing -> return Nothing when save $ if null actions then putStrLn "no changes to save" else do- let changes = concatMap saveRepo actions+ let changes = concatMap (saveRepo mpkgmgr) actions unless (null changes) $ do ok <- yesNo $ "Save changed repo" +-+ "enabled state" ++ ['s' | length changes > 1] when ok $ do- mdnf3 <- checkSystemPathFile "dnf-3"- case mdnf3 of- Just dnf3 ->- -- FIXME cannot combine --disable and --enable- doSudo dryrun debug dnf3 $ "config-manager" : changes- Nothing ->- -- FIXME need to have repo files in changes- -- doSudo dryrun debug "sed" $ "config-manager" : changes- error' "Saving repo state not yet supported without dnf"+ case mpkgmgr of+ Just dnf -> doSudo dryrun debug (pkgMgrCmd dnf) $ "config-manager" : changes+ Nothing -> 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@@ -183,28 +192,23 @@ listRepos $ map (updateState actions) nameStates else do when save $ putStrLn ""- mdnf <-- if dnf4- then checkSystemPathFile "dnf"- else- maybeM (checkSystemPathFile "dnf") (return . Just) $- checkSystemPathFile "dnf5"- case mdnf of+ 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 install"- case modes of- [mode] ->- case mode of- AddCopr proj _ _ | args == ["install"] ->- [takeWhileEnd (/= ':') proj]+ -- 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 doSudo dryrun debug dnf $+ -- 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@@ -212,66 +216,11 @@ 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) = serverOwnerProject repo- repofile =- "_copr:" ++ server ++ ':' : owner ++ ':' : project <.> "repo"- exists <- doesFileExist repofile- if exists- then warning $ "copr repo already defined:" +-+ repofile- else do- osName <- maybe getRpmOSName return mosname- osVersion <- maybe getRpmOsRelease return mrelease- let repofileUrl = "https://" ++ server +/+ "coprs" +/+ mungeGroupUrl owner +/+ project +/+ "repo" +/+ osName ++ '-' : osVersion +/+ 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- mungeGroupUrl ('g':'r':'o':'u':'p':'_':own) = "g" +/+ own- mungeGroupUrl own = own-- serverOwnerProject rpo =- case splitOn ":" rpo of- [] -> error' "empty repo string"- [_] -> error' $ "unqualified repo project:" +-+ rpo- [o,p] -> (fedoraCopr, o , p)- [c,o,p] ->- if '.' `elem` c- then (c, o, p)- else error' $ "unknown copr server:" +-+ rpo- ["copr",_,_,_] -> serverOwnerProject $ dropPrefix "copr:" rpo- _ -> error' $ "unknown copr:" +-+ rpo--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 warning $ "koji repo already defined:" +-+ repofile- else do- 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 ""+ 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 ()@@ -300,7 +249,7 @@ listRepos repoStates = do let (on,off) = -- can't this be simplified?- bimap (map fst) (map fst) $ partition (fst . snd) repoStates+ bimap (map fst) (map fst) $ partition (fst3 . snd) repoStates putStrLn "Enabled:" mapM_ putStrLn on putStrLn ""@@ -350,44 +299,6 @@ 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 #if !MIN_VERSION_filepath(1,4,2) isExtensionOf :: String -> FilePath -> Bool
src/State.hs view
@@ -1,7 +1,9 @@+{-# LANGUAGE CPP #-}+ module State ( Mode(..), SpecificChange(..),- ChangeEnable(Expire,UnExpire,Delete),+ ChangeEnable(Enable,Expire,UnExpire,Delete,TimeStamp), printAction, reduceOutput, selectRepo,@@ -9,16 +11,22 @@ saveRepo, updateState, expiring,- deleting+ deleting,+ PkgMgr(..),+ pkgMgrCmd ) where --import Debug.Trace (traceShowId) import Data.Either (partitionEithers)-import Data.List.Extra (dropPrefix, dropSuffix, foldl',+import Data.List.Extra (dropPrefix, dropSuffix,+#if !MIN_VERSION_base(4,20,0)+ foldl',+#endif isPrefixOf, isInfixOf, isSuffixOf, nub, replace, sortOn, stripInfix) import Data.Maybe (mapMaybe)+import Safe (headMay, lastMay, tailSafe) import SimpleCmd (error', (+-+)) import System.FilePath (takeBaseName) import System.FilePath.Glob (compile, match)@@ -29,7 +37,7 @@ | AddRepo String (Maybe String) | RepoURL String | EnableRepo String | DisableRepo String | OnlyRepo String | ExpireRepo String | ClearExpires- | DeleteRepo String+ | DeleteRepo String | TimeStampRepo String | Specific SpecificChange deriving (Eq, Ord, Show) @@ -44,6 +52,7 @@ modePattern (ExpireRepo r) = Just r modePattern ClearExpires = Nothing modePattern (DeleteRepo r) = Just r+modePattern (TimeStampRepo r) = Just r modePattern (Specific _) = Nothing data SpecificChange = EnableModular | DisableModular@@ -69,6 +78,7 @@ | Expire String Bool | UnExpire | Delete FilePath Bool+ | TimeStamp String (Maybe String) Bool | BaseURL String deriving (Eq,Ord,Show) @@ -103,6 +113,7 @@ if s then Just $ Right $ "delete" +-+ quote f else Just $ Left $ quote f +-+ "deletion skipped"+printAction _ (TimeStamp {}) = Nothing printAction _ (BaseURL _) = Nothing reduceOutput :: [Either String String] -> [String]@@ -119,6 +130,7 @@ maybeRepoName e@(Enable r _) = Just (e, r) maybeRepoName o@(Only r _) = Just (o, r) maybeRepoName x@(Expire r _) = Just (x, r)+maybeRepoName t@(TimeStamp r _ _) = Just (t, r) maybeRepoName UnExpire = Nothing maybeRepoName (Delete _ _) = Nothing maybeRepoName (BaseURL _) = Nothing@@ -128,6 +140,7 @@ changeRepo (Enable r True) = Just $ "--enablerepo=" ++ r changeRepo (Only r True) = Just $ "--repo=" ++ r changeRepo (Expire r True) = Just $ "--enablerepo=" ++ r+changeRepo (TimeStamp r _ True) = Just $ "--enablerepo=" ++ r changeRepo (BaseURL url) = Just $ "--repofrompath=" ++ repoUrlName ++ "," ++ url where repoUrlName = replace "/" ":" $@@ -136,11 +149,29 @@ dropPrefix "https://" url changeRepo _ = Nothing -saveRepo :: ChangeEnable -> [String]-saveRepo (Disable r True) = ["--disable", r]-saveRepo (Enable r True) = ["--enable", r]-saveRepo _ = []+data PkgMgr = Dnf5 | Dnf4 +pkgMgrCmd :: PkgMgr -> String+pkgMgrCmd Dnf5 = "dnf5"+pkgMgrCmd Dnf4 = "dnf-3"++saveRepo :: Maybe PkgMgr -> ChangeEnable -> [String]+saveRepo pkgmgr (Disable r True) =+ case pkgmgr of+ Just dnf ->+ case dnf of+ Dnf4 -> ["--disable", r]+ Dnf5 -> ["setopt", r ++ ".enabled=0"]+ Nothing -> ["/^\\[" ++ r ++ "\\]/,/^\\[/ s/^enabled=1/enabled=0/"]+saveRepo pkgmgr (Enable r True) =+ case pkgmgr of+ Just dnf ->+ case dnf of+ Dnf4 -> ["--enable", r]+ Dnf5 -> ["setopt", r ++ ".enabled=1"]+ Nothing -> ["/^\\[" ++ r ++ "\\]/,/^\\[/ s/^enabled=0/enabled=1/"]+saveRepo _ _ = []+ expiring :: ChangeEnable -> Maybe String expiring (Expire r _) = Just r expiring _ = Nothing@@ -151,12 +182,12 @@ updateState :: [ChangeEnable] -> RepoState -> RepoState updateState [] rs = rs-updateState (ce:ces) re@(repo,(enabled,file)) =+updateState (ce:ces) re@(repo,(enabled,file,url)) = case ce of- Disable r True | r == repo && enabled -> (repo,(False,file))- Enable r True | r == repo && not enabled -> (repo,(True,file))- Only r True | r == repo && not enabled -> (repo,(True,file))- Only r True | r /= repo && enabled -> (repo,(False,file))+ Disable r True | r == repo && enabled -> (repo,(False,file,url))+ Enable r True | r == repo && not enabled -> (repo,(True,file,url))+ Only r True | r == repo && not enabled -> (repo,(True,file,url))+ Only r True | r /= repo && enabled -> (repo,(False,file,url)) _ -> updateState ces re selectRepo :: Bool -> [RepoState] -> [Mode] -> [ChangeEnable]@@ -180,39 +211,40 @@ else let actNames = mapMaybe maybeRepoName results in- if null actNames- then results- else- let base = head $ sortOn (length . snd) actNames- in- if all ((snd base `isPrefixOf`) . snd) actNames- then [fst base]+ case sortOn (length . snd) actNames of+ [] -> results+ (an:_ans) ->+ if all ((snd an `isPrefixOf`) . snd) actNames+ then [fst an] else results selectRepoMode :: Mode -> [ChangeEnable] -> RepoState -> Maybe ChangeEnable- selectRepoMode mode acc (name,(enabled,file)) =+ selectRepoMode mode acc (name,(enabled,file,murl)) = case mode of AddCopr repo _ _ ->- maybeChange repo isSuffixOf (not enabled) (Enable name)+ maybeChange repo isSuffixOf (not enabled) False (Enable name) AddKoji repo ->- maybeChange repo isSuffixOf (not enabled) (Enable name)+ maybeChange repo isSuffixOf (not enabled) False (Enable name) AddRepo repo _ ->- maybeChange (takeBaseName repo) isSuffixOf (not enabled) (Enable name)+ maybeChange (takeBaseName repo) isSuffixOf (not enabled) False (Enable name) RepoURL url -> Just $ BaseURL url EnableRepo pat ->- maybeChange pat matchesRepo (not enabled) (Enable name)+ maybeChange pat matchesRepo (not enabled) False (Enable name) DisableRepo pat ->- maybeChange pat matchesRepo enabled (Disable name)+ maybeChange pat matchesRepo enabled False (Disable name) OnlyRepo pat ->- maybeChange pat matchesRepo (not enabled) (Only name)+ maybeChange pat matchesRepo (not enabled) True (Only name) ExpireRepo pat ->- maybeChange pat matchesRepo True (Expire name)+ maybeChange pat matchesRepo True False (Expire name) ClearExpires -> Just UnExpire DeleteRepo pat -> maybeChange pat matchesRepo (not enabled || error ("disable repo before deleting:" +-+ name))+ False (Delete file)+ TimeStampRepo pat ->+ maybeChange pat matchesRepo (not enabled) False (TimeStamp name murl) Specific change -> let substr = repoSubstr change in if change `elem`@@ -221,27 +253,30 @@ maybeChange substr (\p n -> p `isInfixOf` n && repoStatus acc (removeInfix substr name))- (not enabled) (Enable name)+ (not enabled) False (Enable name) else- maybeChange substr isInfixOf enabled (Disable name)+ maybeChange substr isInfixOf enabled False (Disable name) where- maybeChange :: String -> (String -> String -> Bool) -> Bool+ maybeChange :: String -> (String -> String -> Bool) -> Bool -> Bool -> (Bool -> ChangeEnable) -> Maybe ChangeEnable- maybeChange pat matcher state change =+ maybeChange pat matcher state always change = if pat `matcher` name then- if state- then Just $ change True+ if always+ then Just $ change state else- if isGlob pat- then Nothing- else Just $ change False+ if state+ then Just $ change True+ else+ if isGlob pat+ then Nothing+ else Just $ change False else Nothing repoStatus :: [ChangeEnable] -> String -> Bool repoStatus acc repo = case lookup repo repostates of- Just (enabled,_) ->+ Just (enabled,_,_) -> enabled || Enable repo True `elem` acc Nothing -> False @@ -256,18 +291,21 @@ if exact then pat else- case ('^' == head pat,'$' == last pat) of- (True,True) -> init (tail pat)- (True,False) -> tail pat ++ ['*' | last pat /= '*']- (False,True) -> ['*' | head pat /= '*'] ++ init pat- _ -> ['*' | head pat /= '*'] ++ pat ++ ['*' | last pat /= '*']+ case startEnd pat of+ (True,True) -> init (tailSafe pat)+ (True,False) -> tailSafe pat ++ ['*' | last pat /= '*']+ (False,True) -> ['*' | headMay pat /= Just '*'] ++ init pat+ _ -> ['*' | headMay pat /= Just '*'] ++ pat ++ ['*' | lastMay pat /= Just '*'] | exact = (pat ==) | otherwise =- case ('^' == head pat,'$' == last pat) of- (True,True) -> (init (tail pat) ==)- (True,False) -> (tail pat `isPrefixOf`)+ case startEnd pat of+ (True,True) -> (init (tailSafe pat) ==)+ (True,False) -> (tailSafe pat `isPrefixOf`) (False,True) -> (init pat `isSuffixOf`) _ -> (pat `isInfixOf`)++ startEnd :: String -> (Bool,Bool)+ startEnd pat = (headMay pat == Just '^', lastMay pat == Just '$') -- adapted from simple-cmd removeInfix :: String -> String-> String
+ src/TimeStamp.hs view
@@ -0,0 +1,20 @@+module TimeStamp (+ timestampRepo+ )+where++import Control.Monad.Extra (whenJust)+import Data.List.Extra (replace)+import Network.HTTP.Directory (httpLastModified', (+/+))++import Common++-- FIXME doesn't work for release repos+-- FIXME matches commented out download.example+timestampRepo :: String -> String -> IO ()+timestampRepo release baseurl = do+ sysarch <- getSysArch+ let url = replace "$releasever" release $+ replace "$basearch" sysarch baseurl+ mtime <- httpLastModified' $ url +/+ "repodata/repomd.xml"+ whenJust mtime print
src/YumRepoFile.hs view
@@ -4,10 +4,13 @@ ) where -import Data.List.Extra (isPrefixOf, splitOn, trim)+import Data.List.Extra (breakOn, isInfixOf, isPrefixOf, splitOn, trim, trimEnd) import SimpleCmd (error', (+-+)) -type RepoState = (String,(Bool,FilePath))+type RepoState = (String, -- reponame+ (Bool, -- enabled+ FilePath, -- repofile+ Maybe String)) -- baseurl readRepos :: FilePath -> IO [RepoState] readRepos file =@@ -19,8 +22,15 @@ case nextSection ls of Nothing -> [] Just (section,rest) ->- let (enabled,more) =- case dropWhile (not . ("enabled" `isPrefixOf`)) rest of+ let (mbaseurl,rest1) =+ case dropWhile (not . ("baseurl" `isInfixOf`)) rest of+ [] -> (Nothing,rest)+ (e:more') ->+ case breakOn "=" e of+ (_,'=':url) -> (Just (trim url), more')+ _ -> error' $ "failed to parse" +-+ show e +-+ "for" +-+ section+ (enabled,more) =+ case dropWhile (not . ("enabled" `isPrefixOf`)) rest1 of [] -> error' $ "no enabled field for" +-+ section (e:more') -> case splitOn "=" e of@@ -30,12 +40,12 @@ "0" -> (False,more') _ -> error' $ "strange enabled state" +-+ e +-+ "for" +-+ section _ -> error' $ "unknown enabled state" +-+ e +-+ "for" +-+ section- in (section,(enabled,file)) : parseRepos file more+ in (section,(enabled,file,mbaseurl)) : parseRepos file more where nextSection :: [String] -> Maybe (String,[String]) nextSection [] = Nothing nextSection (l:ls') =- case l of+ case trimEnd l of ('[' : rest) -> if last rest == ']' then Just (init rest, ls')
test/tests.hs view
@@ -3,7 +3,7 @@ program :: [String] -> IO () program test = do- cmdLog "dnf-repo" test+ cmdLog_ "dnf-repo" test putStrLn "" tests :: [[String]]