diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,5 @@ # dl-fedora -[![GitHub CI](https://github.com/juhp/dl-fedora/workflows/build/badge.svg)](https://github.com/juhp/dl-fedora/actions) [![Hackage](https://img.shields.io/hackage/v/dl-fedora.svg)](https://hackage.haskell.org/package/dl-fedora) [![GPL-3 license](https://img.shields.io/badge/license-GPL--3-blue.svg)](LICENSE) [![Stackage Lts](http://stackage.org/package/dl-fedora/badge/lts)](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: 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.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, diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 ", P.text "and also ." @@ -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 diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -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"