Binary.hs

-----------------------------------------------------------------------------
-- |
-- Module: System.Debian.Binary.Utils.Temp
-- Copyright: (c) 2008 Marco Túlio Gontijo e Silva <marcot@riseup.net>
-- License: Simple permissive license (see LICENSE)
--
-- Maintainer: Marco Túlio Gontijo e Silva <marcot@riseup.net>
-- 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