module System.Authenticate.SmbClient (
loginSmbClient,
SmbClientResult
) where
import Control.Applicative
import Data.Char
import Data.Maybe
import Data.Text hiding (head)
import Prelude hiding (unlines, null, takeWhile)
import System.Exit
import System.Process
import System.Timeout
commandName = "smbclient"
type SmbClientResult = Either () Text
loginSmbClient :: Text
-> Text
-> Text
-> Text
-> IO SmbClientResult
loginSmbClient server domain username password = do
timedResult <- timeout (10 * 1000000) process
case timedResult of
Just result -> return result
Nothing -> return $ Left ()
where
domain' = checkedText domain
username' = checkedText username
password' = checkedText password
authInfo dom usr pas = [
"username = " `append` usr,
"password = " `append` pas,
"domain = " `append` dom]
authInfo' =
unpack <$> unlines
<$> (authInfo <$> domain' <*> username' <*> password')
process =
case authInfo' of
Just a -> validate commandName server a
$ Right (fromJust username')
_ -> return $ Left ()
validate command server authInfo successInfo = do
(exitCode, _, _) <-
readProcessWithExitCode command [
"-L", unpack server,
"-A", "/dev/stdin"]
authInfo
case exitCode of
ExitSuccess -> return successInfo
_ -> return $ Left ()
checkedText = noneEmptyText . trimWhite . takeUntilNewline
where
noneEmptyText text =
if null text
then Nothing
else Just text
takeUntilNewline =
takeWhile (not . isControl)
trimWhite =
dropAround isSpace