[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:53:13 UTC 2010
The following commit has been merged in the master branch:
commit 993c2f0776faa34c444fd321a988ff72d2f7e92d
Author: John Goerzen <jgoerzen at complete.org>
Date: Wed Dec 22 03:53:36 2004 +0100
Expanded notion of state
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.7--patch-134)
diff --git a/ChangeLog b/ChangeLog
index e80a5f2..db67f92 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
#
+2004-12-21 20:53:36 GMT John Goerzen <jgoerzen at complete.org> patch-134
+
+ Summary:
+ Expanded notion of state
+ Revision:
+ missingh--head--0.7--patch-134
+
+
+ modified files:
+ ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+
+
2004-12-21 20:42:42 GMT John Goerzen <jgoerzen at complete.org> patch-133
Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index 41bac89..db0ad58 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -53,10 +53,13 @@ import MissingH.Printf
import Data.IORef
import Data.List
-data FTPState = NoAuth
+data AuthState = NoAuth
| User String
| Authenticated String
-data FTPServer = forall a. HVFS a => FTPServer Handle a (IORef FTPState)
+data FTPState = FTPState
+ { auth :: IORef AuthState }
+
+data FTPServer = forall a. HVFS a => FTPServer Handle a FTPState
s_crlf = "\r\n"
logname = "MissingH.Network.FTP.Server"
@@ -85,7 +88,7 @@ anonFtpHandler f h sa =
in
traplogging logname NOTICE "" $
do r <- newIORef (NoAuth)
- let s = serv r
+ let s = serv (FTPState {auth = r})
sendReply s 220 "Welcome to MissingH.Network.FTP.Server."
commandLoop s sa
@@ -106,8 +109,8 @@ trapIOError h testAction remainingAction =
Right result -> remainingAction result
forceLogin :: CommandHandler -> CommandHandler
-forceLogin func h@(FTPServer _ _ stateref) sa args =
- do state <- readIORef stateref
+forceLogin func h@(FTPServer _ _ state) sa args =
+ do state <- readIORef (auth state)
case state of
Authenticated _ -> func h sa args
x -> do sendReply h 530 "Command not possible in non-authenticated state."
@@ -115,11 +118,12 @@ forceLogin func h@(FTPServer _ _ stateref) sa args =
commands :: [Command]
commands =
- [("HELP", (cmd_help, help_help))
- ,("QUIT", (cmd_quit, help_quit))
- ,("USER", (cmd_user, help_user))
- ,("PASS", (cmd_pass, help_pass))
- ,("CWD", (forceLogin cmd_cwd, help_cwd))
+ [("HELP", (cmd_help, help_help))
+ ,("QUIT", (cmd_quit, help_quit))
+ ,("USER", (cmd_user, help_user))
+ ,("PASS", (cmd_pass, help_pass))
+ ,("CWD", (forceLogin cmd_cwd, help_cwd))
+ ,("CDUP", (forceLogin cmd_cdup, help_cdup))
]
commandLoop :: FTPServer -> SockAddr -> IO ()
@@ -162,27 +166,27 @@ help_user =
])
cmd_user :: CommandHandler
-cmd_user h@(FTPServer _ _ stateref) _ passedargs =
+cmd_user h@(FTPServer _ _ state) _ passedargs =
let args = strip passedargs
in
case args of
"anonymous" -> do sendReply h 331 "User name accepted; send password."
- writeIORef stateref (User args)
+ writeIORef (auth state) (User args)
return True
_ -> do sendReply h 530 "Unrecognized user name; please try \"anonymous\""
- writeIORef stateref NoAuth
+ writeIORef (auth state) NoAuth
return True
help_pass =
("Provide a password",
"PASS password will provide the password for authentication.")
cmd_pass :: CommandHandler
-cmd_pass h@(FTPServer _ _ stateref) _ passedargs =
- do curstate <- readIORef stateref
+cmd_pass h@(FTPServer _ _ state) _ passedargs =
+ do curstate <- readIORef (auth state)
case curstate of
User "anonymous" ->
do sendReply h 230 "Anonymous login successful."
- writeIORef stateref (Authenticated "anonymous")
+ writeIORef (auth state) (Authenticated "anonymous")
infoM logname "Anonymous authentication successful"
return True
_ -> do sendReply h 530 "Out of sequence PASS command"
@@ -203,6 +207,10 @@ cmd_cwd h@(FTPServer _ fs _) _ args =
sendReply h 250 $ "New directory now " ++ newdir
return True
+help_cdup =
+ ("Change to parent directory", "Same as CWD ..")
+cmd_cdup h sa _ = cmd_cwd h sa ".."
+
help_help =
("Display help on available commands",
"When called without arguments, shows a summary of available system\n"
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list