1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
{-# LANGUAGE OverloadedStrings #-}
module ConfigFiles where
import Data.ByteString.Lazy.Char8 as L
import System.Posix.User
import System.Posix.Files (fileExist)
import System.FilePath
import System.Directory
import System.IO
-- import System.IO.Strict
import System.IO.Error
import Control.Exception
import Control.Monad
import Control.DeepSeq
import ByteStringOperators () -- For NFData instance
import Data.List (partition)
import Data.Maybe (catMaybes,isJust)
import DPut
import DebugTag
type User = ByteString
type Profile = String
configDir, buddyFile, subscriberFile,
otherFile, pendingFile, solicitedFile,
secretsFile :: FilePath
-- A "buddy" is somebody who approved our friend request and will keep
-- us informed of their presence.
--
-- A "subscriber" is somebody who we approved and promised to keep informed
-- of our own presence.
configDir = ".presence"
buddyFile = "buddies" -- subscription="to"
subscriberFile = "subscribers" -- subscription="from"
pendingFile = "pending" -- pending subscriber (we've yet to approve)
solicitedFile = "solicited" -- pending buddy (we sent a friend request)
otherFile = "others"
secretsFile = "secret"
configPath :: User -> Profile -> String -> IO String
configPath user "." filename = do
ue <- getUserEntryForName (unpack user)
return $ (++("/"++configDir++"/"++filename)) $ homeDirectory ue
`catchIOError` \e -> do
dput XJabber $ "configPath " ++ show user ++ "\".\": " ++ show e
return $ (++("/"++configDir++"/"++filename)) $ "/tmp"
configPath user profile filename = do
ue <- getUserEntryForName (unpack user)
return $ (++("/"++configDir++"/"++profile++"/"++filename)) $ homeDirectory ue
`catchIOError` \e -> do
dput XJabber $ "configPath " ++ show user ++ " " ++ show profile ++ ": " ++ show e
return $ (++("/"++configDir++"/"++filename)) $ "/tmp"
createConfigFile :: ByteString -> FilePath -> IO ()
createConfigFile tag path = do
let dir = dropFileName path
doesDirectoryExist dir >>= flip unless (do
createDirectory dir
)
withFile path WriteMode $ \h -> do
L.hPutStrLn h tag
addItem :: ByteString -> ByteString -> FilePath -> IO ()
addItem item tag path =
let doit = do
handle (\e -> when (isDoesNotExistError e)
(createConfigFile tag path >> doit))
$ do exists <- fileExist path
if exists
then withFile path AppendMode $ \h ->
L.hPutStrLn h item
else withFile path WriteMode $ \h -> do
L.hPutStrLn h tag
L.hPutStrLn h item
in doit
-- | Modify a presence configuration file. This function will iterate over all
-- items in the file and invoke a test function. If the function returns
-- Nothing, that item is removed from the file. Otherwise, the function may
-- rename the item by returning the new name.
--
-- If the last argument is populated, it is a new item to append to the end of
-- the file.
--
-- Note that the entire file is read in, processed, and then rewritten from
-- scratch.
modifyFile ::
(ByteString,FilePath)
-> User
-> Profile
-> (ByteString -> IO (Maybe ByteString)) -- ^ Returns Just for each item you want to keep.
-> Maybe ByteString -- ^ Optionally append this item.
-> IO Bool -- Returns True if test function ever returned Nothing
modifyFile (tag,file) user profile test appending = configPath user profile file >>= doit
where
doit path = do
handle (\e -> if (isDoesNotExistError e)
then (createConfigFile tag path >> doit path)
else return False)
$ do exists <- fileExist path
if exists
then do
xs <- withFile path ReadMode $ \h -> do
contents <- L.hGetContents h
case L.lines contents of
x:xs -> mapM test xs
_ -> return []
let (keepers,deleted) = partition isJust xs
withFile path WriteMode $ \h -> do
L.hPutStrLn h tag
forM_ (catMaybes keepers) (L.hPutStrLn h)
forM_ appending (L.hPutStrLn h)
return . not . Prelude.null $ deleted
else do
withFile path WriteMode $ \h -> do
L.hPutStrLn h tag
forM_ appending (L.hPutStrLn h)
return False
modifySolicited, modifyBuddies, modifyOthers, modifyPending, modifySubscribers
:: User -> Profile -> (ByteString -> IO (Maybe ByteString)) -> Maybe ByteString -> IO Bool
modifySolicited = modifyFile ("<? solicited ?>" , solicitedFile)
modifyBuddies = modifyFile ("<? buddies ?>" , buddyFile)
modifyOthers = modifyFile ("<? others ?>" , otherFile)
modifyPending = modifyFile ("<? pending ?>" , pendingFile)
modifySubscribers = modifyFile ("<? subscribers ?>" , subscriberFile)
addBuddy :: User -> Profile -> ByteString -> IO ()
addBuddy user profile buddy =
configPath user profile buddyFile >>= addItem buddy "<? buddies ?>"
addSubscriber :: User -> Profile -> ByteString -> IO ()
addSubscriber user profile subscriber =
configPath user profile subscriberFile >>= addItem subscriber "<? subscribers ?>"
addSolicited :: User -> Profile -> ByteString -> IO ()
addSolicited user profile solicited =
configPath user profile solicitedFile >>= addItem solicited "<? solicited ?>"
getConfigList :: FilePath -> IO [ByteString]
getConfigList path =
handle (\e -> if isDoesNotExistError e then (return []) else throw e)
$ withFile path ReadMode $
L.hGetContents
>=> return . Prelude.tail . L.lines
>=> (\a -> seq (rnf a) (return a))
getBuddies :: User -> Profile -> IO [ByteString]
getBuddies user profile = configPath user profile buddyFile >>= getConfigList
getSubscribers :: User -> Profile -> IO [ByteString]
getSubscribers user profile = configPath user profile subscriberFile >>= getConfigList
getOthers :: User -> Profile -> IO [ByteString]
getOthers user profile = configPath user profile otherFile >>= getConfigList
getPending :: User -> Profile -> IO [ByteString]
getPending user profile = configPath user profile pendingFile >>= getConfigList
getSolicited :: User -> Profile -> IO [ByteString]
getSolicited user profile = configPath user profile solicitedFile >>= getConfigList
getSecrets :: User -> Profile -> IO [ByteString]
getSecrets user profile = configPath user profile secretsFile >>= getConfigList
|
