Greetings, If we have a package, which doesn't migrate to testing, we usually check the "Why does package X not in testing yet?" page or the PTS. Usually they do a great job in telling us why our package doesn't migrate. But sometimes you have packages, which have complicated dependencies, that don't make it easy to tell why our package doesn't migrate. Usually the PTS and "Why is package X not in testing yet?" fail at those packages and don't give any useful explanation. For example look at the page for haskell-hgettext[1]. Those packages usually have to go into testing together with a few other packages. If it's getting worse your package needs to go into testing with a lot of other packages (usually if your package is part of a bigger transition). If your package is part of a transition you might have luck and the transition page can tell you what the problem is. But sometimes not even that pages help. For that reason I made a tool that takes a package name and tries to find out why your package doesn't migrate to testing. When run, it gathers all packages that block our given package X. Then it fetches all excuses for these packages and throws all of them away, except those that are identified as interesting. These types of excuses are identified as interesting: - out of date on <arch> - <pkg> has new bugs - Too young This takes a long time (for me 3 Minutes) depending on your internet connection. This is mostly useful for haskell packages, as they have very close dependencies. However, it might be interesting in any other transition. The source code is attached and can be found in the tools repository[2] of the Haskell Group. In order to compile it you need the following packages: - ghc - libghc-regex-pcre-dev - libpcre++-dev (This should be a dependency of libghc-regex-pcre-dev but it isn't due to a bug) Compile it with: ghc --make reasons.hs To run it you need the following packages: - devscripts - wget - ca-certificates - locales (you should use an UTF-8 encoding, otherwise its guaranteed you will have problems.) Also you must have enabled the source URIs in you sources.list. There are still some rough edges. The most notable ones are: - Most errors that can happen aren't catched. So an haskell exception will be thrown, which gives not very much information of the problem. - The excuses are fetched with grep-excuses. So the excuses file is downloaded over ad over again. There is already a bug with a patch filed against grep-excuses to fix this. - "out of date" excuses are all considered interesting, even though it would be better to only include those that aren't in state B-D unistallable. A bit more detail on the workflow of this tool is described in this[3] post. [1]: https://release.debian.org/migration/testing.pl?package=haskell-hgettext [2]: http://anonscm.debian.org/cgit/pkg-haskell/tools.git/ [3]: https://lists.debian.org/debian-haskell/2014/08/msg00027.html
import Text.Regex.PCRE
import System.Environment
import System.Exit
import System.Process
import System.IO
import Data.Maybe
import Data.List
import Data.Char
import qualified Data.Set as S
import Control.Exception
import System.IO.Error
import System.Directory
import Debug.Trace
data Excuses = Excuses String [String]
isEmpty :: Excuses -> Bool
isEmpty (Excuses _ []) = False
isEmpty (Excuses _ _) = True
excuses2String :: Excuses -> String
excuses2String (Excuses pkg excuses) = unlines $ (pkg ++ ":"):(map (" " ++) excuses)
main = do
package <- getArgs >>= parse
output <- fmap lines acquireBritneyOut
let bins = getBinBlockers output package
result <- try (fmap nub $ mapM getSrcPackage bins) :: IO (Either ErrorCall [String])
srcBlockers <- case result of
Left e -> putStrLn packageNotFoundMsg >> exitFailure
Right pkgs -> return pkgs
excuses <- mapM getExcuse srcBlockers
additionalExcuses <- getAdditionalExcuses srcBlockers excuses
let filteredExcuses = filterExcuses isInteresting $ excuses ++ additionalExcuses
mapM_ putStrLn $ map excuses2String filteredExcuses
acquireBritneyOut :: IO String
acquireBritneyOut = do
cachePath <- chooseCachePath
case cachePath of
Nothing -> readProcess "/usr/bin/wget" ["-q", "-O", "-", outputUrl] ""
Just path -> do
createDirectoryIfMissing False path
setCurrentDirectory path
readProcess "/usr/bin/wget" ["-q", "-N", outputUrl] ""
readFile "update_output.txt"
chooseCachePath :: IO (Maybe String)
chooseCachePath = do
result <- tryJust shouldCatch $ getAppUserDataDirectory "reasons"
hasHome <- getHomeDirectory >>= doesDirectoryExist
return $ case result of
Right dir -> if hasHome
then Just dir
else Nothing
Left _ -> Nothing
where shouldCatch e = if isDoesNotExistError e
then Just e
else Nothing
outputUrl :: String
outputUrl = "release.debian.org/britney/update_output.txt"
parse :: [String] -> IO String
parse [package] = return package
parse _ = printUsage >> exitFailure
printUsage :: IO ()
printUsage = do
progName <- getProgName
putStrLn $ "Usage: " ++ progName ++ " package-name"
packageNotFoundMsg :: String
packageNotFoundMsg
= "The package you requested was not processed by the autohinter.\n\
\grep-excuses <pkg> should list all reasons why this package doesn't\
\migrate."
filterExcuses :: (String -> Bool) -> [Excuses] -> [Excuses]
filterExcuses f excuses = filter isEmpty $ map filterPkgExcuses excuses
where filterPkgExcuses (Excuses pkg excuses) = Excuses pkg
$ filter f excuses
isInteresting :: String -> Bool
isInteresting excuse = "out of date on" `isPrefixOf` excuse
|| "introduces new bugs" `isInfixOf` excuse
|| "Too young" `isPrefixOf` excuse
isInterestingDependency :: [String] -> String -> Bool
isInterestingDependency pkgs excuse = "(not considered)" `isSuffixOf` excuse
&& (mangleDependency excuse) `notElem` pkgs
mangleDependency :: String -> String
mangleDependency excuse
| null dependency = ""
| otherwise = tail $ dropWhile (/= ' ') dependency
where dependency = excuse =~ "(?<=Depends: ).*(?= \\(not considered\\))"
-- Takes a list of already fetched excuses and returns the excuses of missing dependencies
getAdditionalExcuses :: [String] -> [Excuses] -> IO [Excuses]
getAdditionalExcuses _ [] = return []
getAdditionalExcuses pkgs excuses = do
let interestingDepends = filterExcuses
(isInterestingDependency pkgs)
excuses
dependencies = nub $ map mangleDependency $ flattenExcuses interestingDepends
excuses <- mapM getExcuse dependencies
evenMoreExcuses <- getAdditionalExcuses (pkgs ++ dependencies) excuses
return $ excuses ++ evenMoreExcuses
flattenExcuses :: [Excuses] -> [String]
flattenExcuses excuses = concat $ map unpackExcuses excuses
unpackExcuses :: Excuses -> [String]
unpackExcuses (Excuses _ excuses) = excuses
maybeTail :: [a] -> Maybe [a]
maybeTail [] = Nothing
maybeTail (x:xs) = Just xs
getExcuse :: String -> IO Excuses
getExcuse pkg = do
hPutStrLn stderr $ "retrievieng excuses for " ++ pkg
excuses <- readProcess "/usr/bin/grep-excuses" [pkg] ""
return $ Excuses pkg $ map (dropWhile isSpace)
$ fromMaybe [] $ maybeTail $ lines excuses
getSrcPackage :: String -> IO String
getSrcPackage bin = do
hPutStrLn stderr $ "querying source for " ++ bin
packageDesc <- readProcess "/usr/bin/apt-cache" ["showsrc", bin] ""
return $ parseDesc packageDesc
parseDesc :: String -> String
parseDesc desc = let ls = lines desc
srcln = findSourceLine ls
in removeFieldPrefix srcln
findSourceLine :: [String] -> String
findSourceLine (curLine:rest)
| "Package: " `isPrefixOf` curLine = curLine
| otherwise = findSourceLine rest
getBinBlockers :: [String] -> String -> [String]
getBinBlockers output package = let arches = getArches package output
in nub $ map stripComma
$ concat
$ map words
$ map removeFieldPrefix arches
where stripComma str = if last str == ','
then init str
else str
removeFieldPrefix :: String -> String
removeFieldPrefix arch = drop 2 $ dropWhile (/= ':') arch
getArches :: String -> [String] -> [String]
getArches package output = get $ removeStats $ fromJust $ findAutohint package output
where get (line:rest)
| line `matches` " *\\* .*:" = line : get rest
| otherwise = []
removeStats :: [String] -> [String]
removeStats = drop 4
findAutohint :: String -> [String] -> Maybe [String]
findAutohint _ [] = Nothing
findAutohint package (curLine:rest)
| curLine `matches` ("Trying easy from autohinter.*" ++ package)
= Just rest
| otherwise = findAutohint package rest
matches :: String -> String -> Bool
str `matches` pattern = (not . null) (str =~ pattern :: String)
Attachment:
signature.asc
Description: PGP signature