----------------------------------------------------------------------------- -- | -- Module: System.Debian.Binary.Utils.Temp -- Copyright: (c) 2008 Marco TĂșlio Gontijo e Silva -- License: Simple permissive license (see LICENSE) -- -- Maintainer: Marco TĂșlio Gontijo e Silva -- Stability: unstable -- Portability: unportable -- -- This module provides functions to work with Debian binary packages. ----------------------------------------------------------------------------- module System.Debian.Binary (module System.Debian.Binary.Utils, updatePackage, withPackage, packageName) where import Control.Applicative import Control.Monad import Data.List import System.Directory import System.FilePath import HSH import System.Debian.Binary.Utils -- | Extracts @package@ in @\/tmp\/debian-binary@, runs @action@ and repacks -- @package@ in @\/tmp\/package@. updatePackage :: FilePath -- ^ @package@, the path to a @.deb@ file -> IO () -- ^ @action@ -> IO () updatePackage package function = do temp <- addTrailingPathSeparator <$> getTemporaryDirectory withPackage package $ function >> updateConffiles >> updateMd5sums >> archive "control" >> archive "data" >> runIO ( "ar -r " ++ temp ++ takeFileName package ++ " debian-binary control.tar.gz data.tar.gz") updateConffiles :: IO () updateConffiles = doesFileExist "control/conffiles" >>= flip when ( removeFile "control/conffiles" >> cdTemp "data" ( run "find etc -type f" >>= writeFile "../control/conffiles" . unlines . map ('/' :))) updateMd5sums :: IO () updateMd5sums = doesFileExist "control/md5sums" >>= flip when ( removeFile "control/md5sums" >> cdTemp "data" ( do exist <- doesFileExist "../control/conffiles" files <- if exist then do debFiles <- run "find * -type f" conffiles <- map tail <$> lines <$> readFile "../control/conffiles" return $ debFiles \\ conffiles else run "find * -type f" mapM_ ((run >=> appendFile "../control/md5sums") . ("md5sum " ++)) files)) archive :: String -> IO () archive field = cdTemp field $ runIO ("tar czf " ++ field ++ ".tar.gz *") >> runIO ("mv " ++ field ++ ".tar.gz ../") -- | Extracts @package@ in @\/tmp\/debian-binary@ and runs @action@. withPackage :: FilePath -- ^ @package@, the path to a @.deb@ file -> IO () -- ^ @action@ -> IO () withPackage package_ function = do current <- getCurrentDirectory let package = completeFilePath current package_ dir <- (++ "debian-binary") <$> addTrailingPathSeparator <$> getTemporaryDirectory mkdirCdTemp dir $ runIO ("ar -x " ++ show package) >> extract "control" (extract "data" function) extract :: String -> IO () -> IO () extract field function = mkdirTemp field $ cdTemp field (runIO $ "tar xzf ../" ++ field ++ ".tar.gz") >> function completeFilePath :: FilePath -> FilePath -> FilePath completeFilePath current file | not $ hasDrive file = addTrailingPathSeparator current ++ file | otherwise = file -- | Extract the package name of a debian @filename@. packageName :: FilePath -- ^ @filename@ -> String packageName = takeWhile (/= '_') . takeFileName