diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/dl-fedora.cabal b/dl-fedora.cabal --- a/dl-fedora.cabal +++ b/dl-fedora.cabal @@ -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, diff --git a/src/DownloadDir.hs b/src/DownloadDir.hs new file mode 100644 --- /dev/null +++ b/src/DownloadDir.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 ", @@ -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 diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -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 ()