{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
module Codec.RPM.Parse(
#ifdef TEST
parseLead,
parseSectionHeader,
parseOneTag,
parseSection,
#endif
parseRPM)
where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative((<$>))
#endif
import Control.Monad(void)
import Data.Attoparsec.Binary
import Data.Attoparsec.ByteString(Parser, anyWord8, count, take, takeByteString, word8)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Data.Maybe(mapMaybe)
import Prelude hiding(take)
import Codec.RPM.Internal.Numbers(asWord32)
import Codec.RPM.Tags(Tag, mkTag)
import Codec.RPM.Types(Header(..), Lead(..), RPM(..), SectionHeader(..))
{-# ANN parseLead "HLint: ignore Functor law" #-}
parseLead :: Parser Lead
parseLead = do
void $ word32be 0xedabeedb
rpmMajor <- anyWord8
rpmMinor <- anyWord8
rpmType <- anyWord16be
rpmArchNum <- anyWord16be
rpmName <- C.unpack <$> BS.takeWhile (/= 0) <$> take 66
rpmOSNum <- anyWord16be
rpmSigType <- anyWord16be
void $ take 16
return Lead { rpmMajor,
rpmMinor,
rpmType,
rpmArchNum,
rpmName,
rpmOSNum,
rpmSigType }
parseSectionHeader :: Parser SectionHeader
parseSectionHeader = do
void $ word8 0x8e >> word8 0xad >> word8 0xe8
sectionVersion <- anyWord8
void $ take 4
sectionCount <- anyWord32be
sectionSize <- anyWord32be
return SectionHeader { sectionVersion,
sectionCount,
sectionSize }
parseOneTag :: C.ByteString -> C.ByteString -> Maybe Tag
parseOneTag store bs | BS.length bs < 16 = Nothing
| otherwise = let
tag = fromIntegral . asWord32 $ BS.take 4 bs
ty = fromIntegral . asWord32 $ BS.take 4 (BS.drop 4 bs)
off = fromIntegral . asWord32 $ BS.take 4 (BS.drop 8 bs)
cnt = fromIntegral . asWord32 $ BS.take 4 (BS.drop 12 bs)
in
mkTag store tag ty off cnt
parseSection :: Parser Header
parseSection = do
headerSectionHeader <- parseSectionHeader
rawTags <- count (fromIntegral $ sectionCount headerSectionHeader) (take 16)
headerStore <- take (fromIntegral $ sectionSize headerSectionHeader)
let headerTags = mapMaybe (parseOneTag headerStore) rawTags
return Header { headerSectionHeader,
headerTags,
headerStore }
parseRPM :: Parser RPM
parseRPM = do
rpmLead <- parseLead
sig <- parseSection
void $ take (signaturePadding sig)
hdr <- parseSection
rpmArchive <- takeByteString
return RPM { rpmLead,
rpmSignatures=[sig],
rpmHeaders=[hdr],
rpmArchive }
where
signaturePadding :: Header -> Int
signaturePadding hdr = let
remainder = (sectionSize . headerSectionHeader) hdr `mod` 8
in
if remainder > 0 then fromIntegral $ 8 - remainder else 0