dl-fedora 0.7.6 → 0.7.7
raw patch · 6 files changed
+500/−449 lines, 6 filesdep ~basedep ~simple-cmd
Dependency ranges changed: base, simple-cmd
Files
- CHANGELOG.md +5/−0
- Main.hs +0/−442
- README.md +8/−5
- dl-fedora.cabal +14/−2
- src/Main.hs +451/−0
- test/tests.hs +22/−0
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog +## 0.7.7 (2021-04-06)+- add the new F34 i3 spin+- shorten mate_compiz to mate+- convert tests to Haskell+ ## 0.7.6 (2021-01-21) - improve help text for releases related for Beta and RCs (#1) - if ~/Downloads/iso/ exists then download to it otherwise ~/Downloads/
− Main.hs
@@ -1,442 +0,0 @@-{-# LANGUAGE CPP #-}--#if !MIN_VERSION_base(4,13,0)-import Control.Applicative ((<|>)-#if !MIN_VERSION_base(4,8,0)- , (<$>), (<*>)-#endif- )-import Data.Semigroup ((<>))-#endif--import Control.Monad.Extra--import qualified Data.ByteString.Char8 as B-import Data.Char (isDigit, toLower, toUpper)-import Data.List-import Data.Maybe-import qualified Data.Text as T-import Data.Time.LocalTime (utcToLocalZonedTime)--import Network.HTTP.Directory--import Options.Applicative (fullDesc, header, progDescDoc)-import qualified Options.Applicative.Help.Pretty as P--import Paths_dl_fedora (version)--import SimpleCmd (cmd_, cmdN, error', grep_, pipe_, pipeBool, pipeFile_,- removePrefix)-import SimpleCmdArgs--import System.Directory (createDirectory, createDirectoryIfMissing,- doesDirectoryExist, doesFileExist, findExecutable,- getHomeDirectory, getPermissions, listDirectory,- removeFile, setCurrentDirectory, withCurrentDirectory,- writable)-import System.Environment.XDG.UserDir (getUserDir)-import System.FilePath (dropFileName, isRelative , joinPath, makeRelative,- takeExtension, takeFileName, (<.>))-import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus,- readSymbolicLink)--import Text.Read-import qualified Text.ParserCombinators.ReadP as R-import qualified Text.ParserCombinators.ReadPrec as RP-import Text.Regex.Posix--{-# ANN module "HLint: ignore Use camelCase" #-}-data FedoraEdition = Cloud- | Container- | Everything- | Server- | Silverblue- | Workstation- | Cinnamon- | KDE- | LXDE- | LXQt- | MATE_Compiz- | Soas- | Xfce- deriving (Show, Enum, Bounded, Eq)--instance Read FedoraEdition where- readPrec = do- s <- look- let e = map toLower s- editionMap =- map (\ ed -> (map toLower (show ed), ed)) [minBound..maxBound]- res = lookup e editionMap- case res of- Nothing -> error' "unknown edition" >> RP.pfail- Just ed -> RP.lift (R.string e) >> return ed--type URL = String--fedoraSpins :: [FedoraEdition]-fedoraSpins = [Cinnamon ..]--data CheckSum = AutoCheckSum | NoCheckSum | CheckSum- deriving Eq--dlFpo, downloadFpo, kojiPkgs, odcsFpo :: 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"--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 "EDITION = " <> P.lbrace <> P.align (P.fillCat (P.punctuate P.comma (map (P.text . map toLower . show) [(minBound :: FedoraEdition)..maxBound])) <> P.rbrace),- P.text "",- P.text "See <https://fedoraproject.org/wiki/Infrastructure/MirrorManager>",- P.text "and also <https://fedoramagazine.org/verify-fedora-iso-file>."- ]- simpleCmdArgsWithMods (Just version) (fullDesc <> header "Fedora iso downloader" <> progDescDoc pdoc) $- program- <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file"- <*> checkSumOpts- <*> switchWith 'n' "dry-run" "Don't actually download anything"- <*> 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"- where- mirrorOpt :: Parser String- mirrorOpt =- flagWith' dlFpo 'd' "dl" "Use dl.fedoraproject.org" <|>- strOptionWith 'm' "mirror" "HOST" ("Mirror url for /pub [default " ++ downloadFpo ++ "]")-- checkSumOpts :: Parser CheckSum- checkSumOpts =- 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 -> Maybe String -> String -> FedoraEdition -> String -> IO ()-program gpg checksum dryrun run removeold mmirror arch edition tgtrel = do- let mirror =- case mmirror of- Nothing | tgtrel == "koji" -> kojiPkgs- Nothing | tgtrel == "eln" -> odcsFpo- Nothing -> downloadFpo- 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- downloadFile done mgr fileurl (masterUrl,masterSize) >>= fileChecksum mgr mchecksum showdestdir- unless dryrun $ do- let localfile = takeFileName fileurl- symlink = filenamePrefix <> (if tgtrel == "eln" then "-" <> arch else "") <> "-latest" <.> takeExtension fileurl- 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!"- dlIsoDir <- let isodir = dlDir </> "iso" in- ifM (doesDirectoryExist isodir) (return isodir) $ do- unless (dirExists || dryrun) $ createDirectoryIfMissing True dlDir- return dlDir- setCurrentDirectory dlIsoDir- return dlIsoDir-- -- urlpath, fileprefix, (master,size), checksum, downloaded- findURL :: Manager -> String -> String -> 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)- let masterDir =- (case tgtrel of- "koji" -> kojiPkgs- "eln" -> odcsFpo- _ -> dlFpo) </> path <> "/"- hrefs <- httpDirectory mgr masterDir- 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- 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- (finalurl, already) <- do- let localfile = takeFileName masterUrl- exists <- doesFileExist localfile- if exists- then do- done <- checkLocalFileSize localfile masterSize showdestdir- if done- then return (masterUrl,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) $- maybe (return ()) putStrLn $ showMSize masterSize <> showMDate mlocaltime- let finalDir = dropFileName finalurl- return (finalurl, prefix, (masterUrl,masterSize), (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- url <-- if mirror `elem` [dlFpo,kojiPkgs,odcsFpo] then return masterUrl- else- if mirror /= downloadFpo then return $ mirror </> path- else do- redir <- httpRedirect mgr $ mirror </> path </> file- case redir of- Nothing -> error' $ mirror </> path </> file <> " redirect failed"- Just u -> do- let url = B.unpack u- exists <- httpExists mgr url- if exists then return url- else return masterUrl- return (url,False)-- checkLocalFileSize localfile masterSize showdestdir = do- localsize <- toInteger . fileSize <$> getFileStatus localfile- if Just localsize == masterSize- then do- when (not run && takeExtension localfile == ".iso") $- putStrLn $ showdestdir </> localfile- return True- else do- let showsize =- case masterSize of- Nothing -> show localsize- Just ms -> show (100 * localsize `div` ms) <> "%"- putStrLn $ "File " <> showsize <> " downloaded"- return False-- urlPathMRel :: Manager -> IO (FilePath, Maybe String)- urlPathMRel mgr = do- let subdir =- if edition `elem` fedoraSpins- then joinPath ["Spins", arch, "iso"]- else joinPath [show edition, arch, editionMedia edition]- case tgtrel of- "respin" -> return ("alt/live-respins", Nothing)- "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)- "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 mrel = listToMaybe rels- 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- -- use http-directory-0.1.7 noTrailingSlash- rels <- reverse . map (T.unpack . T.dropWhileEnd (== '/')) <$> httpDirectory mgr url- let mrel = listToMaybe rels- 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- 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)-- -- 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)- else do- let dir' = "fedora/linux/development"- 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- makeFilePrefix mrelease =- case tgtrel of- "respin" -> "F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64" <> "-LIVE"- "eln" -> "Fedora-ELN-Rawhide"- _ ->- let showRel r = if last r == '/' then init r else r- rel = maybeToList (showRel <$> mrelease)- middle =- if edition `elem` [Cloud, Container]- then rel ++ [".*" <> arch]- else arch : rel- in- intercalate "-" (["Fedora", show edition, editionType edition] ++ middle)-- downloadFile :: Bool -> Manager -> URL -> (URL, Maybe Integer) -> IO Bool- downloadFile done mgr url (masterUrl,masterSize) =- if done- then return False- else do- when (url /= masterUrl) $ do- mirrorSize <- httpFileSize mgr url- unless (mirrorSize == masterSize) $- putStrLn "Warning! Mirror filesize differs from master file"- putStrLn url- if dryrun then return False- else do- cmd_ "curl" ["-C", "-", "-O", url]- return True-- fileChecksum :: Manager -> Maybe URL -> String -> Bool -> IO ()- fileChecksum _ Nothing _ _ = return ()- fileChecksum mgr (Just url) showdestdir needChecksum =- when ((needChecksum && checksum /= NoCheckSum) || checksum == CheckSum) $ do- let checksumdir = ".dl-fedora-checksums"- checksumfile = checksumdir </> takeFileName url- exists <- do- dirExists <- doesDirectoryExist checksumdir- if dirExists then checkChecksumfile mgr url checksumfile showdestdir- else createDirectory checksumdir >> return False- putStrLn ""- unless exists $- whenM (httpExists mgr url) $- withCurrentDirectory checksumdir $- cmd_ "curl" ["-C", "-", "-s", "-S", "-O", url]- haveChksum <- doesFileExist checksumfile- if not haveChksum- then putStrLn "No checksum file found"- else do- pgp <- grep_ "PGP" checksumfile- when (gpg && pgp) $ do- havekey <- checkForFedoraKeys- unless havekey $ do- putStrLn "Importing Fedora GPG keys:\n"- -- https://fedoramagazine.org/verify-fedora-iso-file/- pipe_ ("curl",["-s", "-S", "https://getfedora.org/static/fedora.gpg"]) ("gpg",["--import"])- putStrLn ""- chkgpg <- if pgp- then checkForFedoraKeys- else return False- let shasum = if "CHECKSUM512" `isPrefixOf` takeFileName checksumfile- then "sha512sum" else "sha256sum"- if chkgpg then do- putStrLn $ "Running gpg verify and " <> shasum <> ":"- pipeFile_ checksumfile ("gpg",["-q"]) (shasum, ["-c", "--ignore-missing"])- else do- putStrLn $ "Running " <> shasum <> ":"- cmd_ shasum ["-c", "--ignore-missing", checksumfile]-- checkChecksumfile :: Manager -> URL -> FilePath -> String -> IO Bool- checkChecksumfile mgr url checksumfile showdestdir = do- exists <- doesFileExist checksumfile- if not exists then return False- else do- masterSize <- httpFileSize mgr url- ok <- checkLocalFileSize checksumfile masterSize showdestdir- unless ok $ error' "Checksum file filesize mismatch"- return ok-- checkForFedoraKeys :: IO Bool- checkForFedoraKeys =- pipeBool ("gpg",["--list-keys"]) ("grep", ["-q", " Fedora .*(" <> tgtrel <> ").*@fedoraproject.org>"])-- updateSymlink :: FilePath -> FilePath -> FilePath -> IO ()- updateSymlink target symlink showdestdir = do- mmsymlinkTarget <- do- havefile <- doesFileExist symlink- if havefile- then Just . Just <$> readSymbolicLink symlink- else do- -- check for broken symlink- dirfiles <- listDirectory "."- return $ if symlink `elem` dirfiles then Just Nothing else Nothing- case mmsymlinkTarget of- Nothing -> makeSymlink- Just Nothing -> do- removeFile symlink- makeSymlink- Just (Just symlinktarget) -> do- when (symlinktarget /= target) $ do- when removeold $ removeFile symlinktarget- removeFile symlink- makeSymlink- where- makeSymlink = do- putStrLn ""- createSymbolicLink target symlink- putStrLn $ unwords [showdestdir </> symlink, "->", target]--editionType :: FedoraEdition -> String-editionType Server = "dvd"-editionType Silverblue = "ostree"-editionType Everything = "netinst"-editionType Cloud = "Base"-editionType Container = "Base"-editionType _ = "Live"--editionMedia :: FedoraEdition -> String-editionMedia Cloud = "images"-editionMedia Container = "images"-editionMedia _ = "iso"--liveRespin :: FedoraEdition -> String-liveRespin = take 4 . map toUpper . show--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 =- case takeExtension img of- ".iso" -> ["-boot", "d", "-cdrom"]- _ -> []- mQemu <- findExecutable "qemu-kvm"- case mQemu of- Just qemu -> do- let args = ["-m", "2048", "-rtc", "base=localtime"] ++ fileopts- cmdN qemu (args ++ [showdir </> img])- cmd_ qemu (args ++ [img])- Nothing -> error' "Need qemu to run image"
README.md view
@@ -13,17 +13,20 @@ `dl-fedora rawhide` : downloads the latest Fedora Rawhide Workstation Live iso -`dl-fedora -e silverblue 33` : downloads the Fedora Silverblue iso+`dl-fedora -e silverblue 34` : downloads the Fedora Silverblue iso `dl-fedora -e kde respin` : downloads the latest KDE Live respin -`dl-fedora --edition server --arch aarch64 32` : will bring down the F32 Server iso+`dl-fedora --edition server --arch aarch64 33` : will bring down the F33 Server iso for armv8 -`dl-fedora --run 33` : will download Fedora 33 Workstation and boot the Live image with qemu-kvm.+`dl-fedora --run 34` : will download Fedora 34 Workstation and boot the Live image with qemu-kvm. -If the image is already in the Downloads/ directory+By default dl-fedora downloads to `~/Downloads/`, 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.-Curl is used to do the downloading.+Curl is used to do the downloading: partial downloads will continue. A symlink to the latest iso is also created: eg for rawhide it might be `"Fedora-Workstation-Live-x86_64-Rawhide-latest.iso"`.
dl-fedora.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: dl-fedora-version: 0.7.6+version: 0.7.7 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,7 +25,7 @@ location: https://github.com/juhp/dl-fedora.git executable dl-fedora- main-is: Main.hs+ main-is: src/Main.hs other-modules: Paths_dl_fedora build-depends: base < 5,@@ -50,3 +50,15 @@ -Wall default-language: Haskell2010++test-suite test+ main-is: tests.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test++ default-language: Haskell2010++ ghc-options: -Wall+ build-depends: base >= 4 && < 5+ , simple-cmd+ build-tools: dl-fedora
+ src/Main.hs view
@@ -0,0 +1,451 @@+{-# LANGUAGE CPP #-}++#if !MIN_VERSION_base(4,13,0)+import Control.Applicative ((<|>)+#if !MIN_VERSION_base(4,8,0)+ , (<$>), (<*>)+#endif+ )+import Data.Semigroup ((<>))+#endif++import Control.Monad.Extra++import qualified Data.ByteString.Char8 as B+import Data.Char (isDigit)+import Data.List.Extra+import Data.Maybe+import qualified Data.Text as T+import Data.Time.LocalTime (utcToLocalZonedTime)++import Network.HTTP.Directory++import Options.Applicative (fullDesc, header, progDescDoc)+import qualified Options.Applicative.Help.Pretty as P++import Paths_dl_fedora (version)++import SimpleCmd (cmd_, cmdN, error', grep_, pipe_, pipeBool, pipeFile_,+ removePrefix)+import SimpleCmdArgs++import System.Directory (createDirectory, createDirectoryIfMissing,+ doesDirectoryExist, doesFileExist, findExecutable,+ getHomeDirectory, getPermissions, listDirectory,+ removeFile, setCurrentDirectory, withCurrentDirectory,+ writable)+import System.Environment.XDG.UserDir (getUserDir)+import System.FilePath (dropFileName, isRelative , joinPath, makeRelative,+ takeExtension, takeFileName, (<.>))+import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus,+ readSymbolicLink)++import Text.Read+import qualified Text.ParserCombinators.ReadP as R+import qualified Text.ParserCombinators.ReadPrec as RP+import Text.Regex.Posix++{-# ANN module "HLint: ignore Use camelCase" #-}+data FedoraEdition = Cloud+ | Container+ | Everything+ | Server+ | Silverblue+ | Workstation+ | Cinnamon+ | KDE+ | LXDE+ | LXQt+ | MATE+ | Soas+ | Xfce+ | I3+ deriving (Show, Enum, Bounded, Eq)++showEdition :: FedoraEdition -> String+showEdition MATE = "MATE_Compiz"+showEdition I3 = "i3"+showEdition e = show e++lowerEdition :: FedoraEdition -> String+lowerEdition = lower . show++instance Read FedoraEdition where+ readPrec = do+ s <- look+ let e = lower s+ editionMap =+ map (\ ed -> (lowerEdition ed, ed)) [minBound..maxBound]+ res = lookup e editionMap+ case res of+ Nothing -> error' "unknown edition" >> RP.pfail+ Just ed -> RP.lift (R.string e) >> return ed++type URL = String++fedoraSpins :: [FedoraEdition]+fedoraSpins = [Cinnamon ..]++data CheckSum = AutoCheckSum | NoCheckSum | CheckSum+ deriving Eq++dlFpo, downloadFpo, kojiPkgs, odcsFpo :: 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"++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 "EDITION = " <> P.lbrace <> P.align (P.fillCat (P.punctuate P.comma (map (P.text . lowerEdition) [(minBound :: FedoraEdition)..maxBound])) <> P.rbrace),+ P.text "",+ P.text "See <https://fedoraproject.org/wiki/Infrastructure/MirrorManager>",+ P.text "and also <https://fedoramagazine.org/verify-fedora-iso-file>."+ ]+ simpleCmdArgsWithMods (Just version) (fullDesc <> header "Fedora iso downloader" <> progDescDoc pdoc) $+ program+ <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file"+ <*> checkSumOpts+ <*> switchWith 'n' "dry-run" "Don't actually download anything"+ <*> 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"+ where+ mirrorOpt :: Parser String+ mirrorOpt =+ flagWith' dlFpo 'd' "dl" "Use dl.fedoraproject.org" <|>+ strOptionWith 'm' "mirror" "HOST" ("Mirror url for /pub [default " ++ downloadFpo ++ "]")++ checkSumOpts :: Parser CheckSum+ checkSumOpts =+ 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 -> Maybe String -> String -> FedoraEdition -> String -> IO ()+program gpg checksum dryrun run removeold mmirror arch edition tgtrel = do+ let mirror =+ case mmirror of+ Nothing | tgtrel == "koji" -> kojiPkgs+ Nothing | tgtrel == "eln" -> odcsFpo+ Nothing -> downloadFpo+ 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+ downloadFile done mgr fileurl (masterUrl,masterSize) >>= fileChecksum mgr mchecksum showdestdir+ unless dryrun $ do+ let localfile = takeFileName fileurl+ symlink = filenamePrefix <> (if tgtrel == "eln" then "-" <> arch else "") <> "-latest" <.> takeExtension fileurl+ 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!"+ dlIsoDir <- let isodir = dlDir </> "iso" in+ ifM (doesDirectoryExist isodir) (return isodir) $ do+ unless (dirExists || dryrun) $ createDirectoryIfMissing True dlDir+ return dlDir+ setCurrentDirectory dlIsoDir+ return dlIsoDir++ -- urlpath, fileprefix, (master,size), checksum, downloaded+ findURL :: Manager -> String -> String -> 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)+ let masterDir =+ (case tgtrel of+ "koji" -> kojiPkgs+ "eln" -> odcsFpo+ _ -> dlFpo) </> path <> "/"+ hrefs <- httpDirectory mgr masterDir+ 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+ 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+ (finalurl, already) <- do+ let localfile = takeFileName masterUrl+ exists <- doesFileExist localfile+ if exists+ then do+ done <- checkLocalFileSize localfile masterSize showdestdir+ if done+ then return (masterUrl,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) $+ maybe (return ()) putStrLn $ showMSize masterSize <> showMDate mlocaltime+ let finalDir = dropFileName finalurl+ return (finalurl, prefix, (masterUrl,masterSize), (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+ url <-+ if mirror `elem` [dlFpo,kojiPkgs,odcsFpo] then return masterUrl+ else+ if mirror /= downloadFpo then return $ mirror </> path+ else do+ redir <- httpRedirect mgr $ mirror </> path </> file+ case redir of+ Nothing -> error' $ mirror </> path </> file <> " redirect failed"+ Just u -> do+ let url = B.unpack u+ exists <- httpExists mgr url+ if exists then return url+ else return masterUrl+ return (url,False)++ checkLocalFileSize localfile masterSize showdestdir = do+ localsize <- toInteger . fileSize <$> getFileStatus localfile+ if Just localsize == masterSize+ then do+ when (not run && takeExtension localfile == ".iso") $+ putStrLn $ showdestdir </> localfile+ return True+ else do+ let showsize =+ case masterSize of+ Nothing -> show localsize+ Just ms -> show (100 * localsize `div` ms) <> "%"+ putStrLn $ "File " <> showsize <> " downloaded"+ return False++ urlPathMRel :: Manager -> IO (FilePath, Maybe String)+ urlPathMRel mgr = do+ let subdir =+ if edition `elem` fedoraSpins+ then joinPath ["Spins", arch, "iso"]+ 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")+ "test" -> testRelease mgr subdir+ "stage" -> stageRelease mgr subdir+ "eln" -> return ("production/latest-Fedora-ELN/compose" </> "Everything" </> 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 mrel = listToMaybe rels+ 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+ -- use http-directory-0.1.7 noTrailingSlash+ rels <- reverse . map (T.unpack . T.dropWhileEnd (== '/')) <$> httpDirectory mgr url+ let mrel = listToMaybe rels+ 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+ 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)++ -- 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)+ else do+ let dir' = "fedora/linux/development"+ 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+ makeFilePrefix mrelease =+ case tgtrel of+ "respin" -> "F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64" <> "-LIVE"+ "eln" -> "Fedora-ELN-Rawhide"+ _ ->+ let showRel r = if last r == '/' then init r else r+ rel = maybeToList (showRel <$> mrelease)+ middle =+ if edition `elem` [Cloud, Container]+ then rel ++ [".*" <> arch]+ else arch : rel+ in+ intercalate "-" (["Fedora", showEdition edition, editionType edition] ++ middle)++ downloadFile :: Bool -> Manager -> URL -> (URL, Maybe Integer) -> IO Bool+ downloadFile done mgr url (masterUrl,masterSize) =+ if done+ then return False+ else do+ when (url /= masterUrl) $ do+ mirrorSize <- httpFileSize mgr url+ unless (mirrorSize == masterSize) $+ putStrLn "Warning! Mirror filesize differs from master file"+ putStrLn url+ if dryrun then return False+ else do+ cmd_ "curl" ["-C", "-", "-O", url]+ return True++ fileChecksum :: Manager -> Maybe URL -> String -> Bool -> IO ()+ fileChecksum _ Nothing _ _ = return ()+ fileChecksum mgr (Just url) showdestdir needChecksum =+ when ((needChecksum && checksum /= NoCheckSum) || checksum == CheckSum) $ do+ let checksumdir = ".dl-fedora-checksums"+ checksumfile = checksumdir </> takeFileName url+ exists <- do+ dirExists <- doesDirectoryExist checksumdir+ if dirExists then checkChecksumfile mgr url checksumfile showdestdir+ else createDirectory checksumdir >> return False+ putStrLn ""+ unless exists $+ whenM (httpExists mgr url) $+ withCurrentDirectory checksumdir $+ cmd_ "curl" ["-C", "-", "-s", "-S", "-O", url]+ haveChksum <- doesFileExist checksumfile+ if not haveChksum+ then putStrLn "No checksum file found"+ else do+ pgp <- grep_ "PGP" checksumfile+ when (gpg && pgp) $ do+ havekey <- checkForFedoraKeys+ unless havekey $ do+ putStrLn "Importing Fedora GPG keys:\n"+ -- https://fedoramagazine.org/verify-fedora-iso-file/+ pipe_ ("curl",["-s", "-S", "https://getfedora.org/static/fedora.gpg"]) ("gpg",["--import"])+ putStrLn ""+ chkgpg <- if pgp+ then checkForFedoraKeys+ else return False+ let shasum = if "CHECKSUM512" `isPrefixOf` takeFileName checksumfile+ then "sha512sum" else "sha256sum"+ if chkgpg then do+ putStrLn $ "Running gpg verify and " <> shasum <> ":"+ pipeFile_ checksumfile ("gpg",["-q"]) (shasum, ["-c", "--ignore-missing"])+ else do+ putStrLn $ "Running " <> shasum <> ":"+ cmd_ shasum ["-c", "--ignore-missing", checksumfile]++ checkChecksumfile :: Manager -> URL -> FilePath -> String -> IO Bool+ checkChecksumfile mgr url checksumfile showdestdir = do+ exists <- doesFileExist checksumfile+ if not exists then return False+ else do+ masterSize <- httpFileSize mgr url+ ok <- checkLocalFileSize checksumfile masterSize showdestdir+ unless ok $ error' "Checksum file filesize mismatch"+ return ok++ checkForFedoraKeys :: IO Bool+ checkForFedoraKeys =+ pipeBool ("gpg",["--list-keys"]) ("grep", ["-q", " Fedora .*(" <> tgtrel <> ").*@fedoraproject.org>"])++ updateSymlink :: FilePath -> FilePath -> FilePath -> IO ()+ updateSymlink target symlink showdestdir = do+ mmsymlinkTarget <- do+ havefile <- doesFileExist symlink+ if havefile+ then Just . Just <$> readSymbolicLink symlink+ else do+ -- check for broken symlink+ dirfiles <- listDirectory "."+ return $ if symlink `elem` dirfiles then Just Nothing else Nothing+ case mmsymlinkTarget of+ Nothing -> makeSymlink+ Just Nothing -> do+ removeFile symlink+ makeSymlink+ Just (Just symlinktarget) -> do+ when (symlinktarget /= target) $ do+ when removeold $ removeFile symlinktarget+ removeFile symlink+ makeSymlink+ where+ makeSymlink = do+ putStrLn ""+ createSymbolicLink target symlink+ putStrLn $ unwords [showdestdir </> symlink, "->", target]++editionType :: FedoraEdition -> String+editionType Server = "dvd"+editionType Silverblue = "ostree"+editionType Everything = "netinst"+editionType Cloud = "Base"+editionType Container = "Base"+editionType _ = "Live"++editionMedia :: FedoraEdition -> String+editionMedia Cloud = "images"+editionMedia Container = "images"+editionMedia _ = "iso"++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 =+ case takeExtension img of+ ".iso" -> ["-boot", "d", "-cdrom"]+ _ -> []+ mQemu <- findExecutable "qemu-kvm"+ case mQemu of+ Just qemu -> do+ let args = ["-m", "2048", "-rtc", "base=localtime"] ++ fileopts+ cmdN qemu (args ++ [showdir </> img])+ cmd_ qemu (args ++ [img])+ Nothing -> error' "Need qemu to run image"
+ test/tests.hs view
@@ -0,0 +1,22 @@+import SimpleCmd++dlFedora :: [String] -> IO ()+dlFedora args =+ putStrLn "" >> cmdLog "dl-fedora" args++tests :: [[String]]+tests =+ [["-n", "33", "-c"]+ ,["-n", "rawhide", "-e", "silverblue"]+ ,["-n", "34", "-e", "silverblue"]+ ,["respin"]+ ,["-n", "32", "-e", "kde"]+ ,["-n", "33", "-e", "everything"]+ ,["-n", "33", "-e", "server", "--arch", "aarch64"]+ ,["-n", "34"]+ ]++main :: IO ()+main = do+ mapM_ dlFedora tests+ putStrLn $ show (length tests) ++ " tests run"