diff --git a/Data/Time/LocalTime/TimeZone/Olson.hs b/Data/Time/LocalTime/TimeZone/Olson.hs new file mode 100644 --- /dev/null +++ b/Data/Time/LocalTime/TimeZone/Olson.hs @@ -0,0 +1,31 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Time.LocalTime.TimeZone.Olson +-- Copyright : Yitzchak Gale 2010 +-- +-- Maintainer : Yitzchak Gale +-- Portability : portable +-- +-- A parser and renderer for binary Olson timezone files whose format +-- are specified by the tzfile(5) man page on Unix-like systems. For +-- more information about this format, see +-- . Functions are provided for +-- converting the parsed data into @TimeZoneSeries@ and @TimeZone@ +-- objects. + +{- Copyright (c) 2010 Yitzchak Gale. All rights reserved. +For licensing information, see the BSD3-style license in the file +LICENSE that was originally distributed by the author together with +this file. -} + +module Data.Time.LocalTime.TimeZone.Olson +( + module Data.Time.LocalTime.TimeZone.Olson.Parse, + module Data.Time.LocalTime.TimeZone.Olson.Render, + module Data.Time.LocalTime.TimeZone.Olson.Types +) +where + +import Data.Time.LocalTime.TimeZone.Olson.Types +import Data.Time.LocalTime.TimeZone.Olson.Parse +import Data.Time.LocalTime.TimeZone.Olson.Render diff --git a/Data/Time/LocalTime/TimeZone/Olson/Parse.hs b/Data/Time/LocalTime/TimeZone/Olson/Parse.hs new file mode 100644 --- /dev/null +++ b/Data/Time/LocalTime/TimeZone/Olson/Parse.hs @@ -0,0 +1,236 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# OPTIONS_HADDOCK hide #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Time.LocalTime.TimeZone.Olson.Parse +-- Copyright : Yitzchak Gale 2010 +-- +-- Maintainer : Yitzchak Gale +-- Portability : portable +-- +-- A parser for binary Olson timezone files whose format is specified +-- by the tzfile(5) man page on Unix-like systems. For more +-- information about this format, see +-- . Functions are provided for +-- converting the parsed data into 'TimeZoneSeries' objects. + +{- Copyright (c) 2010 Yitzchak Gale. All rights reserved. +For licensing information, see the BSD3-style license in the file +LICENSE that was originally distributed by the author together with +this file. -} + +module Data.Time.LocalTime.TimeZone.Olson.Parse +( + -- * Parsing Olson timezone files + getTimeZoneSeriesFromOlsonFile, + getOlsonFromFile, + olsonToTimeZoneSeries, + getOlson, + OlsonError +) +where + +import Data.Time.LocalTime.TimeZone.Olson.Types +import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(..)) +import Data.Time (TimeZone(TimeZone)) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.Binary.Get (Get, runGet, getWord8, getWord32be, getWord64be, + getByteString, getRemainingLazyByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.Monoid (mappend) +import Data.Maybe (listToMaybe, fromMaybe) +import Data.Word (Word8) +import Data.Int (Int32, Int64) +import Data.Typeable (Typeable) +import Control.Monad (guard, replicateM, replicateM_, when) +import Control.Exception.Extensible (try, throw, Exception, ErrorCall) + +-- | An exception indicating that the binary data being parsed was not +-- valid Olson timezone data +data OlsonError = OlsonError String + deriving Typeable +instance Show OlsonError where + show (OlsonError msg) = msg +instance Exception OlsonError + +-- | Convert parsed Olson timezone data into a @TimeZoneSeries@. +olsonToTimeZoneSeries :: OlsonData -> Maybe TimeZoneSeries +olsonToTimeZoneSeries (OlsonData ttimes ttinfos@(dflt0:_) _ _) = + fmap (TimeZoneSeries $ mkTZ dflt) . mapM (lookupTZ ttinfos) $ + reverse ttimes + where + dflt = fromMaybe dflt0 . listToMaybe $ filter isStd ttinfos + isStd (TtInfo _ isdst _ _) = not isdst + mkTZ (TtInfo gmtoff isdst _ abbr) = + TimeZone ((gmtoff + 30) `div` 60) isdst abbr + lookupTZ ttinfos ttime = fmap (((,) $ toUTC ttime) . mkTZ) . listToMaybe $ + drop (transIndex ttime) ttinfos + toUTC = posixSecondsToUTCTime . fromIntegral . transTime +olsonToTimeZoneSeries _ = Nothing + +-- | Read timezone data from a binary Olson timezone file and convert +-- it into a @TimeZoneSeries@ for use together with the types and +-- fucntions of "Data.Time". This is the function from this module +-- for which you are most likely to have use. +-- +-- If the values in the Olson timezone file exceed the standard size +-- limits (see 'defaultLimits'), this function throws an +-- exception. For other behavior, use 'getOlson' and +-- 'Data.Binary.Get.runGet' directly. +getTimeZoneSeriesFromOlsonFile :: FilePath -> IO TimeZoneSeries +getTimeZoneSeriesFromOlsonFile fp = getOlsonFromFile fp >>= + maybe (throwOlson fp "no timezone found in OlsonData") return . + olsonToTimeZoneSeries + +-- | Parse a binary Olson timezone file. +-- +-- If the values in the Olson timezone file exceed the standard size +-- limits (see 'defaultLimits'), this function throws an +-- exception. For other behavior, use 'getOlson' and +-- 'Data.Binary.Get.runGet' directly. +getOlsonFromFile :: FilePath -> IO OlsonData +getOlsonFromFile fp = do + e <- try . fmap (runGet $ getOlson defaultLimits) $ L.readFile fp + either (formatError fp) return e + +formatError :: FilePath -> ErrorCall -> IO a +formatError fp e = throwOlson fp $ show e + +-- | A binary parser for binary Olson timezone files +getOlson :: SizeLimits -> Get OlsonData +getOlson limits = do + (version, part1) <- getOlsonPart True limits get32bitInteger + -- There is one part for Version 1 format data, and two parts and a POSIX + -- TZ string for Version 2 format data + case version of + 0 -> return part1 + 50 -> do (_, part2) <- getOlsonPart False limits get64bitInteger + posixTZ <- getPosixTZ + return $ part1 `mappend` part2 `mappend` posixTZ + _ -> verify (const False) "invalid version number" undefined + +-- Parse the part of an Olson file that contains timezone data +getOlsonPart :: Integral a => Bool -> SizeLimits -> Get a -> + Get (Word8, OlsonData) +getOlsonPart verifyMagic limits getTime = do + magic <- fmap (toASCII . B.unpack) $ getByteString 4 + when verifyMagic $ verify_ (== "TZif") "missing magic number" magic + version <- getWord8 + replicateM_ 15 getWord8 -- padding nulls + tzh_ttisgmtcnt <- get32bitInt + tzh_ttisstdcnt <- get32bitInt + tzh_leapcnt <- get32bitInt + >>= verify (withinLimit maxLeaps) "too many leap second specifications" + tzh_timecnt <- get32bitInt + >>= verify (withinLimit maxTimes) "too many timezone transitions" + tzh_typecnt <- get32bitInt + >>= verify (withinLimit maxTypes) "too many timezone type specifications" + verify (withinLimit maxTypes) "too many isgmt specifiers" tzh_ttisgmtcnt + verify (withinLimit maxTypes) "too many isstd specifiers" tzh_ttisstdcnt + tzh_charcnt <- get32bitInt + >>= verify (withinLimit maxAbbrChars) "too many tilezone specifiers" + times <- fmap (map toInteger) $ replicateM tzh_timecnt getTime + indexes <- replicateM tzh_timecnt get8bitInt + ttinfos <- replicateM tzh_typecnt getTtInfo + abbr_chars <- fmap (toASCII . B.unpack) $ getByteString tzh_charcnt + leaps <- replicateM tzh_leapcnt $ getLeapInfo getTime + isstds <- replicateM tzh_ttisstdcnt getBool + isgmts <- replicateM tzh_ttisgmtcnt getBool + return + (version, + OlsonData + (zipWith Transition times indexes) + (map (flip lookupAbbr abbr_chars) . zipWith setTtype ttinfos $ + zipWithExtend boolsToTType False False isstds isgmts) + leaps + Nothing + ) + where + withinLimit limit value = maybe True (value <=) $ limit limits + lookupAbbr (TtInfo gmtoff isdst ttype abbrind) = + TtInfo gmtoff isdst ttype . takeWhile (/= '\NUL') . drop abbrind + setTtype ttinfo ttype = ttinfo {tt_ttype = ttype} + boolsToTType _ isgmt | isgmt = UTC + boolsToTType isstd _ + | isstd = Std + | otherwise = Wall + +-- A variant of zipWith whose result is the length of the longer +-- rather than the shorter list, by extending the shorter list with +-- a default value +zipWithExtend :: (a -> b -> c) -> a -> b -> [a] -> [b] -> [c] +zipWithExtend f x0 y0 (x:xs) (y:ys) = f x y : zipWithExtend f x0 y0 xs ys +zipWithExtend f x0 _ [] ys = map (f x0) ys +zipWithExtend f _ y0 xs _ = map (flip f y0) xs + +-- Parse a POSIX-style TZ string. +-- We don't try to understand the TZ string, we just pass it along whole. +getPosixTZ :: Get OlsonData +getPosixTZ = do + getWord8 >>= verify (== 10) + "POSIX TZ string not preceded by newline" + posixTZ <- fmap (L.takeWhile (/= 10)) getRemainingLazyByteString + -- We don't check for the trailing newline, in order to keep it lazy + return . OlsonData [] [] [] $ do + guard (not $ L.null posixTZ) + Just . toASCII $ L.unpack posixTZ + +-- Parse a ttinfo struct. Each ttinfo struct corresponds to a single +-- Data.Time.TimeZone object. +getTtInfo :: Get (TtInfo Int) +getTtInfo = do + gmtoff <- get32bitInt + isdst <- getBool + abbrind <- get8bitInt + return $ TtInfo gmtoff isdst Wall abbrind + +-- Parse leap second info. (usually not used) +getLeapInfo :: Integral a => Get a -> Get LeapInfo +getLeapInfo getTime = do + lTime <- fmap toInteger getTime + lOffset <- get32bitInt + return $ LeapInfo lTime lOffset + +-- Our 8-bit ints are unsigned, so we can convert them directly +get8bitInt :: Get Int +get8bitInt = fmap fromIntegral getWord8 + +getInt32 :: Get Int32 +getInt32 = fmap fromIntegral getWord32be + +get32bitInt :: Get Int +get32bitInt = fmap fromIntegral getInt32 + -- via Int32 to get the sign right + -- in case we are on a 64-bit platform + +get32bitInteger :: Get Integer +get32bitInteger = fmap fromIntegral getInt32 + -- via Int32 to get the sign right + +getInt64 :: Get Int64 +getInt64 = fmap fromIntegral getWord64be + +get64bitInteger :: Get Integer +get64bitInteger = fmap fromIntegral getInt64 + -- via Int64 to get the sign right + +getBool :: Get Bool +getBool = fmap (/= 0) getWord8 + +toASCII :: [Word8] -> String +toASCII = map (toEnum . fromIntegral) + +verify :: Monad m => (a -> Bool) -> String -> a -> m a +verify pred msg val + | pred val = return val + | otherwise = error msg + +verify_ :: Monad m => (a -> Bool) -> String -> a -> m () +verify_ pred msg val + | pred val = return () + | otherwise = error msg + +throwOlson :: FilePath -> String -> IO a +throwOlson fp msg = throw . OlsonError $ + fp ++ ": invalid timezone file: " ++ msg diff --git a/Data/Time/LocalTime/TimeZone/Olson/Render.hs b/Data/Time/LocalTime/TimeZone/Olson/Render.hs new file mode 100644 --- /dev/null +++ b/Data/Time/LocalTime/TimeZone/Olson/Render.hs @@ -0,0 +1,224 @@ +{-# OPTIONS_HADDOCK hide #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Time.LocalTime.TimeZone.Olson.Render +-- Copyright : Yitzchak Gale 2010 +-- +-- Maintainer : Yitzchak Gale +-- Portability : portable +-- +-- Render Olson timezone data in the standard binary format as used in +-- Olson timezone files, and as specified by the tzfile(5) man page on +-- Unix-like systems. For more information about this format, see +-- . + +{- Copyright (c) 2010 Yitzchak Gale. All rights reserved. +For licensing information, see the BSD3-style license in the file +LICENSE that was originally distributed by the author together with +this file. -} + +module Data.Time.LocalTime.TimeZone.Olson.Render +( + -- * Rendering Olson timezone files + -- | If any of the transition times or leap second times specified + -- require more than a 32-bit integer to represent as a Unix + -- timestamp, or if a POSIX-style TZ string is specified, timezone + -- data is rendered using Version 2 format. Otherwise, the timezone data + -- is rendered using Version 1 format. + renderTimeZoneSeriesToOlsonFile, + timeZoneSeriesToOlson, + renderOlsonToFile, + verifyOlsonLimits, + putOlson, + splitOlson +) +where + +import Data.Time.LocalTime.TimeZone.Olson.Types +import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(TimeZoneSeries)) +import Data.Time (TimeZone(TimeZone, timeZoneSummerOnly, timeZoneName)) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) +import Data.Binary.Put (Put, runPut, putByteString, putWord8, flush, + putWord32be, putWord64be) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.List (partition, sortBy, sort, group) +import Data.Ord (comparing) +import Data.Word (Word8) +import Data.Maybe (listToMaybe, maybeToList, isNothing, fromMaybe, catMaybes) +import Data.Monoid (mempty) +import Control.Monad (guard, replicateM_, unless) + +-- | Render a @TimeZoneSeries@ as a binary Olson timezone file. +-- +-- If the values in the Olson timezone data exceed the standard size +-- limits (see 'defaultLimits'), this function throws an +-- exception. For other behavior, use 'timeZoneSeriesToOlson', +-- 'verifyOlsonLimits', 'putOlson' and 'Data.Binary.Put.runPut' +-- directly. +renderTimeZoneSeriesToOlsonFile :: FilePath -> TimeZoneSeries -> IO () +renderTimeZoneSeriesToOlsonFile fp = renderOlsonToFile fp . + fromMaybe (error "Cannot render TimeZoneSeries: default is summer time") . + timeZoneSeriesToOlson + +-- | Convert a @TimeZoneSeries@ to @OlsonData@ for rendering. +timeZoneSeriesToOlson :: TimeZoneSeries -> Maybe OlsonData +timeZoneSeriesToOlson (TimeZoneSeries dflt pairs) + | timeZoneSummerOnly dflt && not (all timeZoneSummerOnly $ map snd pairs) + = Nothing + | otherwise = Just $ + OlsonData + [Transition secs ttinfo | + (t, tzs) <- reverse pairs, + let secs = round $ utcTimeToPOSIXSeconds t, + ttinfo <- maybeToList $ lookup (mkTT tzs) ttAssocs] + ttinfos + [] + Nothing + where + mkTT (TimeZone offset isdst abbr) = + TtInfo (offset*60) isdst Wall abbr + dfltTT = mkTT dflt + ttAssocs = (dfltTT, 0) : + zip (uniq . sort . filter (/= dfltTT) $ map (mkTT . snd) pairs) [1..] + ttinfos = map fst ttAssocs + +-- | Check whether @OlsonData@ is within size limits. +verifyOlsonLimits :: SizeLimits -> OlsonData -> Bool +verifyOlsonLimits limits (OlsonData transs ttinfos leaps _) = + withinLimit maxTimes transs && + withinLimit maxTypes ttinfos && + withinLimit maxLeaps leaps && + withinLimit maxAbbrChars abbrChars + where + withinLimit limit items = maybe True (null . flip drop items) $ + limit limits + abbrChars = concat abbrStrs ++ map (const '\NUL') abbrStrs + abbrStrs = map tt_abbr ttinfos + +-- | Render Olson timezone data as a binary Olson timezone file +-- +-- If the values in the Olson timezone data exceed the standard size +-- limits (see 'defaultLimits'), this function throws an +-- exception. For other behavior, use 'verifyOlsonLimits', 'putOlson' +-- and 'Data.Binary.Put.runPut' directly. +renderOlsonToFile :: FilePath -> OlsonData -> IO () +renderOlsonToFile fp olson = do + unless (verifyOlsonLimits defaultLimits olson) $ + error "Olson timezone data exceeds size limits" + L.writeFile fp . runPut . putOlson $ olson + +-- | Render Olson timezone data in binary Olson timezone file format +-- as a lazy @ByteString@ +putOlson :: OlsonData -> Put +putOlson olson = putOlsonParts version olson1 olson2 posix >> flush + where + (olson1, olson2, posix) = splitOlson olson + version + | olson2 /= mempty = 50 + | otherwise = maybe 0 (const 50) $ posix >>= guard . not . null + +-- | Split Olson timezone data into three parts: timezone data that can +-- be rendered using Version 1 format, timezone data that can only be +-- rendered using Version 2 format, and the POSIX-style TZ string +-- if specified +splitOlson :: OlsonData -> (OlsonData, OlsonData, Maybe String) +splitOlson (OlsonData transs ttinfos leaps posix) = + (OlsonData transs1 ttinfos1 leaps1 Nothing, + OlsonData transs2 ttinfos2 leaps2 Nothing, + posix) + where + cutoff = 0x80000000 -- 2^31 + fitsIn32bits x = x < cutoff && x >= negate cutoff + ( leaps1 , leaps2 ) = partition (fitsIn32bits . leapTime) leaps + (transs1', transs2') = partition (fitsIn32bits . transTime) transs + assoc1 = mkAssoc [0] transs1' + assoc2 = mkAssoc [] transs2' + transs1 = mkTranss transs1' assoc1 + transs2 = mkTranss transs2' assoc2 + ttinfos1 = mkTtinfos assoc1 + ttinfos2 = mkTtinfos assoc2 + mkAssoc prepend transs' = zip + (sortBy (comparing $ fmap tt_ttype . listToMaybe . flip drop ttinfos) . + uniq . sort . (prepend ++) $ map transIndex transs') + [0..] + mkTranss transs' assoc = [t {transIndex = i} | + t <- transs', i <- maybeToList $ lookup (transIndex t) assoc] + mkTtinfos assoc = map snd . dropWhile (isNothing . fst) . + sortBy (comparing fst) $ zip (map (flip lookup assoc) [0..]) ttinfos + +putOlsonParts :: Word8 -> OlsonData -> OlsonData -> Maybe String -> Put +putOlsonParts 0 olson1 _ _ = putOlsonPart 0 put32bitIntegral olson1 +putOlsonParts v2 olson1 olson2 posix = do + putOlsonPart v2 put32bitIntegral olson1 + putOlsonPart v2 put64bitIntegral olson2 + putPosixTZ posix + +putOlsonPart :: Word8 -> (Integer -> Put) -> OlsonData -> Put +putOlsonPart version putTime (OlsonData transs ttinfos leaps _) = do + putASCII "TZif" + putWord8 version + putByteString . B.pack $ replicate 15 0 -- padding nulls + replicateM_ 2 $ putCount ttinfosWithTtype + -- tzh_ttisgmtcnt + -- tzh_ttisstdcnt + putCount leaps -- tzh_leapcnt + putCount transs -- tzh_timecnt + putCount ttinfos -- tzh_typecnt + putCount abbrChars -- tzh_charcnt + mapM_ (putTime . transTime ) transs + mapM_ (put8bitIntegral . transIndex) transs + mapM_ putTtInfo ttinfosIndexed + putASCII abbrChars + mapM_ (putLeapInfo putTime) leaps + mapM_ (putBool . (== Std) . tt_ttype) ttinfosWithTtype -- isstd + mapM_ (putBool . (== UTC) . tt_ttype) ttinfosWithTtype -- isgmt + where + putCount = put32bitIntegral . length + ttinfosWithTtype = takeWhile ((<= UTC) . tt_ttype) ttinfosIndexed + abbrStrings = uniq . sort $ map tt_abbr ttinfos + abbrChars = concatMap (++ "\NUL") abbrStrings + abbrAssocs = zip abbrStrings . scanl (+) 0 $ + map ((+ 1) . length) abbrStrings + ttinfosIndexed = [TtInfo gmtoff isdst ttype i | + TtInfo gmtoff isdst ttype abbr <- ttinfos, + i <- maybeToList $ lookup abbr abbrAssocs] + +putPosixTZ :: Maybe String -> Put +putPosixTZ posix = do + putWord8 10 + putASCII $ fromMaybe "" posix + putWord8 10 + +putTtInfo :: TtInfo Int -> Put +putTtInfo tt = do + put32bitIntegral $ tt_gmtoff tt + putBool $ tt_isdst tt + put8bitIntegral $ tt_abbr tt + +putLeapInfo :: Integral a => (a -> Put) -> LeapInfo -> Put +putLeapInfo putTime leap = do + putTime . fromIntegral $ leapTime leap + put32bitIntegral $ leapOffset leap + +-- Converting signed integrals to unsigned can be done directly, +-- without the care needed for the opposite direction when parsing. + +put8bitIntegral :: Integral a => a -> Put +put8bitIntegral = putWord8 . fromIntegral + +put32bitIntegral :: Integral a => a -> Put +put32bitIntegral = putWord32be . fromIntegral + +put64bitIntegral :: Integral a => a -> Put +put64bitIntegral = putWord64be . fromIntegral + +putBool :: Bool -> Put +putBool False = putWord8 0 +putBool True = putWord8 1 + +uniq :: Eq a => [a] -> [a] +uniq = map head . group + +putASCII :: String -> Put +putASCII = putByteString . B.pack . map (fromIntegral . fromEnum) diff --git a/Data/Time/LocalTime/TimeZone/Olson/Types.hs b/Data/Time/LocalTime/TimeZone/Olson/Types.hs new file mode 100644 --- /dev/null +++ b/Data/Time/LocalTime/TimeZone/Olson/Types.hs @@ -0,0 +1,151 @@ +{-# OPTIONS_HADDOCK hide #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Time.LocalTime.TimeZone.Olson.Types +-- Copyright : Yitzchak Gale 2010 +-- +-- Maintainer : Yitzchak Gale +-- Portability : portable +-- +-- Data types to represent timezone data as used in Olson timezone +-- files, and as specified by the tzfile(5) man page on Unix-like +-- systems. For more information about this format, see +-- . +-- +-- Both Version 1 and Version 2 timezone data can be represented. + +{- Copyright (c) 2010 Yitzchak Gale. All rights reserved. +For licensing information, see the BSD3-style license in the file +LICENSE that was originally distributed by the author together with +this file. -} + +module Data.Time.LocalTime.TimeZone.Olson.Types +( + -- * Olson timezone datatypes + OlsonData(..), + Transition(..), + TransitionType(..), + TtInfo(..), + LeapInfo(..), + + -- ** Size limits for Olson timezone data + SizeLimits(..), + defaultLimits, + limitsNoSolar, + noLimits +) +where + +import Data.Monoid (Monoid(..)) +import Control.Monad (mplus) + +-- | @OlsonData@ represents a full set of timezone data for a location. +-- +-- @OlsonData@ can represent timezone data from files in Version 1 format +-- or Version 2 format. Version 1 format files can only contain timestamp +-- values that can be represented in less than 32 bits, and cannot contain +-- a POSIX TZ string. +-- +-- In a Version 2 format file, the timezone data is split into two parts. +-- The first part contains timezone data for which all timestamp values +-- can be represented in less than 32 bits, and the second part contains +-- timezone data for which 32 bits or more are required to represent +-- timestamp values. The POSIX TZ string, if present, can only be rendered +-- in a Version 2 file, and appears after both parts of the timezone data. +data OlsonData = + OlsonData { + olsonTransitions :: [Transition], + olsonTypes :: [TtInfo String], + olsonLeaps :: [LeapInfo], + olsonPosixTZ :: (Maybe String) + -- ^ Optional POSIX TZ string for + -- times after the last @Transition@ + } + deriving (Eq, Show) + +instance Monoid OlsonData where + mempty = OlsonData [] [] [] Nothing + mappend (OlsonData a b c d ) (OlsonData a' b' c' d') + = OlsonData (a++a') (b++b') (c++c') (d `mplus` d') + +-- | A @Transition@ represents a moment when the clocks change in a +-- timezone. It consists of a Unix timestamp value that indicates the +-- exact moment in UTC when the clocks change, and the 0-based index +-- in the list of @TtInfo@ specifications for the description of the +-- new time after the clocks change. +data Transition = + Transition + {transTime :: Integer, -- ^ Unix timestamp indicating the time + -- when the clocks change + transIndex :: Int -- ^ 0-based index in the list of @TtInfo@ + -- that describes the new time + } + deriving (Eq, Show) + +-- | A @TransitionType@ is historical information about whether the +-- official body that announced a time change specified the time of +-- the change in terms of UTC, standard time (i.e., non-summer time) +-- for the time zone, or the current wall clock time in the time +-- zone. This historical trivia may seem rather boring, but +-- unfortunately it is needed to interpret a POSIX-style TZ string +-- timezone specification correctly. +data TransitionType = Std | Wall | UTC + deriving (Eq, Ord, Show) + +-- | A @TtInfo@ is a specification of local time in a timezone for +-- some period during which the clocks did not change. `abbr` is +-- @String@ if the timezone abbreviation is represented as a @String@, +-- or @Int@ if it is represented as an index into a long string of +-- null-terminated abbreviation strings (as in an Olson binary +-- timezone file). +data TtInfo abbr = + TtInfo + {tt_gmtoff :: Int, -- ^ The offset of local clocks from UTC, + -- in seconds + tt_isdst :: Bool, -- ^ True if local clocks are summer time + tt_ttype :: TransitionType, + tt_abbr :: abbr -- ^ The timezone abbreviation string. + } + deriving (Eq, Ord, Show) + +-- | Olson timezone files can contain leap second specifications, though +-- most do not. +data LeapInfo = + LeapInfo + {leapTime :: Integer, -- ^ A Unix timestamp indicating the time + -- that the leap second occurred + leapOffset :: Int -- ^ The new total offset of UTC from UT1 + -- after this leap second + } + deriving (Eq, Show) + +-- | The reference C implentation imposes size limits on the data +-- structures in a timezone file. +data SizeLimits = SizeLimits + {maxTimes :: Maybe Int, -- ^ The maximum number of transition times + maxTypes :: Maybe Int, -- ^ The maximum number of TtInfo + -- clock settings + maxAbbrChars :: Maybe Int, -- ^ The maximum total number of bytes in + -- all timezone abbreviations. + maxLeaps :: Maybe Int -- ^ The maximum number of leap second + -- specifications. + } + +-- | The size limits in @defaultLimits@ are taken from the file +-- tzfile.h from tzcode version 2010f. These are the limits for the C +-- implementation on many platforms. +defaultLimits :: SizeLimits +defaultLimits = SizeLimits { maxTimes = Just 1200, maxTypes = Just 256, + maxAbbrChars = Just 50, maxLeaps = Just 50 } + +-- | @limitsNoSolar@ contains the tighter size limits imposed on some +-- platforms that do not allow timezones that are based on solar time. +limitsNoSolar :: SizeLimits +limitsNoSolar = defaultLimits { maxTypes = Just 20 } + +-- | @noLimits@ imposes no size limits. If you use @noLimits@ when +-- parsing, you may exhaust all available memory when reading a faulty +-- or malicious timezone file. If you use @noLimits@ when rendering, +-- the rendered timezone file might not be readable on some systems. +noLimits :: SizeLimits +noLimits = SizeLimits Nothing Nothing Nothing Nothing diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2010 Yitzchak Gale. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Yitzchak Gale nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,49 @@ +timezone-olson version 0.1.0 + +This package provides a parser and renderer for binary Olson timezone +files whose format is specified by the tzfile(5) man page on Unix-like +systems. For more information about this format, see +. Functions are provided for +converting the parsed data into 'TimeZoneSeries' objects from the +timezone-series package. On many platforms, binary Olson timezone +files suitable for use with this package are available in the +directory /usr/share/zoneinfo and its subdirectories on your computer. + +This version of timezone-olson is highly experimental. Expect there +to be bugs, and do not rely on any stability of the exposed +interfaces. + +Copyright (c) 2010 Yitzchak Gale. All rights reserved. +For licensing information, see the BSD3-style license in the file +LICENSE that was originally distributed by the author together with +this file. + +This package is part of the time-ng project: +http://projects.haskell.org/time-ng/ + +Send suggestions, bug reports, and patches to: +yitz@community.haskell.org + +INSTALLATION: + +To install the latest version of this package, make sure that +cabal-install is installed on your system (it is if you have installed +the Haskell Platform) and type the commands: + +cabal update +cabal install timezone-olson + +TESTING UTILITIES: + +This package also provides two Haskell files, each of which can be +compiled into a command-line utility that might be helpful for testing +purposes. + +zhdump.hs: A clone of zdump(8), including most of its bugs, that + is usually present on systems that have an Olson timezone + database, except hzdump takes paths to timezone files + instead of timezone identifiers on the command line. + +catTZ: Read and parse a timezone file, then render it. With the + -i flag, interprets the timezone data as a TimeZoneSeries + object before rendering. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/catTZ.hs b/catTZ.hs new file mode 100644 --- /dev/null +++ b/catTZ.hs @@ -0,0 +1,14 @@ +-- | Parse an Olson timezone file, then render it. +-- If -i is specified, interpret it as a TimeZoneSeries before rendering. +module Main where + +import Data.Time.LocalTime.TimeZone.Olson +import Data.Time.LocalTime.TimeZone.Series +import System.Environment + +main = do + args <- getArgs + if head args == "-i" + then getTimeZoneSeriesFromOlsonFile (args !! 1) >>= + renderTimeZoneSeriesToOlsonFile (args !! 2) + else getOlsonFromFile (args !! 0) >>= renderOlsonToFile (args !! 1) diff --git a/hzdump.hs b/hzdump.hs new file mode 100644 --- /dev/null +++ b/hzdump.hs @@ -0,0 +1,118 @@ +-- | A clone in Haskell of the zdump(8) command, including most of +-- the bugs, that takes paths to Olson files instead of timezone +-- names. This is useful for testing the Haskell implementation +-- of the Olson timezone parser and renderer against the reference +-- implementation in C. But less useful than it might seem at first, +-- because Haskell rounds historical solar mean timezones to the +-- nearest minute, whereas the C implementation rounds to the nearest +-- second. +module Main where + +import Data.Time.LocalTime.TimeZone.Series +import Data.Time.LocalTime.TimeZone.Olson +import Data.Time +import Data.Maybe (listToMaybe) +import System.Environment (getArgs) +import System.Exit (exitWith, exitSuccess, ExitCode(ExitFailure)) +import System.Locale (defaultTimeLocale) +import Control.Monad (guard) + +version :: IO a +version = do + putStrLn "hzdump version 0.1, clone of zdump 1.7 -c option fixed," + putStrLn "takes zone file paths instead of zone specifications" + exitSuccess + +usage :: IO a +usage = do + putStrLn "usage: hzdump [--version] [-v] [-c cutoff] zone-file-path ..." + putStrLn " where cutoff is lo-year,hi-year or hi-year" + exitWith $ ExitFailure 1 + +illegalOpt :: Char -> IO a -- sic +illegalOpt opt = do + putStrLn $ "hzdump: illegal option -- " ++ [opt] + usage + +data Option = Version | Illegal Char | + Verbose (Maybe Integer, Maybe Integer) | Now + deriving (Eq, Ord, Show) + +main = do + (opts, zones) <- fmap parseArgs getArgs + (getTimes, displayTime) <- case opts of + Version -> version + Illegal opt -> illegalOpt opt + Verbose rng -> return (transitionTimes rng, displayVerbose) + _ -> do now <- getCurrentTime + return (const [now], displayConcise) + tzss <- mapM getZone zones + putStr . unlines . concat $ + zipWith (displayZone getTimes displayTime) zones tzss + where + getZone "-" = return utcTZ -- sic + getZone z = getTimeZoneSeriesFromOlsonFile z + + displayZone getTimes displayTime zone tzs = + map ((zone ++) . (" " ++) . displayTime tzs) $ getTimes tzs + +parseArgs :: [String] -> (Option, [FilePath]) +parseArgs args | "--version" `elem` args = (Version, []) +parseArgs args = getOpts False (Nothing, Nothing) args + where + getOpts _ cutoff ("-v":args) = getOpts True cutoff args + getOpts v _ ("-c":c:args) = maybe (Illegal 'c', []) + (\y -> getOpts v y args) $ + parseCutoff c + getOpts v cutoff ("--":zones ) = (opts v cutoff, zones) + getOpts _ _ (('-':x:_):_) = (Illegal x, []) + getOpts v cutoff zones = (opts v cutoff, zones) + + opts v cutoff = if v then Verbose cutoff else Now + + parseCutoff c = let p0 = listToMaybe $ reads c + los = fmap fst p0 + his = do str <- fmap snd p0 + let (comma, str1) = splitAt 1 str + guard $ comma == "," + maybeRead str1 + in los >> Just (maybe (Nothing, los) ((,) los . Just) his) + +displayConcise :: TimeZoneSeries -> UTCTime -> String +displayConcise tzs t = formatTime defaultTimeLocale format $ + ZoneSeriesTime t tzs + where + format = "%a %b %e %T %Y %Z" + +displayVerbose :: TimeZoneSeries -> UTCTime -> String +displayVerbose tzs t = concat [displayConcise utcTZ t, " = ", + displayConcise tzs t, " isdst=", if isdst then "1" else "0"] + where + isdst = timeZoneSummerOnly $ timeZoneFromSeries tzs t + +transitionTimes :: (Maybe Integer, Maybe Integer) -> TimeZoneSeries -> + [UTCTime] +transitionTimes (lo, hi) = + maybe id (takeWhile . (>)) (fmap happyNewYear hi) . + maybe id (dropWhile . (>)) (fmap happyNewYear lo) . + addBugs . addPrevSecond . actualTransitions + where + happyNewYear y = UTCTime (fromGregorian y 1 1) 0 + actualTransitions (TimeZoneSeries d cs) = + let rs = reverse cs + in map snd . filter fst $ + zipWith (\(t, tz) prevTz -> (tz /= prevTz, t)) + rs + (d : map snd rs) + addPrevSecond = concatMap (\t -> [(-1) `addUTCTime` t, t]) + addBugs = (bug0 ++) . (++ bug1) -- sic + bug0 = [UTCTime (fromGregorian 1901 12 13) (20*3600+45*60+52), + UTCTime (fromGregorian 1901 12 14) (20*3600+45*60+52)] + bug1 = [UTCTime (fromGregorian 2038 1 18) ( 3*3600+14*60+ 7), + UTCTime (fromGregorian 2038 1 19) ( 3*3600+14*60+ 7)] + +utcTZ :: TimeZoneSeries +utcTZ = TimeZoneSeries utc [] + +maybeRead :: Read a => String -> Maybe a +maybeRead = fmap fst . listToMaybe . filter (null . snd) . reads diff --git a/timezone-olson.cabal b/timezone-olson.cabal new file mode 100644 --- /dev/null +++ b/timezone-olson.cabal @@ -0,0 +1,76 @@ +-- timezone-olson.cabal auto-generated by cabal init. For additional +-- options, see +-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. +-- The name of the package. +Name: timezone-olson + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.1.0 + +-- A short (one-line) description of the package. +Synopsis: A pure Haskell parser and renderer for binary Olson timezone files + +-- A longer description of the package. +Description: A parser and renderer for binary Olson timezone + files whose format is specified by the tzfile(5) + man page on Unix-like systems. For more + information about this format, see + . Functions + are provided for converting the parsed data into + 'TimeZoneSeries' objects from the timezone-series + package. On many platforms, binary Olson timezone + files suitable for use with this package are + available in the directory /usr/share/zoneinfo + and its subdirectories on your computer. + +-- URL for the project homepage or repository. +Homepage: http://projects.haskell.org/time-ng/ + +-- The license under which the package is released. +License: BSD3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Yitzchak Gale + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: yitz@community.haskell.org + +-- A copyright notice. +Copyright: Copyright (c) 2010 Yitzchak Gale. All rights reserved. + +Category: Data + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +Extra-source-files: README, catTZ.hs, hzdump.hs + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.2 + + +Library + -- Modules exported by the library. + Exposed-modules: Data.Time.LocalTime.TimeZone.Olson, Data.Time.LocalTime.TimeZone.Olson.Parse, Data.Time.LocalTime.TimeZone.Olson.Render, Data.Time.LocalTime.TimeZone.Olson.Types + + -- Packages needed in order to build this package. + Build-depends: base >= 3.0 && < 5.0, + timezone-series >= 0.1.0 && < 0.2, + time >= 1.1.4 && < 1.3, + binary >= 0.4.1 && < 0.6, + bytestring >= 0.9 && < 1.0, + extensible-exceptions >= 0.1.0 && < 0.2 + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: +