{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module: Codec.RPM.Parse
-- Copyright: (c) 2016-2017 Red Hat, Inc.
-- License: LGPL
--
-- Maintainer: https://github.com/weldr
-- Stability: stable
-- Portability: portable
--
-- A module for creating 'RPM' records from various data sources.

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(..))

-- "a <$> b <$> c" looks better than "a . b <$> c"
{-# ANN parseLead "HLint: ignore Functor law" #-}
parseLead :: Parser Lead
parseLead :: Parser Lead
parseLead = do
    -- Verify this is an RPM by checking the first four bytes.
    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

    -- Skip 16 reserved bytes at the end of the lead.
    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
parseSectionHeader :: Parser SectionHeader
parseSectionHeader = do
    -- Verify this is a header section header by checking the first three bytes.
    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
    -- Skip four reserved bytes.
    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
    -- Grab the tags as a list of bytestrings.  We need the store before we can process the tags, as
    -- that's where all the values for the tags are kept.  However, grabbing each individual tag here
    -- makes it a lot easier to process them later.
    [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)

    -- Now that we've got the store, process each tag by looking up its values in the store.
    -- NOTE: mapMaybe will reject tags which are Nothing
    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 }

-- | A parser (in the attoparsec sense of the term) that constructs 'Codec.RPM.Types.RPM' records.
-- The parser can be run against a 'Data.ByteString.ByteString' of RPM data using any of the usual
-- functions.  'Data.Attoparsec.ByteString.parse' and 'Data.Attoparsec.ByteString.parseOnly' are
-- especially useful:
--
-- > import Data.Attoparsec.ByteString(parse)
-- > import qualified Data.ByteString as BS
-- > s <- BS.readFile "some.rpm"
-- > result <- parse parseRPM s
--
-- The 'Data.Attoparsec.ByteString.Result' can then be examined directly or converted using
-- 'Data.Attoparsec.ByteString.maybeResult' (for converting it into a 'Maybe' 'RPM') or
-- 'Data.Attoparsec.ByteString.eitherResult' (for converting it into an 'Either' 'String' 'RPM').
-- In the latter case, the String contains any parse error that occurred when reading the
-- RPM data.
parseRPM :: Parser RPM
parseRPM :: Parser RPM
parseRPM = do
    -- First comes the (mostly useless) lead.
    Lead
rpmLead <- Parser Lead
parseLead
    -- Then comes the signature, which is like a regular section except it's also padded.
    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)
    -- And then comes the real header.  There could be several, but for now there's only ever one.
    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