diff --git a/FTPLine.cabal b/FTPLine.cabal --- a/FTPLine.cabal +++ b/FTPLine.cabal @@ -1,5 +1,5 @@ Name: FTPLine -Version: 1.1.0 +Version: 1.2.0 Cabal-Version: >= 1.6 License: BSD3 License-file: license @@ -12,18 +12,15 @@ . Changes from last version: . - * State becomes a record (was a tuple). - . - * File content changes from @String@ to @ByteString@. + * Echoing of @stdin@ is turned off while running @pause@ command. . - * Added modes (local and remote). + * New field (@interactive@) in the state record. . - * Changed lazy state to strict state, - and it has been instantiated at haskeline's @MonadException@ class. + * New login method, with hidden password. Now haskeline dependency is @>= 0.6.3 && < 0.7@. . - * The way FTP results are shown has varied. + * Added history. . - * Memory usage has been reduced considerably. + * Added a few notes in the @help@ command. Build-Type: Simple Executable FTPLine @@ -32,7 +29,7 @@ , ftphs , directory , network - , haskeline >=0.6.2.4 && < 0.7 + , haskeline >= 0.6.3 && < 0.7 , ansi-terminal , strict , bytestring diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,6 +1,15 @@ {-# LANGUAGE FlexibleInstances #-} +-- +-- Below is the code of the FTPLine application. +-- Sorry for lack of code notes. +-- If you have any question about the code, I have your answer (I hope). +-- +-- Daniel Diaz < danieldiaz@asofilak.es > +-- 2010 +-- + import Data.Maybe import qualified Data.Strict.Maybe as Strict import Control.Monad.State.Strict @@ -15,7 +24,7 @@ import Data.List (intercalate) import Prelude hiding (catch) import System.Console.ANSI -import System.IO (hFlush,stdout) +import System.IO import System.Environment (getArgs) import qualified Data.ByteString.Char8 as B @@ -53,10 +62,16 @@ data FTPState = FTPState { conn :: Maybe FTPConnection , file :: !(SMaybe File) , host :: Maybe String - , mode :: Bool } + , mode :: Bool + , interactive :: Bool } initialFTPState :: FTPState -initialFTPState = FTPState Nothing Strict.Nothing Nothing False +initialFTPState = FTPState { conn = Nothing + , file = Strict.Nothing + , host = Nothing + , mode = False + , interactive = False + } type FTPLine a = InputT (StateT FTPState IO) a @@ -70,19 +85,19 @@ getConnection = getting conn newConnection :: String -> FTPConnection -> FTPLine () -newConnection hn c = modif $ \(FTPState _ mf _ b) -> FTPState (Just c) mf (Just hn) b +newConnection hn c = modif $ \(FTPState _ mf _ b i) -> FTPState (Just c) mf (Just hn) b i removeConnection :: FTPLine () -removeConnection = modif $ \(FTPState _ mf _ b) -> FTPState Nothing mf Nothing b +removeConnection = modif $ \(FTPState _ mf _ b i) -> FTPState Nothing mf Nothing b i getFile :: FTPLine (SMaybe File) getFile = getting file newFile :: File -> FTPLine () -newFile f = modif $! \(FTPState mc _ md b) -> FTPState mc (Strict.Just f) md b +newFile f = modif $! \(FTPState mc _ md b i) -> FTPState mc (Strict.Just f) md b i cleanFile :: FTPLine () -cleanFile = modif $! \(FTPState mc _ md b) -> FTPState mc Strict.Nothing md b +cleanFile = modif $! \(FTPState mc _ md b i) -> FTPState mc Strict.Nothing md b i getHost :: FTPLine String getHost = return "Local" <-> const (getting $ maybe "Local" id . host) @@ -93,6 +108,12 @@ turnMode :: FTPLine () turnMode = modif $ \s -> s { mode = not $ mode s } +isInteractive :: FTPLine Bool +isInteractive = getting interactive + +setInteractive :: Bool -> FTPLine () +setInteractive b = modif $ \s -> s { interactive = b } + -- connect :: HostName -> PortNumber -> FTPLine FTPResult @@ -261,12 +282,40 @@ printHelp str = withColor Cyan $ mapM_ (\ln -> if head ln == '*' then outputStrLn ln else italized $ outputStrLn ln ) $ commandDesc str +-- Echo set + +inEchoOff, inEchoOn :: FTPLine () +inEchoOff = liftIO $ hSetEcho stdin False +inEchoOn = liftIO $ hSetEcho stdin True + +-- + runCom :: String -> [String] -> FTPLine () runCom str ["help"] = printHelp str -runCom "help" _ = mapM_ printHelp commands +runCom "help" _ = do withColor Cyan $ outputStrLn helpHead + mapM_ printHelp commands runCom "connect" args = handres $ mkCom args $ uncurry connect -runCom "login" args = if null args then handres $ ftplogin Nothing - else handres $ mkCom args $ ftplogin . Just +runCom "login" args = + do isInt <- isInteractive + if isInt then do let isAnon = do withColor Yellow $ outputStr "Login as anonymous? (y/n) " + c <- getInputChar "" + case c of + Just 'y' -> return True + Just 'n' -> return False + _ -> do liftIO $ do cursorUpLine 1 + clearFromCursorToScreenEnd + isAnon + b <- isAnon + if b then handres $ withColor Green $ ftplogin Nothing + else do withColor Yellow $ outputStr "User name: " + name <- Haskeline.getInputLine "" + withColor Yellow $ outputStr "Password : " + pass <- getPassword (Just '*') "" + if isNothing name || isNothing pass then outputStrLn "Incorrect login." + else handres $ withColor Green $ + ftplogin $ Just (fromJust name,fromJust pass) + else if null args then handres $ ftplogin Nothing + else handres $ mkCom args $ ftplogin . Just runCom "disconnect" _ = handres disconnect runCom "ftpdebug" _ = ftpdebug runCom "dir" args = if null args then hand_ $ pdir Nothing @@ -284,8 +333,10 @@ runCom "clear" _ = do hand_ cleanFile outputStrLn "Memory Cleared." runCom "pause" _ = do outputStr "PAUSE. Press ENTER to continue..." - withColor White $ liftIO getLine - return () + inEchoOff + liftIO $ getLine + inEchoOn + outputStrLn "" runCom "switch" _ = turnMode runCom x _ = withColor Cyan $ outputStrLn $ "Command doesn't exist: " ++ x @@ -302,11 +353,18 @@ , "exit" ] +helpHead :: String +helpHead = unlines [ "" + , "Below is a list of available commands." + , "Arguments in brackets are optional." + , "Arguments in braces only are used in batch mode." + ] + commandDesc :: String -> [String] commandDesc "connect" = [ "connect HostName Port" , "* Connect to remote FTP server." ] -commandDesc "login" = [ "login [UserName Password]" - , "* Log in to the FTP server." ] +commandDesc "login" = [ "login {[UserName Password]}" + , "* Login to the FTP server." ] commandDesc "disconnect" = [ "disconnect" , "* Close the current conection." ] commandDesc "ftpdebug" = [ "ftpdebug" @@ -343,7 +401,7 @@ commandDesc "switch" = [ "switch" , "* Switch between local and remote mode." , "* CTRL+D invokes this action." ] -commandDesc _ = ["Invalid command."] +commandDesc _ = ["* Invalid command."] mkCom :: Arg a => [String] -> (a -> FTPLine b) -> FTPLine b mkCom [] f = ftperror "Need more arguments." @@ -410,13 +468,17 @@ main = do setSGR [ SetColor Foreground Vivid White ] -- args <- getArgs - putStrLn "*** Welcome to FTPLine 1.1.0 ***" + appDir <- getAppUserDataDirectory "FTPLine" + createDirectoryIfMissing True appDir + -- + putStrLn "*** Welcome to FTPLine 1.2.0 ***" if null args then do withColor Cyan $ do putStr "Type " italized $ putStr "help" putStrLn " for a list of commands." - -- - runStateT (runInputT defaultSettings runCicle) initialFTPState - setSGR [ Reset ] + -- + let sets = defaultSettings { historyFile = Just $ appDir ++ "/History" } + runStateT (runInputT sets mainInteractive) initialFTPState + return () else do let arg = head args exst <- doesFileExist arg if exst then do txt <- readFile arg @@ -430,7 +492,11 @@ initialFTPState putStrLn "Closing FTPLine." else withColor Red $ putStrLn $ "File " ++ arg ++ " doesn't exist." - setSGR [ Reset ] + setSGR [ Reset ] + +mainInteractive :: FTPLine () +mainInteractive = do setInteractive True + runCicle runCicle :: FTPLine () runCicle = hand (\e -> do withColor Red $ output e