dl-fedora 0.6 → 0.7
raw patch · 4 files changed
+184/−119 lines, 4 filesdep ~directory
Dependency ranges changed: directory
Files
- CHANGELOG.md +11/−0
- Main.hs +168/−116
- README.md +3/−1
- dl-fedora.cabal +2/−2
CHANGELOG.md view
@@ -1,5 +1,16 @@ # Changelog +## 0.7 (2019-09-12)+- add --checksum to always do checksum when possible+- add --run to run image in qemu-kvm if available+- rework algorithms+ - check local filesize earlier: don't even check mirror if always downloaded+ - for partial local file output percentage already downloaded+ - otherwise show filesize+- show dir for symlink: so one knows location+- drop the 'devel' target (use release version number instead)+- handle old dangling symlink too (after deleting iso)+ ## 0.6 (2019-09-02) - major rework to correct the url logic - first checks on dl.fedoraproject.org (master)
Main.hs view
@@ -26,10 +26,12 @@ import SimpleCmdArgs import System.Directory (createDirectoryIfMissing, doesDirectoryExist,- doesFileExist, getPermissions, removeFile,+ doesFileExist, findExecutable, getHomeDirectory,+ getPermissions, listDirectory, removeFile, setCurrentDirectory, writable) import System.Environment.XDG.UserDir (getUserDir)-import System.FilePath (dropFileName, joinPath, takeExtension, takeFileName, (<.>))+import System.FilePath (dropFileName, joinPath, makeRelative, takeExtension,+ takeFileName, (<.>)) import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus, readSymbolicLink) @@ -68,6 +70,9 @@ fedoraSpins :: [FedoraEdition] fedoraSpins = [Cinnamon ..] +data CheckSum = AutoCheckSum | NoCheckSum | CheckSum+ deriving Eq+ dlFpo, downloadFpo :: String dlFpo = "https://dl.fedoraproject.org/pub" downloadFpo = "https://download.fedoraproject.org/pub"@@ -76,17 +81,18 @@ main = do let pdoc = Just $ P.vcat [ P.text "Tool for downloading Fedora iso file images.",- P.text ("RELEASE = " <> intercalate ", " ["rawhide", "devel", "respin", "test", "or Release version"]),+ P.text ("RELEASE = " <> intercalate ", " ["rawhide", "respin", "test", "or release number"]), 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) $- findISO+ program <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file"- <*> switchWith 'C' "no-checksum" "Do not check checksum"+ <*> checkSumOpts <*> switchWith 'n' "dry-run" "Don't actually download anything"+ <*> switchWith 'r' "run" "Boot image in Qemu" <*> mirrorOpt <*> strOptionalWith 'a' "arch" "ARCH" "Architecture [default: x86_64]" "x86_64" <*> optionalWith auto 'e' "edition" "EDITION" "Fedora edition [default: workstation]" Workstation@@ -97,26 +103,38 @@ flagWith' dlFpo 'd' "dl" "Use dl.fedoraproject.org" <|> strOptionalWith 'm' "mirror" "HOST" "Mirror url for /pub [default https://download.fedoraproject.org/pub]" downloadFpo -findISO :: Bool -> Bool -> Bool -> String -> String -> FedoraEdition -> String -> IO ()-findISO gpg nochecksum dryrun mirror arch edition tgtrel = do- mgr <- httpManager- (fileurl, filenamePrefix, (masterUrl,masterSize), mchecksum) <- findURL mgr+ 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 -> String -> String -> FedoraEdition -> String -> IO ()+program gpg checksum dryrun run mirror arch edition tgtrel = do+ home <- getHomeDirectory dlDir <- getUserDir "DOWNLOAD"- if dryrun- then do- dirExists <- doesDirectoryExist dlDir- when dirExists $ setCurrentDirectory dlDir- else do- createDirectoryIfMissing False dlDir- setCurrentDirectory dlDir- let localfile = takeFileName fileurl- done <- downloadFile mgr fileurl (masterUrl,masterSize) localfile- when (done && not nochecksum) $ fileChecksum mchecksum- let symlink = dlDir </> filenamePrefix <> "-latest" <.> takeExtension fileurl- updateSymlink dryrun localfile symlink+ setDownloadDir dlDir home+ mgr <- httpManager+ (fileurl, filenamePrefix, (masterUrl,masterSize), mchecksum, done) <- findURL mgr+ downloadFile done mgr fileurl (masterUrl,masterSize) >>= fileChecksum mchecksum+ unless dryrun $ do+ let localfile = takeFileName fileurl+ symlink = filenamePrefix <> "-latest" <.> takeExtension fileurl+ showdestdir = "~" </> makeRelative home dlDir+ updateSymlink localfile symlink showdestdir+ when run $ bootImage localfile where- -- urlpath, fileprefix, (master,size), checksum- findURL :: Manager -> IO (String, String, (String,Maybe Integer), Maybe String)+ setDownloadDir dlDir home = do+ dirExists <- doesDirectoryExist dlDir+ unless (dryrun || dirExists) $+ when (home == dlDir) $+ error' "HOME directory does not exist!"+ unless (dirExists || dryrun) $ createDirectoryIfMissing False dlDir+ dirExists' <- if dirExists then return True+ else doesDirectoryExist dlDir+ when dirExists' $ setCurrentDirectory dlDir++ -- urlpath, fileprefix, (master,size), checksum, downloaded+ findURL :: Manager -> IO (String, String, (String,Maybe Integer), Maybe String, Bool) findURL mgr = do (path,mrelease) <- urlPathMRel mgr -- use http-directory trailing (0.1.6)@@ -130,28 +148,61 @@ Nothing -> error' $ "no match for " <> prefixPat <> " in " <> masterDir Just file -> do- let masterUrl = masterDir </> file- size <- httpFileSize mgr masterUrl- -- use http-directory trailing (0.1.6)- finalurl <- if mirror == dlFpo 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- let finalDir = dropFileName finalurl- prefix = if '*' `elem` prefixPat+ let prefix = if '*' `elem` prefixPat then file =~ prefixPat 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+ if done+ then return (masterUrl,True)+ else do+ canwrite <- writable <$> getPermissions localfile+ unless canwrite $+ error' $ localfile <> " does have write permission, aborting!"+ findMirror masterUrl path file+ else do+ maybe (return ()) (\ s -> putStrLn $ "size " <> show s) masterSize+ findMirror masterUrl path file+ let finalDir = dropFileName finalurl putStrLn finalurl- return (finalurl, prefix, (masterUrl,size), (finalDir </>) . T.unpack <$> mchecksum)+ return (finalurl, prefix, (masterUrl,masterSize), (finalDir </>) . T.unpack <$> mchecksum, already)+ where+ findMirror masterUrl path file = do+ url <-+ if mirror == dlFpo 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) - -- avoid import of Manager until http-directory-0.1.6+ checkLocalFileSize localfile masterSize = do+ localsize <- toInteger . fileSize <$> getFileStatus localfile+ if Just localsize == masterSize+ then do+ putStrLn "File already fully downloaded"+ 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 (String, Maybe String) urlPathMRel mgr = do let subdir =@@ -160,19 +211,19 @@ 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")- "devel" -> checkForRelease mgr "development" subdir- "test" -> checkForRelease mgr "releases/test" subdir+ "rawhide" -> return ("fedora/linux/development/rawhide" </> subdir, Just "Rawhide")+ "test" -> checkTestRel mgr subdir rel | all isDigit rel -> checkReleased mgr rel subdir _ -> error' "Unknown release" - checkForRelease :: Manager -> FilePath -> FilePath -> IO (FilePath, Maybe String)- checkForRelease mgr dir subdir = do- let url = dlFpo </> "fedora/linux" </> dir+ checkTestRel :: Manager -> FilePath -> IO (FilePath, Maybe String)+ checkTestRel mgr subdir = do+ let path = "fedora/linux" </> "releases/test"+ url = dlFpo </> path -- use http-directory-0.1.6 removeTrailing rels <- map (T.unpack . T.dropWhileEnd (== '/')) <$> httpDirectory mgr url- let mrel = listToMaybe $ delete "rawhide" rels- return $ ("fedora/linux" </> dir </> fromMaybe (error' ("release not found in " <> url)) mrel </> subdir, mrel)+ let mrel = listToMaybe rels+ return (path </> fromMaybe (error' ("test release not found in " <> url)) mrel </> subdir, mrel) checkReleased :: Manager -> FilePath -> FilePath -> IO (FilePath, Maybe String) checkReleased mgr rel subdir = do@@ -185,11 +236,11 @@ 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/"+ else error' "release not found in releases/ or development/" makeFilePrefix :: Maybe String -> String makeFilePrefix mrelease =- if tgtrel == "respin" then "F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64"+ if tgtrel == "respin" then "F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64" <> "-LIVE" else let showRel r = if last r == '/' then init r else r rel = maybeToList (showRel <$> mrelease)@@ -200,85 +251,74 @@ in intercalate "-" (["Fedora", show edition, editionType edition] ++ middle) - downloadFile :: Manager -> String -> (String, Maybe Integer) -> String -> IO Bool- downloadFile mgr url (masterUrl,masterSize) localfile = do- exists <- doesFileExist localfile- if exists- then do- localsize <- fileSize <$> getFileStatus localfile- if Just (fromIntegral localsize) == masterSize- then do- putStrLn "File already fully downloaded"- return True- else do- canwrite <- writable <$> getPermissions localfile- unless canwrite $ error' "file does have write permission, aborting!"- if dryrun- then do- putStrLn "Local filesize differs from master"- return False- else do- when (url /= masterUrl) $ do- mirrorSize <- httpFileSize mgr url- unless (mirrorSize == masterSize) $- putStrLn "Warning! Mirror filesize differs from master file"- cmd_ "curl" ["-C", "-", "-O", url]- return True- else- if dryrun then return False+ downloadFile :: Bool -> Manager -> String -> (String, 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"+ if dryrun then return False+ else do cmd_ "curl" ["-C", "-", "-O", url] return True - fileChecksum :: Maybe FilePath -> IO ()- fileChecksum mchecksum =- case mchecksum of- Nothing -> return ()- Just url -> do- let checksum = takeFileName url- exists <- doesFileExist checksum- putStrLn ""- unless exists $- cmd_ "curl" ["-C", "-", "-s", "-S", "-O", url]- pgp <- grep_ "PGP" checksum- 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` checksum- then "sha512sum" else "sha256sum"- if chkgpg then do- putStrLn $ "Running gpg verify and " <> shasum <> ":"- pipeFile_ checksum ("gpg",["-q"]) (shasum, ["-c", "--ignore-missing"])- else do- putStrLn $ "Running " <> shasum <> ":"- cmd_ shasum ["-c", "--ignore-missing", checksum]+ fileChecksum :: Maybe FilePath -> Bool -> IO ()+ fileChecksum Nothing _ = return ()+ fileChecksum (Just url) needChecksum =+ when ((needChecksum && checksum /= NoCheckSum) || checksum == CheckSum) $ do+ let checksumfile = takeFileName url+ exists <- doesFileExist checksumfile+ putStrLn ""+ unless exists $+ cmd_ "curl" ["-C", "-", "-s", "-S", "-O", url]+ 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` 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] checkForFedoraKeys :: IO Bool checkForFedoraKeys = pipeBool ("gpg",["--list-keys"]) ("grep", ["-q", " Fedora .*(" <> tgtrel <> ").*@fedoraproject.org>"]) -updateSymlink :: Bool -> FilePath -> FilePath -> IO ()-updateSymlink dryrun target symlink =- unless dryrun $ do- symExists <- doesFileExist symlink+updateSymlink :: FilePath -> FilePath -> String -> IO ()+updateSymlink target symlink showdestdir = do+ symExists <- do+ havefile <- doesFileExist symlink+ if havefile then return True+ else do+ -- check for broken symlink+ dirfiles <- listDirectory "."+ return $ symlink `elem` dirfiles if symExists then do linktarget <- readSymbolicLink symlink when (linktarget /= target) $ do removeFile symlink- createSymbolicLink target symlink- putStrLn $ unwords [symlink, "->", target]- else do- createSymbolicLink target symlink- putStrLn $ unwords [symlink, "->", target]-+ makeSymlink+ else makeSymlink+ where+ makeSymlink = do+ putStrLn ""+ createSymbolicLink target symlink+ putStrLn $ unwords [showdestdir </> symlink, "->", target] editionType :: FedoraEdition -> String editionType Server = "dvd"@@ -303,3 +343,15 @@ s </> t | last s == '/' = init s </> t | head t == '/' = s </> tail t s </> t = s <> "/" <> t++bootImage :: FilePath -> IO ()+bootImage img = do+ let fileopts =+ case takeExtension img of+ ".iso" -> ["-boot", "d", "-cdrom"]+ _ -> []+ mQemu <- findExecutable "qemu-kvm"+ case mQemu of+ Just qemu ->+ cmd_ qemu (["-m", "2048", "-usb", "-rtc", "base=localtime"] ++ fileopts ++ [img])+ Nothing -> error' "Need qemu to run image"
README.md view
@@ -1,6 +1,6 @@ # dl-fedora -Previously called `fedora-img-dl`.+Earlier called `fedora-img-dl`. [](https://hackage.haskell.org/package/dl-fedora) [](LICENSE)@@ -19,6 +19,8 @@ `dl-fedora -e kde respin` : downloads the latest KDE Live respin `dl-fedora --edition server --arch aarch64 29` : will bring down the F29 Server iso++`dl-fedora --run 31` : will download Fedora 31 Workstation and boot the Live image with qemu-kvm. 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,9 +1,9 @@ cabal-version: 1.18 name: dl-fedora-version: 0.6+version: 0.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+-- can change to GPL-3.0-or-later with Cabal-2.2 license: GPL-3 license-file: LICENSE homepage: https://github.com/juhp/dl-fedora