dl-fedora 1.2.1 → 1.3
raw patch · 6 files changed
+396/−193 lines, 6 filesdep +fedora-releases
Dependencies added: fedora-releases
Files
- CHANGELOG.md +17/−0
- README.md +39/−19
- dl-fedora.cabal +4/−3
- src/DownloadDir.hs +3/−1
- src/Main.hs +301/−166
- test/tests.hs +32/−4
CHANGELOG.md view
@@ -1,5 +1,22 @@ # Changelog +## 1.3 (2025-02-XX)+- F42 Workstation now created with Kiwi+- KDE spin renamed to KDE Desktop+- add COSMIC for F42+- use "c{9,10}s-live" for alt live respins instead of --cs-live-respin+- support downloading multiple editions/spins or all editions/spins:+ --all-editions and --all-spins defined per release or respin+- handle Kiwi use for different versions+- rawhide can now be specified by version number (uses fedora-release)+- respin --local: now correctly lists latest respin (not oldest)+- bump QEMU mem to 3GB+- wrap http-directory functions with retry+- allow "ws" and "gnome" as aliases for Workstation+- add release aliases 'current' and 'previous'+- aliases {9,10}-live+- --alt-cs-extra-edition to allow MAX/MIN Live images+ ## 1.2.1 (2024-11-01) - add MiracleWM and KDE_Mobile Live images
README.md view
@@ -12,14 +12,18 @@ `dl-fedora rawhide` : downloads the latest Fedora Rawhide Workstation Live iso -`dl-fedora 41 silverblue` : downloads the Fedora Silverblue iso+`dl-fedora 42 silverblue` : downloads the Fedora Silverblue iso `dl-fedora respin kde` : downloads the latest KDE Live respin -`dl-fedora 40 server --arch aarch64` : will download the Server iso for armv8+`dl-fedora 41 --list` : list editions for version -`dl-fedora --run 41` : will download Fedora Workstation and boot the Live image with qemu-kvm.+`dl-fedora 42 kde workstation` : download both KDE and Workstation editions +`dl-fedora 41 server --arch aarch64` : will download the Server iso for armv8++`dl-fedora --run 42` : will download Fedora Workstation and boot the Live image with qemu-kvm.+ `dl-fedora --check respin` : checks if there is a newer respin iso image available. @@ -27,7 +31,7 @@ It can be combined with `--run` to quickly run the latest local image, without a newer download. -`dl-fedora c9s` : downloads a Centos Stream 9 net installer.+`dl-fedora c10s` : downloads a Centos Stream net installer. By default dl-fedora downloads to `~/Downloads/` (correctly the XDG user "DOWNLOADS" directory),@@ -49,32 +53,44 @@ It also tries to check the iso checksum and its gpg signature. +There are a couple of edition abbreviations:+- `ws` and `gnome` are aliases for `workstation` (default edition)+- `sb` is short for `silverblue`.++Also release aliases:+- {`8`,`9`,`10`} are aliases for {`c8s`, `c9s`, `c10s`}+- `{8,9,10}-{live,respin}` are aliases for `{c8s,c9s,c10s}-{live,respin}`+- currently `11` is an alias for eln+- the current rawhide version can be used for `rawhide`+- `current` is an alias for the latest current stable Fedora release+- `previous` is an alias for the previous current stable Fedora release+ ## Usage `$ dl-fedora --version` ```-1.2+1.3 ``` `$ dl-fedora --help` ``` Fedora iso downloader -Usage: dl-fedora [--version] [-g|--gpg-keys] [--no-checksum | --checksum] - [--debug] [-T|--no-http-timeout] - [(-c|--check) | (-l|--local) | --list | (-R|--replace)] - [-n|--dry-run] [-r|--run] - [(-L|--latest) | (-d|--dl) | (-k|--koji) | (-m|--mirror URL)] - [--dvd] [--cs-live-respin] - [--cs-devel | --cs-test | --cs-production] [-a|--arch ARCH]- RELEASE [EDITION]+Usage: dl-fedora [--version] [-g|--gpg-keys] [--no-checksum | --checksum]+ [--debug] [-T|--no-http-timeout]+ [(-c|--check) | (-l|--local) | --list | (-R|--replace)]+ [-n|--dry-run] [-r|--run]+ [(-L|--latest) | (-d|--dl) | (-k|--koji) | (-m|--mirror URL)]+ [--dvd] [--cs-devel | --cs-test | --cs-production]+ [--alt-cs-extra-edition ('MAX'|'MIN')] [-a|--arch ARCH] RELEASE+ [--all-spins | --all-editions | [EDITION...]] Tool for downloading Fedora iso file images.- RELEASE = release number, respin, rawhide, test (Beta), stage (RC), eln, c9s, c10s- EDITION = {cloud,container,everything,server,workstation,budgie,cinnamon,i3,- kde,kdemobile,lxde,lxqt,mate,miracle,soas,sway,xfce,silverblue,- kinoite,onyx,sericea,iot} [default: workstation]- + RELEASE = release number, respin, rawhide, test (Beta), stage (RC), eln, c9s, c10s, c9s-live+ EDITION = {cloud,container,everything,server,workstation,budgie,cinnamon,+ cosmic,i3,kde,kdemobile,lxde,lxqt,mate,miracle,soas,sway,xfce,+ silverblue,kinoite,onyx,sericea,iot} [default: workstation]+ See <https://github.com/juhp/dl-fedora/#readme> Available options:@@ -100,12 +116,16 @@ https://download.fedoraproject.org/pub] --dvd Download dvd iso instead of boot netinst (for Server, eln, centos)- --cs-live-respin Centos Stream Alternative Live image --cs-devel Use centos-stream development compose --cs-test Use centos-stream test compose --cs-production Use centos-stream production compose (default is mirror.stream.centos.org)+ --alt-cs-extra-edition ('MAX'|'MIN')+ Centos Stream Alternative Live Spin editions+ (MAX,MIN) -a,--arch ARCH Specify arch [default: x86_64]+ --all-spins Get all Fedora Spins+ --all-editions Get all Fedora editions ``` ## References
dl-fedora.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: dl-fedora-version: 1.2.1+version: 1.3 synopsis: Fedora image download tool description: Tool to download Fedora and Centos Stream iso and image files.@@ -11,14 +11,14 @@ bug-reports: https://github.com/juhp/dl-fedora/issues author: Jens Petersen <juhpetersen@gmail.com> maintainer: Jens Petersen <juhpetersen@gmail.com>-copyright: 2019-2024 Jens Petersen+copyright: 2019-2025 Jens Petersen category: Utility build-type: Simple extra-doc-files: README.md CHANGELOG.md tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.8, GHC == 9.4.8,- GHC == 9.6.6, GHC == 9.8.2+ GHC == 9.6.6, GHC == 9.8.4, GHC == 9.10.1 source-repository head type: git@@ -35,6 +35,7 @@ bytestring, directory >= 1.2.5, extra,+ fedora-releases >= 0.2.1, filepath, http-client, http-client-tls,
src/DownloadDir.hs view
@@ -10,7 +10,8 @@ import System.Environment.XDG.UserDir (getUserDir) import System.FilePath -setDownloadDir :: Bool -> String -> IO FilePath+setDownloadDir :: Bool -> String+ -> IO String -- used to present ~/<dir> to user setDownloadDir dryrun subdir = do home <- getHomeDirectory dlDir <- getUserDir "DOWNLOAD"@@ -34,6 +35,7 @@ createDirectoryIfMissing True dlDir setCWD dlDir let path = makeRelative home dir+ -- only used for output to user return $ if isRelative path then "~" </> path else path where setCWD :: FilePath -> IO FilePath
src/Main.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +-- see https://pagure.io/pungi-fedora/+ #if !MIN_VERSION_base(4,13,0) import Control.Applicative ((<|>) #if !MIN_VERSION_base(4,8,0)@@ -9,16 +11,17 @@ import Data.Semigroup ((<>)) #endif -import Control.Monad.Extra-+import Control.Exception.Extra (retry)+import Control.Monad.Extra (filterM, unless, unlessM, when, whenJust) import qualified Data.ByteString.Char8 as B import Data.Char (isDigit) import Data.List.Extra+import Data.Ord (comparing, Down(Down)) import Data.Maybe import qualified Data.Text as T import Data.Time (UTCTime) import Data.Time.LocalTime (getCurrentTimeZone, utcToZonedTime, TimeZone)-+import Distribution.Fedora.Release (getCurrentFedoraVersion, getRawhideVersion) import Network.HTTP.Client (managerResponseTimeout, newManager, responseTimeoutNone) import Network.HTTP.Client.TLS@@ -42,8 +45,8 @@ import SimplePrompt (yesNo, yesNoDefault) import System.Directory (createDirectory, doesDirectoryExist, doesFileExist,- findExecutable, getPermissions,- listDirectory, removeFile, withCurrentDirectory,+ findExecutable, getPermissions, listDirectory,+ pathIsSymbolicLink, removeFile, withCurrentDirectory, writable) import System.FilePath (dropFileName, joinPath, takeExtension, takeFileName, (</>), (<.>))@@ -66,13 +69,14 @@ | Workstation | Budgie -- first spin: used below | Cinnamon+ | COSMIC | I3 | KDE- | KDEMobile -- made with Kiwi+ | KDEMobile | LXDE | LXQt | MATE- | Miracle -- made with Kiwi+ | Miracle | SoaS | Sway | Xfce -- last spin: used below@@ -83,12 +87,17 @@ | IoT deriving (Show, Enum, Bounded, Eq) -showEdition :: FedoraEdition -> String-showEdition KDEMobile = "KDE-Mobile"-showEdition MATE = "MATE_Compiz"-showEdition Miracle = "MiracleWM"-showEdition I3 = "i3"-showEdition e = show e+showEdition :: Release -> FedoraEdition -> String+showEdition rel KDE =+ case rel of+ Rawhide -> "KDE-Desktop"+ Fedora r | r >= 42 -> "KDE-Desktop"+ _ -> "KDE"+showEdition _ KDEMobile = "KDE-Mobile"+showEdition _ MATE = "MATE_Compiz"+showEdition _ Miracle = "MiracleWM"+showEdition _ I3 = "i3"+showEdition _ e = show e lowerEdition :: FedoraEdition -> String lowerEdition = lower . show@@ -98,11 +107,13 @@ s <- look let e = lower s editionMap =+ ("gnome", Workstation) : ("sb", Silverblue) :+ ("ws", Workstation) : map (\ ed -> (lowerEdition ed, ed)) [minBound..maxBound] res = lookup e editionMap case res of- Nothing -> error' "unknown edition" >> RP.pfail+ Nothing -> error' ("unknown edition: " ++ show s) >> RP.pfail Just ed -> RP.lift (R.string e) >> return ed type URL = String@@ -110,9 +121,46 @@ fedoraSpins :: [FedoraEdition] fedoraSpins = [Budgie .. Xfce] -kiwiSpins :: [FedoraEdition]-kiwiSpins = [Miracle, KDEMobile]+allSpins :: Natural -> Natural -> Release -> [FedoraEdition]+allSpins rawhide current rel =+ case rel of+ Rawhide -> allSpins rawhide current $ Fedora rawhide+ Fedora r ->+ fedoraSpins \\ case compare r 41 of+ GT -> []+ EQ -> [COSMIC]+ LT -> [COSMIC, KDEMobile, Miracle]+ FedoraRespin -> delete KDEMobile $ allSpins rawhide current $ Fedora current+ FedoraTest -> allSpins rawhide current $ Fedora current -- FIXME use fedora-releases+ FedoraStage -> allSpins rawhide current $ Fedora (current + 1) -- FIXME use fedora-releases+ CS 9 True -> [Cinnamon, KDE, MATE, Xfce] -- FIXME missing MAX, MIN+ CS 10 True -> [KDE] -- FIXME missing MAX, MIN+ CS n False -> error' $ "no spins available" ++ if n >= 9 then ": perhaps you want 'c" ++ show n ++ "s-live'?" else ""+ CS _ _ -> error' "--all-spins not supported"+ ELN -> error' "--all-spins not supported for this release" +allEditions :: Natural -> Natural -> Release -> [FedoraEdition]+allEditions rawhide current rel =+ case rel of+ Rawhide -> allEditions rawhide current $ Fedora rawhide+ Fedora r ->+ [minBound..maxBound] \\ missingEditions r+ FedoraRespin -> Workstation : allSpins rawhide current FedoraRespin+ FedoraTest -> allEditions rawhide current $ Fedora current -- FIXME use fedora-releases+ FedoraStage -> allEditions rawhide current $ Fedora (current + 1) -- FIXME use fedora-releases+ CS _ True -> Workstation : allSpins rawhide current rel+ CS n False -> [Workstation]+ _ -> error' "--all-editions not supported for this release"+ where+ missingEditions r =+ case compare r 41 of+ GT -> [IoT]+ EQ -> [COSMIC]+ LT -> [COSMIC, KDEMobile, Miracle]++data RequestEditions = Editions [FedoraEdition] | AllSpins | AllEditions+ deriving Eq+ data CheckSum = AutoCheckSum | NoCheckSum | CheckSum deriving Eq @@ -143,23 +191,37 @@ | FedoraTest | FedoraStage | ELN- | CS Natural+ | CS Natural Bool -- alt live respin deriving Eq -readRelease :: String -> Release-readRelease rel =+readRelease :: Natural -> Natural -> String -> Release+readRelease rawhide current rel = case lower rel of 'f': n@(_:_) | all isDigit n -> Fedora (read n) n@(_:_) | all isDigit n -> let v = read n in case compare v 11 of- LT -> CS v+ LT -> CS v False EQ -> ELN- GT -> Fedora v+ GT ->+ case compare v rawhide of+ LT -> Fedora v+ EQ -> Rawhide+ GT -> error' $ "Current rawhide is" +-+ show rawhide+ "current" -> Fedora current+ "previous" -> Fedora (current -1) -- FIXME hardcoding- "c8s" -> CS 8- "c9s" -> CS 9- "c10s" -> CS 10+ "c8s" -> CS 8 False+ "c9s" -> CS 9 False+ "c10s" -> CS 10 False+ "9-live" -> CS 9 True+ "9-respin" -> CS 9 True+ "c9s-live" -> CS 9 True+ "c9s-respin" -> CS 9 True+ "10-live" -> CS 10 True+ "10-respin" -> CS 10 True+ "c10s-live" -> CS 10 True+ "c10s-respin" -> CS 10 True "respin" -> FedoraRespin "rawhide" -> Rawhide "test" -> FedoraTest@@ -168,19 +230,22 @@ _ -> error' "unknown release" data Mode = Check | Local | List | Download Bool -- replace+ deriving Eq main :: IO () main = do let pdoc = Just $ P.vcat [ P.text "Tool for downloading Fedora iso file images.",- P.text ("RELEASE = " <> intercalate ", " ["release number", "respin", "rawhide", "test (Beta)", "stage (RC)", "eln", "c9s", "c10s"]),+ P.text ("RELEASE = " <> intercalate ", " ["release number", "respin", "rawhide", "test (Beta)", "stage (RC)", "eln", "c9s", "c10s", "c9s-live"]), P.text "EDITION = " <> P.lbrace <> P.align (P.fillCat (P.punctuate P.comma (map (P.text . lowerEdition) [(minBound :: FedoraEdition)..maxBound])) <> P.rbrace) <> P.text " [default: workstation]" , P.text "", P.text "See <https://github.com/juhp/dl-fedora/#readme>" ] sysarch <- readArch <$> cmd "rpm" ["--eval", "%{_arch}"]+ rawhideVersion <- getRawhideVersion+ currentRelease <- getCurrentFedoraVersion simpleCmdArgsWithMods (Just version) (fullDesc <> header "Fedora iso downloader" <> progDescDoc pdoc) $- program+ program rawhideVersion <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file" <*> checksumOpts <*> switchLongWith "debug" "Debug output"@@ -193,13 +258,15 @@ <*> switchWith 'r' "run" "Boot image in QEMU" <*> mirrorOpt <*> switchLongWith "dvd" "Download dvd iso instead of boot netinst (for Server, eln, centos)"- <*> switchLongWith "cs-live-respin" "Centos Stream Alternative Live image" <*> optional (flagLongWith' CSDevelopment "cs-devel" "Use centos-stream development compose" <|> flagLongWith' CSTest "cs-test" "Use centos-stream test compose" <|> flagLongWith' CSProduction "cs-production" "Use centos-stream production compose (default is mirror.stream.centos.org)")+ <*> optional (strOptionLongWith "alt-cs-extra-edition" "('MAX'|'MIN')" "Centos Stream Alternative Live Spin editions (MAX,MIN)") <*> (optionWith (eitherReader eitherArch) 'a' "arch" "ARCH" ("Specify arch [default:" +-+ showArch sysarch ++ "]") <|> pure sysarch)- <*> (readRelease <$> strArg "RELEASE")- <*> (fromMaybe Workstation <$> optional (argumentWith auto "EDITION"))+ <*> (readRelease rawhideVersion currentRelease <$> strArg "RELEASE")+ <*> (flagLongWith' AllSpins "all-spins" "Get all Fedora Spins" <|>+ flagLongWith' AllEditions "all-editions" "Get all Fedora editions" <|>+ Editions <$> many (argumentWith auto "EDITION...")) where mirrorOpt :: Parser Mirror mirrorOpt =@@ -218,10 +285,10 @@ primarySize :: Maybe Integer, primaryTime :: Maybe UTCTime} -program :: Bool -> CheckSum -> Bool -> Bool -> Mode -> Bool -> Bool- -> Mirror -> Bool -> Bool -> Maybe CentosChannel -> Arch -> Release- -> FedoraEdition -> IO ()-program gpg checksum debug notimeout mode dryrun run mirror dvdnet cslive mchannel arch tgtrel edition = do+program :: Natural -> Bool -> CheckSum -> Bool -> Bool -> Mode -> Bool -> Bool+ -> Mirror -> Bool -> Maybe CentosChannel -> Maybe String -> Arch+ -> Release -> RequestEditions -> IO ()+program rawhide gpg checksum debug notimeout mode dryrun run mirror dvdnet mchannel mcsedition arch tgtrel reqeditions = do when (isJust mchannel && not (isCentosStream tgtrel)) $ error' "channels are only for centos-stream" let mirrorUrl =@@ -233,20 +300,47 @@ _ -> case tgtrel of ELN -> odcsFpo- CS n | n >= 9 -> if isJust mchannel+ CS n _ | n >= 9 -> if isJust mchannel then csComposes else csMirror- CS 8 -> csComposes+ CS 8 _ -> csComposes _ -> downloadFpo showdestdir <- setDownloadDir dryrun "iso" when debug $ print showdestdir mgr <- if notimeout then newManager (tlsManagerSettings {managerResponseTimeout = responseTimeoutNone}) else httpManager+ unless (reqeditions == Editions []) $+ case tgtrel of+ ELN -> error' "cannot specify edition for eln"+ CS _ False -> error' "cannot specify edition for centos-stream"+ _ -> return ()+ when (isJust mcsedition) $+ case tgtrel of+ CS n True | n >= 9 ->+ case reqeditions of+ Editions [] -> return ()+ _ -> error' "combining extra edition unsupported"+ _ -> error' "--alt-cs-extra-edition is only for CS Alt Live spins"+ current <- getCurrentFedoraVersion+ mapM_ (runProgramEdition mgr mirrorUrl showdestdir gpg checksum debug mode dryrun run mirror dvdnet mchannel mcsedition arch tgtrel reqeditions) $+ if mode == List+ then [Workstation]+ else+ case reqeditions of+ AllEditions -> allEditions rawhide current tgtrel+ AllSpins -> allSpins rawhide current tgtrel+ Editions editions ->+ if null editions then [Workstation] else editions++runProgramEdition :: Manager -> URL -> String -> Bool -> CheckSum -> Bool+ -> Mode -> Bool -> Bool -> Mirror -> Bool+ -> Maybe CentosChannel -> Maybe String -> Arch -> Release+ -> RequestEditions -> FedoraEdition -> IO ()+runProgramEdition mgr mirrorUrl showdestdir gpg checksum debug mode dryrun run mirror dvdnet mchannel mcsedition arch tgtrel reqeditions edition = case mode of Check -> do- (fileurl, filenamePrefix, _prime, _mchecksum, done) <-- findURL mgr mirrorUrl showdestdir True+ (fileurl, filenamePrefix, _prime, _mchecksum, done) <- findURL True if done then do putStrLn $ "Local:" +-+ takeFileName fileurl +-+ "is latest"@@ -263,7 +357,7 @@ putStrLn $ "Newer:" +-+ takeFileName fileurl Nothing -> putStrLn $ "Available:" +-+ takeFileName fileurl Local -> do- prefix <- getFilePrefix showdestdir+ prefix <- getFilePrefix -- FIXME support non-iso let symlink = prefix <> (if tgtrel == ELN then "-" <> showArch arch else "") <> "-latest" <.> "iso" mtarget <- derefSymlink symlink@@ -271,31 +365,39 @@ putStrLn $ "Local:" +-+ target when run $ bootImage dryrun target showdestdir- List ->- -- FIXME only list/check for editions for release- putStrLn $ (unwords . sort . map lowerEdition) [(minBound :: FedoraEdition)..maxBound]+ List -> do+ rawhide <- getRawhideVersion+ current <- getCurrentFedoraVersion+ let editions =+ case reqeditions of+ AllSpins -> allSpins rawhide current tgtrel+ _ -> allEditions rawhide current tgtrel+ extras =+ case tgtrel of+ CS _ True -> ["max","min"]+ _ -> []+ putStrLn $ unwords $ sort (map lowerEdition editions) ++ extras Download removeold -> do- (fileurl, filenamePrefix, prime, mchecksum, done) <-- findURL mgr mirrorUrl showdestdir False+ (fileurl, filenamePrefix, prime, mchecksum, done) <- findURL False let symlink = filenamePrefix <> (if tgtrel == ELN then "-" <> showArch arch else "") <> "-latest" <.> takeExtension fileurl downloadFile dryrun debug done mgr fileurl prime showdestdir >>=- fileChecksum mgr fileurl mchecksum showdestdir+ fileChecksum fileurl mchecksum unless dryrun $ do let localfile = takeFileName fileurl- updateSymlink localfile symlink showdestdir removeold+ updateSymlink localfile symlink removeold when run $ bootImage dryrun localfile showdestdir where- findURL :: Manager -> String -> String -> Bool+ findURL :: Bool -- urlpath, fileprefix, primary, checksum, downloaded -> IO (URL, String, Primary, Maybe String, Bool)- findURL mgr mirrorUrl showdestdir quiet = do- (path,mrelease) <- urlPathMRel mgr+ findURL quiet = do+ (path,mrelease) <- urlPathMRel let path' = trailingSlash path (primeDir,hrefs) <- case tgtrel of -- "koji" -> getUrlDirectory kojiPkgs path' ELN -> getUrlDirectory odcsFpo path'- CS n ->+ CS n _ -> if n < 9 || isJust mchannel then getUrlDirectory odcsStream path' else getUrlDirectory csMirror path'@@ -308,54 +410,52 @@ then getUrlDirectory dlFpo path' else return (url,ls) when (null hrefs) $ error' $ primeDir +-+ "is empty"- let prefixPat = makeFilePrefix mrelease- selector = if '*' `elem` prefixPat then (=~ prefixPat) else (prefixPat `isPrefixOf`)+ let (prefixPat,selector) = makeFileSelector mrelease fileslen = groupSortOn length $ filter selector $ map T.unpack hrefs mchecksum = find ((if tgtrel == FedoraRespin then T.isPrefixOf else T.isSuffixOf) (T.pack "CHECKSUM")) hrefs- if null fileslen- then error' $ "no match for " <> prefixPat <> " in " <> primeDir- else do- let files = head fileslen- when (length files > 1) $ mapM_ putStrLn files- let file = last files- prefix = if '*' `elem` prefixPat- then (file =~ prefixPat) ++ if showArch arch `isInfixOf` prefixPat then "" else showArch arch- else prefixPat- primeUrl = primeDir +/+ file- (primeSize,primeTime) <- httpFileSizeTime mgr primeUrl- (finalurl, already) <- do- let localfile = takeFileName primeUrl- exists <- doesFileExist localfile- if exists- then do- localsize <- toInteger . fileSize <$> getFileStatus localfile- done <- checkLocalFileSize localsize localfile primeSize primeTime showdestdir quiet- if done- then return (primeUrl,True)- else do- unlessM (writable <$> getPermissions localfile) $ do- putStrLn $ localfile <> " does not have write permission!"- yes <- yesNo "Fix ownership"- if yes- then do- user <- getLoginName- sudoLog "chown" [user,localfile]- else- error' $ localfile <> " does not have write permission, aborting!"- findMirror primeUrl path file- else findMirror primeUrl path file- let finalDir = dropFileName finalurl- return (finalurl, prefix, Primary primeUrl primeSize primeTime,- (finalDir +/+) . T.unpack <$> mchecksum, already)+ case fileslen of+ [] -> error' $ "no match for " <> prefixPat <> " in " <> primeDir+ (files:_) -> do+ when (length files > 1) $ mapM_ putStrLn files+ let file = last files+ prefix = if '[' `elem` prefixPat+ then (file =~ prefixPat) ++ if showArch arch `isInfixOf` prefixPat then "" else showArch arch+ else prefixPat+ primeUrl = primeDir +/+ file+ (primeSize,primeTime) <- retry 3 $ httpFileSizeTime mgr primeUrl+ (finalurl, already) <- do+ let localfile = takeFileName primeUrl+ exists <- doesFileExist localfile+ if exists+ then do+ localsize <- toInteger . fileSize <$> getFileStatus localfile+ done <- checkLocalFileSize localsize localfile primeSize primeTime quiet+ if done+ then return (primeUrl,True)+ else do+ unlessM (writable <$> getPermissions localfile) $ do+ putStrLn $ localfile <> " does not have write permission!"+ yes <- yesNo "Fix ownership"+ if yes+ then do+ user <- getLoginName+ sudoLog "chown" [user,localfile]+ else+ error' $ localfile <> " does not have write permission, aborting!"+ findMirror primeUrl path file+ else findMirror primeUrl path file+ let finalDir = dropFileName finalurl+ return (finalurl, prefix, Primary primeUrl primeSize primeTime,+ (finalDir +/+) . T.unpack <$> mchecksum, already) where getUrlDirectory :: String -> FilePath -> IO (String, [T.Text]) getUrlDirectory top path = do let url = top +/+ path when debug $ do print url- redirs <- httpRedirects mgr $ replace "https:" "http:" url+ redirs <- retry 3 $ httpRedirects mgr $ replace "https:" "http:" url print redirs- ls <- httpDirectory mgr url+ ls <- retry 3 $ httpDirectory mgr url return (url, ls) findMirror primeUrl path file = do@@ -366,34 +466,33 @@ if mirrorUrl /= downloadFpo then return $ mirrorUrl +/+ path +/+ file else do- redir <- httpRedirect mgr $ mirrorUrl +/+ path +/+ file+ redir <- retry 3 $ httpRedirect mgr $ mirrorUrl +/+ path +/+ file case redir of Nothing -> do warning $ mirrorUrl +/+ path +/+ file <> " redirect failed" return primeUrl Just u -> do let url = B.unpack u- exists <- httpExists mgr url+ exists <- retry 3 $ httpExists mgr url when debug $ print (url, exists) if exists then return url else return primeUrl return (url,False) - getFilePrefix :: String -> IO String- getFilePrefix showdestdir = do- let prefixPat = makeFilePrefix getRelease- selector = if '*' `elem` prefixPat then (=~ prefixPat) else (prefixPat `isPrefixOf`)- -- FIXME filter to symlinks only- files <- listDirectory "."- case find selector files of- Nothing -> return $ if '*' `elem` prefixPat- then error' $ "no match for " <> prefixPat <> " in " <> showdestdir- else prefixPat- Just file -> do- let prefix = if '*' `elem` prefixPat- then (file =~ prefixPat) ++ if showArch arch `isInfixOf` prefixPat then "" else showArch arch- else prefixPat- return prefix+ getFilePrefix :: IO String+ getFilePrefix = do+ let (prefixPat,selector) = makeFileSelector getRelease+ symlinks <- listDirectory "." >>= filterM pathIsSymbolicLink+ return $+ case find selector (reverseSort symlinks) of+ Nothing ->+ if '[' `elem` prefixPat+ then error' $ "no match for " <> prefixPat <> " in " <> showdestdir+ else prefixPat+ Just symlink ->+ if '[' `elem` prefixPat+ then (symlink =~ prefixPat) ++ if showArch arch `isInfixOf` prefixPat then "" else showArch arch+ else prefixPat getRelease :: Maybe String getRelease =@@ -402,13 +501,13 @@ Rawhide -> Just "Rawhide" FedoraRespin -> Nothing ELN -> Nothing- CS _ -> Nothing- Fedora rel -> Just (show rel)+ CS _ _ -> Nothing+ Fedora rel -> Just $ show rel _ -> error' "release target is unsupported with --dryrun" checkLocalFileSize :: Integer -> FilePath -> Maybe Integer -> Maybe UTCTime- -> String -> Bool -> IO Bool- checkLocalFileSize localsize localfile mprimeSize mprimeTime showdestdir quiet = do+ -> Bool -> IO Bool+ checkLocalFileSize localsize localfile mprimeSize mprimeTime quiet = do if Just localsize == mprimeSize then do unless quiet $ do@@ -426,46 +525,47 @@ putStrLn $ "File " <> sizepercent <> " downloaded" return False - urlPathMRel :: Manager -> IO (FilePath, Maybe String)- urlPathMRel mgr = do+ urlPathMRel :: IO (FilePath, Maybe String)+ urlPathMRel = do let subdir = if edition `elem` fedoraSpins then joinPath ["Spins", showArch arch, "iso"]- else joinPath [showEdition edition, showArch arch, editionMedia edition]+ else joinPath [showEdition tgtrel edition, showArch arch, editionMedia edition] case tgtrel of FedoraRespin -> return ("alt/live-respins", Nothing) Rawhide -> return ("fedora/linux/development/rawhide" +/+ subdir, Just "Rawhide")- FedoraTest -> testRelease mgr subdir- FedoraStage -> stageRelease mgr subdir+ FedoraTest -> testRelease subdir+ FedoraStage -> stageRelease subdir ELN -> return ("production/latest-Fedora-ELN/compose" +/+ "BaseOS" +/+ showArch arch +/+ "iso", Nothing)- CS 8 ->+ CS 8 False -> return ("stream-8" +/+ showChannel (fromMaybe CSProduction mchannel) +/+ "latest-CentOS-Stream/compose" +/+ "BaseOS" +/+ showArch arch +/+ "iso", Nothing)- CS n -> return $- case mchannel of- Nothing ->- if cslive- then ("SIGs" +/+ show n ++ "-stream/altimages/images/live" +/+ showArch arch, Nothing)- else (show n ++ "-stream" +/+ "BaseOS" +/+ showArch arch +/+ "iso", Nothing)- Just channel ->- ((if n == 9 then id else (("stream-" ++ show n) +/+)) $ showChannel channel +/+ "latest-CentOS-Stream/compose" +/+ "BaseOS" +/+ showArch arch +/+ "iso", Nothing)+ CS n cslive ->+ return $+ case mchannel of+ Nothing ->+ if cslive+ then ("SIGs" +/+ show n ++ "-stream/altimages/images/live" +/+ showArch arch, Nothing)+ else (show n ++ "-stream" +/+ "BaseOS" +/+ showArch arch +/+ "iso", Nothing)+ Just channel ->+ ((if n == 9 then id else (("stream-" ++ show n) +/+)) $ showChannel channel +/+ "latest-CentOS-Stream/compose" +/+ "BaseOS" +/+ showArch arch +/+ "iso", Nothing) Fedora n -> if edition == IoT then return ("alt/iot" +/+ show n +/+ subdir, Nothing)- else released mgr (show n) subdir+ else released (show n) subdir - testRelease :: Manager -> FilePath -> IO (FilePath, Maybe String)- testRelease mgr subdir = do+ testRelease :: FilePath -> IO (FilePath, Maybe String)+ testRelease subdir = do let path = "fedora/linux" +/+ "releases/test" url = dlFpo +/+ path- rels <- map (T.unpack . noTrailingSlash) <$> httpDirectory mgr url+ rels <- map (T.unpack . noTrailingSlash) <$> retry 3 (httpDirectory mgr url) let mrel = if null rels then Nothing else Just (last rels) return (path +/+ fromMaybe (error' ("test release not found in " <> url)) mrel +/+ subdir, mrel) - stageRelease :: Manager -> FilePath -> IO (FilePath, Maybe String)- stageRelease mgr subdir = do+ stageRelease :: FilePath -> IO (FilePath, Maybe String)+ stageRelease subdir = do let path = "alt/stage" url = dlFpo +/+ path- rels <- reverse . map (T.unpack . noTrailingSlash) <$> httpDirectory mgr url+ rels <- reverse . map (T.unpack . noTrailingSlash) <$> retry 3 (httpDirectory mgr url) let mrel = listToMaybe rels return (path +/+ fromMaybe (error' ("staged release not found in " <> url)) mrel +/+ subdir, takeWhile (/= '_') <$> mrel) @@ -474,54 +574,85 @@ -- let path = "branched" -- url = kojiPkgs +/+ path -- prefix = "latest-Fedora-"- -- latest <- filter (prefix `isPrefixOf`) . map T.unpack <$> httpDirectory mgr url+ -- latest <- filter (prefix `isPrefixOf`) . map T.unpack <$> retry 3 $ httpDirectory mgr url -- let mlatest = listToMaybe latest- -- return (path +/+ fromMaybe (error' ("koji branched latest dir not not found in " <> url)) mlatest +/+ "compose" +/+ subdir, removePrefix prefix <$> mlatest)+ -- return (path +/+ fromMaybe (error' ("koji branched latest dir not found in " <> url)) mlatest +/+ "compose" +/+ subdir, removePrefix prefix <$> mlatest) -- use https://admin.fedoraproject.org/pkgdb/api/collections ?- released :: Manager -> FilePath -> FilePath -> IO (FilePath, Maybe String)- released mgr rel subdir = do+ released :: FilePath -> FilePath -> IO (FilePath, Maybe String)+ released rel subdir = do let dir = "fedora/linux/releases" url = dlFpo +/+ dir- exists <- httpExists mgr $ url +/+ rel+ exists <- retry 3 $ httpExists mgr $ url +/+ rel when debug $ print (exists, url +/+ rel) if exists then return (dir +/+ rel +/+ subdir, Just rel) else do let dir' = "fedora/linux/development" url' = dlFpo +/+ dir'- exists' <- httpExists mgr $ url' +/+ rel+ exists' <- retry 3 $ httpExists mgr $ url' +/+ rel if exists' then return (dir' +/+ rel +/+ subdir, Just rel) else error' "release not found in releases/ or development/" renderdvdboot = if dvdnet then "dvd1" else "boot" - makeFilePrefix :: Maybe String -> String- makeFilePrefix mrelease =+ makeFileSelector :: Maybe String -> (String, String -> Bool)+ makeFileSelector mrelease =+ let (prefixPat,msuffix) = makeFilePrefixSuffix mrelease+ selector f =+ not ("-latest-" `isInfixOf` f) &&+ case msuffix of+ Just suffix -> f =~ (prefixPat ++ ".*-" ++ suffix)+ Nothing ->+ if '[' `elem` prefixPat+ then f =~ prefixPat+ else prefixPat `isPrefixOf` f+ in (prefixPat, selector)++ makeFilePrefixSuffix :: Maybe String -> (String, Maybe String)+ makeFilePrefixSuffix mrelease = case tgtrel of- FedoraRespin -> "F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64" <> "-LIVE"- ELN -> "Fedora-eln-.*" ++ renderdvdboot- CS n ->+ FedoraRespin ->+ ("F[1-9][0-9]-" <> liveRespin edition <> "-x86_64" <> "-LIVE",+ Nothing)+ ELN -> ("Fedora-eln", Just renderdvdboot)+ CS n cslive -> if cslive- then "CentOS-Stream-Image-" ++ csLive edition ++ "-Live" <.> showArch arch ++ '-' : show n- else "CentOS-Stream-" ++ show n ++ "-.*" ++ renderdvdboot+ then ("CentOS-Stream-Image-" ++ maybe (csLive edition) upper mcsedition ++ "-Live" <.> showArch arch ++ '-' : show n, Nothing)+ else ("CentOS-Stream-" ++ show n, Just renderdvdboot) _ -> let showRel r = if last r == '/' then init r else r rel = maybeToList (showRel <$> mrelease) (midpref,middle) = case edition of -- https://github.com/fedora-iot/iot-distro/issues/1- IoT -> ("", rel ++ [".*" <> showArch arch])- Cloud -> ('.' : showArch arch, rel)- Container -> ('.' : showArch arch, rel)+ IoT -> ("", rel)+ Cloud | tgtrel == Fedora 40 -> ('.' : showArch arch, rel)+ Container | tgtrel == Fedora 40 -> ('.' : showArch arch, rel) _ -> ("", if edition `elem` kiwiSpins then rel else showArch arch : rel)- in- intercalate "-" (["Fedora", showEdition edition, editionType edition ++ midpref] ++ middle)+ in (intercalate "-" (["Fedora", showEdition tgtrel edition, editionType edition ++ midpref] ++ middle),+ Nothing) + -- https://pagure.io/pungi-fedora/blob/main/f/fedora.conf#_251 kiwibuild+ kiwiSpins :: [FedoraEdition]+ kiwiSpins =+ -- https://fedoraproject.org/wiki/Changes/EROFSforLiveMedia+ (if fedoraVerOrLater 42 tgtrel+ then [Budgie, COSMIC, KDE, LXQt, Workstation, Xfce]+ else []) +++ (if fedoraVerOrLater 41 tgtrel+ then [Cloud, Container, KDEMobile, Miracle]+ else [])+ where+ fedoraVerOrLater :: Natural -> Release -> Bool+ fedoraVerOrLater _ Rawhide = True+ fedoraVerOrLater n (Fedora m) = m >= n+ fedoraVerOrLater _ _ = False+ editionType :: FedoraEdition -> String editionType Server = if dvdnet then "dvd" else "netinst" editionType IoT = "ostree"@@ -534,10 +665,9 @@ editionType Container = "Base-Generic" editionType _ = "Live" - fileChecksum :: Manager -> String -> Maybe URL -> String -> Maybe Bool- -> IO ()- fileChecksum _ _ Nothing _ _ = return ()- fileChecksum mgr imageurl (Just url) showdestdir mneedChecksum =+ fileChecksum :: String -> Maybe URL -> Maybe Bool -> IO ()+ fileChecksum _ Nothing _ = return ()+ fileChecksum imageurl (Just url) mneedChecksum = when ((mneedChecksum == Just True && checksum /= NoCheckSum) || (isJust mneedChecksum && checksum == CheckSum)) $ do let checksumdir = ".dl-fedora-checksums" checksumfilename = takeFileName url@@ -545,14 +675,14 @@ exists <- do dirExists <- doesDirectoryExist checksumdir if dirExists- then checkChecksumfile mgr url checksumpath showdestdir+ then checkChecksumfile url checksumpath else createDirectory checksumdir >> return False putStrLn "" haveChksum <- if exists then return True else do- remoteExists <- httpExists mgr url+ remoteExists <- retry 3 $ httpExists mgr url if remoteExists then do withCurrentDirectory checksumdir $ do@@ -593,16 +723,16 @@ ("grep",[takeFileName imageurl,checksumpath]) (shasum,["-c","-"]) - checkChecksumfile :: Manager -> URL -> FilePath -> String -> IO Bool- checkChecksumfile mgr url checksumfile showdestdir = do+ checkChecksumfile :: URL -> FilePath -> IO Bool+ checkChecksumfile url checksumfile = do exists <- doesFileExist checksumfile if not exists then return False else do filesize <- toInteger . fileSize <$> getFileStatus checksumfile when (filesize == 0) $ error' $ checksumfile +-+ "empty!"- (primeSize,primeTime) <- httpFileSizeTime mgr url+ (primeSize,primeTime) <- retry 3 $ httpFileSizeTime mgr url when debug $ print (primeSize,primeTime,url)- ok <- checkLocalFileSize filesize checksumfile primeSize primeTime showdestdir True+ ok <- checkLocalFileSize filesize checksumfile primeSize primeTime True unless ok $ error' $ "Checksum file filesize mismatch for " ++ checksumfile return ok @@ -610,8 +740,8 @@ checkForFedoraKeys n = pipeBool ("gpg",["--list-keys"]) ("grep", ["-q", " Fedora .*(" <> show n <> ").*@fedoraproject.org>"]) - updateSymlink :: FilePath -> FilePath -> FilePath -> Bool -> IO ()- updateSymlink target symlink showdestdir removeold = do+ updateSymlink :: FilePath -> FilePath -> Bool -> IO ()+ updateSymlink target symlink removeold = do mmsymlinkTarget <- do havefile <- doesFileExist symlink if havefile@@ -657,7 +787,7 @@ mtime <- do if url /= primaryUrl prime then do- (mirrorSize,mirrorTime) <- httpFileSizeTime mgr url+ (mirrorSize,mirrorTime) <- retry 3 $ httpFileSizeTime mgr url unless (mirrorSize == primarySize prime) $ putStrLn "Warning! Mirror filesize differs from primary file" unless (mirrorTime == primaryTime prime) $@@ -686,7 +816,10 @@ editionMedia _ = "iso" liveRespin :: FedoraEdition -> String-liveRespin = take 4 . upper . showEdition+liveRespin Budgie = "Budgie"+liveRespin I3 = "i3"+liveRespin Miracle = "MiracleWM"+liveRespin e = take 4 . upper . showEdition FedoraRespin $ e bootImage :: Bool -> FilePath -> String -> IO () bootImage dryrun img showdir = do@@ -697,7 +830,7 @@ mQemu <- findExecutable "qemu-kvm" case mQemu of Just qemu -> do- let args = ["-m", "2048", "-rtc", "base=localtime", "-cpu", "host"] ++ fileopts+ let args = ["-m", "3072", "-rtc", "base=localtime", "-cpu", "host"] ++ fileopts cmdN qemu (args ++ [showdir </> img]) unless dryrun $ cmd_ qemu (args ++ [img])@@ -755,17 +888,16 @@ cmdBool "curl" $ opts ++ args isCentosStream :: Release -> Bool-isCentosStream (CS _) = True+isCentosStream (CS _ _) = True isCentosStream _ = False --- FIXME support other editions: MAX, MIN csLive :: FedoraEdition -> String csLive Workstation = "GNOME" csLive Cinnamon = "CINNAMON" csLive KDE = "KDE" csLive MATE = "MATE" csLive Xfce = "XFCE"-csLive ed = error' $ "unsupported edition:" +-+ showEdition ed+csLive ed = error' $ "unsupported edition:" +-+ showEdition FedoraRespin ed #if !MIN_VERSION_simple_cmd(0,2,7) sudoLog :: String -- ^ command@@ -773,3 +905,6 @@ -> IO () sudoLog = sudo_ #endif++reverseSort :: Ord a => [a] -> [a]+reverseSort = sortBy (comparing Down)
test/tests.hs view
@@ -1,4 +1,7 @@+import Control.Monad (forM_, unless)+import Data.List (sort) import Data.Maybe+import Numeric.Natural (Natural) import System.Environment (lookupEnv) import SimpleCmd @@ -9,7 +12,7 @@ -- FIXME automate me branched :: Int-branched = 41+branched = 42 current, previous :: String current = show branched previous = show (branched - 1)@@ -21,23 +24,48 @@ ,["-c", "respin"] ,["-l", current] ,["-l", "rawhide", "-n"]- ,["40", "iot", "-n"]+ ,["-n", previous, "kde"] ] ++ if ghAction then [] else [["-c", current, "silverblue"]- ,["-n", previous, "kde"] ,["-T", "-n", current, "everything"] ,["-n", previous, "server", "--dvd", "--arch", "aarch64"]+ ,["41", "iot", "-n"] ,["-n", "c8s"] ,["-n", "c9s", "--dvd"] ,["-n", "c10s"] ,["-c", "eln"]- ,["-n", "c9s", "--cs-live-respin"]+ ,["-n", "c9s-live"]+ ,["-n", "c10s-live"]+ ,["-d", "-T", "-n", "40", "--all-editions"]+ ,["-d", "-T", "-n", "41", "--all-editions"]+ ,["-d", "-T", "-n", "42", "--all-editions"]+ ,["-d", "-T", "-n", "43", "--all-editions"]+ ,["-d", "-T", "-n", "respin", "--all-editions"]+ ,["-T", "-n", "c9s-live", "--all-editions"]+ ,["-T", "-n", "c10s-live", "--all-editions"] ] +allEditions :: Natural -> [String]+allEditions 9 = allEditions 10 ++ ["cinnamon", "mate", "xfce"]+allEditions 10 = ["workstation", "kde", "max", "min"]+allEditions rel = ["cloud","container","everything","server","workstation","budgie","cinnamon","i3","kde","lxde","lxqt","mate","soas","sway","xfce","silverblue","kinoite","onyx","sericea"] +++ ["cosmic" | rel >= 42] ++ ["kdemobile" | rel >= 41] ++ ["miracle" | rel >= 41] ++ ["iot" | rel < 42]++listEditions :: Natural -> IO ()+listEditions n = do+ let args = ["--list", show n ++ if n < 11 then "-live" else ""]+ cmdN "dl-fedora" args+ es <- sort . words <$> cmd "dl-fedora" args+ let aes = sort $ allEditions n+ unless (es == aes) $+ error' $ show n +-+ "editions unmatched:\n" ++ show es ++ "\n" ++ show aes+ main :: IO () main = do+ forM_ [40..43] listEditions+ forM_ [9..10] listEditions ghAction <- isJust <$> lookupEnv "GITHUB_ACTIONS" let cases = tests ghAction mapM_ (dlFedora ghAction) cases