dl-fedora 1.3 → 2.0
raw patch · 6 files changed
+267/−166 lines, 6 filesdep +pretty-terminaldep ~fedora-releases
Dependencies added: pretty-terminal
Dependency ranges changed: fedora-releases
Files
- CHANGELOG.md +15/−3
- README.md +24/−17
- dl-fedora.cabal +3/−1
- src/DownloadDir.hs +11/−34
- src/Main.hs +182/−89
- test/tests.hs +32/−22
CHANGELOG.md view
@@ -1,12 +1,24 @@ # Changelog -## 1.3 (2025-02-XX)+## 2.0 (2025-03-07)+- move short `-d` option from `--dl` to `--dir`+- simplify the download dir logic+ (now falls back to current directory if ~/Downloads/ doesn't exist)+- partial downloads are now staged in a `.dl-fedora-partial/` subdirectory+- promote KDE to edition+- accumulate download errors and report number of failures+- 'next' is now also accepted as a release alias+- add `--all-desktops`+- add `--dir option` to override download dir+- add `--exclude` editions switch++## 1.3 (2025-02-16) - 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+- support downloading multiple or all editions/spins:+ --all-editions and --all-spins are 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)
README.md view
@@ -34,9 +34,11 @@ `dl-fedora c10s` : downloads a Centos Stream net installer. By default dl-fedora downloads to `~/Downloads/`-(correctly the XDG user "DOWNLOADS" directory),-but if you create an `iso` subdirectory there (`~/Downloads/iso/`)-it will use that directory instead.+(correctly the XDG user "DOWNLOAD" directory), or `~/Downloads/iso/` if it exists.+If `~/Downloads/` doesn't exist then the current directory is used.+You can override the download directory with `--dir DIR` (which can be relative: eg `.`).+Curl downloads to a `.dl-fedora-partial` subdirectory first (which can safely be removed when not using dl-fedora)+and the downloaded file is then moved up to the actual download directory when complete. `dl-fedora` downloads the latest mirrored image redirected from `download.fedoraproject.org` by default.@@ -45,7 +47,7 @@ _if_ your mirror is not synced yet. If the image is already found to be downloaded-it will not be re-downloaded of course.+it will not be re-downloaded of course (unless you use a different `--dir` say). Curl is used to do the downloading: partial downloads will continue. A symlink to the latest iso is also created:@@ -53,23 +55,24 @@ 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:+There are some 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+- `next` is an alias for the next Fedora release (either Rawhide or "branched")+- `current` is an alias for the latest current stable Fedora release (though you may prefer newer `respin`) - `previous` is an alias for the previous current stable Fedora release +Also a few edition abbreviations:+- `ws` and `gnome` are aliases for `workstation` (default edition)+- `sb` is short for `silverblue`.+ ## Usage `$ dl-fedora --version` ```-1.3+2.0 ``` `$ dl-fedora --help` @@ -79,16 +82,17 @@ 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)]+ [-d|--dir DIRECTORY] [-n|--dry-run] [-r|--run]+ [(-L|--latest) | --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...]]+ [--all-desktops | --all-spins | --all-editions | [-x|--exclude]+ [EDITION...]] Tool for downloading Fedora iso file images. 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,+ EDITION = {cloud,container,everything,kde,server,workstation,budgie,cinnamon,+ cosmic,i3,kdemobile,lxde,lxqt,mate,miracle,soas,sway,xfce, silverblue,kinoite,onyx,sericea,iot} [default: workstation] See <https://github.com/juhp/dl-fedora/#readme>@@ -106,11 +110,12 @@ --list List spins and editions -R,--replace Delete previous snapshot image after downloading latest one+ -d,--dir DIRECTORY Download directory [default: ~/Downloads/iso] -n,--dry-run Don't actually download anything -r,--run Boot image in QEMU -L,--latest Get latest image either from mirror or dl.fp.o if newer- -d,--dl Use dl.fedoraproject.org (dl.fp.o)+ --dl Use dl.fedoraproject.org (dl.fp.o) -k,--koji Use koji.fedoraproject.org -m,--mirror URL Mirror url for /pub [default https://download.fedoraproject.org/pub]@@ -124,8 +129,10 @@ Centos Stream Alternative Live Spin editions (MAX,MIN) -a,--arch ARCH Specify arch [default: x86_64]+ --all-desktops Get all Fedora desktops --all-spins Get all Fedora Spins --all-editions Get all Fedora editions+ -x,--exclude Exclude specified editions ``` ## References
dl-fedora.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: dl-fedora-version: 1.3+version: 2.0 synopsis: Fedora image download tool description: Tool to download Fedora and Centos Stream iso and image files.@@ -46,6 +46,7 @@ simple-cmd >= 0.2, simple-cmd-args >= 0.1.8, simple-prompt >= 0.2,+ pretty-terminal, text, time, unix,@@ -67,5 +68,6 @@ ghc-options: -Wall build-depends: base >= 4 && < 5+ , fedora-releases , simple-cmd build-tool-depends: dl-fedora:dl-fedora
src/DownloadDir.hs view
@@ -1,44 +1,21 @@ module DownloadDir (- setDownloadDir)+ checkDefaultIsoDir+ ) where -import Control.Monad-import SimpleCmd (error')-import System.Directory (createDirectoryIfMissing,- doesDirectoryExist, getHomeDirectory,- setCurrentDirectory)+import System.Directory (doesDirectoryExist) import System.Environment.XDG.UserDir (getUserDir) import System.FilePath -setDownloadDir :: Bool -> String- -> IO String -- used to present ~/<dir> to user-setDownloadDir dryrun subdir = do- home <- getHomeDirectory+checkDefaultIsoDir :: IO FilePath+checkDefaultIsoDir = do dlDir <- getUserDir "DOWNLOAD" dirExists <- doesDirectoryExist dlDir- -- is this really necessary?- unless (dryrun || dirExists) $- when (home == dlDir) $- error' "HOME directory does not exist!"- let isoDir = dlDir </> subdir+ let isoDir = dlDir </> "iso" isoExists <- doesDirectoryExist isoDir- dir <-+ return $ if isoExists- then setCWD isoDir- else- if dirExists- then setCWD dlDir- else do- if dryrun- then return dlDir- else do- 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- setCWD dir = do- setCurrentDirectory dir- return dir+ then isoDir+ else if dirExists+ then dlDir+ else "."
src/Main.hs view
@@ -12,9 +12,9 @@ #endif import Control.Exception.Extra (retry)-import Control.Monad.Extra (filterM, unless, unlessM, when, whenJust)+import Control.Monad.Extra (filterM, unless, unlessM, when, whenJust, whenM) import qualified Data.ByteString.Char8 as B-import Data.Char (isDigit)+import Data.Char (isAlphaNum, isDigit) import Data.List.Extra import Data.Ord (comparing, Down(Down)) import Data.Maybe@@ -32,7 +32,7 @@ import Paths_dl_fedora (version) -import SimpleCmd (cmd, cmd_, cmdBool, cmdN, error', grep_, logMsg,+import SimpleCmd (cmd, cmd_, cmdBool, error', grep_, logMsg, pipe_, pipeBool, pipeFile_, warning, (+-+), #if MIN_VERSION_simple_cmd(0,2,7)@@ -41,15 +41,16 @@ sudo_ #endif )-import SimpleCmdArgs+import SimpleCmdArgs hiding (str) import SimplePrompt (yesNo, yesNoDefault)-+import System.Console.Pretty (color, Color(Red,Yellow)) import System.Directory (createDirectory, doesDirectoryExist, doesFileExist,- findExecutable, getPermissions, listDirectory,- pathIsSymbolicLink, removeFile, withCurrentDirectory,+ findExecutable, getHomeDirectory, getPermissions,+ listDirectory, pathIsSymbolicLink, removeFile,+ renameFile, setCurrentDirectory, withCurrentDirectory, writable)-import System.FilePath (dropFileName, joinPath, takeExtension, takeFileName,- (</>), (<.>))+import System.FilePath (dropFileName, isAbsolute, isRelative, makeRelative,+ joinPath, takeExtension, takeFileName, (</>), (<.>)) import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus, readSymbolicLink) import System.Posix.User (getLoginName)@@ -65,13 +66,13 @@ data FedoraEdition = Cloud | Container | Everything+ | KDE | Server | Workstation | Budgie -- first spin: used below | Cinnamon | COSMIC | I3- | KDE | KDEMobile | LXDE | LXQt@@ -99,6 +100,10 @@ showEdition _ I3 = "i3" showEdition _ e = show e +showShortEdition :: Release -> FedoraEdition -> String+showShortEdition rel edition =+ if edition == KDE then "KDE" else showEdition rel edition+ lowerEdition :: FedoraEdition -> String lowerEdition = lower . show @@ -118,47 +123,52 @@ type URL = String -fedoraSpins :: [FedoraEdition]-fedoraSpins = [Budgie .. Xfce]+fedoraSpins :: Release -> [FedoraEdition]+fedoraSpins rel =+ (if fedoraVerOrLater 42 rel then id else (KDE :)) [Budgie .. Xfce] +fedoraVerOrLater :: Natural -> Release -> Bool+fedoraVerOrLater _ Rawhide = True+fedoraVerOrLater n (Fedora m) = m >= n+fedoraVerOrLater _ _ = False+ 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]+ Fedora r -> fedoraSpins rel \\ missingEditions r 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"+ CS _ False -> []+ CS _ _ -> []+ ELN -> [] allEditions :: Natural -> Natural -> Release -> [FedoraEdition] allEditions rawhide current rel = case rel of Rawhide -> allEditions rawhide current $ Fedora rawhide- Fedora r ->- [minBound..maxBound] \\ missingEditions r+ 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]+ CS _ 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+missingEditions :: Natural -> [FedoraEdition]+missingEditions r =+ case compare r 41 of+ GT -> [IoT]+ EQ -> [COSMIC]+ LT -> [COSMIC, KDEMobile, Miracle]++data RequestEditions = Editions Bool [FedoraEdition]+ | AllDesktops+ | AllSpins+ | AllEditions deriving Eq data CheckSum = AutoCheckSum | NoCheckSum | CheckSum@@ -208,6 +218,7 @@ LT -> Fedora v EQ -> Rawhide GT -> error' $ "Current rawhide is" +-+ show rawhide+ "next" -> Fedora (current + 1) "current" -> Fedora current "previous" -> Fedora (current -1) -- FIXME hardcoding@@ -244,6 +255,8 @@ sysarch <- readArch <$> cmd "rpm" ["--eval", "%{_arch}"] rawhideVersion <- getRawhideVersion currentRelease <- getCurrentFedoraVersion+ home <- getHomeDirectory+ defaultDir <- checkDefaultIsoDir simpleCmdArgsWithMods (Just version) (fullDesc <> header "Fedora iso downloader" <> progDescDoc pdoc) $ program rawhideVersion <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file"@@ -254,6 +267,7 @@ flagWith' Local 'l' "local" "Show current local image" <|> flagLongWith' List "list" "List spins and editions" <|> Download <$> switchWith 'R' "replace" "Delete previous snapshot image after downloading latest one")+ <*> strOptionalWith 'd' "dir" "DIRECTORY" ("Download directory [default:" +-+ prettyDir home defaultDir ++ "]") defaultDir <*> switchWith 'n' "dry-run" "Don't actually download anything" <*> switchWith 'r' "run" "Boot image in QEMU" <*> mirrorOpt@@ -264,14 +278,17 @@ <*> 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 rawhideVersion currentRelease <$> strArg "RELEASE")- <*> (flagLongWith' AllSpins "all-spins" "Get all Fedora Spins" <|>+ <*> (flagLongWith' AllDesktops "all-desktops" "Get all Fedora desktops" <|>+ flagLongWith' AllSpins "all-spins" "Get all Fedora Spins" <|> flagLongWith' AllEditions "all-editions" "Get all Fedora editions" <|>- Editions <$> many (argumentWith auto "EDITION..."))+ (Editions+ <$> switchWith 'x' "exclude" "Exclude specified editions"+ <*> many (argumentWith auto "EDITION..."))) where mirrorOpt :: Parser Mirror mirrorOpt = flagWith' DefaultLatest 'L' "latest" "Get latest image either from mirror or dl.fp.o if newer" <|>- flagWith' DlFpo 'd' "dl" "Use dl.fedoraproject.org (dl.fp.o)" <|>+ flagLongWith' DlFpo "dl" "Use dl.fedoraproject.org (dl.fp.o)" <|> flagWith' KojiFpo 'k' "koji" "Use koji.fedoraproject.org" <|> Mirror <$> strOptionWith 'm' "mirror" "URL" ("Mirror url for /pub [default " ++ downloadFpo ++ "]") <|> pure UseMirror@@ -285,10 +302,10 @@ primarySize :: Maybe Integer, primaryTime :: Maybe UTCTime} -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+program :: Natural -> Bool -> CheckSum -> Bool -> Bool -> Mode -> FilePath+ -> Bool -> Bool -> Mirror -> Bool -> Maybe CentosChannel+ -> Maybe String -> Arch -> Release -> RequestEditions -> IO ()+program rawhide gpg checksum debug notimeout mode dlDir 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 =@@ -305,57 +322,103 @@ else csMirror CS 8 _ -> csComposes _ -> downloadFpo- showdestdir <- setDownloadDir dryrun "iso"+ unlessM (doesDirectoryExist dlDir) $+ error' $ "No such directory:" +-+ dlDir+ setCurrentDirectory dlDir+ showdestdir <- do -- only used for output to user+ home <- getHomeDirectory+ return $ prettyDir home dlDir+ when debug $ print showdestdir mgr <- if notimeout then newManager (tlsManagerSettings {managerResponseTimeout = responseTimeoutNone}) else httpManager- unless (reqeditions == Editions []) $+ unless (reqeditions == Editions False []) $ case tgtrel of ELN -> error' "cannot specify edition for eln"- CS _ False -> error' "cannot specify edition for centos-stream"+ CS n False -> error' $ "cannot specify edition for centos-stream" +++ if n >= 9 then ": perhaps you want 'c" ++ show n ++ "s-live'?" else "" _ -> return () when (isJust mcsedition) $ case tgtrel of CS n True | n >= 9 -> case reqeditions of- Editions [] -> return ()+ Editions False [] -> 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) $+ successes <-+ 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+ AllDesktops -> Workstation : allSpins rawhide current tgtrel AllEditions -> allEditions rawhide current tgtrel AllSpins -> allSpins rawhide current tgtrel- Editions editions ->+ Editions False editions -> if null editions then [Workstation] else editions+ Editions True [] -> error' "cannot exclude zero editions"+ Editions True editions ->+ allEditions rawhide current tgtrel \\ editions+ let failures = length $ filter not successes+ when (failures > 0) $ error' $ plural failures "download" +-+ "failed" +prettyDir :: FilePath -> FilePath -> FilePath+prettyDir home dir =+ let path = makeRelative home dir+ in if isAbsolute dir && isRelative path then "~" </> path else dir++-- from fbrnch Common+plural :: Int -> String -> String+plural i ns =+ pluralException i Nothing ns (ns ++ "s")++pluralException :: Int -> Maybe String -> String -> String -> String+pluralException 0 (Just z) _ _ = z+pluralException i _ ns ps =+ mconcat+ [+ if i == 0 then "no" else show i,+ " ",+ if i == 1 then ns else ps+ ]++multipleEditions :: RequestEditions -> Bool+multipleEditions req =+ case req of+ Editions _ es -> length es > 1+ _ -> True+ runProgramEdition :: Manager -> URL -> String -> Bool -> CheckSum -> Bool -> Mode -> Bool -> Bool -> Mirror -> Bool -> Maybe CentosChannel -> Maybe String -> Arch -> Release- -> RequestEditions -> FedoraEdition -> IO ()+ -> RequestEditions -> FedoraEdition -> IO Bool 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 True- if done- then do- putStrLn $ "Local:" +-+ takeFileName fileurl +-+ "is latest"- when debug $ print fileurl- else do- let symlink = filenamePrefix <> (if tgtrel == ELN then "-" <> showArch arch else "") <> "-latest" <.> takeExtension fileurl- mtarget <- derefSymlink symlink- case mtarget of- Just target -> do- if target == takeFileName fileurl- then putStrLn $ "Latest:" +-+ target +-+ "(locally incomplete)"- else do- putStrLn $ "Local:" +-+ target- putStrLn $ "Newer:" +-+ takeFileName fileurl- Nothing -> putStrLn $ "Available:" +-+ takeFileName fileurl+ eres <- findURL True+ case eres of+ Left err -> do+ (if multipleEditions reqeditions then warning else error') err+ return False+ Right (fileurl, filenamePrefix, _prime, _mchecksum, done) -> do+ if done+ then do+ putStrLn $ "Local:" +-+ takeFileName fileurl +-+ "is latest"+ when debug $ print fileurl+ else do+ let symlink = filenamePrefix <> (if tgtrel == ELN then "-" <> showArch arch else "") <> "-latest" <.> takeExtension fileurl+ mtarget <- derefSymlink symlink+ case mtarget of+ Just target -> do+ if target == takeFileName fileurl+ then putStrLn $ "Latest:" +-+ target +-+ "(locally incomplete)"+ else do+ putStrLn $ "Local:" +-+ target+ putStrLn $ "Newer:" +-+ takeFileName fileurl+ Nothing -> putStrLn $ "Available:" +-+ takeFileName fileurl+ return True Local -> do prefix <- getFilePrefix -- FIXME support non-iso@@ -365,11 +428,13 @@ putStrLn $ "Local:" +-+ target when run $ bootImage dryrun target showdestdir+ return True List -> do rawhide <- getRawhideVersion current <- getCurrentFedoraVersion let editions = case reqeditions of+ AllDesktops -> Workstation : allSpins rawhide current tgtrel AllSpins -> allSpins rawhide current tgtrel _ -> allEditions rawhide current tgtrel extras =@@ -377,19 +442,26 @@ CS _ True -> ["max","min"] _ -> [] putStrLn $ unwords $ sort (map lowerEdition editions) ++ extras+ return True Download removeold -> do- (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 fileurl mchecksum- unless dryrun $ do- let localfile = takeFileName fileurl- updateSymlink localfile symlink removeold- when run $ bootImage dryrun localfile showdestdir+ eres <- findURL False+ case eres of+ Left err -> do+ (if multipleEditions reqeditions then warning else error') err+ return False+ Right (fileurl, filenamePrefix, prime, mchecksum, done) -> do+ let symlink = filenamePrefix <> (if tgtrel == ELN then "-" <> showArch arch else "") <> "-latest" <.> takeExtension fileurl+ downloadFile dryrun debug done mgr fileurl prime showdestdir >>=+ fileChecksum fileurl mchecksum+ unless dryrun $ do+ let localfile = takeFileName fileurl+ updateSymlink localfile symlink removeold+ when run $ bootImage dryrun localfile showdestdir+ return True where findURL :: Bool -- urlpath, fileprefix, primary, checksum, downloaded- -> IO (URL, String, Primary, Maybe String, Bool)+ -> IO (Either String (URL, String, Primary, Maybe String, Bool)) findURL quiet = do (path,mrelease) <- urlPathMRel let path' = trailingSlash path@@ -414,7 +486,7 @@ fileslen = groupSortOn length $ filter selector $ map T.unpack hrefs mchecksum = find ((if tgtrel == FedoraRespin then T.isPrefixOf else T.isSuffixOf) (T.pack "CHECKSUM")) hrefs case fileslen of- [] -> error' $ "no match for " <> prefixPat <> " in " <> primeDir+ [] -> return $ Left $ "**" +-+ color Red "no match" +-+ "for" +-+ color Red prefixPat +-+ "in" +-+ primeDir (files:_) -> do when (length files > 1) $ mapM_ putStrLn files let file = last files@@ -445,8 +517,9 @@ 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)+ return $ Right+ (finalurl, prefix, Primary primeUrl primeSize primeTime,+ (finalDir +/+) . T.unpack <$> mchecksum, already) where getUrlDirectory :: String -> FilePath -> IO (String, [T.Text]) getUrlDirectory top path = do@@ -528,9 +601,9 @@ urlPathMRel :: IO (FilePath, Maybe String) urlPathMRel = do let subdir =- if edition `elem` fedoraSpins+ if edition `elem` fedoraSpins tgtrel then joinPath ["Spins", showArch arch, "iso"]- else joinPath [showEdition tgtrel edition, showArch arch, editionMedia edition]+ else joinPath [showShortEdition tgtrel edition, showArch arch, editionMedia edition] case tgtrel of FedoraRespin -> return ("alt/live-respins", Nothing) Rawhide -> return ("fedora/linux/development/rawhide" +/+ subdir, Just "Rawhide")@@ -642,16 +715,11 @@ kiwiSpins = -- https://fedoraproject.org/wiki/Changes/EROFSforLiveMedia (if fedoraVerOrLater 42 tgtrel- then [Budgie, COSMIC, KDE, LXQt, Workstation, Xfce]+ then [Budgie, COSMIC, KDE, LXQt, SoaS, 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"@@ -798,17 +866,28 @@ then return Nothing else do tz <- getCurrentTimeZone- putStrLn $ unwords ["downloading", takeFileName url, renderTime tz mtime, "to", showdestdir]+ putStrLn $ unwords ["downloading", filename, renderTime tz mtime, "to", showdestdir] doCurl return (Just True) where+ filename = takeFileName url+ doCurl = do- ok <- curl debug ["--fail", "--remote-name", url]- unless ok $ do- yes <- yesNoDefault True "retry download"- if yes- then doCurl- else error' "download failed"+ let subdir = ".dl-fedora-partial"+ whenM (doesFileExist filename) $ do+ partial <- doesFileExist $ subdir </> filename+ if partial+ then warning $ color Yellow "2 partials downloads exist! - better to remove one"+ else renameFile filename (subdir </> filename)+ ok <- curl debug ["--create-dirs", "--output-dir", subdir, "--fail", "--remote-name", url]+ unless ok $ do+ yes <- yesNoDefault True "retry download"+ if yes+ then doCurl+ else error' "download failed"+ whenM (doesFileExist filename) $+ error' $ color Red "file already exists" ++ ": not moving" +-+ subdir </> filename+ renameFile (subdir </> filename) filename editionMedia :: FedoraEdition -> String editionMedia Cloud = "images"@@ -830,11 +909,25 @@ mQemu <- findExecutable "qemu-kvm" case mQemu of Just qemu -> do- let args = ["-m", "3072", "-rtc", "base=localtime", "-cpu", "host"] ++ fileopts- cmdN qemu (args ++ [showdir </> img])+ let args = ["-m", "4096", "-rtc", "base=localtime", "-cpu", "host"] ++ fileopts+ -- replace with showCommandForUser or cmdN when updated+ putStrLn . unwords $ qemu : map translateInternal (args ++ [showdir </> img]) unless dryrun $ cmd_ qemu (args ++ [img]) Nothing -> error' "Need qemu to run image"++-- from process System.Process.Posix+translateInternal :: String -> String+translateInternal "" = "''"+translateInternal str+ -- goodChar is a pessimistic predicate, such that if an argument is+ -- non-empty and only contains goodChars, then there is no need to+ -- do any quoting or escaping+ | all goodChar str = str+ | otherwise = '\'' : foldr escape "'" str+ where escape '\'' = showString "'\\''"+ escape c = showChar c+ goodChar c = isAlphaNum c || c `elem` "-_.,/" #if !MIN_VERSION_http_directory(0,1,6) noTrailingSlash :: T.Text -> T.Text
test/tests.hs view
@@ -1,6 +1,7 @@ import Control.Monad (forM_, unless) import Data.List (sort) import Data.Maybe+import Distribution.Fedora.Release (getCurrentFedoraVersion, getRawhideVersion) import Numeric.Natural (Natural) import System.Environment (lookupEnv) import SimpleCmd@@ -8,28 +9,24 @@ dlFedora :: Bool -> [String] -> IO () dlFedora ghAction args = putStrLn "" >> cmdLog "dl-fedora"- ((if ghAction then ("-d" :) . ("-T" :) else id) args)---- FIXME automate me-branched :: Int-branched = 42-current, previous :: String-current = show branched-previous = show (branched - 1)+ ((if ghAction then ("--dl" :) . ("-T" :) else id) args) -tests :: Bool -> [[String]]-tests ghAction =+tests :: Bool -> Natural -> Natural -> [[String]]+tests ghAction rawhide oldest =+ let latest = show $ rawhide - 1+ previous = show $ rawhide - 2+ in [["-n", previous, "--checksum"] ,["-n", "rawhide", "silverblue"] ,["-c", "respin"]- ,["-l", current]+ ,["-l", latest] ,["-l", "rawhide", "-n"] ,["-n", previous, "kde"] ] ++ if ghAction then [] else- [["-c", current, "silverblue"]- ,["-T", "-n", current, "everything"]+ [["-c", latest, "silverblue"]+ ,["-T", "-n", latest, "everything"] ,["-n", previous, "server", "--dvd", "--arch", "aarch64"] ,["41", "iot", "-n"] ,["-n", "c8s"]@@ -38,15 +35,24 @@ ,["-c", "eln"] ,["-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"]+ ]+ +++ allFedoraEditions oldest rawhide+ +++ [["--dl", "-T", "-n", "respin", "--all-desktops"]+ ,["-T", "-n", "c9s-live", "--all-desktops"] ,["-T", "-n", "c10s-live", "--all-editions"] ] +allFedoraEditions :: Natural -> Natural -> [[String]]+allFedoraEditions oldest rawhide =+ let mkFedEd rel = ["--dl", "-T", "-n", show rel, "--all-editions"]+ in+ map mkFedEd [oldest..(rawhide-1)]+ +++ -- currently MATE is broken in Rawhide+ [["--dl", "-T", "-n", show rawhide, "--exclude", "mate"]]+ allEditions :: Natural -> [String] allEditions 9 = allEditions 10 ++ ["cinnamon", "mate", "xfce"] allEditions 10 = ["workstation", "kde", "max", "min"]@@ -64,9 +70,13 @@ main :: IO () main = do- forM_ [40..43] listEditions- forM_ [9..10] listEditions ghAction <- isJust <$> lookupEnv "GITHUB_ACTIONS"- let cases = tests ghAction+ current <- getCurrentFedoraVersion+ rawhide <- getRawhideVersion+ let oldest = current -1+ unless ghAction $ do+ forM_ [oldest..rawhide] listEditions+ forM_ [9..10] listEditions+ let cases = tests ghAction rawhide oldest mapM_ (dlFedora ghAction) cases putStrLn $ show (length cases) ++ " tests ran"