{-# 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 :: Parser Lead
parseLead = do
Parser ByteString Word32 -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word32 -> Parser ByteString ())
-> Parser ByteString Word32 -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Parser ByteString Word32
word32be 0xedabeedb
Word8
rpmMajor <- Parser Word8
anyWord8
Word8
rpmMinor <- Parser Word8
anyWord8
Word16
rpmType <- Parser Word16
anyWord16be
Word16
rpmArchNum <- Parser Word16
anyWord16be
String
rpmName <- ByteString -> String
C.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> ByteString -> ByteString
BS.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (ByteString -> String)
-> Parser ByteString ByteString -> Parser ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
take 66
Word16
rpmOSNum <- Parser Word16
anyWord16be
Word16
rpmSigType <- Parser Word16
anyWord16be
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ByteString ())
-> Parser ByteString ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString ByteString
take 16
Lead -> Parser Lead
forall (m :: * -> *) a. Monad m => a -> m a
return Lead :: Word8
-> Word8 -> Word16 -> Word16 -> String -> Word16 -> Word16 -> Lead
Lead { Word8
rpmMajor :: Word8
rpmMajor :: Word8
rpmMajor,
Word8
rpmMinor :: Word8
rpmMinor :: Word8
rpmMinor,
Word16
rpmType :: Word16
rpmType :: Word16
rpmType,
Word16
rpmArchNum :: Word16
rpmArchNum :: Word16
rpmArchNum,
String
rpmName :: String
rpmName :: String
rpmName,
Word16
rpmOSNum :: Word16
rpmOSNum :: Word16
rpmOSNum,
Word16
rpmSigType :: Word16
rpmSigType :: Word16
rpmSigType }
parseSectionHeader :: Parser SectionHeader
= do
Parser Word8 -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Word8 -> Parser ByteString ())
-> Parser Word8 -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
word8 0x8e Parser Word8 -> Parser Word8 -> Parser Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Parser Word8
word8 0xad Parser Word8 -> Parser Word8 -> Parser Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Parser Word8
word8 0xe8
Word8
sectionVersion <- Parser Word8
anyWord8
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ByteString ())
-> Parser ByteString ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString ByteString
take 4
Word32
sectionCount <- Parser ByteString Word32
anyWord32be
Word32
sectionSize <- Parser ByteString Word32
anyWord32be
SectionHeader -> Parser SectionHeader
forall (m :: * -> *) a. Monad m => a -> m a
return SectionHeader :: Word8 -> Word32 -> Word32 -> SectionHeader
SectionHeader { Word8
sectionVersion :: Word8
sectionVersion :: Word8
sectionVersion,
Word32
sectionCount :: Word32
sectionCount :: Word32
sectionCount,
Word32
sectionSize :: Word32
sectionSize :: Word32
sectionSize }
parseOneTag :: C.ByteString -> C.ByteString -> Maybe Tag
parseOneTag :: ByteString -> ByteString -> Maybe Tag
parseOneTag store :: ByteString
store bs :: ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 16 = Maybe Tag
forall a. Maybe a
Nothing
| Bool
otherwise = let
tag :: Int
tag = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (ByteString -> Word32) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
asWord32 (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take 4 ByteString
bs
ty :: Word32
ty = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32)
-> (ByteString -> Word32) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
asWord32 (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take 4 (Int -> ByteString -> ByteString
BS.drop 4 ByteString
bs)
off :: Word32
off = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32)
-> (ByteString -> Word32) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
asWord32 (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take 4 (Int -> ByteString -> ByteString
BS.drop 8 ByteString
bs)
cnt :: Word32
cnt = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32)
-> (ByteString -> Word32) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
asWord32 (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take 4 (Int -> ByteString -> ByteString
BS.drop 12 ByteString
bs)
in
ByteString -> Int -> Word32 -> Word32 -> Word32 -> Maybe Tag
mkTag ByteString
store Int
tag Word32
ty Word32
off Word32
cnt
parseSection :: Parser Header
parseSection :: Parser Header
parseSection = do
SectionHeader
headerSectionHeader <- Parser SectionHeader
parseSectionHeader
[ByteString]
rawTags <- Int
-> Parser ByteString ByteString -> Parser ByteString [ByteString]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ SectionHeader -> Word32
sectionCount SectionHeader
headerSectionHeader) (Int -> Parser ByteString ByteString
take 16)
ByteString
headerStore <- Int -> Parser ByteString ByteString
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ SectionHeader -> Word32
sectionSize SectionHeader
headerSectionHeader)
let headerTags :: [Tag]
headerTags = (ByteString -> Maybe Tag) -> [ByteString] -> [Tag]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ByteString -> ByteString -> Maybe Tag
parseOneTag ByteString
headerStore) [ByteString]
rawTags
Header -> Parser Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header :: SectionHeader -> [Tag] -> ByteString -> Header
Header { SectionHeader
headerSectionHeader :: SectionHeader
headerSectionHeader :: SectionHeader
headerSectionHeader,
[Tag]
headerTags :: [Tag]
headerTags :: [Tag]
headerTags,
ByteString
headerStore :: ByteString
headerStore :: ByteString
headerStore }
parseRPM :: Parser RPM
parseRPM :: Parser RPM
parseRPM = do
Lead
rpmLead <- Parser Lead
parseLead
Header
sig <- Parser Header
parseSection
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ByteString ())
-> Parser ByteString ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString ByteString
take (Header -> Int
signaturePadding Header
sig)
Header
hdr <- Parser Header
parseSection
ByteString
rpmArchive <- Parser ByteString ByteString
takeByteString
RPM -> Parser RPM
forall (m :: * -> *) a. Monad m => a -> m a
return RPM :: Lead -> [Header] -> [Header] -> ByteString -> RPM
RPM { Lead
rpmLead :: Lead
rpmLead :: Lead
rpmLead,
rpmSignatures :: [Header]
rpmSignatures=[Header
sig],
rpmHeaders :: [Header]
rpmHeaders=[Header
hdr],
ByteString
rpmArchive :: ByteString
rpmArchive :: ByteString
rpmArchive }
where
signaturePadding :: Header -> Int
signaturePadding :: Header -> Int
signaturePadding hdr :: Header
hdr = let
remainder :: Word32
remainder = (SectionHeader -> Word32
sectionSize (SectionHeader -> Word32)
-> (Header -> SectionHeader) -> Header -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> SectionHeader
headerSectionHeader) Header
hdr Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` 8
in
if Word32
remainder Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ 8 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
remainder else 0