imported fquery-0.2
[fquery.git] / Adelie / QCheck.hs
blob9b4803ab4c3bd0654f0622e0f3a1b2bd672f26a1
1 -- QMD5sum.hs
2 --
3 -- Check MD5sums and timestamps of installed packages.
5 module Adelie.QCheck (qCheck) where
7 import Char (isHexDigit)
8 import IO
9 import Monad (unless)
10 import System
11 import System.Process (runProcess, waitForProcess)
12 import System.Posix.Files (getFileStatus)
13 import System.Posix.IO (createPipe, fdToHandle)
15 import Adelie.Colour
16 import Adelie.Contents
17 import Adelie.Portage
18 import Adelie.Pretty
20 -- Good, Bad
21 type Count = (Int, Int)
23 ----------------------------------------------------------------
25 qCheck :: [String] -> IO ()
26 qCheck args = mapM_ check =<< findInstalledPackages args
28 check :: (String, String) -> IO ()
29 check catname = do
30 putStr "Checking " >> putCatNameLn catname
31 (g, b) <- readContents check' contents (0, 0)
32 putNum g >> putStr " out of " >> putNum (b+g) >> putStrLn " files good"
33 putChar '\n'
34 where contents = contentsFromCatName catname
36 check' :: Contents -> Count -> IO (Bool, Count)
38 check' (Dir _) (g, b) = return (False, (g+1, b))
40 check' (Obj o m _) (g, b) = do
41 r <- try (getFileStatus o)
42 case r of
43 Left e -> do
44 inRed (putStr "!!! ") >> putStr o >> putStrLn " does not exist"
45 return (False, (g, b+1))
46 Right stat -> do
47 (rd, wr) <- createPipeHandle
48 runMD5sum o (Just wr) >>= waitForProcess
49 ln <- hGetLine rd
50 hClose rd
51 hClose wr
52 if m == (takeWhile isHexDigit ln)
53 then return (False, (g+1, b))
54 else putMD5error o >> return (False, (g, b+1))
56 check' (Sym _ _ _) (g, b) = return (False, (g+1, b))
58 ----------------------------------------------------------------
60 createPipeHandle :: IO (Handle, Handle)
61 createPipeHandle = do
62 (read, write) <- createPipe
63 hRead <- fdToHandle read
64 hWrite <- fdToHandle write
65 return (hRead, hWrite)
67 ----------------------------------------------------------------
69 runMD5sum f stdout = runProcess md5sum [f] Nothing Nothing stdin stdout stderr
70 where md5sum = "/usr/bin/md5sum"
71 stdin = Nothing
72 stderr = Nothing
74 putMD5error :: String -> IO ()
75 putMD5error file =
76 inRed (putStr "!!! ") >> putStrLn (file ++ " has incorrect md5sum")