Owner.hs

{-----------------------------------------------------------------
 
  this module contains the functionality to search for the package
  owning a particular system installed file on the filesystem


  (c) 2008-2009 Markus Dittrich 
 
  This program is free software; you can redistribute it 
  and/or modify it under the terms of the GNU General Public 
  License Version 3 as published by the Free Software Foundation. 
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License Version 3 for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 59 Temple Place - Suite 330, 
  Boston, MA 02111-1307, USA.

--------------------------------------------------------------------}


module Drivers.Owner ( display_file_owner ) where


-- imports
import Prelude
import System.FilePath.Posix((</>), joinPath, splitPath, 
  takeBaseName)
import Text.Regex.PCRE((=~))


-- local imports
import Parsers.Content(get_content)
import Helpers.FileIO(retrieve_directory_contents)
import Helpers.PrettyPrint(putColorStr, Color(..))



-- | main handler for displaying the owners of a supplied file
display_file_owner :: FilePath -> [FilePath] -> IO ()
display_file_owner filePath paths =

  mapM_ (\path -> do
    -- peek into category and then into each packages CONTENTS 
    packages <- retrieve_directory_contents path
    let categoryName = takeBaseName path 
    matches <- check_contents filePath path categoryName packages 
    print_owner matches filePath 
  ) paths



-- | check if one of the CONTENTS file of packages in a 
-- category contains the looked for file. Instead
-- of parsing the whole file, we do a simple pattern
-- match on the complete content read in as a ByteString
--
-- NOTE: In order to handle lookups through the /usr/lib
-- symlink to /usr/lib64 on amd64 systems we employ a hack:
-- each provided filepath is copied to a second variable
-- with lib replaced by lib64 and both filepaths are matched
-- against the contents of each package. This creates
-- some overhead for non-lib packages and on non x86 systems
-- but the speed impact should be small.
-- 
check_contents :: FilePath -> FilePath -> String -> [FilePath] 
                    -> IO [String]
check_contents filePath baseDir category packages = check [] packages

  where
    check :: [String] -> [FilePath] -> IO [String]
    check acc [] = return acc
    check acc (x:xs) = 
    
      -- read CONTENT and parse it
      get_content (baseDir </> x)
      >>= \content -> 
        let 
          match1 = (content =~ (filePath ++ " ") :: Bool) 
          match2 = (content =~ (replace_lib filePath ++ " ") :: Bool)
        in
        
          -- append and move to next package
          if match1 || match2
          then 
            check ((category </> x):acc) xs
          else 
            check acc xs 


-- | function replacing all occurences of lib with lib64 in
-- and arbitrary filepath
replace_lib :: FilePath -> FilePath
replace_lib = joinPath 
              . map (\x -> if x == "lib/" then "lib64/" else x)
              . splitPath



-- | print successfully matched files
print_owner :: [String] -> String -> IO () 
print_owner matches filePath = 
  
  mapM_ (\m -> do
    putStr $ m ++ " ["
    putColorStr Red filePath
    putStrLn "]" 
  ) matches