@@ -44,7 +44,7 @@ import Data.Maybe (listToMaybe, fromMaybe)
4444import Data.Word (Word8)
4545import Data.Int (Int32, Int64)
4646import Data.Typeable (Typeable)
47−import Control.Monad (guard, replicateM, replicateM_)
47+import Control.Monad (guard, replicateM, replicateM_, when)
4848import Control.Exception.Extensible (try, throw, Exception, ErrorCall)
4949
5050-- | An exception indicating that the binary data being parsed was not
@@ -91,26 +91,23 @@ formatError fp e = throwOlson fp $ show e
9191-- | A binary parser for binary Olson timezone files
9292getOlson :: Get OlsonData
9393getOlson = do
94− getByteString 4
95− >>= verify ((== "TZif") . toASCII . B.unpack) "missing magic number"
96− version <- getWord8
97− >>= verify (`elem` [0, 50]) "invalid version number"
98− replicateM_ 15 getWord8 -- padding nulls
99− getOlsonParts version
100−
101−-- There is one part for Version 1 format data, and two parts and a POSIX
102−-- TZ string for Version 2 format data
103−getOlsonParts :: Word8 -> Get OlsonData
104−getOlsonParts 0 = getOlsonPart get32bitInteger
105−getOlsonParts 50 = do part1 <- getOlsonPart get32bitInteger
106− part2 <- getOlsonPart get64bitInteger
107− posixTZ <- getPosixTZ
108− return $ part1 `mappend` part2 `mappend` posixTZ
109−getOlsonParts _ = error "Invalid version number" -- never reached
94+ (version, part1) <- getOlsonPart True get32bitInteger
95+ -- There is one part for Version 1 format data, and two parts and a POSIX
96+ -- TZ string for Version 2 format data
97+ case version of
98+ 0 -> return part1
99+ 50 -> do (_, part2) <- getOlsonPart False get64bitInteger
100+ posixTZ <- getPosixTZ
101+ return $ part1 `mappend` part2 `mappend` posixTZ
102+ _ -> verify (const False) "invalid version number" undefined
110103
111104-- Parse the part of an Olson file that contains timezone data
112−getOlsonPart :: Integral a => Get a -> Get OlsonData
113−getOlsonPart getTime = do
105+getOlsonPart :: Integral a => Bool -> Get a -> Get (Word8, OlsonData)
106+getOlsonPart verifyMagic getTime = do
107+ magic <- fmap (toASCII . B.unpack) $ getByteString 4
108+ when verifyMagic $ verify_ (== "TZif") "missing magic number" magic
109+ version <- getWord8
110+ replicateM_ 15 getWord8 -- padding nulls
114111 tzh_ttisgmtcnt <- get32bitInt
115112 tzh_ttisstdcnt <- get32bitInt
116113 tzh_leapcnt <- get32bitInt
@@ -124,13 +121,16 @@ getOlsonPart getTime = do
124121 leaps <- replicateM tzh_leapcnt $ getLeapInfo getTime
125122 isstds <- replicateM tzh_ttisstdcnt getBool
126123 isgmts <- replicateM tzh_ttisgmtcnt getBool
127− return $ OlsonData
128− (zipWith Transition times indexes)
129− (map (flip lookupAbbr abbr_chars) . zipWith setTtype ttinfos .
130− (++ repeat UnknownType) $
131− zipWith boolsToTType (map Just isstds ++ repeat Nothing) isgmts)
132− leaps
133− Nothing
124+ return
125+ (version,
126+ OlsonData
127+ (zipWith Transition times indexes)
128+ (map (flip lookupAbbr abbr_chars) . zipWith setTtype ttinfos .
129+ (++ repeat UnknownType) $
130+ zipWith boolsToTType (map Just isstds ++ repeat Nothing) isgmts)
131+ leaps
132+ Nothing
133+ )
134134 where
135135 lookupAbbr (TtInfo gmtoff isdst ttype abbrind) =
136136 TtInfo gmtoff isdst ttype . takeWhile (/= '\NUL') . drop abbrind
@@ -203,6 +203,11 @@ verify pred msg val
203203 | pred val = return val
204204 | otherwise = error msg
205205
206+verify_ :: Monad m => (a -> Bool) -> String -> a -> m ()
207+verify_ pred msg val
208+ | pred val = return ()
209+ | otherwise = error msg
210+
206211throwOlson :: FilePath -> String -> IO a
207212throwOlson fp msg = throw . OlsonError $
208213 fp ++ ": invalid timezone file: " ++ msg