diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Chris Done + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Chris Done nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 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/cabal-sign.cabal b/cabal-sign.cabal new file mode 100644 --- /dev/null +++ b/cabal-sign.cabal @@ -0,0 +1,26 @@ +name: cabal-sign +version: 0.1.0.0 +synopsis: Sign and verify Cabal packages. +description: Sign and verify Cabal packages. +license: BSD3 +license-file: LICENSE +author: Chris Done +maintainer: chrisdone@gmail.com +category: Development +build-type: Simple +cabal-version: >=1.8 + +executable cabal-sign + main-is: Main.hs + ghc-options: -O2 + hs-source-dirs: src + build-depends: base > 4 && < 5, + pureMD5, + optparse-applicative, + zlib, + tar, + bytestring, + directory, + cereal, + filepath, + process diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Codec.Archive.Tar (Entry,EntryContent(..)) +import qualified Codec.Archive.Tar as Tar +import qualified Codec.Archive.Tar.Entry as Tar +import qualified Codec.Compression.GZip as Gzip +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as L +import qualified Data.Digest.Pure.MD5 as Md5 +import Data.List +import Data.Serialize +import Data.String +import System.Directory +import System.Environment +import System.FilePath +import System.IO +import System.Process + +data Options = OptionSign FilePath | Verify FilePath + +main = do + (cmd:archive:_) <- getArgs + case cmd of + "sign" -> sumAndSign archive + "verify" -> verify archive + +sumAndSign :: FilePath -> IO () +sumAndSign fp = do + exists <- doesFileExist fp + if not exists + then error $ fp ++ " doesn't exist" + else do gzip <- L.readFile fp + entries <- getGzipEntries gzip + L.writeFile sum (checksum entries) + rawSystem "gpg" ["--detach-sign",sum] + removeFile sum + addSignature fp (sum <.> "sig") entries + + where sum = translate ".sum" fp + +addSignature :: FilePath -> FilePath -> [Entry] -> IO () +addSignature gz sig entries = do + signature <- L.readFile sig + case Tar.toTarPath False (makeSigName gz) of + Left err -> error err + Right spath -> do + let sigEntry = Tar.fileEntry spath signature + L.writeFile (translate ".signed.tar.gz" gz) + (Gzip.compress (Tar.write (sigEntry : entries))) + removeFile sig + +makeSigName = translate ".sig" . takeFileName + +translate ext = (++ ext) . dropSigned . dropExtension . dropExtension where + dropSigned x | isSuffixOf ".signed" x = dropExtension x + | otherwise = x + + +getGzipEntries gzip = + case result of + Left err -> error ("tar reading error: " ++ show err) + Right entries -> return entries + + where result = Tar.foldEntries (fmap . (:)) + (Right []) + Left + (Tar.read (Gzip.decompress gzip)) + +checksum :: [Entry] -> ByteString +checksum entries = L.intercalate "\n" (filter (not . L.null) (map hashEntry (sort (map Tar.entryContent entries)))) + +hashEntry :: EntryContent -> ByteString +hashEntry entry = + case entry of + NormalFile bytes _ -> hexify (Md5.md5 bytes) + SymbolicLink target -> encodeTarget target + HardLink target -> encodeTarget target + OtherEntryType typ bytes _ -> hexify (Md5.md5 (L.cons (word typ) bytes)) + CharacterDevice major minor -> L.cons (word 'c') (L.concat [iword major,iword minor]) + BlockDevice major minor -> L.cons (word 'b') (L.concat [iword major,iword minor]) + _ -> L.empty + + where encodeTarget = fromString . Tar.fromLinkTarget + iword = fromString . show + hexify = fromString . show + word = fromIntegral . fromEnum + +verify :: FilePath -> IO () +verify fp = do + exists <- doesFileExist fp + if not exists + then error $ fp ++ " doesn't exist" + else do gzip <- L.readFile fp + entries <- getGzipEntries gzip + case find isSig entries of + Nothing -> error $ "unable to find " ++ sigName ++ " in archive" + Just entry -> do + L.writeFile sum (checksum (filter (not . isSig) entries)) + L.writeFile sig (getEntryFileContent entry) + rawSystem "gpg" ["--verify",sig,sum] + removeFile sum + removeFile sig + + where sigName = makeSigName fp + sum = translate ".sum" fp + isSig = (==sigName) . Tar.entryPath + sig = translate ".sig" fp + +getEntryFileContent entry = + case Tar.entryContent entry of + NormalFile bytes _ -> bytes + _ -> error "malformed signature in the tar archive"