-- SPDX-License-Identifier: BSD-3-Clause
module Main (main) where
import Control.Monad.Extra
import Data.Char
import Data.List.Extra
import Data.Maybe
import Data.RPM
import Distribution.Koji
import qualified Distribution.Koji.API as Koji
import Options.Applicative (fullDesc, header, progDescDoc)
import qualified Options.Applicative.Help.Pretty as P
import SimpleCmd
import SimpleCmdArgs
import System.Directory
import System.FilePath ((<.>))
import System.IO
import DownloadDir
import Paths_koji_install (version)
data InstallMode = Update | All | Ask | Base | NoDevel
data Request = ReqName | ReqNV | ReqNVR
-- FIXME --include devel, --exclude *
-- FIXME specify tag or task
-- FIXME support enterprise builds
-- FIXME --arch (including src)
-- FIXME --debuginfo
-- FIXME --delete after installing
main :: IO ()
main = do
sysdisttag <- cmd "rpm" ["--eval", "%{dist}"]
let pdoc = Just $ P.vcat
[ P.text "Download and install latest package build from Koji tag.",
P.text ("HUB = " <> intercalate ", " knownHubs)
]
simpleCmdArgsWithMods (Just Paths_koji_install.version)
(fullDesc <> header "Install latest build from Koji" <> progDescDoc pdoc) $
program
<$> switchWith 'n' "dry-run" "Don't actually download anything"
<*> switchWith 'D' "debug" "More detailed output"
<*> optional (strOptionWith 'H' "hub" "HUB"
"KojiHub shortname or url [default: fedora]")
<*> optional (strOptionWith 'P' "packages-url" "URL"
"KojiFiles packages url [default: fedora]")
<*> modeOpt
<*> disttagOpt sysdisttag
<*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name"
<|> flagWith ReqName ReqNVR 'V' "nv" "Give an N-V instead of package name")
<*> some (strArg "PACKAGE")
where
modeOpt :: Parser InstallMode
modeOpt =
flagWith' All 'a' "all" "all subpackages" <|>
flagWith' Ask 'A' "ask" "ask for each subpackge" <|>
flagWith' Base 'b' "base-only" "only base package" <|>
flagWith' NoDevel 'D' "exclude-devel" "Skip devel packages" <|>
pure Update
disttagOpt :: String -> Parser String
disttagOpt disttag = startingDot <$> strOptionalWith 'd' "disttag" "DISTTAG" ("Use a different disttag [default: " ++ disttag ++ "]") disttag
startingDot cs =
case cs of
"" -> error' "empty disttag"
(c:_) -> if c == '.' then cs else '.' : cs
knownHubs :: [String]
knownHubs = ["fedora","stream","mbox","rpmfusion", "URL"]
hubURL :: String -> String
hubURL "fedora" = fedoraKojiHub
-- later use centosKojiHub
hubURL "stream" = "https://kojihub.stream.centos.org/kojihub"
hubURL "mbox" = "https://koji.mbox.centos.org/kojihub"
hubURL "rpmfusion" = "https://koji.rpmfusion.org/kojihub"
hubURL "fusion" = "https://koji.rpmfusion.org/kojihub"
hubURL hub =
if "http" `isPrefixOf` hub
then hub
else error' $ "unknown hub: try " ++ show knownHubs
defaultPkgsURL :: Maybe String -> String
defaultPkgsURL Nothing =
"https://kojipkgs.fedoraproject.org/packages"
defaultPkgsURL (Just url) =
case url of
"https://kojihub.stream.centos.org/kojihub" ->
"https://kojihub.stream.centos.org/kojifiles/packages"
_ ->
if "kojihub" `isSuffixOf` url
then replace "kojihub" "kojifiles" url
else error' "use --files-url to specify kojifiles url for this kojihub"
program :: Bool -> Bool -> Maybe String -> Maybe String -> InstallMode
-> String -> Request -> [String] -> IO ()
program dryrun debug mhuburl mpkgsurl mode disttag request pkgs = do
let huburl = maybe fedoraKojiHub hubURL mhuburl
pkgsurl = fromMaybe (defaultPkgsURL mhuburl) mpkgsurl
when debug $ do
putStrLn huburl
putStrLn pkgsurl
-- FIXME use this?
dlDir <- setDownloadDir dryrun "rpms"
when debug $ putStrLn dlDir
setNoBuffering
mapM (kojiLatestRPMs huburl pkgsurl dlDir) pkgs
>>= installRPMs dryrun . mconcat
where
kojiLatestRPMs :: String -> String -> String -> String -> IO [String]
kojiLatestRPMs huburl pkgsurl dlDir pkg = do
mnvr <- kojiLatestOSBuild huburl disttag request pkg
case mnvr of
Nothing -> error' $ "latest " ++ pkg ++ " not found"
Just nvr -> do
putStrLn $ nvr ++ "\n"
allRpms <- map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr
dlRpms <- decideRpms mode allRpms
unless (dryrun || null dlRpms) $ do
mapM_ (downloadRpm pkgsurl (readNVR nvr)) dlRpms
-- FIXME once we check file size - can skip if no downloads
putStrLn $ "Packages downloaded to " ++ dlDir
return dlRpms
where
decideRpms :: InstallMode -> [String] -> IO [String]
decideRpms mode' allRpms =
case mode' of
All -> return allRpms
Ask -> mapMaybeM rpmPrompt allRpms
Base -> return $ pure $ minimumOn length $ filter (pkg `isPrefixOf`) allRpms
Update -> do
rpms <- filterM (isInstalled . rpmName . readNVRA) allRpms
if null rpms
then decideRpms Ask allRpms
else return rpms
NoDevel -> return $ filter (not . ("-devel-" `isInfixOf`)) allRpms
rpmPrompt :: String -> IO (Maybe String)
rpmPrompt rpm = do
putStr $ rpm ++ " [y/n]: "
c <- getChar
putStrLn ""
case toLower c of
'y' -> return $ Just rpm
'n' -> return Nothing
_ -> rpmPrompt rpm
isInstalled :: String -> IO Bool
isInstalled rpm = cmdBool "rpm" ["--quiet", "-q", rpm]
debugPkg :: String -> Bool
debugPkg p = "-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p
kojiLatestOSBuild :: String -> String -> Request -> String -> IO (Maybe String)
kojiLatestOSBuild hub disttag request pkgpat = do
let (pkg,full) = packageOfPattern pkgpat
mpkgid <- Koji.getPackageID hub pkg
case mpkgid of
Nothing -> error $ "package not found: " ++ pkg
Just pkgid -> do
let opts = [("packageID", ValueInt pkgid),
("state", ValueInt (fromEnum BuildComplete)),
("queryOpts",ValueStruct [("limit",ValueInt 1),
("order",ValueString "-build_id")])]
res <- Koji.listBuilds hub $
("pattern", ValueString (if full then pkgpat else dropSuffix "*" pkgpat ++ "*" ++ disttag)) : opts
case res of
[] -> return Nothing
[bld] -> return $ lookupStruct "nvr" bld
_ -> error $ "more than one latest build found for " ++ pkg
where
packageOfPattern :: String -> (String, Bool)
packageOfPattern pat =
case request of
ReqName -> (dropSuffix "-" $ takeWhile (/= '*') pat, False)
ReqNV ->
case readNV pat of
NV n _ -> (n, False)
ReqNVR ->
case readNVR pat of
NVR n _ -> (n, True)
kojiGetBuildRPMs :: String -> String -> IO [String]
kojiGetBuildRPMs huburl nvr = do
mbid <- kojiGetBuildID huburl nvr
case mbid of
Nothing -> error $ "Build id not found for " ++ nvr
Just (BuildId bid) -> do
rpms <- Koji.listBuildRPMs huburl bid
return $ map getNVRA $ filter (forArch "x86_64") rpms
where
forArch :: String -> Struct -> Bool
forArch sysarch st =
case lookupStruct "arch" st of
Just arch -> arch `elem` [sysarch, "noarch"]
Nothing -> error $ "No arch found for rpm for: " ++ nvr
getNVRA :: Struct -> String
getNVRA st =
case lookupStruct "nvr" st of
Nothing -> error' "NVR not found"
Just pnvr ->
case lookupStruct "arch" st of
Nothing -> error "arch not found"
Just arch ->
pnvr <.> arch
setNoBuffering :: IO ()
setNoBuffering = do
hSetBuffering stdin NoBuffering
hSetBuffering stdout NoBuffering
installRPMs :: Bool -> [FilePath] -> IO ()
installRPMs _ [] = return ()
installRPMs dryrun pkgs =
unless dryrun $
sudo_ "dnf" ("install" : map ("./" ++) pkgs)
-- FIXME check file size
downloadRpm :: String -> NVR -> String -> IO ()
downloadRpm pkgsurl (NVR n (VerRel v r)) rpm = do
unlessM (doesFileExist rpm) $ do
let arch = rpmArch (readNVRA rpm)
url = pkgsurl +/+ n +/+ v +/+ r +/+ arch +/+ rpm
putStrLn $ "Downloading " ++ rpm
cmd_ "curl" ["--fail", "--silent", "-C-", "--show-error", "--remote-name", url]
-- from next http-directory or http-query
infixr 5 +/+
(+/+) :: String -> String -> String
"" +/+ s = s
s +/+ "" = s
s +/+ t | last s == '/' = init s +/+ t
| head t == '/' = s +/+ tail t
s +/+ t = s ++ "/" ++ t