diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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 ", P.text "and also ." ] 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" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # dl-fedora -Previously called `fedora-img-dl`. +Earlier called `fedora-img-dl`. [![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) @@ -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"`. diff --git a/dl-fedora.cabal b/dl-fedora.cabal --- a/dl-fedora.cabal +++ b/dl-fedora.cabal @@ -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