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