dl-fedora 0.8 → 0.9
raw patch · 5 files changed
+96/−46 lines, 5 filesdep +http-clientdep +http-client-tls
Dependencies added: http-client, http-client-tls
Files
- CHANGELOG.md +4/−0
- README.md +5/−6
- dl-fedora.cabal +4/−2
- src/Main.hs +61/−25
- test/tests.hs +22/−13
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog +## 0.9 (2021-04-22)+- edition is now an argument after release, not an option+- --local --dryrun only accesses local files now for speed+ ## 0.8 (2021-04-07) - --local option: print (or --run) current local image instead of newer download - improve --dryrun Downloads/ handling for testsuite in CI
README.md view
@@ -1,6 +1,5 @@ # dl-fedora -[](https://github.com/juhp/dl-fedora/actions) [](https://hackage.haskell.org/package/dl-fedora) [](LICENSE) [](http://stackage.org/lts/package/dl-fedora)@@ -13,22 +12,22 @@ `dl-fedora rawhide` : downloads the latest Fedora Rawhide Workstation Live iso -`dl-fedora -e silverblue 34` : downloads the Fedora Silverblue iso+`dl-fedora 34 silverblue` : downloads the Fedora Silverblue iso -`dl-fedora -e kde respin` : downloads the latest KDE Live respin+`dl-fedora respin kde` : downloads the latest KDE Live respin -`dl-fedora --edition server --arch aarch64 33` : will bring down the F33 Server iso for armv8+`dl-fedora 33 server --arch aarch64` : will bring down the F33 Server iso for armv8 `dl-fedora --run 34` : will download Fedora 34 Workstation and boot the Live image with qemu-kvm. -`dl-fedora --local rawhide` : shows the current locally available image (as well as the latest one).+`dl-fedora --local rawhide` : shows the current locally available image (as well as the latest one). With `--dryrun` it doesn't check for newest iso. By default dl-fedora downloads to `~/Downloads/` (correctly the XDG user "DOWNLOADS" directory), but if you create `~/Downloads/iso/` it will use that directory instead. If the image is already found to be downloaded-it will not be downloaded again of course.+it will not be re-downloaded of course. Curl is used to do the downloading: partial downloads will continue. A symlink to the latest iso is also created:
dl-fedora.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: dl-fedora-version: 0.8+version: 0.9 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@@ -15,7 +15,7 @@ build-type: Simple extra-doc-files: README.md , CHANGELOG.md-tested-with: GHC == 8.10.3,+tested-with: GHC == 8.10.4, GHC == 8.8.4, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3, GHC == 7.8.4, GHC == 7.6.3, GHC == 7.4.2@@ -33,6 +33,8 @@ directory >= 1.2.5, extra, filepath,+ http-client,+ http-client-tls, http-directory == 0.1.5 || >= 0.1.8, http-types, optparse-applicative,
src/Main.hs view
@@ -18,6 +18,9 @@ import qualified Data.Text as T import Data.Time.LocalTime (utcToLocalZonedTime) +import Network.HTTP.Client (managerResponseTimeout, newManager,+ responseTimeoutNone)+import Network.HTTP.Client.TLS import Network.HTTP.Directory import Options.Applicative (fullDesc, header, progDescDoc)@@ -99,7 +102,7 @@ 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 "EDITION = " <> P.lbrace <> P.align (P.fillCat (P.punctuate P.comma (map (P.text . lowerEdition) [(minBound :: FedoraEdition)..maxBound])) <> P.rbrace),+ 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>", P.text "and also <https://fedoramagazine.org/verify-fedora-iso-file>."@@ -109,13 +112,14 @@ <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file" <*> checkSumOpts <*> switchWith 'n' "dry-run" "Don't actually download anything"+ <*> switchWith 'T' "no-http-timeout" "Do not timeout for http response" <*> switchWith 'l' "local" "Show current local image via symlink" <*> switchWith 'r' "run" "Boot image in Qemu" <*> switchWith 'R' "replace" "Delete old image after downloading new one" <*> optional mirrorOpt <*> strOptionalWith 'a' "arch" "ARCH" "Architecture [default: x86_64]" "x86_64"- <*> optionalWith auto 'e' "edition" "EDITION" "Fedora edition [default: workstation]" Workstation <*> strArg "RELEASE"+ <*> (fromMaybe Workstation <$> optional (argumentWith auto "EDITION")) where mirrorOpt :: Parser String mirrorOpt =@@ -127,8 +131,8 @@ flagWith' NoCheckSum 'C' "no-checksum" "Do not check checksum" <|> flagWith AutoCheckSum CheckSum 'c' "checksum" "Do checksum even if already downloaded" -program :: Bool -> CheckSum -> Bool -> Bool -> Bool -> Bool -> Maybe String -> String -> FedoraEdition -> String -> IO ()-program gpg checksum dryrun local run removeold mmirror arch edition tgtrel = do+program :: Bool -> CheckSum -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe String -> String -> String -> FedoraEdition -> IO ()+program gpg checksum dryrun notimeout local run removeold mmirror arch tgtrel edition = do let mirror = case mmirror of Nothing | tgtrel == "koji" -> kojiPkgs@@ -137,23 +141,29 @@ Just _ | tgtrel == "koji" -> error' "Cannot specify mirror for koji" Just m -> m home <- getHomeDirectory- dlDir <- setDownloadDir home- mgr <- httpManager- let showdestdir =- let path = makeRelative home dlDir in- if isRelative path then "~" </> path else path- (fileurl, filenamePrefix, (masterUrl,masterSize), mchecksum, done) <- findURL mgr mirror showdestdir- unless local $- downloadFile done mgr fileurl (masterUrl,masterSize) >>= fileChecksum mgr mchecksum showdestdir- unless dryrun $ do- let symlink = filenamePrefix <> (if tgtrel == "eln" then "-" <> arch else "") <> "-latest" <.> takeExtension fileurl- if local- then if run- then bootImage symlink showdestdir- else do- putStrLn $ "Latest: " ++ takeFileName fileurl ++ "\n"- showSymlink symlink showdestdir+ showdestdir <- setDownloadDir home+ mgr <- if notimeout+ then newManager (tlsManagerSettings {managerResponseTimeout = responseTimeoutNone})+ else httpManager+ if local+ then do+ symlink <- if dryrun+ then do+ filePrefix <- getFilePrefix showdestdir+ -- FIXME support non-iso+ return $ filePrefix <> (if tgtrel == "eln" then "-" <> arch else "") <> "-latest" <.> "iso" else do+ (fileurl, filenamePrefix, (_masterUrl,_masterSize), _mchecksum, _done) <- findURL mgr mirror showdestdir+ putStrLn $ "Newest " ++ takeFileName fileurl ++ "\n"+ return $ filenamePrefix <> (if tgtrel == "eln" then "-" <> arch else "") <> "-latest" <.> takeExtension fileurl+ if run+ then bootImage symlink showdestdir+ else showSymlink symlink showdestdir+ else do+ (fileurl, filenamePrefix, (masterUrl,masterSize), mchecksum, done) <- findURL mgr mirror showdestdir+ let symlink = filenamePrefix <> (if tgtrel == "eln" then "-" <> arch else "") <> "-latest" <.> takeExtension fileurl+ downloadFile done mgr fileurl (masterUrl,masterSize) >>= fileChecksum mgr mchecksum showdestdir+ unless dryrun $ do let localfile = takeFileName fileurl updateSymlink localfile symlink showdestdir when run $ bootImage localfile showdestdir@@ -177,11 +187,12 @@ else do createDirectoryIfMissing True dlDir setCWD dlDir-- setCWD :: FilePath -> IO FilePath- setCWD dir = do- setCurrentDirectory dir- return dir+ 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)@@ -250,6 +261,31 @@ if exists then return url else return masterUrl 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 arch `isInfixOf` prefixPat then "" else arch+ else prefixPat+ return prefix++ getRelease :: Maybe String+ getRelease =+ case tgtrel of+ "rawhide" -> Just "Rawhide"+ "respin" -> Nothing+ "eln" -> Nothing+ rel | all isDigit rel -> Just rel+ _ -> error' $ tgtrel ++ " is unsupported with --dryrun" checkLocalFileSize localfile masterSize showdestdir = do localsize <- toInteger . fileSize <$> getFileStatus localfile
test/tests.hs view
@@ -1,22 +1,31 @@+import Data.Maybe+import System.Environment (lookupEnv) import SimpleCmd -dlFedora :: [String] -> IO ()-dlFedora args =- putStrLn "" >> cmdLog "dl-fedora" args+dlFedora :: Bool -> [String] -> IO ()+dlFedora ghAction args =+ putStrLn "" >> cmdLog "dl-fedora"+ ((if ghAction then ("-T" :) else id) args) -tests :: [[String]]-tests =+tests :: Bool -> [[String]]+tests ghAction = [["-n", "33", "-c"]- ,["-n", "rawhide", "-e", "silverblue"]- ,["-n", "34", "-e", "silverblue"]+ ,["-n", "rawhide", "silverblue"] ,["-n", "respin"]- ,["-n", "32", "-e", "kde"]- ,["-n", "33", "-e", "everything"]- ,["-n", "33", "-e", "server", "--arch", "aarch64"] ,["-l", "34"]- ]+ ,["-l", "rawhide", "-n"]+ ] +++ if ghAction then []+ else+ [["-n", "34", "silverblue"]+ ,["-n", "32", "kde"]+ ,["-T", "-n", "33", "everything"]+ ,["-n", "33", "server", "--arch", "aarch64"]+ ] main :: IO () main = do- mapM_ dlFedora tests- putStrLn $ show (length tests) ++ " tests run"+ ghAction <- isJust <$> lookupEnv "GITHUB_ACTIONS"+ let cases = tests ghAction+ mapM_ (dlFedora ghAction) cases+ putStrLn $ show cases ++ " tests run"