skypelogexport 0.1 → 0.2
raw patch · 6 files changed
+6/−414 lines, 6 filesdep +old-localedep +timedep −datetimedep ~base
Dependencies added: old-locale, time
Dependencies removed: datetime
Dependency ranges changed: base
Files
- Skype/Entry.hs +0/−88
- Skype/LogAggregator.hs +0/−39
- Skype/LogExport.hs +0/−78
- Skype/LogParser.hs +0/−160
- Skype/Util.hs +0/−39
- skypelogexport.cabal +6/−10
− Skype/Entry.hs
@@ -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) ) ++ ")"
− Skype/LogAggregator.hs
@@ -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)
− Skype/LogExport.hs
@@ -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
− Skype/LogParser.hs
@@ -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
− Skype/Util.hs
@@ -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
skypelogexport.cabal view
@@ -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