@@ -0,0 +1,228 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+-----------------------------------------------------------------------------
3+-- |
4+-- Module : Data.Time.LocalTime.TimeZone.Olson.Parse
5+-- Copyright : Yitzchak Gale 2010
6+--
7+-- Maintainer : Yitzchak Gale <gale@sefer.org>
8+-- Portability : portable
9+--
10+-- A parser for binary Olson timezone files whose format are specified
11+-- by the tzfile(5) man page on Unix-like systems. For more
12+-- information about this format, see
13+-- http://www.twinsun.com/tz/tz-link.htm. Functions are provided for
14+-- converting the parsed data into @TimeZoneSeries@ and @TimeZone@
15+-- objects.
16+
17+{-
18+Copyright (c) 2010 Yitzchak Gale. All rights reserved.
19+
20+Redistribution and use in source and binary forms, with or without
21+modification, are permitted provided that the following conditions are
22+met:
23+
24+ * Redistributions of source code must retain the above copyright
25+ notice, this list of conditions and the following disclaimer.
26+
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.
31+
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.
35+
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+----------------------------------------------------------------------------}
48+
49+module Data.Time.LocalTime.TimeZone.Olson.Parse
50+(
51+ getTimeZoneSeriesFromOlsonFile,
52+ getOlsonFromFile,
53+ olsonToTimeZoneSeries,
54+ getOlson,
55+ OlsonError
56+)
57+where
58+
59+import Data.Time.LocalTime.TimeZone.Olson.Types
60+import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(..))
61+import Data.Time (TimeZone(TimeZone))
62+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
63+import Data.Binary.Get (Get, runGet, getWord8, getWord32be, getWord64be,
64+ getByteString, getRemainingLazyByteString)
65+import qualified Data.ByteString as B
66+import qualified Data.ByteString.Lazy as L
67+import Data.Monoid (mappend)
68+import Data.Maybe (listToMaybe)
69+import Data.Word (Word8)
70+import Data.Int (Int32, Int64)
71+import Data.Typeable (Typeable)
72+import Control.Monad (guard, replicateM, replicateM_)
73+import Control.Exception.Extensible (try, throw, Exception, ErrorCall)
74+
75+-- | An exception indicating that the binary data being parsed was not
76+-- valid Olson timezone data
77+data OlsonError = OlsonError String
78+ deriving Typeable
79+instance Show OlsonError where
80+ show (OlsonError msg) = msg
81+instance Exception OlsonError
82+
83+-- | Convert parsed Olson timezone data into a @TimeZoneSeries@.
84+olsonToTimeZoneSeries :: OlsonData -> Maybe TimeZoneSeries
85+olsonToTimeZoneSeries (OlsonData ttimes ttinfos@(dflt:_) _ _) =
86+ fmap (TimeZoneSeries $ mkTZ dflt) . mapM (lookupTZ ttinfos) $
87+ reverse ttimes
88+ where
89+ mkTZ (TtInfo gmtoff isdst _ abbr) = TimeZone (gmtoff `div` 60) isdst abbr
90+ lookupTZ ttinfos ttime = fmap (((,) $ toUTC ttime) . mkTZ) . listToMaybe $
91+ drop (transIndex ttime) ttinfos
92+ toUTC = posixSecondsToUTCTime . fromIntegral . transTime
93+olsonToTimeZoneSeries _ = Nothing
94+
95+-- | Read timezone data from a binary Olson timezone file and convert
96+-- it into a @TimeZoneSeries@.
97+getTimeZoneSeriesFromOlsonFile :: FilePath -> IO TimeZoneSeries
98+getTimeZoneSeriesFromOlsonFile fp = getOlsonFromFile fp >>=
99+ maybe (throwOlson fp "no timezone found in OlsonData") return .
100+ olsonToTimeZoneSeries
101+
102+-- | Parse a binary Olson timezone file.
103+getOlsonFromFile :: FilePath -> IO OlsonData
104+getOlsonFromFile fp = do
105+ e <- try . fmap (runGet getOlson) $ L.readFile fp
106+ either (formatError fp) return e
107+
108+formatError :: FilePath -> ErrorCall -> IO a
109+formatError fp e = throwOlson fp $ show e
110+
111+-- | A binary parser for binary Olson timezone files
112+getOlson :: Get OlsonData
113+getOlson = do
114+ getByteString 4
115+ >>= verify ((== "TZif") . toASCII . B.unpack) "missing magic number"
116+ version <- getWord8
117+ >>= verify (`elem` [0, 50]) "invalid version number"
118+ replicateM_ 15 getWord8 -- padding nulls
119+ getOlsonParts version
120+
121+-- There is one part for Version 1 format data, and two parts and a POSIX
122+-- TZ string for Version 2 format data
123+getOlsonParts :: Word8 -> Get OlsonData
124+getOlsonParts 0 = getOlsonPart get32bitInteger
125+getOlsonParts 50 = do part1 <- getOlsonPart get32bitInteger
126+ part2 <- getOlsonPart get64bitInteger
127+ posixTZ <- getPosixTZ
128+ return $ part1 `mappend` part2 `mappend` posixTZ
129+getOlsonParts _ = error "Invalid version number" -- never reached
130+
131+-- Parse the part of an Olson file that contains timezone data
132+getOlsonPart :: Integral a => Get a -> Get OlsonData
133+getOlsonPart getTime = do
134+ tzh_ttisgmtcnt <- get32bitInt
135+ tzh_ttisstdcnt <- get32bitInt
136+ tzh_leapcnt <- get32bitInt
137+ tzh_timecnt <- get32bitInt
138+ tzh_typecnt <- get32bitInt
139+ tzh_charcnt <- get32bitInt
140+ times <- fmap (map toInteger) $ replicateM tzh_timecnt getTime
141+ indexes <- replicateM tzh_timecnt get8bitInt
142+ ttinfos <- replicateM tzh_typecnt getTtInfo
143+ abbr_chars <- fmap (toASCII . B.unpack) $ getByteString tzh_charcnt
144+ leaps <- replicateM tzh_leapcnt $ getLeapInfo getTime
145+ isstds <- replicateM tzh_ttisstdcnt getBool
146+ isgmts <- replicateM tzh_ttisgmtcnt getBool
147+ return $ OlsonData
148+ (zipWith Transition times indexes)
149+ (map (flip lookupAbbr abbr_chars) . zipWith setTtype ttinfos .
150+ (++ repeat UnknownType) $
151+ zipWith boolsToTType (map Just isstds ++ repeat Nothing) isgmts)
152+ leaps
153+ Nothing
154+ where
155+ lookupAbbr (TtInfo gmtoff isdst ttype abbrind) =
156+ TtInfo gmtoff isdst ttype . takeWhile (/= '\NUL') . drop abbrind
157+ setTtype ttinfo ttype = ttinfo {tt_ttype = ttype}
158+ boolsToTType _ isgmt | isgmt = UTC
159+ booslToTType isstd _ = maybe UnknownType stdOrWall isstd
160+ stdOrWall isstd
161+ | isstd = Std
162+ | otherwise = Wall
163+
164+-- Parse a POSIX-style TZ string.
165+-- We don't try to understand the TZ string, we just pass it along whole.
166+getPosixTZ :: Get OlsonData
167+getPosixTZ = do
168+ getWord8 >>= verify (== 10)
169+ "POSIX TZ string not preceded by newline"
170+ posixTZ <- fmap (L.takeWhile (/= 10)) getRemainingLazyByteString
171+ -- We don't check for the trailing newline, in order to keep it lazy
172+ return . OlsonData [] [] [] $ do
173+ guard (not $ L.null posixTZ)
174+ Just . toASCII $ L.unpack posixTZ
175+
176+-- Parse a ttinfo struct. Each ttinfo struct corresponds to a single
177+-- Data.Time.TimeZone object.
178+getTtInfo :: Get (TtInfo Int)
179+getTtInfo = do
180+ gmtoff <- get32bitInt
181+ isdst <- getBool
182+ abbrind <- get8bitInt
183+ return $ TtInfo gmtoff isdst UnknownType abbrind
184+
185+-- Parse leap second info. (usually not used)
186+getLeapInfo :: Integral a => Get a -> Get LeapInfo
187+getLeapInfo getTime = do
188+ lTime <- fmap toInteger getTime
189+ lOffset <- get32bitInt
190+ return $ LeapInfo lTime lOffset
191+
192+-- Our 8-bit ints are unsigned, so we can convert them directly
193+get8bitInt :: Get Int
194+get8bitInt = fmap fromIntegral getWord8
195+
196+getInt32 :: Get Int32
197+getInt32 = fmap fromIntegral getWord32be
198+
199+get32bitInt :: Get Int
200+get32bitInt = fmap fromIntegral getInt32
201+ -- via Int32 to get the sign right
202+ -- in case we are on a 64-bit platform
203+
204+get32bitInteger :: Get Integer
205+get32bitInteger = fmap fromIntegral getInt32
206+ -- via Int32 to get the sign right
207+
208+getInt64 :: Get Int64
209+getInt64 = fmap fromIntegral getWord64be
210+
211+get64bitInteger :: Get Integer
212+get64bitInteger = fmap fromIntegral getInt64
213+ -- via Int64 to get the sign right
214+
215+getBool :: Get Bool
216+getBool = fmap (/= 0) getWord8
217+
218+toASCII :: [Word8] -> String
219+toASCII = map (toEnum . fromIntegral)
220+
221+verify :: Monad m => (a -> Bool) -> String -> a -> m a
222+verify pred msg val
223+ | pred val = return val
224+ | otherwise = error msg
225+
226+throwOlson :: FilePath -> String -> IO a
227+throwOlson fp msg = throw . OlsonError $
228+ fp ++ ": invalid timezone file: " ++ msg