diff options
Diffstat (limited to 'shareguard-authnz-external.hs')
-rw-r--r-- | shareguard-authnz-external.hs | 75 |
1 files changed, 75 insertions, 0 deletions
diff --git a/shareguard-authnz-external.hs b/shareguard-authnz-external.hs new file mode 100644 index 0000000..f20f363 --- /dev/null +++ b/shareguard-authnz-external.hs @@ -0,0 +1,75 @@ +{- +shareguard-authnz-external: mod_authnz_external-to-ShareGuard interface + + 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 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) |