dl-fedora 0.9.2 → 0.9.3
raw patch · 5 files changed
+98/−79 lines, 5 filesdep ~http-directory
Dependency ranges changed: http-directory
Files
- CHANGELOG.md +3/−0
- README.md +3/−3
- dl-fedora.cabal +6/−7
- src/Main.hs +79/−62
- test/tests.hs +7/−7
CHANGELOG.md view
@@ -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
README.md view
@@ -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.
dl-fedora.cabal view
@@ -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
src/Main.hs view
@@ -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
test/tests.hs view
@@ -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"