[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 9fc614133656b264223e6b9adc4e301aa3e7b7cb
Author: John Goerzen <jgoerzen at complete.org>
Date:   Wed Dec 22 05:02:45 2004 +0100

    Added rename features
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-136)

diff --git a/ChangeLog b/ChangeLog
index d888996..efd1e32 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 22:02:45 GMT	John Goerzen <jgoerzen at complete.org>	patch-136
+
+    Summary:
+      Added rename features
+    Revision:
+      missingh--head--0.7--patch-136
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+
+
 2004-12-21 21:13:57 GMT	John Goerzen <jgoerzen at complete.org>	patch-135
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index cff5a22..eb67bad 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -61,7 +61,8 @@ data AuthState = NoAuth
                 deriving (Eq, Show)
 data FTPState = FTPState
               { auth :: IORef AuthState,
-                datatype :: IORef DataType}
+                datatype :: IORef DataType,
+                rename :: IORef (Maybe String)}
 
 data FTPServer = forall a. HVFS a => FTPServer Handle a FTPState
 
@@ -93,7 +94,9 @@ anonFtpHandler f h sa =
         traplogging logname NOTICE "" $
           do authr <- newIORef (NoAuth)
              typer <- newIORef ASCII
-             let s = serv (FTPState {auth = authr, datatype = typer})
+             renamer <- newIORef (Nothing::Maybe String)
+             let s = serv (FTPState {auth = authr, datatype = typer,
+                                    rename = renamer})
              sendReply s 220 "Welcome to MissingH.Network.FTP.Server."
              commandLoop s sa
 
@@ -131,6 +134,8 @@ commands =
     ,("CDUP", (forceLogin cmd_cdup,  help_cdup))
     ,("TYPE", (forceLogin cmd_type,  help_type))
     ,("NOOP", (forceLogin cmd_noop,  help_noop))
+    ,("RNFR", (forceLogin cmd_rnfr,  help_rnfr))
+    ,("RNTO", (forceLogin cmd_rnto,  help_rnto))
     ]
 
 commandLoop :: FTPServer -> SockAddr -> IO ()
@@ -241,6 +246,34 @@ cmd_noop h _ _ =
     do sendReply h 200 "OK"
        return True
 
+help_rnfr = ("Specify FROM name for a file rename", "")
+cmd_rnfr :: CommandHandler
+cmd_rnfr h@(FTPServer _ _ state) _ args = 
+    if length args < 1
+       then do sendReply h 501 "Filename required"
+               return True
+       else do writeIORef (rename state) (Just args)
+               sendReply h 350 "Noted rename from name; please send RNTO."
+               return True
+
+help_rnto = ("Specify TO name for a file name", "")
+cmd_rnto :: CommandHandler
+cmd_rnto h@(FTPServer _ fs state) _ args =
+    if length args < 1
+       then do sendReply h 501 "Filename required"
+               return True
+       else do fr <- readIORef (rename state)
+               case fr of
+                   Nothing -> do sendReply h 503 "RNFR required before RNTO"
+                                 return True
+                   Just fromname -> 
+                       do writeIORef (rename state) Nothing
+                          trapIOError h (vRenameFile fs fromname args)
+                              $ \_ -> do sendReply h 250 
+                                           ("File " ++ fromname ++ 
+                                            " renamed to " ++ args)
+                                         return True
+
 help_help =
     ("Display help on available commands",
      "When called without arguments, shows a summary of available system\n"

-- 
haskell-testpack