diff options
Diffstat (limited to 'cgi.hs')
| -rw-r--r-- | cgi.hs | 134 |
1 files changed, 134 insertions, 0 deletions
@@ -0,0 +1,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 |