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
|
{-
cgi: manipulate the ShareGuard database through the web
Copyright (C) 2011 Clint Adams <clint@gnu.org>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
-}
import Network.CGI
import Text.XHtml
import System.Environment
import System.IO.Error
import Data.ConfigFile
import Config as C
import qualified DB as D
import Control.Monad
import Maybe (catMaybes)
tableize :: [(String,String)] -> Html
tableize asswords = table << tablepuss asswords
fullPage :: Html -> Html
fullPage x = x +++ pwForm +++ dirForm +++ ownerForm
lamepara :: String -> Html
lamepara x = paragraph << x
maplamepara :: [String] -> [Html]
maplamepara xs = map lamepara xs
rawdog :: [Maybe String] -> [Html] -> Html
rawdog ss xs = htmlfold (concat [stringvert (catMaybes ss),xs])
where htmlfold xs = foldr (+++) noHtml xs
stringvert ss = (maplamepara ss)
pwForm = form ! [method "post", enctype "multipart/form-data"] << [paragraph << ("username " +++ textfield "username"),
paragraph << ("password " +++ textfield "password"),
submit "act" "Add user"]
dirForm = form ! [method "post", enctype "multipart/form-data"] << [paragraph << ("username " +++ textfield "username"),
paragraph << ("directory " +++ textfield "directory"),
submit "act" "Authorize user"]
ownerForm = form ! [method "post", enctype "multipart/form-data"] << [paragraph << ("directory " +++ textfield "directory"),
paragraph << ("owner " +++ textfield "ownership"),
submit "act" "Add directory"]
foad = paragraph << ("You're not logged in!")
page t b = header << thetitle << t +++ body << b
tablepuss :: [(String,String)] -> Html
tablepuss x = foldr (+++) noHtml (rows x)
where rows rs = flip map rs (\y -> tr << [(td << fst y),(td << snd y)])
addUserPw :: Maybe String -> Maybe String -> IO ()
addUserPw Nothing _ = return ()
addUserPw _ Nothing = return ()
addUserPw (Just u) (Just p) = do
cnf <- C.getConfig "/usr/local/etc/shareguard.conf"
D.withDB cnf $ \db -> D.insertUserPw db (u,p)
return ()
addUserDir :: Maybe String -> Maybe String -> IO ()
addUserDir Nothing _ = return ()
addUserDir _ Nothing = return ()
addUserDir (Just u) (Just p) = do
cnf <- C.getConfig "/usr/local/etc/shareguard.conf"
D.withDB cnf $ \db -> D.insertUserDir db (u,p)
return ()
addOwnership :: Maybe String -> Maybe String -> IO ()
addOwnership Nothing _ = return ()
addOwnership _ Nothing = return ()
addOwnership (Just u) (Just p) = do
cnf <- C.getConfig "/usr/local/etc/shareguard.conf"
D.withDB cnf $ \db -> D.insertOwnership db (u,p)
return ()
actOut :: Maybe String -> Maybe String -> CGI CGIResult
actOut Nothing _ = output . renderHtml $ page "You don't belong here" foad
actOut user act
| act == Nothing = do
cnf <- liftIO $ C.getConfig "/usr/local/etc/shareguard.conf"
passwords <- liftIO $ D.withDB cnf $ \db -> D.getUserPw db
dirs <- liftIO $ D.withDB cnf $ \db -> D.getUserDirs db
owners <- liftIO $ D.withDB cnf $ \db -> D.getOwnership db
u <- getInput "username"
p <- getInput "password"
d <- getInput "directory"
o <- getInput "owner"
output . renderHtml $ page "LolCats" (fullPage $ rawdog [user,u,p,d,o] (map tableize [passwords,dirs,owners]))
| act == Just("Add user") = do
cnf <- liftIO $ C.getConfig "/usr/local/etc/shareguard.conf"
u <- getInput "username"
p <- getInput "password"
liftIO $ addUserPw u p
actOut user Nothing
| act == Just("Authorize user") = do
cnf <- liftIO $ C.getConfig "/usr/local/etc/shareguard.conf"
u <- getInput "username"
d <- getInput "directory"
liftIO $ addUserDir u d
actOut user Nothing
| act == Just("Add directory") = do
cnf <- liftIO $ C.getConfig "/usr/local/etc/shareguard.conf"
d <- getInput "directory"
o <- getInput "owner"
liftIO $ addOwnership d o
actOut user Nothing
cgiMain = do user <- remoteUser
act <- getInput "act"
setHeader "Content-type" "text/html;charset=UTF-8"
actOut user act
main = runCGI $ handleErrors cgiMain
|
