{- shareguard-authnz-external: mod_authnz_external-to-ShareGuard interface Copyright (C) 2011 Clint Adams 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 . -} import System.Exit ( exitWith, ExitCode (..) ) import System.Environment import System.IO.Error import Control.Monad.Trans import Control.Monad.Error import System.Path.NameManip (normalise_path, guess_dotdot, slice_path) import Config as C import DB as D data AuthQuery = AuthQuery { uname :: String   , pass :: String   , uri :: String } main = do uri <- catch (getEnv "URI") envvarHandler cnf <- C.getConfig "/usr/local/etc/shareguard.conf" user <- getLine   pw <- getLine passwords <- D.withDB cnf $ \db -> getUserPw db let dbpass = snd $ head $ filter ((==user).fst) passwords alldirs <- D.withDB cnf $ \db -> getUserDirs db let dirs = map snd (filter ((==user).fst) alldirs) if isValidRequest (AuthQuery user pw uri) dbpass dirs then exitWith (ExitSuccess) else exitWith (ExitFailure 1) envvarHandler :: IOError -> IO (String)   envvarHandler e     | isDoesNotExistError e = return ""     | otherwise = ioError e isValidRequest :: AuthQuery -> String -> [String] -> Bool isValidRequest (AuthQuery {uname = u, pass = p, uri = req}) dbpass dirs = and [isCorrectPassword p dbpass, isAuthorizedURI (rootDir $ sanitizeURI req) dirs] isCorrectPassword :: String -> String -> Bool isCorrectPassword p1 p2 = and [p1 == p2, p2 /= ""] isAuthorizedURI :: Maybe String -> [String] -> Bool isAuthorizedURI Nothing _ = False isAuthorizedURI (Just req) dirs = elem req dirs rootDir :: Maybe String -> Maybe String rootDir Nothing = Nothing rootDir (Just x) = Just (head (slice_path x)) sanitizeURI :: String -> Maybe String sanitizeURI uri = guess_dotdot (normalise_path uri)