diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,8 @@ # Changelog +## 0.2 +- fix and improve symlink naming +- use new http-directory library to check exact filesize + ## 0.1 * initial release diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -7,61 +7,81 @@ import Control.Monad (when, unless) import qualified Data.ByteString.Char8 as B +import Data.Char (isDigit, toLower) +import Data.List (intercalate) import Data.Maybe import Data.Semigroup ((<>)) import Data.Text (Text) +import qualified Data.Text as T -import Network.HTTP.Client (brConsume, hrFinalResponse, hrRedirects, newManager, parseRequest, responseBody, responseHeaders, responseOpenHistory, responseStatus) +import Network.HTTP.Client (newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) -import Network.HTTP.Types (decodePathSegments, extractPath, statusCode) +import Network.HTTP.Types (decodePathSegments, extractPath) -import qualified Data.Text as T +import Network.HTTP.Directory import Options.Applicative (auto, fullDesc, header, optional, progDescDoc) import qualified Options.Applicative.Help.Pretty as P -import Text.HTML.DOM (parseBSChunks) -import Text.XML.Cursor +import Paths_fedora_img_dl (version) + import SimpleCmd (cmd_, error') import SimpleCmdArgs -import Paths_fedora_img_dl (version) -import System.Directory (doesFileExist, getPermissions, removeFile, +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, + doesFileExist, getPermissions, removeFile, setCurrentDirectory, writable) import System.Environment.XDG.UserDir (getUserDir) -import System.FilePath (takeExtension, takeFileName, (), (<.>)) -import System.Posix.Files (createSymbolicLink, readSymbolicLink) +import System.FilePath (joinPath, 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 + data FedoraEdition = Cloud | Container | Everything | Server | Silverblue - | Spins | Workstation - deriving (Read, Show) + deriving (Show, Enum, Bounded) +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 + main :: IO () main = let pdoc = Just $ P.text "Tool for downloading Fedora iso file images." - P.<$$> P.text "RELEASE can be 'rawhide', 'branched', 'respin', 'beta' or release version" in + P.<$$> P.text "RELEASE can be 'rawhide', 'respin', 'beta' or release version" in simpleCmdArgsWithMods (Just version) (fullDesc <> header "Fedora iso downloader" <> progDescDoc pdoc) $ findISO - <$> switchWith 'n' "dry-run" "Don't actually download anything" - <*> optional (strOptionWith 'm' "mirror" "HOST" "default https://download.fedoraproject.org") + <$> optional (strOptionWith 'm' "mirror" "HOST" "default https://download.fedoraproject.org") + <*> switchWith 'n' "dry-run" "Don't actually download anything" <*> strOptionalWith 'a' "arch" "ARCH" "architecture (default x86_64)" "x86_64" - <*> optionalWith auto 'e' "edition" "EDITION" "Fedora edition (Workstation [default], Server, ...)" Workstation + <*> optionalWith auto 'e' "edition" "EDITION" "Fedora edition: workstation [default], server, ..." Workstation <*> strArg "RELEASE" -findISO :: Bool -> Maybe String -> String -> FedoraEdition -> String -> IO () -findISO dryrun mhost arch edition release = do - let (mlocn, relpath, mprefix) = - case release of - "rawhide" -> (Nothing, "development/rawhide", Nothing) - "respin" -> (Just "https://dl.fedoraproject.org", "pub/alt/live-respins/", Just "F29-WORK-x86_64") - "beta" -> (Nothing ,"releases/test/30_Beta", Nothing) -- FIXME: navigate! - rel | rel `elem` ["30", "branched"] -> (Nothing, "development/30", Nothing) -- FIXME: navigate! - _ -> (Nothing, "releases" release, Nothing) +findISO :: Maybe String -> Bool -> String -> FedoraEdition -> String -> IO () +findISO mhost dryrun arch edition tgtrel = do + let (mlocn, relpath, mprefix, mrelease) = + case tgtrel of + "rawhide" -> (Nothing, "development/rawhide", Nothing, Just "Rawhide") + -- FIXME: version hardcoding for respin, beta, and 30 + "respin" -> (Just "https://dl.fedoraproject.org", "pub/alt/live-respins/", Just "F29-WORK-x86_64", Nothing) + "beta" -> (Nothing ,"releases/test/30_Beta", Nothing, Just "30_Beta") -- FIXME: hardcoding + "30" -> (Nothing, "development/30", Nothing, Just "30") -- FIXME: hardcoding + rel | all isDigit rel -> (Nothing, "releases" rel, Nothing, Just rel) + _ -> error' "Unknown release" when (isJust mlocn && isJust mhost && mlocn /= mhost) $ error' "Cannot specify host for this image" let host = fromMaybe "https://download.fedoraproject.org" $ @@ -69,62 +89,71 @@ toppath = if null ((decodePathSegments . extractPath) (B.pack host)) then "pub/fedora/linux" else "" - url = if isJust mlocn then host relpath else host toppath relpath show edition arch editionMedia edition ++ "/" - fileurl <- checkURL url mprefix - putStrLn fileurl - unless dryrun $ do - dlDir <- getUserDir "DOWNLOAD" + url = if isJust mlocn then host relpath else joinPath [host, toppath, relpath, show edition, arch, editionMedia edition <> "/"] + prefix = fromMaybe (intercalate "-" ([editionPrefix edition, arch] <> maybeToList mrelease)) mprefix + (fileurl, remotesize) <- findURL url prefix + 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 - exists <- doesFileExist localfile - when exists $ do - putStrLn "Image file already exists" + let localfile = takeFileName fileurl + symlink = dlDir prefix <> "-latest" <.> takeExtension fileurl + exists <- doesFileExist localfile + if exists + then do + filestatus <- getFileStatus localfile + let localsize = fileSize filestatus + if Just (fromIntegral localsize) == remotesize + then do + putStrLn "File already fully downloaded" + updateSymlink localfile symlink + else do canwrite <- writable <$> getPermissions localfile unless canwrite $ error' "file does have write permission, aborting!" - cmd_ "curl" ["-C", "-", "-O", fileurl] - let symlink = dlDir T.unpack (editionPrefix edition) ++ "-" ++ arch ++ "-" ++ show release ++ "-latest" <.> takeExtension fileurl - symExists <- doesFileExist symlink - if symExists - then do - lnktgt <- readSymbolicLink symlink - unless (lnktgt == localfile) $ do - removeFile symlink - createSymlink localfile symlink - else createSymlink localfile symlink + downloadFile fileurl + updateSymlink localfile symlink + else do + downloadFile fileurl + updateSymlink localfile symlink where - checkURL :: String -> Maybe Text -> IO String - checkURL url mprefix = do - req <- parseRequest url + findURL :: String -> String -> IO (String, Maybe Integer) + findURL url prefix = do mgr <- newManager tlsManagerSettings - respHist <- responseOpenHistory req mgr - let redirect = listToMaybe . reverse $ mapMaybe (lookup "Location" . responseHeaders . snd) $ hrRedirects respHist + redirect <- httpRedirect mgr url let finalUrl = maybe url B.unpack redirect - when (isJust redirect) $ putStr "Redirected to " - let response = hrFinalResponse respHist - -- print finalUrl - if statusCode (responseStatus response) /= 200 - then - error' $ show $ responseStatus response - else do - body <- brConsume $ responseBody response - let doc = parseBSChunks body - cursor = fromDocument doc - hrefs = concatMap (attribute "href") $ cursor $// element "a" - prefix = fromMaybe (editionPrefix edition) mprefix - mfile = listToMaybe $ filter (prefix `T.isPrefixOf`) hrefs :: Maybe Text - case mfile of - Nothing -> do - print doc - error' $ "not found " ++ finalUrl - Just file -> - return $ finalUrl T.unpack file + hrefs <- httpDirectory mgr finalUrl + let mfile = listToMaybe $ filter (T.pack prefix `T.isPrefixOf`) hrefs :: Maybe Text + case mfile of + Nothing -> + error' $ "not found " <> finalUrl + Just file -> do + let finalfile = finalUrl T.unpack file + putStrLn finalfile + size <- httpFileSize mgr finalfile + return (finalfile, size) - createSymlink :: FilePath -> FilePath -> IO () - createSymlink tgt symlink = do - createSymbolicLink tgt symlink - putStrLn $ symlink ++ " -> " ++ tgt + updateSymlink :: FilePath -> FilePath -> IO () + updateSymlink target symlink = + unless dryrun $ do + symExists <- doesFileExist symlink + if symExists + then do + linktarget <- readSymbolicLink symlink + when (linktarget /= target) $ do + removeFile symlink + createSymbolicLink target symlink + else createSymbolicLink target symlink + putStrLn $ unwords [symlink, "->", target] -editionPrefix :: FedoraEdition -> Text + downloadFile :: String -> IO () + downloadFile url = + unless dryrun $ cmd_ "curl" ["-C", "-", "-O", url] + +editionPrefix :: FedoraEdition -> String editionPrefix Workstation = "Fedora-Workstation-Live" editionPrefix Server = "Fedora-Server-dvd" editionPrefix Silverblue = "Fedora-Silverblue-ostree" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,10 +5,20 @@ [![Stackage Lts](http://stackage.org/package/fedora-img-dl/badge/lts)](http://stackage.org/lts/package/fedora-img-dl) [![Stackage Nightly](http://stackage.org/package/fedora-img-dl/badge/nightly)](http://stackage.org/nightly/package/fedora-img-dl) -Fedora image download tool +A tool for downloading Fedora images. +By default it targets the Workstation edition of Fedora. -`fedora-img-dl 31` downloads by default the Fedora 31 Workstation Live iso +Usage example: -`fedora-img-dl -e Silverblue` downloads Fedora 30 Silverblue iso +`fedora-img-dl rawhide` : downloads the latest Fedora Rawhide Workstation Live iso -`fedora-img-dl --edition Silver --arch aarch64 29` will bring down F29 Server iso +`fedora-img-dl respin` : downloads the latest Live Workstation respin + +`fedora-img-dl -e silverblue 30` : downloads Fedora 30 Silverblue iso + +`fedora-img-dl --edition server --arch aarch64 29` : will bring down the F29 Server iso + +(Currently Spins are not yet supported.) + +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/fedora-img-dl.cabal b/fedora-img-dl.cabal --- a/fedora-img-dl.cabal +++ b/fedora-img-dl.cabal @@ -1,10 +1,13 @@ cabal-version: 1.18 name: fedora-img-dl -version: 0.1 +version: 0.2 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 license: GPL-3 license-file: LICENSE +homepage: https://github.com/juhp/fedora-img-dl +bug-reports: https://github.com/juhp/fedora-img-dl/issues author: Jens Petersen maintainer: juhpetersen@gmail.com copyright: 2019 Jens Petersen @@ -27,19 +30,16 @@ bytestring, directory, filepath, - html-conduit, http-client, http-client-tls, + http-directory, http-types, - hxt, - network-uri, optparse-applicative, simple-cmd >= 0.1.4, simple-cmd-args >= 0.1.1, text, unix, - xdg-userdirs, - xml-conduit + xdg-userdirs if impl(ghc<8.0) Build-depends: semigroups @@ -47,4 +47,3 @@ -Wall default-language: Haskell2010 - default-extensions: OverloadedStrings