diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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 ." + 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 ", + P.text "and also ." + ] 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" diff --git a/dl-fedora.cabal b/dl-fedora.cabal --- a/dl-fedora.cabal +++ b/dl-fedora.cabal @@ -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,