src/tnef/object.hs

   1 --
   2 -- Copyright Michael Orlitzky
   3 --
   4 -- http://michael.orlitzky.com/
   5 --
   6 -- This program is free software: you can redistribute it and/or modify
   7 -- it under the terms of the GNU General Public License as published by
   8 -- the Free Software Foundation, either version 3 of the License, or
   9 -- (at your option) any later version.
  10 --
  11 -- This program is distributed in the hope that it will be useful,
  12 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14 -- GNU General Public License for more details.
  15 --
  16 -- http://www.fsf.org/licensing/licenses/gpl.html
  17 --
  18
  19 module Tnef.Object where
  20
  21 import Control.Monad (replicateM)
  22 import Data.Binary
  23 import qualified Data.Binary.Get as BinaryGet
  24 import qualified Data.Binary.Put as BinaryPut
  25 import qualified Data.ByteString.Lazy as BS
  26 import Data.Char
  27 import Data.Word
  28 import Tnef.ObjectName
  29 import Tnef.ObjectLvl
  30
  31
  32 -- The only tricky part here is the "chained" TnefObjects.
  33 -- Each object contains the next one. It's like that because
  34 -- I couldn't figure out how to parse an unknown number of
  35 -- objects using Binary.Get.
  36 data TnefObject = TnefObject { obj_lvl      :: TnefObjectLvl,
  37                                obj_name     :: TnefObjectName,
  38                                obj_type     :: Word16,
  39                                obj_length   :: Word32,
  40                                obj_data     :: [Word8],
  41                                obj_checksum :: Word16,
  42                                next_object  :: TnefObject }
  43                 | Nil
  44
  45
  46 instance Show TnefObject where
  47     show Nil = "Nil"
  48     show x = "<object>" ++ "\n" ++
  49              "  Level: " ++ (show (obj_lvl x)) ++ "\n" ++
  50              "  Name: " ++ (show (obj_name x)) ++ "\n" ++
  51              "  Type: " ++ (show (obj_type x)) ++ "\n" ++
  52              "  Data: " ++ (show_data x) ++ "\n" ++
  53              "  Checksum: " ++ (show (obj_checksum x)) ++ " (Actual: " ++ (show (checksum (obj_data x))) ++ ")\n" ++
  54              "</object>\n"
  55
  56 drop_null_byte :: [Word8] -> [Word8]
  57 drop_null_byte = takeWhile (/= 0)
  58
  59 show_data :: TnefObject -> String
  60 show_data Nil = ""
  61 show_data x
  62     | ((show n) == "Attachment Data") = "(Binary)"
  63     | ((show n) == "Date Sent") = show (obj_data x)
  64     | ((show n) == "Date Received") = show (obj_data x)
  65     | ((show n) == "Date Modified") = show (obj_data x)
  66     | ((show n) == "Attachment Modification Date") = show (obj_data x)
  67     | otherwise = t
  68       where
  69         n = (obj_name x)
  70         t = (map (chr . word8_to_int) (drop_null_byte (obj_data x)))
  71
  72
  73 -- Just sum up the values of the bytes, and take that
  74 -- value mod 65536 at the end. (checksum obj_data) should
  75 -- equal the value of obj_checksum for each TnefObject.
  76 checksum :: [Word8] -> Int
  77 checksum x = (foldr (+) 0 (map word8_to_int x)) `mod` 0x10000
  78
  79
  80 -- Just for convenience
  81 word8_to_int :: Word8 -> Int
  82 word8_to_int x = (fromIntegral x)
  83
  84
  85 instance Binary TnefObject where
  86     put _ = do BinaryPut.putWord8 0
  87     get = do
  88       obj_lvl_word    <- BinaryGet.getWord8
  89       obj_name_word   <- BinaryGet.getWord16host
  90       obj_type_word   <- BinaryGet.getWord16host
  91       obj_length_word <- BinaryGet.getWord32host
  92       -- This pulls in obj_length bytes of data as a [Word8]
  93       obj_data_word  <- replicateM (fromIntegral obj_length_word) BinaryGet.getWord8
  94       obj_checksum_word <- BinaryGet.getWord16host
  95       next_object_word  <- get_next_tnef_object
  96       return (TnefObject { obj_lvl = (word_to_lvl obj_lvl_word),
  97                            obj_name = (word_to_name obj_name_word),
  98                            obj_type = obj_type_word,
  99                            obj_length = obj_length_word,
 100                            obj_data = obj_data_word,
 101                            obj_checksum = obj_checksum_word,
 102                            next_object = next_object_word })
 103
 104
 105 -- If there's no more data, return Nil as the "next" object.
 106 get_next_tnef_object :: Get TnefObject
 107 get_next_tnef_object = do
 108   is_empty <- BinaryGet.isEmpty
 109   if is_empty
 110     then return Nil
 111     else (get :: Get TnefObject)
 112
 113
 114 write_tnef_object :: String -> TnefObject -> IO ()
 115 write_tnef_object _ Nil = return ()
 116 write_tnef_object path x
 117     | ((show n) == "Attachment Data") = BS.writeFile path (BS.pack (obj_data x))
 118     | otherwise = return ()
 119       where n = (obj_name x)