dl-fedora 0.9 → 0.9.1
raw patch · 5 files changed
+117/−80 lines, 5 files
Files
- CHANGELOG.md +5/−0
- dl-fedora.cabal +4/−2
- src/DownloadDir.hs +42/−0
- src/Main.hs +60/−72
- test/tests.hs +6/−6
CHANGELOG.md view
@@ -1,8 +1,13 @@ # Changelog +## 0.9.1 (2021-08-30)+- new Kinoite edition for F35+- initial Centos Stream "c9s" target for production boot images+ ## 0.9 (2021-04-22) - edition is now an argument after release, not an option - --local --dryrun only accesses local files now for speed+- add '--no-http-timeout' (mostly for CI) ## 0.8 (2021-04-07) - --local option: print (or --run) current local image instead of newer download
dl-fedora.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: dl-fedora-version: 0.9+version: 0.9.1 synopsis: Fedora image download tool description: Tool to download Fedora iso and image files -- can change to GPL-3.0-or-later with Cabal-2.2@@ -25,8 +25,10 @@ location: https://github.com/juhp/dl-fedora.git executable dl-fedora- main-is: src/Main.hs+ hs-source-dirs: src+ main-is: Main.hs other-modules: Paths_dl_fedora+ DownloadDir build-depends: base < 5, bytestring,
+ src/DownloadDir.hs view
@@ -0,0 +1,42 @@+module DownloadDir (+ setDownloadDir)+where++import Control.Monad+import SimpleCmd (error')+import System.Directory (createDirectoryIfMissing,+ doesDirectoryExist, getHomeDirectory,+ setCurrentDirectory)+import System.Environment.XDG.UserDir (getUserDir)+import System.FilePath++setDownloadDir :: Bool -> String -> IO FilePath+setDownloadDir dryrun subdir = do+ home <- getHomeDirectory+ 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+ isoExists <- doesDirectoryExist isoDir+ dir <-+ 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+ return $ if isRelative path then "~" </> path else path+ where+ setCWD :: FilePath -> IO FilePath+ setCWD dir = do+ setCurrentDirectory dir+ return dir
src/Main.hs view
@@ -32,14 +32,12 @@ removePrefix) import SimpleCmdArgs -import System.Directory (createDirectory, createDirectoryIfMissing,- doesDirectoryExist, doesFileExist, findExecutable,- getHomeDirectory, getPermissions, listDirectory,- removeFile, setCurrentDirectory, withCurrentDirectory,+import System.Directory (createDirectory, doesDirectoryExist, doesFileExist,+ findExecutable, getPermissions,+ listDirectory, removeFile, withCurrentDirectory, writable)-import System.Environment.XDG.UserDir (getUserDir)-import System.FilePath (dropFileName, isRelative , joinPath, makeRelative,- takeExtension, takeFileName, (<.>))+import System.FilePath (dropFileName, joinPath, takeExtension, takeFileName,+ (</>), (<.>)) import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus, readSymbolicLink) @@ -48,9 +46,12 @@ import qualified Text.ParserCombinators.ReadPrec as RP import Text.Regex.Posix +import DownloadDir+ data FedoraEdition = Cloud | Container | Everything+ | Kinoite | Server | Silverblue | Workstation@@ -91,17 +92,19 @@ data CheckSum = AutoCheckSum | NoCheckSum | CheckSum deriving Eq -dlFpo, downloadFpo, kojiPkgs, odcsFpo :: String+dlFpo, downloadFpo, kojiPkgs, odcsFpo, c9sComposes, odcsStream :: String dlFpo = "https://dl.fedoraproject.org/pub" downloadFpo = "https://download.fedoraproject.org/pub" kojiPkgs = "https://kojipkgs.fedoraproject.org/compose" odcsFpo = "https://odcs.fedoraproject.org/composes"+c9sComposes = "https://composes.stream.centos.org"+odcsStream = "https://odcs.stream.centos.org" 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", "or koji"]),+ P.text ("RELEASE = " <> intercalate ", " ["release number", "respin", "rawhide", "test (Beta)", "stage (RC)", "eln", "c9s", "or koji"]), 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://fedoraproject.org/wiki/Infrastructure/MirrorManager>",@@ -137,11 +140,11 @@ case mmirror of Nothing | tgtrel == "koji" -> kojiPkgs Nothing | tgtrel == "eln" -> odcsFpo+ Nothing | tgtrel == "c9s" -> c9sComposes Nothing -> downloadFpo Just _ | tgtrel == "koji" -> error' "Cannot specify mirror for koji" Just m -> m- home <- getHomeDirectory- showdestdir <- setDownloadDir home+ showdestdir <- setDownloadDir dryrun "iso" mgr <- if notimeout then newManager (tlsManagerSettings {managerResponseTimeout = responseTimeoutNone}) else httpManager@@ -168,34 +171,9 @@ updateSymlink localfile symlink showdestdir when run $ bootImage localfile showdestdir where- setDownloadDir home = do- dlDir <- getUserDir "DOWNLOAD"- dirExists <- doesDirectoryExist dlDir- unless (dryrun || dirExists) $- when (home == dlDir) $- error' "HOME directory does not exist!"- let isoDir = dlDir </> "iso"- isoExists <- doesDirectoryExist isoDir- 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- where- setCWD :: FilePath -> IO FilePath- setCWD dir = do- setCurrentDirectory dir- let path = makeRelative home dir- return $ if isRelative path then "~" </> path else path-- -- urlpath, fileprefix, (master,size), checksum, downloaded- findURL :: Manager -> String -> String -> IO (URL, String, (URL,Maybe Integer), Maybe String, Bool)+ findURL :: Manager -> String -> String+ -- urlpath, fileprefix, (master,size), checksum, downloaded+ -> IO (URL, String, (URL,Maybe Integer), Maybe String, Bool) findURL mgr mirror showdestdir = do (path,mrelease) <- urlPathMRel mgr -- use http-directory trailingSlash (0.1.7)@@ -203,7 +181,8 @@ (case tgtrel of "koji" -> kojiPkgs "eln" -> odcsFpo- _ -> dlFpo) </> path <> "/"+ "c9s" -> odcsStream+ _ -> dlFpo) +/+ path <> "/" hrefs <- httpDirectory mgr masterDir let prefixPat = makeFilePrefix mrelease selector = if '*' `elem` prefixPat then (=~ prefixPat) else (prefixPat `isPrefixOf`)@@ -216,7 +195,7 @@ let prefix = if '*' `elem` prefixPat then (file =~ prefixPat) ++ if arch `isInfixOf` prefixPat then "" else arch else prefixPat- masterUrl = masterDir </> file+ masterUrl = masterDir +/+ file masterSize <- httpFileSize mgr masterUrl (finalurl, already) <- do let localfile = takeFileName masterUrl@@ -235,7 +214,7 @@ unless (run && already || local) $ maybe (return ()) putStrLn $ showMSize masterSize <> showMDate mlocaltime let finalDir = dropFileName finalurl- return (finalurl, prefix, (masterUrl,masterSize), (finalDir </>) . T.unpack <$> mchecksum, already)+ return (finalurl, prefix, (masterUrl,masterSize), (finalDir +/+) . T.unpack <$> mchecksum, already) where httpTimestamp url = do mUtc <- httpLastModified mgr url@@ -250,11 +229,11 @@ url <- if mirror `elem` [dlFpo,kojiPkgs,odcsFpo] then return masterUrl else- if mirror /= downloadFpo then return $ mirror </> path+ if mirror /= downloadFpo then return $ mirror +/+ path +/+ file else do- redir <- httpRedirect mgr $ mirror </> path </> file+ redir <- httpRedirect mgr $ mirror +/+ path +/+ file case redir of- Nothing -> error' $ mirror </> path </> file <> " redirect failed"+ Nothing -> error' $ mirror +/+ path +/+ file <> " redirect failed" Just u -> do let url = B.unpack u exists <- httpExists mgr url@@ -284,6 +263,7 @@ "rawhide" -> Just "Rawhide" "respin" -> Nothing "eln" -> Nothing+ "c9s" -> Nothing rel | all isDigit rel -> Just rel _ -> error' $ tgtrel ++ " is unsupported with --dryrun" @@ -310,53 +290,53 @@ else joinPath [showEdition edition, arch, editionMedia edition] case tgtrel of "respin" -> return ("alt/live-respins", Nothing)- "rawhide" -> return ("fedora/linux/development/rawhide" </> subdir, Just "Rawhide")+ "rawhide" -> return ("fedora/linux/development/rawhide" +/+ subdir, Just "Rawhide") "test" -> testRelease mgr subdir "stage" -> stageRelease mgr subdir- "eln" -> return ("production/latest-Fedora-ELN/compose" </> "Everything" </> arch </> "iso", Nothing)+ "eln" -> return ("production/latest-Fedora-ELN/compose" +/+ "Everything" +/+ arch +/+ "iso", Nothing)+ "c9s" -> return ("production/latest-CentOS-Stream/compose" +/+ "BaseOS" +/+ arch +/+ "iso", Nothing) "koji" -> kojiCompose mgr subdir rel | all isDigit rel -> released mgr rel subdir _ -> error' "Unknown release" testRelease :: Manager -> FilePath -> IO (FilePath, Maybe String) testRelease mgr subdir = do- let path = "fedora/linux" </> "releases/test"- url = dlFpo </> path- -- use http-directory-0.1.7 noTrailingSlash- rels <- map (T.unpack . T.dropWhileEnd (== '/')) <$> httpDirectory mgr url+ let path = "fedora/linux" +/+ "releases/test"+ url = dlFpo +/+ path+ rels <- map (T.unpack . noTrailingSlash) <$> httpDirectory mgr url let mrel = listToMaybe rels- return (path </> fromMaybe (error' ("test release not found in " <> url)) mrel </> subdir, mrel)+ return (path +/+ fromMaybe (error' ("test release not found in " <> url)) mrel +/+ subdir, mrel) stageRelease :: Manager -> FilePath -> IO (FilePath, Maybe String) stageRelease mgr subdir = do let path = "alt/stage"- url = dlFpo </> path+ url = dlFpo +/+ path -- use http-directory-0.1.7 noTrailingSlash- rels <- reverse . map (T.unpack . T.dropWhileEnd (== '/')) <$> httpDirectory mgr url+ rels <- reverse . map (T.unpack . noTrailingSlash) <$> httpDirectory mgr url let mrel = listToMaybe rels- return (path </> fromMaybe (error' ("staged release not found in " <> url)) mrel </> subdir, takeWhile (/= '_') <$> mrel)+ return (path +/+ fromMaybe (error' ("staged release not found in " <> url)) mrel +/+ subdir, takeWhile (/= '_') <$> mrel) kojiCompose :: Manager -> FilePath -> IO (FilePath, Maybe String) kojiCompose mgr subdir = do let path = "branched"- url = kojiPkgs </> path+ url = kojiPkgs +/+ path prefix = "latest-Fedora-" latest <- filter (prefix `isPrefixOf`) . map T.unpack <$> 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 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 let dir = "fedora/linux/releases"- url = dlFpo </> dir- exists <- httpExists mgr $ url </> rel- if exists then return (dir </> rel </> subdir, Just rel)+ url = dlFpo +/+ dir+ exists <- httpExists mgr $ 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- if exists' then return (dir' </> rel </> subdir, Just rel)+ url' = dlFpo +/+ dir'+ exists' <- httpExists mgr $ url' +/+ rel+ if exists' then return (dir' +/+ rel +/+ subdir, Just rel) else error' "release not found in releases/ or development/" makeFilePrefix :: Maybe String -> String@@ -364,6 +344,7 @@ case tgtrel of "respin" -> "F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64" <> "-LIVE" "eln" -> "Fedora-ELN-Rawhide"+ "c9s" -> "CentOS-Stream-9" _ -> let showRel r = if last r == '/' then init r else r rel = maybeToList (showRel <$> mrelease)@@ -437,7 +418,7 @@ else do masterSize <- httpFileSize mgr url ok <- checkLocalFileSize checksumfile masterSize showdestdir- unless ok $ error' "Checksum file filesize mismatch"+ unless ok $ error' $ "Checksum file filesize mismatch for " ++ checksumfile return ok checkForFedoraKeys :: IO Bool@@ -483,6 +464,7 @@ editionType :: FedoraEdition -> String editionType Server = "dvd"+editionType Kinoite = "ostree" editionType Silverblue = "ostree" editionType Everything = "netinst" editionType Cloud = "Base"@@ -497,14 +479,6 @@ liveRespin :: FedoraEdition -> String liveRespin = take 4 . upper . showEdition -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- bootImage :: FilePath -> String -> IO () bootImage img showdir = do let fileopts =@@ -518,3 +492,17 @@ cmdN qemu (args ++ [showdir </> img]) cmd_ qemu (args ++ [img]) Nothing -> error' "Need qemu to run image"++#if !MIN_VERSION_http_directory(0,1,6)+noTrailingSlash :: T.Text -> T.Text+noTrailingSlash = T.dropWhileEnd (== '/')+#endif++-- 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
test/tests.hs view
@@ -9,18 +9,18 @@ tests :: Bool -> [[String]] tests ghAction =- [["-n", "33", "-c"]+ [["-n", "34", "-c"] ,["-n", "rawhide", "silverblue"] ,["-n", "respin"]- ,["-l", "34"]+ ,["-l", "35"] ,["-l", "rawhide", "-n"] ] ++ if ghAction then [] else- [["-n", "34", "silverblue"]- ,["-n", "32", "kde"]- ,["-T", "-n", "33", "everything"]- ,["-n", "33", "server", "--arch", "aarch64"]+ [["-n", "35", "silverblue"]+ ,["-n", "33", "kde"]+ ,["-T", "-n", "34", "everything"]+ ,["-n", "34", "server", "--arch", "aarch64"] ] main :: IO ()