diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,8 @@ # Changelog +## 0.9.3 (2022-06-11) +- show timestamp of image + ## 0.9.2 (2021-10-01) - fix test (beta) image selection to be the latest version diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -12,13 +12,13 @@ `dl-fedora rawhide` : downloads the latest Fedora Rawhide Workstation Live iso -`dl-fedora 35 silverblue` : downloads the Fedora Silverblue iso +`dl-fedora 36 silverblue` : downloads the Fedora Silverblue iso `dl-fedora respin kde` : downloads the latest KDE Live respin -`dl-fedora 34 server --arch aarch64` : will bring down the Server iso for armv8 +`dl-fedora 35 server --arch aarch64` : will download the Server iso for armv8 -`dl-fedora --run 35` : will download Fedora Workstation and boot the Live image with qemu-kvm. +`dl-fedora --run 36` : will download Fedora 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). With `--dryrun` it doesn't check for newest iso. 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.2 +version: 0.9.3 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 @@ -10,15 +10,14 @@ bug-reports: https://github.com/juhp/dl-fedora/issues author: Jens Petersen maintainer: juhpetersen@gmail.com -copyright: 2019-2021 Jens Petersen +copyright: 2019-2022 Jens Petersen category: Utility build-type: Simple extra-doc-files: README.md , CHANGELOG.md -tested-with: GHC == 8.10.4, +tested-with: GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.3 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 + GHC == 8.0.2, GHC == 7.10.3 source-repository head type: git @@ -37,7 +36,7 @@ filepath, http-client, http-client-tls, - http-directory == 0.1.5 || >= 0.1.8, + http-directory >= 0.1.10, http-types, optparse-applicative, regex-posix, @@ -65,4 +64,4 @@ ghc-options: -Wall build-depends: base >= 4 && < 5 , simple-cmd - build-tools: dl-fedora + build-tool-depends: dl-fedora:dl-fedora diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -16,7 +16,8 @@ import Data.List.Extra import Data.Maybe import qualified Data.Text as T -import Data.Time.LocalTime (utcToLocalZonedTime) +import Data.Time (UTCTime) +import Data.Time.LocalTime (getCurrentTimeZone, utcToZonedTime, TimeZone) import Network.HTTP.Client (managerResponseTimeout, newManager, responseTimeoutNone) @@ -118,7 +119,7 @@ <*> 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" + <*> switchWith 'R' "replace" "Delete previous snapshot image after downloading latest one" <*> optional mirrorOpt <*> strOptionalWith 'a' "arch" "ARCH" "Architecture [default: x86_64]" "x86_64" <*> strArg "RELEASE" @@ -134,6 +135,10 @@ flagWith' NoCheckSum 'C' "no-checksum" "Do not check checksum" <|> flagWith AutoCheckSum CheckSum 'c' "checksum" "Do checksum even if already downloaded" +data Primary = Primary {primaryUrl :: String, + primarySize :: Maybe Integer, + primaryTime :: Maybe UTCTime} + 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 = @@ -150,84 +155,77 @@ else httpManager if local then do - symlink <- if dryrun + 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" + (fileurl, filenamePrefix, prime, _mchecksum, _done) <- + findURL mgr mirror showdestdir + tz <- getCurrentTimeZone + putStrLn $ unwords ["Newest:", takeFileName fileurl, renderTime tz (primaryTime prime)] + putStrLn fileurl 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 + (fileurl, filenamePrefix, prime, 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 + downloadFile dryrun done mgr fileurl prime >>= fileChecksum mgr mchecksum showdestdir unless dryrun $ do let localfile = takeFileName fileurl updateSymlink localfile symlink showdestdir when run $ bootImage localfile showdestdir where findURL :: Manager -> String -> String - -- urlpath, fileprefix, (master,size), checksum, downloaded - -> IO (URL, String, (URL,Maybe Integer), Maybe String, Bool) + -- urlpath, fileprefix, primary, checksum, downloaded + -> IO (URL, String, Primary, Maybe String, Bool) findURL mgr mirror showdestdir = do (path,mrelease) <- urlPathMRel mgr -- use http-directory trailingSlash (0.1.7) - let masterDir = + let primaryDir = (case tgtrel of "koji" -> kojiPkgs "eln" -> odcsFpo "c9s" -> odcsStream _ -> dlFpo) +/+ path <> "/" - hrefs <- httpDirectory mgr masterDir + hrefs <- httpDirectory mgr primaryDir let prefixPat = makeFilePrefix mrelease selector = if '*' `elem` prefixPat then (=~ prefixPat) else (prefixPat `isPrefixOf`) mfile = find selector $ map T.unpack hrefs mchecksum = find ((if tgtrel == "respin" then T.isPrefixOf else T.isSuffixOf) (T.pack "CHECKSUM")) hrefs case mfile of Nothing -> - error' $ "no match for " <> prefixPat <> " in " <> masterDir + error' $ "no match for " <> prefixPat <> " in " <> primaryDir Just file -> do let prefix = if '*' `elem` prefixPat then (file =~ prefixPat) ++ if arch `isInfixOf` prefixPat then "" else arch else prefixPat - masterUrl = masterDir +/+ file - masterSize <- httpFileSize mgr masterUrl + primeUrl = primaryDir +/+ file + (primeSize,primeTime) <- httpFileSizeTime mgr primeUrl (finalurl, already) <- do - let localfile = takeFileName masterUrl + let localfile = takeFileName primeUrl exists <- doesFileExist localfile if exists then do - done <- checkLocalFileSize localfile masterSize showdestdir + done <- checkLocalFileSize localfile primeSize primeTime showdestdir if done - then return (masterUrl,True) + then return (primeUrl,True) else do unlessM (writable <$> getPermissions localfile) $ error' $ localfile <> " does have write permission, aborting!" - findMirror masterUrl path file - else findMirror masterUrl path file - mlocaltime <- httpTimestamp masterUrl - unless (run && already || local) $ - maybe (return ()) putStrLn $ showMSize masterSize <> showMDate mlocaltime + findMirror primeUrl path file + else findMirror primeUrl path file let finalDir = dropFileName finalurl - return (finalurl, prefix, (masterUrl,masterSize), (finalDir +/+) . T.unpack <$> mchecksum, already) + return (finalurl, prefix, Primary primeUrl primeSize primeTime, + (finalDir +/+) . T.unpack <$> mchecksum, already) where - httpTimestamp url = do - mUtc <- httpLastModified mgr url - case mUtc of - Nothing -> return Nothing - Just u -> Just <$> utcToLocalZonedTime u - - showMSize = fmap (\ s -> "size " <> show s <> " ") - showMDate = fmap (\ s -> "(" <> show s <> ")") - - findMirror masterUrl path file = do + findMirror primeUrl path file = do url <- - if mirror `elem` [dlFpo,kojiPkgs,odcsFpo] then return masterUrl + if mirror `elem` [dlFpo,kojiPkgs,odcsFpo] then return primeUrl else if mirror /= downloadFpo then return $ mirror +/+ path +/+ file else do @@ -238,7 +236,7 @@ let url = B.unpack u exists <- httpExists mgr url if exists then return url - else return masterUrl + else return primeUrl return (url,False) getFilePrefix :: String -> IO String @@ -267,19 +265,25 @@ rel | all isDigit rel -> Just rel _ -> error' $ tgtrel ++ " is unsupported with --dryrun" - checkLocalFileSize localfile masterSize showdestdir = do + checkLocalFileSize :: FilePath -> Maybe Integer -> Maybe UTCTime + -> String -> IO Bool + checkLocalFileSize localfile mprimeSize mprimeTime showdestdir = do localsize <- toInteger . fileSize <$> getFileStatus localfile - if Just localsize == masterSize + if Just localsize == mprimeSize then do - when (not run && takeExtension localfile == ".iso") $ - putStrLn $ showdestdir localfile + when (not run && takeExtension localfile == ".iso") $ do + tz <- getCurrentTimeZone + -- FIXME abbreviate size + putStrLn $ unwords [showdestdir localfile, renderTime tz mprimeTime, "size " ++ show localsize ++ " okay"] return True else do - let showsize = - case masterSize of + when (isNothing mprimeSize) $ + putStrLn "original size could not be read" + let sizepercent = + case mprimeSize of Nothing -> show localsize Just ms -> show (100 * localsize `div` ms) <> "%" - putStrLn $ "File " <> showsize <> " downloaded" + putStrLn $ "File " <> sizepercent <> " downloaded" return False urlPathMRel :: Manager -> IO (FilePath, Maybe String) @@ -355,22 +359,6 @@ in intercalate "-" (["Fedora", showEdition edition, editionType edition] ++ middle) - downloadFile :: Bool -> Manager -> URL -> (URL, Maybe Integer) - -> IO (Maybe Bool) - downloadFile done mgr url (masterUrl,masterSize) = - if done - then return (Just False) - else do - when (url /= masterUrl) $ do - mirrorSize <- httpFileSize mgr url - unless (mirrorSize == masterSize) $ - putStrLn "Warning! Mirror filesize differs from master file" - unless local $ putStrLn url - if dryrun || local then return Nothing - else do - cmd_ "curl" ["-C", "-", "-O", url] - return (Just True) - fileChecksum :: Manager -> Maybe URL -> String -> Maybe Bool -> IO () fileChecksum _ Nothing _ _ = return () fileChecksum mgr (Just url) showdestdir mneedChecksum = @@ -417,8 +405,8 @@ exists <- doesFileExist checksumfile if not exists then return False else do - masterSize <- httpFileSize mgr url - ok <- checkLocalFileSize checksumfile masterSize showdestdir + (primeSize,primeTime) <- httpFileSizeTime mgr url + ok <- checkLocalFileSize checksumfile primeSize primeTime showdestdir unless ok $ error' $ "Checksum file filesize mismatch for " ++ checksumfile return ok @@ -460,9 +448,37 @@ then Just <$> readSymbolicLink symlink else return Nothing case msymlinkTarget of - Just symlinktarget -> putStrLn $ showdestdir symlinktarget + Just symlinktarget -> + putStrLn $ "Local: " ++ showdestdir symlinktarget _ -> return () +renderTime :: TimeZone -> Maybe UTCTime -> String +renderTime tz mprimeTime = + "(" ++ maybe "" (show . utcToZonedTime tz) mprimeTime ++ ")" + +downloadFile :: Bool -> Bool -> Manager -> URL -> Primary -> IO (Maybe Bool) +downloadFile dryrun done mgr url prime = do + putStrLn url + if done + then return (Just False) + else do + mtime <- do + if url /= primaryUrl prime + then do + (mirrorSize,mirrorTime) <- httpFileSizeTime mgr url + unless (mirrorSize == primarySize prime) $ + putStrLn "Warning! Mirror filesize differs from primary file" + unless (mirrorTime == primaryTime prime) $ + putStrLn "Warning! Mirror timestamp differs from primary file" + return mirrorTime + else return $ primaryTime prime + if dryrun then return Nothing + else do + tz <- getCurrentTimeZone + putStrLn $ unwords ["downloading", takeFileName url, renderTime tz mtime] + cmd_ "curl" ["-C", "-", "-O", url] + return (Just True) + editionType :: FedoraEdition -> String editionType Server = "dvd" editionType Kinoite = "ostree" @@ -499,7 +515,7 @@ noTrailingSlash = T.dropWhileEnd (== '/') #endif --- from next http-directory or http-query +#if !MIN_VERSION_http_directory(0,1,9) infixr 5 +/+ (+/+) :: String -> String -> String "" +/+ s = s @@ -507,3 +523,4 @@ s +/+ t | last s == '/' = init s +/+ t | head t == '/' = s +/+ tail t s +/+ t = s ++ "/" ++ t +#endif 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", "34", "-c"] + [["-n", "35", "-c"] ,["-n", "rawhide", "silverblue"] ,["-n", "respin"] - ,["-l", "35"] + ,["-l", "36"] ,["-l", "rawhide", "-n"] ] ++ if ghAction then [] else - [["-n", "35", "silverblue"] - ,["-n", "33", "kde"] - ,["-T", "-n", "34", "everything"] - ,["-n", "34", "server", "--arch", "aarch64"] + [["-n", "36", "silverblue"] + ,["-n", "34", "kde"] + ,["-T", "-n", "35", "everything"] + ,["-n", "35", "server", "--arch", "aarch64"] ] main :: IO () @@ -28,4 +28,4 @@ ghAction <- isJust <$> lookupEnv "GITHUB_ACTIONS" let cases = tests ghAction mapM_ (dlFedora ghAction) cases - putStrLn $ show cases ++ " tests run" + putStrLn $ show (length cases) ++ " tests ran"