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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Regfish
( dump
, login
, list
, add
, edit
, del
, RRData(..)
) where
import Control.Lens
import Control.Monad.IO.Class
import Data.Default
import qualified Data.Acid as A
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.List as L
import qualified Network.HTTP.Client as C
import qualified Network.Wreq as W
import qualified Network.Wreq.Types as W (Postable)
import Regfish.AcidState
import Regfish.Default ()
import Regfish.Parser
import Regfish.Types
import Text.Printf
loginUrl :: Url
loginUrl = "https://www.regfish.de/my/login"
sessionCookieName :: BS8.ByteString
sessionCookieName = "rf51"
sessionToken :: C.CookieJar -> Maybe SessionToken
sessionToken =
fmap C.cookie_value .
L.find ((==sessionCookieName) . C.cookie_name) .
C.destroyCookieJar
responseSessionToken :: Getter (W.Response body) (Maybe SessionToken)
responseSessionToken =
W.responseCookieJar . to sessionToken
dump :: IO ()
dump =
withLocalState def $ \qa -> do
print =<< A.query qa DumpQuery
login :: IO ()
login =
withLocalState def $ \qa -> do
cj <- A.query qa CookieJarQuery
putStrLn $ "session token: " <> show (sessionToken cj)
putStrLn $ "Logging in..."
res <- liftIO $ W.post loginUrl
[ "u" W.:= _username def
, "p" W.:= _password def
]
putStrLn $ "session token: " <> show (res ^. responseSessionToken)
A.update qa $ CookieJarUpdate $ res ^. W.responseCookieJar
list :: IO ()
list =
regfishGet (_allinone def) >>= \case
Left err -> error err
Right r -> do
let body = r ^. W.responseBody
if isLoginPage $ LBS8.unpack body
then do
-- TODO login and try again (once)
error "not logged in"
else do
mapM_ pr =<< readZoneIO body
where
pr (RR rrid rrname rrttl x) = case x of
A rrdata -> f "A" rrid rrname rrttl 0 rrdata
AAAA rrdata -> f "AAAA" rrid rrname rrttl 0 rrdata
ALIAS rrdata -> f "ALIAS" rrid rrname rrttl 0 rrdata
CNAME rrdata -> f "CNAME" rrid rrname rrttl 0 rrdata
MX rraux rrdata -> f "MX" rrid rrname rrttl rraux rrdata
NS rrdata -> f "NS" rrid rrname rrttl 0 rrdata
TXT rrdata -> f "TXT" rrid rrname rrttl 0 rrdata
SRV rrdata -> f "SRV" rrid rrname rrttl 0 rrdata
f :: String -> String -> String -> Integer -> Integer -> String -> IO ()
f rrtype rrid rrname rrttl rraux rrdata =
printf "%-8s %-24s\t%s\tin\t%-5s\t%s\n"
rrid
rrname
(if rrttl /= 0 then show rrttl else mempty)
rrtype $
(if rraux /= 0 then show rraux <> " " else mempty)
<> rrdata
regfishGet :: Url -> IO (Either String (W.Response LBS8.ByteString))
regfishGet url =
withLocalState def $ \qa -> do
cj <- A.query qa CookieJarQuery
--putStrLn $ "session token: " <> show (sessionToken cj)
case sessionToken cj of
Nothing -> do
putStrLn "Not logged in."
-- TODO log in
return $ Left "not logged in"
Just _ -> do
--putStrLn $ "GET " <> url
let opts = W.defaults & W.cookies .~ Just cj
res <- liftIO $ W.getWith opts url
--now <- getCurrentTime
--putStrLn $ "session token: " <> show (res ^. W.responseCookieJar . to sessionToken)
let cj' = res ^. W.responseCookieJar
--cj'' = C.evictExpiredCookies cj' now
A.update qa $ CookieJarUpdate cj'
return $ Right res
regfishPost :: W.Postable p =>
Url -> p -> IO (Either String (W.Response LBS8.ByteString))
regfishPost url params = do
withLocalState def $ \qa -> do
cj <- A.query qa CookieJarQuery
--putStrLn $ "session token: " <> show (sessionToken cj)
case sessionToken cj of
Nothing -> do
putStrLn "Not logged in."
-- TODO log in
return $ Left "not logged in"
Just _ -> do
--putStrLn $ "POST " <> url <> " " <> show params
let opts = W.defaults & W.cookies .~ Just cj
res <- liftIO $ W.postWith opts url params
-- TODO check error
--putStrLn $ "session token: " <> show (res ^. W.responseCookieJar . to sessionToken)
A.update qa $ CookieJarUpdate $ res ^. W.responseCookieJar
return $ Right res
-- | We're on a login page, when a form action is `loginUrl`.
isLoginPage :: String -> Bool
isLoginPage =
(("action=" ++ show loginUrl) `L.isInfixOf`)
undata :: RRData -> (String -> Integer -> String -> a) -> a
undata (A rrdata) f = f "A" 0 rrdata
undata (AAAA rrdata) f = f "AAAA" 0 rrdata
undata (ALIAS rrdata) f = f "ALIAS" 0 rrdata
undata (CNAME rrdata) f = f "CNAME" 0 rrdata
undata (MX rraux rrdata) f = f "MX" rraux rrdata
undata (NS rrdata) f = f "NS" 0 rrdata
undata (TXT rrdata) f = f "TXT" 0 rrdata
undata (SRV rrdata) f = f "SRV" 0 rrdata
add :: RRname -> RRttl -> RRData -> IO (Either String (W.Response LBS8.ByteString))
add rrname rrttl rrdata =
regfishPost (_allinone def) $ undata rrdata $ getRRAddValidation rrname rrttl
edit :: RRid -> RRname -> RRttl -> RRData -> IO (Either String (W.Response LBS8.ByteString))
edit rrid rrname rrttl rrdata =
regfishPost (_allinone def) $ undata rrdata $ commitRRChanges rrid rrname rrttl
del :: RRid -> IO (Either String (W.Response LBS8.ByteString))
del rrid =
regfishPost (_allinone def) $ removeRREntry rrid
removeRREntry :: RRid -> [W.FormParam]
removeRREntry rrid =
[ "action" W.:= ("removeRREntry" :: String)
, "rrid" W.:= rrid
]
commitRRChanges ::
RRid -> RRname -> RRttl -> RRtype -> RRaux -> RRdata -> [W.FormParam]
commitRRChanges rrid rrname rrttl rrtype rraux rrdata =
[ "action" W.:= ("commitRRChanges" :: String)
, "rrid" W.:= rrid
, "type" W.:= rrtype
, "name" W.:= rrname
, "ttl" W.:= rrttl
, "data" W.:= rrdata
, "aux" W.:= rraux
]
getRRAddValidation ::
RRname -> RRttl -> RRtype -> RRaux -> RRdata -> [W.FormParam]
getRRAddValidation rrname rrttl rrtype rraux rrdata =
[ "action" W.:= ("getRRAddValidation" :: String)
, "type" W.:= rrtype
, "name" W.:= rrname
, "ttl" W.:= rrttl
, "data" W.:= rrdata
, "aux" W.:= rraux
]
|
