diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,14 @@ +Copyright (c) 2008 Marco Túlio Gontijo e Silva + +Permission is hereby granted, free of charge, to any person obtaining this work +(the "Work"), to deal in the Work without restriction, including without +limitation the rights to use, copy, modify, merge, publish, distribute, +sublicense, and/or sell copies of the Work, and to permit persons to whom the +Work is furnished to do so. + +THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, +INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A +PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS IN THE WORK. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,32 @@ +DEBIAN-BINARY 0.0.1 +=================== + +This package is util for manipulating Debian binary packages. It contains 3 +executables: + +1. manual + +Usage: manual PACKAGE + +Extracts the content of PACKAGE to /tmp/debian-binary and waits for a character +input from the user. After the input, every change on the file will be +packaged to a file written in /tmp/PACKAGE. The files of PACKAGE will be +accessible in the following path: + +debian-binary +control.tar.gz +data.tar.gz +control/ +data/ + +2. query + +Usage: query COMMAND PACKAGE ... + +Extracts each PACKAGE and runs COMMAND in it. + +3. update + +Usage: update COMMAND PACKAGE ... + +Extracts each PACKAGE, runs COMMAND and repacks it. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Debian/Binary.hs b/System/Debian/Binary.hs new file mode 100644 --- /dev/null +++ b/System/Debian/Binary.hs @@ -0,0 +1,113 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff --git a/System/Debian/Binary/Utils.hs b/System/Debian/Binary/Utils.hs new file mode 100644 --- /dev/null +++ b/System/Debian/Binary/Utils.hs @@ -0,0 +1,29 @@ +----------------------------------------------------------------------------- +-- | +-- 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 utility functions to work with Debian binary packages. +----------------------------------------------------------------------------- + +module + System.Debian.Binary.Utils + (module System.Debian.Binary.Utils.Temp, strictReadFile) + where + +import System.Debian.Binary.Utils.Temp + +-- | Read a @file@ strictly. +strictReadFile + :: FilePath -- ^ @file@ + -> IO String +strictReadFile path + = do + file <- readFile path + length file `seq` return file + diff --git a/System/Debian/Binary/Utils/Temp.hs b/System/Debian/Binary/Utils/Temp.hs new file mode 100644 --- /dev/null +++ b/System/Debian/Binary/Utils/Temp.hs @@ -0,0 +1,61 @@ +----------------------------------------------------------------------------- +-- | +-- 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 do an action and undo it after a function +-- passed as paramaeter is executed. +----------------------------------------------------------------------------- + +module + System.Debian.Binary.Utils.Temp + (cdTemp, mkdirTemp, mkdirCdTemp, gzipTemp) + where + +import Control.Exception + +import System.Directory + +import HSH + +-- | Changes the current directory to @directory@, executes @action@, and then +-- changes the current directory to the original one. +cdTemp + :: FilePath -- ^ @directory@ + -> IO result -- ^ @action@ + -> IO result +cdTemp directory action + = do + current <- getCurrentDirectory + bracket_ + (setCurrentDirectory directory) + (setCurrentDirectory current) + action + +-- | Creates a @directory@, executes @action@, then removes it and all its +-- contents. +mkdirTemp + :: FilePath -- ^ @directory@ + -> IO result -- ^ @action@ + -> IO result +mkdirTemp directory + = bracket_ (createDirectory directory) $ removeDirectoryRecursive directory + +-- | Utility function that runs 'mkdirTemp' inside a 'cdTemp'. +mkdirCdTemp :: FilePath -> IO a -> IO a +mkdirCdTemp dir = mkdirTemp dir . cdTemp dir + +-- | Extracts a gziped @file@, executes @action@ and compact it again. +gzipTemp + :: FilePath -- ^ @file@ + -> IO result -- ^ @action@ + -> IO result +gzipTemp file + = bracket_ (runIO $ "gzip -d " ++ file ++ ".gz") + $ runIO + $ "gzip --best " ++ file diff --git a/debian-binary.cabal b/debian-binary.cabal new file mode 100644 --- /dev/null +++ b/debian-binary.cabal @@ -0,0 +1,29 @@ +name: debian-binary +version: 0.0.1 +cabal-version: >= 1.2.3.0 +build-type: Simple +license: OtherLicense +license-file: LICENSE +copyright: (c) 2008 Marco Túlio Gontijo e Silva +author: Marco Túlio Gontijo e Silva +maintainer: Marco Túlio Gontijo e Silva +synopsis: Utilities to work with debian binary packages +description: + This package provides a library and some tools to work with debian binary + packages. +category: System +tested-with: GHC == 6.8.2 +extra-source-files: README +Library + build-depends: base, directory, filepath, HSH + exposed-modules: + System.Debian.Binary + , System.Debian.Binary.Utils + , System.Debian.Binary.Utils.Temp + ghc-options: -Wall +Executable manual + main-is: manual.hs +Executable query + main-is: query.hs +Executable update + main-is: update.hs diff --git a/manual.hs b/manual.hs new file mode 100644 --- /dev/null +++ b/manual.hs @@ -0,0 +1,6 @@ +import System.Environment + +import System.Debian.Binary + +main :: IO () +main = getArgs >>= flip updatePackage (getChar >> return ()) . head diff --git a/query.hs b/query.hs new file mode 100644 --- /dev/null +++ b/query.hs @@ -0,0 +1,18 @@ +import System.Environment +import System.IO + +import HSH + +import System.Debian.Binary + +main :: IO () +main + = do + args <- getArgs + mapM_ (\deb -> withPackage deb $ showContents (head args) deb) $ tail args + +showContents :: String -> FilePath -> IO () +showContents command deb + = hPutStrLn stdout ("PACOTE: " ++ deb) + >> hFlush stdout + >> runIO command diff --git a/update.hs b/update.hs new file mode 100644 --- /dev/null +++ b/update.hs @@ -0,0 +1,12 @@ +import System.Environment +import System.IO + +import HSH + +import System.Debian.Binary + +main :: IO () +main + = do + args <- getArgs + mapM_ (flip updatePackage $ runIO $ head args) $ tail args