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

    Added a bunch of commands
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-137)

diff --git a/ChangeLog b/ChangeLog
index efd1e32..f25ec4f 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:22:12 GMT	John Goerzen <jgoerzen at complete.org>	patch-137
+
+    Summary:
+      Added a bunch of commands
+    Revision:
+      missingh--head--0.7--patch-137
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+
+
 2004-12-21 22:02:45 GMT	John Goerzen <jgoerzen at complete.org>	patch-136
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index eb67bad..dbcf862 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -48,6 +48,7 @@ import MissingH.Str
 import MissingH.Printf
 import MissingH.IO.HVIO
 import MissingH.IO.HVFS
+import MissingH.IO.HVFS.InstanceHelpers
 import Data.Char
 import MissingH.Printf
 import Data.IORef
@@ -136,6 +137,10 @@ commands =
     ,("NOOP", (forceLogin cmd_noop,  help_noop))
     ,("RNFR", (forceLogin cmd_rnfr,  help_rnfr))
     ,("RNTO", (forceLogin cmd_rnto,  help_rnto))
+    ,("DELE", (forceLogin cmd_dele,  help_dele))
+    ,("RMD",  (forceLogin cmd_rmd,   help_rmd))
+    ,("MKD",  (forceLogin cmd_mkd,   help_mkd))
+    ,("PWD",  (forceLogin cmd_pwd,   help_pwd))
     ]
 
 commandLoop :: FTPServer -> SockAddr -> IO ()
@@ -167,7 +172,7 @@ help_quit =
 
 cmd_quit :: CommandHandler
 cmd_quit h sa args =
-    do sendReply h 211 "OK, Goodbye."
+    do sendReply h 221 "OK, Goodbye."
        return False
 
 help_user =
@@ -274,6 +279,44 @@ cmd_rnto h@(FTPServer _ fs state) _ args =
                                             " renamed to " ++ args)
                                          return True
 
+help_dele = ("Delete files", "")
+cmd_dele :: CommandHandler
+cmd_dele h@(FTPServer _ fs _) _ args =
+    if length args < 1
+       then do sendReply h 501 "Filename required"
+               return True
+       else trapIOError h (vRemoveFile fs args) $
+              \_ -> do sendReply h 250 $ "File " ++ args ++ " deleted."
+                       return True
+
+help_rmd = ("Remove directory", "")
+cmd_rmd :: CommandHandler
+cmd_rmd h@(FTPServer _ fs _) _ args =
+    if length args < 1
+       then do sendReply h 501 "Filename required"
+               return True
+       else trapIOError h (vRemoveDirectory fs args) $
+            \_ -> do sendReply h 250 $ "Directory " ++ args ++ " removed."
+                     return True
+
+help_mkd = ("Make directory", "")
+cmd_mkd :: CommandHandler
+cmd_mkd h@(FTPServer _ fs _) _ args =
+    if length args < 1
+       then do sendReply h 501 "Filename required"
+               return True
+       else trapIOError h (vCreateDirectory fs args) $
+            \_ -> do newname <- getFullPath fs args
+                     sendReply h 257 $ "\"" ++ newname ++ "\" created."
+                     return True
+
+help_pwd = ("Print working directory", "")
+cmd_pwd :: CommandHandler
+cmd_pwd h@(FTPServer _ fs _) _ _ =
+    do d <- vGetCurrentDirectory fs
+       sendReply h 257 $ "\"" ++ d ++ "\" is the current working directory."
+       return True
+
 help_help =
     ("Display help on available commands",
      "When called without arguments, shows a summary of available system\n"

-- 
haskell-testpack