[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 e8750b1d643b289e3f3ed2eb2a69825ff4947d27
Author: John Goerzen <jgoerzen at complete.org>
Date:   Wed Dec 22 04:13:57 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index db67f92..d888996 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 21:13:57 GMT	John Goerzen <jgoerzen at complete.org>	patch-135
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-135
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+
+
 2004-12-21 20:53:36 GMT	John Goerzen <jgoerzen at complete.org>	patch-134
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index db0ad58..cff5a22 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -53,11 +53,15 @@ import MissingH.Printf
 import Data.IORef
 import Data.List
 
+data DataType = ASCII | Binary
+              deriving (Eq, Show)
 data AuthState = NoAuth 
               | User String
               | Authenticated String
+                deriving (Eq, Show)
 data FTPState = FTPState
-              { auth :: IORef AuthState }
+              { auth :: IORef AuthState,
+                datatype :: IORef DataType}
 
 data FTPServer = forall a. HVFS a => FTPServer Handle a FTPState
 
@@ -87,8 +91,9 @@ anonFtpHandler f h sa =
     let serv r = FTPServer h f r
         in
         traplogging logname NOTICE "" $
-          do r <- newIORef (NoAuth)
-             let s = serv (FTPState {auth = r})
+          do authr <- newIORef (NoAuth)
+             typer <- newIORef ASCII
+             let s = serv (FTPState {auth = authr, datatype = typer})
              sendReply s 220 "Welcome to MissingH.Network.FTP.Server."
              commandLoop s sa
 
@@ -124,6 +129,8 @@ commands =
     ,("PASS", (cmd_pass,             help_pass))
     ,("CWD",  (forceLogin cmd_cwd,   help_cwd))
     ,("CDUP", (forceLogin cmd_cdup,  help_cdup))
+    ,("TYPE", (forceLogin cmd_type,  help_type))
+    ,("NOOP", (forceLogin cmd_noop,  help_noop))
     ]
 
 commandLoop :: FTPServer -> SockAddr -> IO ()
@@ -211,6 +218,29 @@ help_cdup =
     ("Change to parent directory", "Same as CWD ..")
 cmd_cdup h sa _ = cmd_cwd h sa ".."
 
+help_type =
+    ("Change the type of data transfer", "Valid args are A, AN, and I")
+cmd_type :: CommandHandler
+cmd_type h@(FTPServer _ _ state) _ args =
+    let changetype newt =
+            do oldtype <- readIORef (datatype state)
+               writeIORef (datatype state) newt
+               sendReply h 200 $ "Type changed from " ++ show oldtype ++
+                             " to " ++ show newt
+               return True
+        in case args of
+         "I" -> changetype Binary
+         "A" -> changetype ASCII
+         "AN" -> changetype ASCII
+         _ -> do sendReply h 504 $ "Type \"" ++ args ++ "\" not supported."
+                 return True
+       
+help_noop = ("Do nothing", "")
+cmd_noop :: CommandHandler
+cmd_noop h _ _ =
+    do sendReply h 200 "OK"
+       return True
+
 help_help =
     ("Display help on available commands",
      "When called without arguments, shows a summary of available system\n"

-- 
haskell-testpack