packages feed

mohws-0.1: src/Module/Userdir.hs

-- Copyright 2002, Simon Marlow.
-- Copyright 2006, Bjorn Bringert.
module Module.Userdir (desc) where

import Config
import ServerState

import Control.Exception
import System.Posix


desc :: ModuleDesc
desc = emptyModuleDesc {
                        moduleName = "userdir",
                        moduleLoad = return funs
                       }

funs :: Module
funs = emptyModule {
                    moduleTranslatePath = userdirTranslatePath
                   }

userdirTranslatePath :: ServerState -> String -> IO (Maybe FilePath)
userdirTranslatePath st ('/':'~':userpath) | not (null (userDir conf)) =
  do let (usr, path) = break (=='/') userpath
     debug st $ "looking for user: " ++ show usr
     u_ent <- tryJust ioErrors (getUserEntryForName usr)
     case u_ent of
       Left _    -> return Nothing
       Right ent ->
           do let p = '/': homeDirectory ent ++ '/':userDir conf ++ path
              debug st $ "userdir path: " ++ p
              return $ Just p
  where conf = serverConfig st
userdirTranslatePath _ _ = return Nothing