packages feed

skypelogexport (empty) → 0.1

raw patch · 9 files changed

+541/−0 lines, 9 filesdep +IfElsedep +attoparsecdep +basesetup-changed

Dependencies added: IfElse, attoparsec, base, bytestring, containers, datetime, directory, filepath, ghc-binary, haskell98, regex-pcre, utf8-string

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Eugene Dzhurinsky++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 Eugene Dzhurinsky 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.
+ Main.hs view
@@ -0,0 +1,34 @@+module Main where++import Skype.Entry+import Skype.LogAggregator+import Skype.LogParser+import Skype.LogExport+import Control.Monad+import Data.List as DL+import System.Directory+import System+import Text.Regex.PCRE+import System.FilePath+import Data.ByteString as S++listChatFiles :: FilePath -> IO [FilePath]+listChatFiles path = (DL.map ( path </> ) . DL.filter chatPredicate ) `fmap` getDirectoryContents path+    where+        chatPredicate x = x =~ "chat(msg)?\\d+.dbb"++main = getArgs >>= go+    where+        go (skypeFolder:targetFolder:[]) = do+            let username = DL.last . splitDirectories $ skypeFolder+            Prelude.putStrLn $ "Processing folder " ++ skypeFolder+            files <- listChatFiles skypeFolder+            Prelude.putStrLn $ "History files found: " ++ show (DL.length files)+            chats <- (aggregateLogs . DL.map parseSkypeLog) `fmap` mapM S.readFile files+            let totals = DL.sum $ DL.map ( DL.length . messages ) chats+            Prelude.putStrLn $ "Sessions found: " ++ show (DL.length chats)+            Prelude.putStrLn $ "Messages found: " ++ show totals+            Prelude.putStrLn $ "Exporting chats for " ++ username ++ " to folder " ++ targetFolder+            exportChats targetFolder username chats+            Prelude.putStrLn $ "Done, results available under" ++ targetFolder+        go _ = Prelude.putStrLn "Usage: skypeexport <skype folder> <output folder>"
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Skype/Entry.hs view
@@ -0,0 +1,88 @@+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) ) ++ ")"
+ Skype/LogAggregator.hs view
@@ -0,0 +1,39 @@+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)
+ Skype/LogExport.hs view
@@ -0,0 +1,78 @@+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
+ Skype/LogParser.hs view
@@ -0,0 +1,160 @@+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
+ Skype/Util.hs view
@@ -0,0 +1,39 @@+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
+ skypelogexport.cabal view
@@ -0,0 +1,71 @@+-- skypelogexport.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:                skypelogexport++-- 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++-- 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.++-- URL for the project homepage or repository.+Homepage:            https://github.com/jdevelop/skypelogexport/wiki++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Eugene Dzhurinsky++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          jdevelop@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Text++Build-type:          Simple++-- 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 ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2+++Executable skypelogexport+  -- .hs or .lhs file containing the Main module.+  Main-is:  Main.hs+  +  -- Packages needed in order to build this package.+  Build-depends: base >= 4 && < 5, bytestring >= 0.9,+                 filepath >= 1.2, regex-pcre >= 0.94,+                 haskell98 >= 1, directory >= 1,+                 datetime >= 0.2, IfElse >= 0.8,+                 containers >= 0.4, utf8-string >= 0.3,+                 attoparsec >= 0.8, ghc-binary >= 0.5+  +  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +