@@ -1,53 +1,27 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2+{-# OPTIONS_HADDOCK hide #-}
2-----------------------------------------------------------------------------
3-----------------------------------------------------------------------------
4-- Module : Data.Time.LocalTime.TimeZone.Olson.Parse
5-- Module : Data.Time.LocalTime.TimeZone.Olson.Parse
5−-- Copyright : Yitzchak Gale 2010
6+-- Copyright : Yitzchak Gale 2018
7-- Maintainer : Yitzchak Gale <gale@sefer.org>
8-- Maintainer : Yitzchak Gale <gale@sefer.org>
8-- Portability : portable
9-- Portability : portable
10−-- A parser for binary Olson timezone files whose format are specified
11+-- A parser for binary Olson timezone files whose format is specified
11-- by the tzfile(5) man page on Unix-like systems. For more
12-- by the tzfile(5) man page on Unix-like systems. For more
12-- information about this format, see
13-- information about this format, see
13−-- http://www.twinsun.com/tz/tz-link.htm. Functions are provided for
14+-- <http://www.twinsun.com/tz/tz-link.htm>. Functions are provided for
14−-- converting the parsed data into @TimeZoneSeries@ and @TimeZone@
15+-- converting the parsed data into 'TimeZoneSeries' objects.
18−Copyright (c) 2010 Yitzchak Gale. All rights reserved.
17+{- Copyright (c) 2018 Yitzchak Gale. All rights reserved.
19−
18+For licensing information, see the BSD3-style license in the file
20−Redistribution and use in source and binary forms, with or without
19+LICENSE that was originally distributed by the author together with
21−modification, are permitted provided that the following conditions are
20+this file. -}
24− * Redistributions of source code must retain the above copyright
25− notice, this list of conditions and the following disclaimer.
27− * Redistributions in binary form must reproduce the above
28− copyright notice, this list of conditions and the following
29− disclaimer in the documentation and/or other materials provided
30− with the distribution.
32− * Neither the name of Yitzchak Gale nor the names of other
33− contributors may be used to endorse or promote products derived
34− from this software without specific prior written permission.
36−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
37−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
38−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
39−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
40−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
41−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
42−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
43−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
44−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
45−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
46−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
47−----------------------------------------------------------------------------}
49module Data.Time.LocalTime.TimeZone.Olson.Parse
22module Data.Time.LocalTime.TimeZone.Olson.Parse
24+ -- * Parsing Olson timezone files
51 getTimeZoneSeriesFromOlsonFile,
25 getTimeZoneSeriesFromOlsonFile,
52 getOlsonFromFile,
26 getOlsonFromFile,
53 olsonToTimeZoneSeries,
27 olsonToTimeZoneSeries,
@@ -65,11 +39,14 @@ import Data.Binary.Get (Get, runGet, getWord8, getWord32be, getWord64be,
65import qualified Data.ByteString as B
39import qualified Data.ByteString as B
66import qualified Data.ByteString.Lazy as L
40import qualified Data.ByteString.Lazy as L
67import Data.Monoid (mappend)
41import Data.Monoid (mappend)
42+import Data.List (sortBy, groupBy)
68import Data.Maybe (listToMaybe, fromMaybe)
43import Data.Maybe (listToMaybe, fromMaybe)
69import Data.Word (Word8)
44import Data.Word (Word8)
70import Data.Int (Int32, Int64)
45import Data.Int (Int32, Int64)
46+import Data.Ord (comparing)
47+import Data.Function (on)
71import Data.Typeable (Typeable)
48import Data.Typeable (Typeable)
72−import Control.Monad (guard, replicateM, replicateM_)
49+import Control.Monad (guard, replicateM, replicateM_, when)
73import Control.Exception.Extensible (try, throw, Exception, ErrorCall)
50import Control.Exception.Extensible (try, throw, Exception, ErrorCall)
75-- | An exception indicating that the binary data being parsed was not
52-- | An exception indicating that the binary data being parsed was not
@@ -83,62 +60,84 @@ instance Exception OlsonError
83-- | Convert parsed Olson timezone data into a @TimeZoneSeries@.
60-- | Convert parsed Olson timezone data into a @TimeZoneSeries@.
84olsonToTimeZoneSeries :: OlsonData -> Maybe TimeZoneSeries
61olsonToTimeZoneSeries :: OlsonData -> Maybe TimeZoneSeries
85olsonToTimeZoneSeries (OlsonData ttimes ttinfos@(dflt0:_) _ _) =
62olsonToTimeZoneSeries (OlsonData ttimes ttinfos@(dflt0:_) _ _) =
86− fmap (TimeZoneSeries $ mkTZ dflt) . mapM (lookupTZ ttinfos) $
63+ fmap (TimeZoneSeries $ mkTZ dflt) . mapM (lookupTZ ttinfos) .
87− reverse ttimes
64+ uniqTimes . sortBy futureToPast $ ttimes
89 dflt = fromMaybe dflt0 . listToMaybe $ filter isStd ttinfos
66 dflt = fromMaybe dflt0 . listToMaybe $ filter isStd ttinfos
90 isStd (TtInfo _ isdst _ _) = not isdst
67 isStd (TtInfo _ isdst _ _) = not isdst
68+ mkTZ (TtInfo gmtoff isdst _ abbr) =
91− mkTZ (TtInfo gmtoff isdst _ abbr) = TimeZone (gmtoff `div` 60) isdst abbr
69+ TimeZone ((gmtoff + 30) `div` 60) isdst abbr
92 lookupTZ ttinfos ttime = fmap (((,) $ toUTC ttime) . mkTZ) . listToMaybe $
70 lookupTZ ttinfos ttime = fmap (((,) $ toUTC ttime) . mkTZ) . listToMaybe $
93 drop (transIndex ttime) ttinfos
71 drop (transIndex ttime) ttinfos
94 toUTC = posixSecondsToUTCTime . fromIntegral . transTime
72 toUTC = posixSecondsToUTCTime . fromIntegral . transTime
73+ uniqTimes = map last . groupBy ((==) `on` transTime)
74+ futureToPast = comparing $ negate . transTime
95olsonToTimeZoneSeries _ = Nothing
75olsonToTimeZoneSeries _ = Nothing
97-- | Read timezone data from a binary Olson timezone file and convert
77-- | Read timezone data from a binary Olson timezone file and convert
98−-- it into a @TimeZoneSeries@.
78+-- it into a @TimeZoneSeries@ for use together with the types and
79+-- fucntions of "Data.Time". This is the function from this module
80+-- for which you are most likely to have use.
82+-- If the values in the Olson timezone file exceed the standard size
83+-- limits (see 'defaultLimits'), this function throws an
84+-- exception. For other behavior, use 'getOlson' and
85+-- 'Data.Binary.Get.runGet' directly.
99getTimeZoneSeriesFromOlsonFile :: FilePath -> IO TimeZoneSeries
86getTimeZoneSeriesFromOlsonFile :: FilePath -> IO TimeZoneSeries
100getTimeZoneSeriesFromOlsonFile fp = getOlsonFromFile fp >>=
87getTimeZoneSeriesFromOlsonFile fp = getOlsonFromFile fp >>=
101 maybe (throwOlson fp "no timezone found in OlsonData") return .
88 maybe (throwOlson fp "no timezone found in OlsonData") return .
102 olsonToTimeZoneSeries
89 olsonToTimeZoneSeries
104-- | Parse a binary Olson timezone file.
91-- | Parse a binary Olson timezone file.
93+-- If the values in the Olson timezone file exceed the standard size
94+-- limits (see 'defaultLimits'), this function throws an
95+-- exception. For other behavior, use 'getOlson' and
96+-- 'Data.Binary.Get.runGet' directly.
105getOlsonFromFile :: FilePath -> IO OlsonData
97getOlsonFromFile :: FilePath -> IO OlsonData
106getOlsonFromFile fp = do
98getOlsonFromFile fp = do
107− e <- try . fmap (runGet getOlson) $ L.readFile fp
99+ e <- try . fmap (runGet $ getOlson defaultLimits) $ L.readFile fp
108 either (formatError fp) return e
100 either (formatError fp) return e
110formatError :: FilePath -> ErrorCall -> IO a
102formatError :: FilePath -> ErrorCall -> IO a
111formatError fp e = throwOlson fp $ show e
103formatError fp e = throwOlson fp $ show e
113-- | A binary parser for binary Olson timezone files
105-- | A binary parser for binary Olson timezone files
114−getOlson :: Get OlsonData
106+getOlson :: SizeLimits -> Get OlsonData
115−getOlson = do
107+getOlson limits = do
116− getByteString 4
108+ (version, part1) <- getOlsonPart True limits get32bitInteger
117− >>= verify ((== "TZif") . toASCII . B.unpack) "missing magic number"
119− >>= verify (`elem` [0, 50]) "invalid version number"
120− replicateM_ 15 getWord8 -- padding nulls
121− getOlsonParts version
123−-- There is one part for Version 1 format data, and two parts and a POSIX
109+ -- There is one part for Version 1 format data, and two parts and a POSIX
124−-- TZ string for Version 2 format data
110+ -- TZ string for Version 2 or 3 format data
125−getOlsonParts :: Word8 -> Get OlsonData
111+ case () of
126−getOlsonParts 0 = getOlsonPart get32bitInteger
112+ _ | version == 0 -> return part1
127−getOlsonParts 50 = do part1 <- getOlsonPart get32bitInteger
113+ | version == 50 || version == 51 -> do
128− part2 <- getOlsonPart get64bitInteger
114+ (_, part2) <- getOlsonPart False limits get64bitInteger
129− posixTZ <- getPosixTZ
115+ posixTZ <- getPosixTZ
130− return $ part1 `mappend` part2 `mappend` posixTZ
116+ return $ part1 `mappend` part2 `mappend` posixTZ
131−getOlsonParts _ = error "Invalid version number" -- never reached
117+ | otherwise -> do
118+ let msg = "getOlson: invalid tzfile version " ++ toASCII [version]
119+ verify (const False) msg undefined
133-- Parse the part of an Olson file that contains timezone data
121-- Parse the part of an Olson file that contains timezone data
134−getOlsonPart :: Integral a => Get a -> Get OlsonData
122+getOlsonPart :: Integral a => Bool -> SizeLimits -> Get a ->
123+ Get (Word8, OlsonData)
135−getOlsonPart getTime = do
124+getOlsonPart verifyMagic limits getTime = do
125+ magic <- fmap (toASCII . B.unpack) $ getByteString 4
126+ when verifyMagic $ verify_ (== "TZif") "missing magic number" magic
128+ replicateM_ 15 getWord8 -- padding nulls
136 tzh_ttisgmtcnt <- get32bitInt
129 tzh_ttisgmtcnt <- get32bitInt
137 tzh_ttisstdcnt <- get32bitInt
130 tzh_ttisstdcnt <- get32bitInt
138 tzh_leapcnt <- get32bitInt
131 tzh_leapcnt <- get32bitInt
132+ >>= verify (withinLimit maxLeaps) "too many leap second specifications"
139 tzh_timecnt <- get32bitInt
133 tzh_timecnt <- get32bitInt
134+ >>= verify (withinLimit maxTimes) "too many timezone transitions"
140 tzh_typecnt <- get32bitInt
135 tzh_typecnt <- get32bitInt
136+ >>= verify (withinLimit maxTypes) "too many timezone type specifications"
137+ verify (withinLimit maxTypes) "too many isgmt specifiers" tzh_ttisgmtcnt
138+ verify (withinLimit maxTypes) "too many isstd specifiers" tzh_ttisstdcnt
141 tzh_charcnt <- get32bitInt
139 tzh_charcnt <- get32bitInt
140+ >>= verify (withinLimit maxAbbrChars) "too many tilezone specifiers"
142 times <- fmap (map toInteger) $ replicateM tzh_timecnt getTime
141 times <- fmap (map toInteger) $ replicateM tzh_timecnt getTime
143 indexes <- replicateM tzh_timecnt get8bitInt
142 indexes <- replicateM tzh_timecnt get8bitInt
144 ttinfos <- replicateM tzh_typecnt getTtInfo
143 ttinfos <- replicateM tzh_typecnt getTtInfo
@@ -146,22 +145,32 @@ getOlsonPart getTime = do
146 leaps <- replicateM tzh_leapcnt $ getLeapInfo getTime
145 leaps <- replicateM tzh_leapcnt $ getLeapInfo getTime
147 isstds <- replicateM tzh_ttisstdcnt getBool
146 isstds <- replicateM tzh_ttisstdcnt getBool
148 isgmts <- replicateM tzh_ttisgmtcnt getBool
147 isgmts <- replicateM tzh_ttisgmtcnt getBool
149− return $ OlsonData
150+ OlsonData
150− (zipWith Transition times indexes)
151+ (zipWith Transition times indexes)
151− (map (flip lookupAbbr abbr_chars) . zipWith setTtype ttinfos .
152+ (map (flip lookupAbbr abbr_chars) . zipWith setTtype ttinfos $
152− (++ repeat UnknownType) $
153− zipWith boolsToTType (map Just isstds ++ repeat Nothing) isgmts)
153+ zipWithExtend boolsToTType False False isstds isgmts)
158+ withinLimit limit value = maybe True (value <=) $ limit limits
157 lookupAbbr (TtInfo gmtoff isdst ttype abbrind) =
159 lookupAbbr (TtInfo gmtoff isdst ttype abbrind) =
158 TtInfo gmtoff isdst ttype . takeWhile (/= '\NUL') . drop abbrind
160 TtInfo gmtoff isdst ttype . takeWhile (/= '\NUL') . drop abbrind
159 setTtype ttinfo ttype = ttinfo {tt_ttype = ttype}
161 setTtype ttinfo ttype = ttinfo {tt_ttype = ttype}
160− boolsToTType _ isgmt | isgmt = UTC
162+ boolsToTType _ isgmt | isgmt = UTC
161− booslToTType isstd _ = maybe UnknownType stdOrWall isstd
163+ boolsToTType isstd _
163− | isstd = Std
164+ | isstd = Std
164− | otherwise = Wall
165+ | otherwise = Wall
167+-- A variant of zipWith whose result is the length of the longer
168+-- rather than the shorter list, by extending the shorter list with
170+zipWithExtend :: (a -> b -> c) -> a -> b -> [a] -> [b] -> [c]
171+zipWithExtend f x0 y0 (x:xs) (y:ys) = f x y : zipWithExtend f x0 y0 xs ys
172+zipWithExtend f x0 _ [] ys = map (f x0) ys
173+zipWithExtend f _ y0 xs _ = map (flip f y0) xs
166-- Parse a POSIX-style TZ string.
175-- Parse a POSIX-style TZ string.
167-- We don't try to understand the TZ string, we just pass it along whole.
176-- We don't try to understand the TZ string, we just pass it along whole.
@@ -182,7 +191,7 @@ getTtInfo = do
182 gmtoff <- get32bitInt
191 gmtoff <- get32bitInt
183 isdst <- getBool
192 isdst <- getBool
184 abbrind <- get8bitInt
193 abbrind <- get8bitInt
185− return $ TtInfo gmtoff isdst UnknownType abbrind
194+ return $ TtInfo gmtoff isdst Wall abbrind
187-- Parse leap second info. (usually not used)
196-- Parse leap second info. (usually not used)
188getLeapInfo :: Integral a => Get a -> Get LeapInfo
197getLeapInfo :: Integral a => Get a -> Get LeapInfo
@@ -225,6 +234,11 @@ verify pred msg val
225 | pred val = return val
234 | pred val = return val
226 | otherwise = error msg
235 | otherwise = error msg
237+verify_ :: Monad m => (a -> Bool) -> String -> a -> m ()
239+ | pred val = return ()
240+ | otherwise = error msg
228throwOlson :: FilePath -> String -> IO a
242throwOlson :: FilePath -> String -> IO a
229throwOlson fp msg = throw . OlsonError $
243throwOlson fp msg = throw . OlsonError $
230 fp ++ ": invalid timezone file: " ++ msg
244 fp ++ ": invalid timezone file: " ++ msg