fedora-img-dl 0.1 → 0.2
raw patch · 4 files changed
+125/−83 lines, 4 filesdep +http-directorydep −html-conduitdep −hxtdep −network-uri
Dependencies added: http-directory
Dependencies removed: html-conduit, hxt, network-uri, xml-conduit
Files
- CHANGELOG.md +4/−0
- Main.hs +101/−72
- README.md +14/−4
- fedora-img-dl.cabal +6/−7
CHANGELOG.md view
@@ -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
Main.hs view
@@ -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"
README.md view
@@ -5,10 +5,20 @@ [](http://stackage.org/lts/package/fedora-img-dl) [](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`.
fedora-img-dl.cabal view
@@ -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