diff --git a/Skype/Entry.hs b/Skype/Entry.hs deleted file mode 100644 --- a/Skype/Entry.hs +++ /dev/null @@ -1,88 +0,0 @@ -module Skype.Entry where - -import Data.DateTime -import Data.List as DL -import Data.Word -import Data.ByteString -import Data.ByteString.UTF8 as U - -data SkypeEntry = SEntry { - recSize :: Word32, - sessionId :: ByteString, - timeStamp :: DateTime, - senderId :: ByteString, - members :: [ByteString], - message :: ByteString, - records :: [RawRecord] -} | IncompleteEntry { parseErrorMsg :: String } deriving Show - -instance Eq (SkypeEntry) where - a == b = sessionId a == sessionId b && - timeStamp a == timeStamp b && - senderId a == senderId b - -instance Ord (SkypeEntry) where - a `compare` b | timeStamp a < timeStamp b = LT - | timeStamp a > timeStamp b = GT - | otherwise = EQ - -data RawRecord = IRecord { - recType :: RecordType, - intVal :: Word64 } | - TRecord { recType :: RecordType, - txtVal :: ByteString } | - BRecord { recType :: RecordType, - blobVal :: ByteString, - bRecSize :: Int} | - URecord { recType :: RecordType, - content :: ByteString } - - -instance Show RawRecord where - show (IRecord rType val) = "I : " ++ show rType ++ " : " ++ show val - show (TRecord rType val) = "T : " ++ show rType ++ " : " ++ show val - show (BRecord rType _ _) = "B : " ++ show rType - show (URecord rType _) = "U : " ++ show rType - -data RecordType = - VoicemailFile | - Call | - Summary | - Language | - Country | - City | - File | - Peek | - Email | - URL | - Description | - Phone | - Type | - User | - Session | - Members | - Name | - Sender | - Recipient | - Message | - Member | - Number | - Screenname | - Fullname | - LogBy | - MsgId | - Date | - Unknown { code :: Word64 } deriving (Show) - -defaultTime = fromGregorian' 1970 1 1 - -makeSEntry :: SkypeEntry -makeSEntry = SEntry 0 empty defaultTime empty [] empty [] - -data SkypeChat = SChat { - userL, userR :: ByteString, - messages :: [SkypeEntry] -} - -instance Show SkypeChat where - show s = U.toString (userL s) ++ " : " ++ U.toString ( userR s ) ++ " (" ++ show ( DL.length (messages s) ) ++ ")" diff --git a/Skype/LogAggregator.hs b/Skype/LogAggregator.hs deleted file mode 100644 --- a/Skype/LogAggregator.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Skype.LogAggregator ( - aggregateLogs -) where - -import Skype.LogParser -import Skype.Entry -import Data.Map as DM -import Data.List as DL -import Data.Word -import Data.ByteString as S -import Data.Attoparsec as DA - -type ChatsMap = DM.Map S.ByteString [SkypeEntry] - -chatsMap :: ChatsMap -chatsMap = DM.empty - -aggregateLogs :: [[SkypeEntry]] -> [SkypeChat] -aggregateLogs = extractChats . DL.foldr allocateEntry chatsMap . DL.concat - where - allocateEntry :: SkypeEntry -> ChatsMap -> ChatsMap - allocateEntry entry = DM.alter ( updMap entry ) ( sessionId entry ) - updMap entry Nothing = Just [entry] - updMap entry (Just entries) = Just $ entry : entries - extractChats :: ChatsMap -> [SkypeChat] - extractChats = DM.foldWithKey go [] - go key value arr = let ( userA, userB ) = extractResult $ DA.parse parseChatSession key - in SChat userA userB value : arr - extractResult (Done _ r) = r - extractResult _ = ( S.empty, S.empty ) - -parseChatSession :: Parser (S.ByteString, S.ByteString) -parseChatSession = do - word8 0x23 - userA <- DA.takeWhile ( /= 0x2f ) - word8 0x2f - word8 0x24 - userB <- DA.takeWhile ( /= 0x3b ) - return (userA, userB) diff --git a/Skype/LogExport.hs b/Skype/LogExport.hs deleted file mode 100644 --- a/Skype/LogExport.hs +++ /dev/null @@ -1,78 +0,0 @@ -module Skype.LogExport ( - exportChats -) where - -import Skype.Entry -import Data.Set as DS -import Data.List as DL -import Data.ByteString.Char8 as DB8 -import Data.ByteString as S -import Control.Monad -import Control.Monad.IfElse -import Control.Exception -import Data.DateTime -import System.Directory -import System.FilePath -import System.IO - -newtype SortedSkypeEntry = SortedSkypeEntry { entries :: [SkypeEntry] } - -type FolderName = ByteString - -newtype ExportChat = ExportChat { export :: ( FolderName, SortedSkypeEntry ) } - -getFolderName = fst . export - -getEntries = entries . snd . export - -sortEntries :: [SkypeEntry] -> SortedSkypeEntry -sortEntries = SortedSkypeEntry . DS.toList . DS.fromList - -exportChat :: String -> SkypeChat -> ExportChat -exportChat srcUser chat = ExportChat (folderName, sortedEntries) - where - sortedEntries = sortEntries . messages $ chat - firstEntry = DL.head . entries $ sortedEntries - srcUser' = DB8.pack srcUser - uL = userL chat - uR = userR chat - folderName | srcUser' == uL = uR - | srcUser' == uR = uL - | otherwise = srcUser' - - -separator = DB8.pack " : " - -exportChats :: String -> String -> [SkypeChat] -> IO () -exportChats folder username = mapM_ ( go . exportChat username ) - where - go chat = do - mkdirs $ splitDirectories folder' - bracket (openFile file' WriteMode) - hClose - doExport - where - mkdirs [dir] = mkDir dir - mkdirs (dir:new:dirs) = do - mkDir dir - mkdirs $ (dir new) : dirs - mkDir dir = - whenM ( liftM not $ doesDirectoryExist dir ) - ( createDirectory dir ) - folder' = folder username DB8.unpack folderName - file' = folder' firstEntryDateStr <.> "log" - firstEntry = DL.head . getEntries $ chat - firstEntryDateStr = formatDateTime "%Y-%m-%d %H-%M-%S" . timeStamp $ firstEntry - folderName = getFolderName chat - doExport handle = - mapM_ (writeEntry handle) $ getEntries chat - writeEntry handle chatEntry = do - let username = senderId chatEntry - let content = message chatEntry - let timestamp = formatDateTime " %d-%m-%Y %H:%M:%S" . timeStamp $ chatEntry - -- ugly formatting goes here - S.hPutStr handle username - S.hPutStr handle separator - S.hPutStr handle $ DB8.pack timestamp - S.hPutStr handle separator - S.hPutStrLn handle content diff --git a/Skype/LogParser.hs b/Skype/LogParser.hs deleted file mode 100644 --- a/Skype/LogParser.hs +++ /dev/null @@ -1,160 +0,0 @@ -module Skype.LogParser ( - LogParser(parseSkypeLog) -) where - -import Data.ByteString.Lazy as L -import Data.ByteString as S - -import Data.Attoparsec as AP - -import Data.Binary.Get - -import Data.Bits - -import Data.Maybe - -import Data.List as DL - -import Data.Map as DM - -import Data.Word - -import Data.DateTime - -import Control.Monad - -import Skype.Entry -import Skype.Util - -class LogParser s where - parseSkypeLog :: s -> [SkypeEntry] - -extractResults :: Parser [a] -> S.ByteString -> [a] -extractResults = ((either (const []) id . AP.eitherResult) .) . (flip AP.feed S.empty .) . AP.parse - -instance LogParser S.ByteString where - parseSkypeLog = extractResults (many parsecLogParser) - -headerSign' = [0x6C,0x33,0x33,0x6C] - -parsecLogParser :: Parser SkypeEntry -parsecLogParser = do - skipUntilString headerSign' - recSz <- read4Bytes - AP.take 9 - content <- AP.take $ fromIntegral recSz - 9 - return . extractResult $ parse (parseLogContent recSz) content - where - extractResult ( Fail _ _ msg ) = IncompleteEntry msg - extractResult ( Partial f ) = extractResult $ f S.empty - extractResult ( Done _ r ) = r - -skipUntilString :: [Word8] -> Parser () -skipUntilString start = go start - where - go [] = return () - go (x:xs) = do - cur <- AP.take 1 - handleChar x xs (S.head cur) - handleChar x xs cur | x == cur = go xs - | cur == DL.head start = go $ DL.tail start - | otherwise = go start - -parseLogContent :: Word32 -> Parser SkypeEntry -parseLogContent recSz = do - let skypeEntry = makeSEntry { recSize=recSz } - records <- try $ many parseRecord - return $ DL.foldl mkSkypeEntry skypeEntry records - where - mkSkypeEntry rec (TRecord Message val) = rec { message = val } - mkSkypeEntry rec (TRecord Sender val) = rec { senderId = val } - mkSkypeEntry rec (TRecord Members val) = rec { members = splitRec val } - mkSkypeEntry rec (IRecord Date val) = rec { timeStamp = fromSeconds . fromIntegral $ val } - mkSkypeEntry rec (TRecord Session val) = rec { sessionId = val } - mkSkypeEntry rec fld = let recs = records rec - in rec { records = fld:recs } - splitRec = S.split 0x20 - - -intMark = S.pack [0x00] -textMark = S.pack [0x03] -blobMark = S.pack [0x04] - -parseRecord :: Parser RawRecord -parseRecord = AP.take 1 >>= handleRecord - where - handleRecord src | src == intMark = parseInt - | src == textMark = parseText - | src == blobMark = parseBlob - | otherwise = parseUnknown - -parseInt :: Parser RawRecord -parseInt = do - itemCode <- liftM deriveType readNumber - itemValue <- readNumber - return $ IRecord itemCode itemValue - -parseText :: Parser RawRecord -parseText = do - itemCode <- liftM deriveType readNumber - content <- AP.takeWhile ( /= 0x00 ) - AP.take 1 - return $ TRecord itemCode content - -parseBlob :: Parser RawRecord -parseBlob = do - itemCode <- liftM deriveType readNumber - itemSize <- readNumber - content <- AP.take $ fromIntegral itemSize - return $ BRecord itemCode content ( fromIntegral itemSize ) - -parseUnknown = do - itemCode <- liftM deriveType readNumber - content <- AP.takeWhile ( > 0x04 ) - return $ URecord itemCode content - - -deriveType :: Word64 -> RecordType -deriveType 15 = VoicemailFile -deriveType 16 = Call -deriveType 20 = Summary -deriveType 36 = Language -deriveType 40 = Country -deriveType 48 = City -deriveType 51 = File -deriveType 55 = Message -deriveType 508 = Message -deriveType 64 = Email -deriveType 68 = URL -deriveType 72 = Description -deriveType 116 = Country -deriveType 184 = Phone -deriveType 296 = Type -deriveType 404 = User -deriveType 408 = User -deriveType 440 = Session -deriveType 456 = Members -deriveType 460 = Members -deriveType 468 = User -deriveType 472 = Name -deriveType 480 = Session -deriveType 488 = Sender -deriveType 492 = Sender -deriveType 500 = Recipient -deriveType 584 = Session -deriveType 588 = Member -deriveType 565 = Date -deriveType 485 = Date -deriveType 828 = Sender -deriveType 840 = User -deriveType 868 = Number -deriveType 920 = Screenname -deriveType 924 = Fullname -deriveType 3160 = LogBy -deriveType num = Unknown num - -skipGarbage = AP.skipWhile ( /= 0x03 ) - -skipDelimiter = AP.skipWhile ( == 0x03 ) - -read4Bytes = liftM ( runGet getWord32le . L.fromChunks . (:[]) ) $ AP.take 4 diff --git a/Skype/Util.hs b/Skype/Util.hs deleted file mode 100644 --- a/Skype/Util.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Skype.Util where - -import Data.Attoparsec as AP -import Data.Word -import Control.Monad -import Data.Bits -import Data.ByteString as S -import Data.List as DL -import Text.Printf - - -readNumber :: Parser Word64 -readNumber = do - buf <- AP.takeWhile ( \c -> c .&. 0x80 > 0 ) - rem <- liftM S.head $ AP.take 1 - return $ DL.foldl makeNum 0 $ DL.zip (S.unpack $ buf `S.snoc` rem) [0,7..] - where - makeNum :: Word64 -> (Word8, Int) -> Word64 - makeNum acc (dig, bits) = acc .|. ( ( fromIntegral dig .&. 0x7f) `shift` bits ) - -convertToBytes :: String -> [Word8] -convertToBytes [] = [] -convertToBytes (x:y:xs) = read ['0','x',x,y] : convertToBytes xs - -parseNumStr :: String -> Result Word64 -parseNumStr = parseNum . convertToBytes - -parseNum :: [Word8] -> Result Word64 -parseNum = parse readNumber . S.pack - -showNum :: Word64 -> [Word8] -showNum item | next == 0 = [cur] - | otherwise = (cur .|. 0x80) : showNum next - where - cur = fromIntegral item .&. 0x7f - next = item `shiftR` 7 - -printNum :: Word64 -> String -printNum = DL.intercalate "," . DL.map (printf "%0x") . showNum diff --git a/skypelogexport.cabal b/skypelogexport.cabal --- a/skypelogexport.cabal +++ b/skypelogexport.cabal @@ -7,14 +7,13 @@ -- 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 +Version: 0.2 -- A short (one-line) description of the package. Synopsis: Export Skype chat logs to text files -- A longer description of the package. -Description: The purpose of this software is to export logs of Skype into - text files. +-- Description: -- URL for the project homepage or repository. Homepage: https://github.com/jdevelop/skypelogexport/wiki @@ -41,11 +40,7 @@ -- Extra files to be distributed with the package, such as examples or -- a README. -Extra-source-files: Skype/Entry.hs - Skype/LogAggregator.hs - Skype/LogExport.hs - Skype/LogParser.hs - Skype/Util.hs +-- Extra-source-files: -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.2 @@ -56,10 +51,11 @@ Main-is: Main.hs -- Packages needed in order to build this package. - Build-depends: base >= 4 && < 5, bytestring >= 0.9, + Build-depends: base < 5, bytestring >= 0.9, filepath >= 1.2, regex-pcre >= 0.94, haskell98 >= 1, directory >= 1, - datetime >= 0.2, IfElse >= 0.8, + old-locale >= 1, IfElse >= 0.8, + time > 1.2, containers >= 0.4, utf8-string >= 0.3, attoparsec >= 0.8, ghc-binary >= 0.5