dl-fedora 0.5 → 0.6
raw patch · 3 files changed
+145/−106 lines, 3 filesdep ~http-directory
Dependency ranges changed: http-directory
Files
- CHANGELOG.md +10/−0
- Main.hs +133/−104
- dl-fedora.cabal +2/−2
CHANGELOG.md view
@@ -1,5 +1,15 @@ # Changelog +## 0.6 (2019-09-02)+- major rework to correct the url logic+ - first checks on dl.fedoraproject.org (master)+ - then tries to download corresponding filepath on download.fedoraproject.org+ - or falls back to master mirror+- new --dl option to download directly from dl.fedoraproject.org+- can now find branched development release+- also compares mirror and master filesizes+- builds with lts-14+ ## 0.5 (2019-07-06) - no hardcoding of devel branch, beta, and respins - fix Spins and Cloud/Container paths
Main.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} +import Control.Applicative ((<|>) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else-import Control.Applicative ((<$>), (<*>))+ , (<$>), (<*>) #endif+ ) import Control.Monad (when, unless) import qualified Data.ByteString.Char8 as B@@ -27,7 +29,7 @@ doesFileExist, getPermissions, removeFile, setCurrentDirectory, writable) import System.Environment.XDG.UserDir (getUserDir)-import System.FilePath (joinPath, takeExtension, takeFileName, (<.>))+import System.FilePath (dropFileName, joinPath, takeExtension, takeFileName, (<.>)) import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus, readSymbolicLink) @@ -66,25 +68,39 @@ fedoraSpins :: [FedoraEdition] fedoraSpins = [Cinnamon ..] +dlFpo, downloadFpo :: String+dlFpo = "https://dl.fedoraproject.org/pub"+downloadFpo = "https://download.fedoraproject.org/pub"+ main :: IO () main = do- let pdoc = Just $ P.text "Tool for downloading Fedora iso file images."- P.<$$> P.text ("RELEASE = " <> intercalate ", " ["rawhide", "devel", "respin", "test", "or Release version"])- P.<$$> 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.<$$> P.text "See also <https://fedoramagazine.org/verify-fedora-iso-file>."+ 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 "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 <$> switchWith 'g' "gpg-keys" "Import Fedora GPG keys for verifying checksum file" <*> switchWith 'C' "no-checksum" "Do not check checksum" <*> switchWith 'n' "dry-run" "Don't actually download anything"- <*> optional (strOptionWith 'm' "mirror" "HOST" "default https://download.fedoraproject.org")- <*> strOptionalWith 'a' "arch" "ARCH" "architecture (default x86_64)" "x86_64"- <*> optionalWith auto 'e' "edition" "EDITION" "Fedora edition: workstation [default]" Workstation+ <*> 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" <|>+ strOptionalWith 'm' "mirror" "HOST" "Mirror url for /pub [default https://download.fedoraproject.org/pub]" downloadFpo -findISO :: Bool -> Bool -> Bool -> Maybe String -> String -> FedoraEdition -> String -> IO ()-findISO gpg nochecksum dryrun mhost arch edition tgtrel = do- (fileurl, prefix, remotesize, mchecksum) <- findURL+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 dlDir <- getUserDir "DOWNLOAD" if dryrun then do@@ -94,128 +110,125 @@ createDirectoryIfMissing False dlDir setCurrentDirectory dlDir let localfile = takeFileName fileurl- symlink = dlDir </> prefix <> "-latest" <.> takeExtension fileurl- done <- downloadFile fileurl remotesize localfile+ done <- downloadFile mgr fileurl (masterUrl,masterSize) localfile when (done && not nochecksum) $ fileChecksum mchecksum- updateSymlink localfile symlink+ let symlink = dlDir </> filenamePrefix <> "-latest" <.> takeExtension fileurl+ updateSymlink dryrun localfile symlink where- -- (top,path,mfile)- urlPath :: (String,String,Maybe String)- urlPath =- if tgtrel == "respin"- then ("", "",- Just ("F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64"))- else- let dirpath =- case tgtrel of- "rawhide" -> "development"- "devel" -> "development"- "test" -> "releases/test"- rel | all isDigit rel -> "releases"- _ -> error' "Unknown release"- -- dirglob = tgtrel `elem` ["devel","test"]- in ("linux" </> dirpath,- if edition `elem` fedoraSpins- then joinPath ["Spins", arch, "iso"]- else joinPath [show edition, arch, editionMedia edition],- Nothing)-- -- url, fileprefix, size, checksum- findURL :: IO (String, String, Maybe Integer, Maybe String)- findURL = do- mgr <- httpManager- let (top,path,mprefix) = urlPath- topurl <- if tgtrel == "respin"- then return "https://dl.fedoraproject.org/pub/alt/live-respins/"- else case mhost of- Just host -> return host- Nothing -> do- let dl = "https://download.fedoraproject.org/"- redirect <- httpRedirect mgr dl- case redirect of- Nothing -> error' $ dl <> " redirect to mirror failed"- Just u -> return $ B.unpack u </> top- mreldir <-- case tgtrel of- "rawhide" -> return $ Just "rawhide"- rel | all isDigit rel -> return $ Just rel- "respin" -> return Nothing- -- test and devel branch- rel -> do- -- use http-directory-0.1.6 removeTrailing- rels <- map (T.unpack . T.dropWhileEnd (== '/')) <$> httpDirectory mgr topurl- return $ listToMaybe $- case rels of- [] -> error' $ rel <> " release not found in " <> topurl- ["rawhide"] -> ["rawhide"]- _ -> delete "rawhide" rels- -- http dirs Should end in "/" probably- let finalUrl = topurl </> fromMaybe "" mreldir </> path <> "/"- hrefs <- httpDirectory mgr finalUrl- let prefixPat = fromMaybe (makeFilePrefix mreldir) mprefix+ -- urlpath, fileprefix, (master,size), checksum+ findURL :: Manager -> IO (String, String, (String,Maybe Integer), Maybe String)+ findURL mgr = do+ (path,mrelease) <- urlPathMRel mgr+ -- use http-directory trailing (0.1.6)+ let masterDir = dlFpo </> path <> "/"+ hrefs <- httpDirectory mgr masterDir+ let prefixPat = makeFilePrefix mrelease selector = if '*' `elem` prefixPat then (=~ prefixPat) else (prefixPat `isPrefixOf`) mfile = listToMaybe $ filter selector $ map T.unpack hrefs mchecksum = listToMaybe $ filter ((if tgtrel == "respin" then T.isPrefixOf else T.isSuffixOf) (T.pack "CHECKSUM")) hrefs case mfile of Nothing ->- error' $ "no match for " <> prefixPat <> " in " <> finalUrl+ error' $ "no match for " <> prefixPat <> " in " <> masterDir Just file -> do- let finalfile = finalUrl </> file- putStrLn finalfile- let prefix = if '*' `elem` prefixPat+ 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 then file =~ prefixPat else prefixPat- size <- httpFileSize mgr finalfile- return (finalfile, prefix, size, (finalUrl </>) . T.unpack <$> mchecksum)- makeFilePrefix :: Maybe String -> String- makeFilePrefix mreldir =- let showRel "rawhide" = "Rawhide"- showRel r = if last r == '/' then init r else r- rel = maybeToList (showRel <$> mreldir)- middle =- if edition `elem` [Cloud, Container]- then rel ++ [".*" <> arch]- else arch : rel- in- intercalate "-" (["Fedora", show edition, editionType edition] ++ middle)+ putStrLn finalurl+ return (finalurl, prefix, (masterUrl,size), (finalDir </>) . T.unpack <$> mchecksum) - 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- putStrLn $ unwords [symlink, "->", target]+ -- avoid import of Manager until http-directory-0.1.6+ urlPathMRel :: Manager -> IO (String, 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")+ "devel" -> checkForRelease mgr "development" subdir+ "test" -> checkForRelease mgr "releases/test" 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+ -- 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)++ checkReleased :: Manager -> FilePath -> FilePath -> IO (FilePath, Maybe String)+ checkReleased 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- createSymbolicLink target symlink- putStrLn $ unwords [symlink, "->", target]+ 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/" - downloadFile :: String -> Maybe Integer -> String -> IO Bool- downloadFile url remotesize localfile = do+ makeFilePrefix :: Maybe String -> String+ makeFilePrefix mrelease =+ if tgtrel == "respin" then "F[1-9][0-9]*-" <> liveRespin edition <> "-x86_64"+ else+ 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 :: 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) == remotesize+ 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 return False+ 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 else do cmd_ "curl" ["-C", "-", "-O", url]- return False+ return True fileChecksum :: Maybe FilePath -> IO () fileChecksum mchecksum =@@ -250,6 +263,22 @@ 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+ 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]+ editionType :: FedoraEdition -> String editionType Server = "dvd"
dl-fedora.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: dl-fedora-version: 0.5+version: 0.6 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@@ -30,7 +30,7 @@ bytestring, directory, filepath,- http-directory >= 0.1.2,+ http-directory >= 0.1.5, http-types, optparse-applicative, regex-posix,