[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit a25500a1541f3638cf3e7a41313d6cab5045e001
Author: John Goerzen <jgoerzen at complete.org>
Date:   Wed Dec 22 02:38:00 2004 +0100

    Checkpointing
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-131)

diff --git a/ChangeLog b/ChangeLog
index e2df792..e2cd2e4 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 19:38:00 GMT	John Goerzen <jgoerzen at complete.org>	patch-131
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-131
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+
+
 2004-12-21 19:17:58 GMT	John Goerzen <jgoerzen at complete.org>	patch-130
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index 6db8d0c..409b8e9 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -34,7 +34,7 @@ Written by John Goerzen, jgoerzen\@complete.org
 -}
 
 module MissingH.Network.FTP.Server(
-                                   ftpHandler
+                                   anonFtpHandler
                                   )
 where
 import MissingH.Network.FTP.ParserServer
@@ -50,12 +50,17 @@ import MissingH.IO.HVIO
 import MissingH.IO.HVFS
 import Data.Char
 import MissingH.Printf
+import Data.IORef
+import Data.List
 
-data FTPServer = forall a. HVFS a => FTPServer Handle a
+data FTPState = NoAuth 
+              | User String
+              | Authenticated String
+data FTPServer = forall a. HVFS a => FTPServer Handle a (IORef FTPState)
 
 s_crlf = "\r\n"
 ftpPutStrLn :: FTPServer -> String -> IO ()
-ftpPutStrLn (FTPServer h _) text =
+ftpPutStrLn (FTPServer h _ _) text =
     do hPutStr h (text ++ s_crlf)
        hFlush h
 
@@ -73,24 +78,32 @@ sendReply h codei text =
 {- | Main FTP handler; pass the result of applying this to one argument to 
 'MissingH.Network.SocketServer.handleHandler' -}
 
-ftpHandler :: forall a. HVFS a => a -> Handle -> SockAddr -> IO ()
-ftpHandler f h sa =
-    let serv = FTPServer h f
+anonFtpHandler :: forall a. HVFS a => a -> Handle -> SockAddr -> IO ()
+anonFtpHandler f h sa =
+    let serv r = FTPServer h f r
         in
         traplogging "MissingH.Network.FTP.Server" NOTICE "" $
-          do sendReply serv 220 "Welcome to MissingH.Network.FTP.Server."
-             commandLoop serv sa
+          do r <- newIORef (NoAuth)
+             let s = serv r
+             sendReply s 220 "Welcome to MissingH.Network.FTP.Server."
+             commandLoop s sa
 
 type CommandHandler = FTPServer -> SockAddr -> String -> IO Bool
+type Command = (String, (CommandHandler, (String, String)))
 
-commands :: [(String, (CommandHandler, (String, String)))]
+instance Eq Command where
+    x == y = (fst x) == (fst y)
+instance Ord Command where
+    compare x y = compare (fst x) (fst y)
+
+commands :: [Command]
 commands =
     [("HELP", (cmd_help, help_help))
     ,("QUIT", (cmd_quit, help_quit))
     ]
 
 commandLoop :: FTPServer -> SockAddr -> IO ()
-commandLoop h@(FTPServer fh _) sa =
+commandLoop h@(FTPServer fh _ _) sa =
     let errorhandler e = do noticeM "MissingH.Network.FTP.Server"
                                     ("Closing due to error: " ++ (show e))
                             hClose fh
@@ -99,7 +112,7 @@ commandLoop h@(FTPServer fh _) sa =
                (do x <- parseCommand fh
                    case x of
                      Left err -> do sendReply h 500 $
-                                      "Couldn't parse command: " ++ (show err)
+                                      " Couldn't parse command: " ++ (show err)
                                     return True
                      Right (cmd, args) -> 
                          case lookup cmd commands of
@@ -113,7 +126,7 @@ commandLoop h@(FTPServer fh _) sa =
                  else return ()
 
 help_quit =
-    ("Terminate the program",
+    ("Terminate the session",
      "")
 
 cmd_quit :: CommandHandler
@@ -130,7 +143,9 @@ help_help =
 cmd_help :: CommandHandler
 cmd_help h sa args =
     let genericreply addr = unlines $
-          ["Welcome to the FTP server, " ++ addr ++ "."
+          [" --- General Help Response ---"
+          ,""
+          ,"Welcome to the FTP server, " ++ addr ++ "."
           ,"This server is implemented as the MissingH.Network.FTP.Server"
           ,"component of the MissingH library.  The MissingH library"
           ,"is available from http://quux.org/devel/missingh."
@@ -138,7 +153,7 @@ cmd_help h sa args =
           ,""
           ,"I know of the following commands:"
           ,concatMap (\ (name, (_, (summary, _))) -> vsprintf "%-10s %s\n" name summary)
-              commands
+              (sort commands)
           ,""
           ,"You may type \"HELP command\" for more help on a specific command."
           ]

-- 
haskell-testpack