cabal-sign 0.3.2.0 → 0.4.0.0
raw patch · 3 files changed
+28/−39 lines, 3 files
Files
- cabal-sign.cabal +1/−1
- cabal-sign.sig binary
- src/Main.hs +27/−38
cabal-sign.cabal view
@@ -1,5 +1,5 @@ name: cabal-sign-version: 0.3.2.0+version: 0.4.0.0 synopsis: Sign and verify Cabal packages. description: Sign and verify Cabal packages. license: BSD3
cabal-sign.sig view
binary file changed (287 → 287 bytes)
src/Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS -Wall #-} module Main where @@ -6,27 +7,33 @@ import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar import qualified Codec.Compression.GZip as Gzip+import qualified Data.ByteString as S import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString as S-import qualified Codec.Digest.SHA as Sha2 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 :: IO () main = do- (cmd:archive:_) <- getArgs+ args <- getArgs+ case args of+ (cmd:archive:_) -> run cmd archive+ [archive] -> run "sign" archive+ _ -> help++run :: String -> FilePath -> IO ()+run cmd archive = case cmd of "sign" -> sumAndSign archive "verify" -> verify archive+ _ -> help +help :: IO ()+help = error "arguments: <sign|verify> <archive>"+ sumAndSign :: FilePath -> IO () sumAndSign fp = do exists <- doesFileExist fp@@ -34,12 +41,8 @@ then error $ fp ++ " doesn't exist" else do gzip <- fmap (L.fromChunks . return) (S.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+ _ <- rawSystem "gpg" ["--detach-sign",fp]+ addSignature fp (fp <.> "sig") entries addSignature :: FilePath -> FilePath -> [Entry] -> IO () addSignature gz sig entries = do@@ -51,45 +54,30 @@ L.writeFile gz (Gzip.compress (Tar.write (sigEntry : entries))) removeFile sig +projectName :: FilePath -> [Char] projectName = dropWhile (=='-') . translate "" . takeFileName +makeSigName :: FilePath -> FilePath makeSigName gz = projectName gz </> filename gz where filename = translate ".sig" . reverse . drop 1 . dropWhile (/='-') . reverse . takeFileName +translate :: [Char] -> FilePath -> [Char] translate ext = (++ ext) . dropSigned . dropExtension . dropExtension where dropSigned x | isSuffixOf ".signed" x = dropExtension x | otherwise = x +getGzipEntries :: ByteString -> IO [Entry] getGzipEntries gzip = case result of Left err -> error ("tar reading error: " ++ show err) Right entries -> return entries - where result = Tar.foldEntries (fmap . (:))+ where result = Tar.foldEntries (\entry -> either Left (Right . (entry:))) (Right []) Left (Tar.read (Gzip.decompress gzip)) -checksum :: [Entry] -> ByteString-checksum entries = L.intercalate "\n" (filter (not . L.null) (map hashEntry (map Tar.entryContent entries)))--hashEntry :: EntryContent -> ByteString-hashEntry entry =- case entry of- NormalFile bytes _ -> hashHex bytes- SymbolicLink target -> encodeTarget target- HardLink target -> encodeTarget target- OtherEntryType typ bytes _ -> hashHex (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- word = fromIntegral . fromEnum- hashHex = fromString . Sha2.showBSasHex . Sha2.hash Sha2.SHA256- verify :: FilePath -> IO () verify fp = do exists <- doesFileExist fp@@ -100,17 +88,18 @@ 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 stripped (Gzip.compress (Tar.write (filter (not . isSig) entries))) L.writeFile sig (getEntryFileContent entry)- rawSystem "gpg" ["--verify",sig,sum]- removeFile sum+ _ <- rawSystem "gpg" ["--verify",sig,stripped]+ removeFile stripped removeFile sig where sigName = makeSigName fp- sum = translate ".sum" fp+ stripped = translate ".stripped" fp isSig = (==sigName) . Tar.entryPath sig = translate ".sig" fp +getEntryFileContent :: Entry -> ByteString getEntryFileContent entry = case Tar.entryContent entry of NormalFile bytes _ -> bytes