[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 6fba5dcf7ea361c5eea8b7627b8a8a54bcada749
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sun Oct 24 08:43:11 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index 37fae24..23d7d30 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-24 02:43:11 GMT	John Goerzen <jgoerzen at complete.org>	patch-113
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--1.0--patch-113
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Client.hs
+     libsrc/MissingH/Network/FTP/Parser.hs
+
+
 2004-10-24 01:37:22 GMT	John Goerzen <jgoerzen at complete.org>	patch-112
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Client.hs b/libsrc/MissingH/Network/FTP/Client.hs
index 87b94d3..ab0bbbf 100644
--- a/libsrc/MissingH/Network/FTP/Client.hs
+++ b/libsrc/MissingH/Network/FTP/Client.hs
@@ -53,6 +53,7 @@ module MissingH.Network.FTP.Client(easyConnectTo, connectTo,
                                    setPassive,
                                    nlst, dir, rename,
                                    delete, cwd, size, quit,
+                                   mkdir, rmdir, pwd, 
                                    FTPConnection(isPassive),
                                    transfercmd, ntransfercmd,
                        )
@@ -258,13 +259,26 @@ size h fn = do
             forceioresp 200 r
             return (read . head . snd $ r)
 
--- FIXME: write mkd, rmd, pwd
+-- | Make new directory.  Returns the absolute name of the
+-- new directory if possible.
+mkdir :: FTPConnection -> String -> IO (Maybe String, FTPResult)
+mkdir h fn = do x <- sendcmd h ("MKD " ++ fn)
+                return (parseDirName x, x)
 
+-- | Remove a directory.
+rmdir :: FTPConnection -> String -> IO FTPResult
+rmdir h fn = sendcmd h ("RMD " ++ fn)
+
+-- | Print the current working directory.  The first component of the result
+-- is the parsed directory name, if the servers response was parsable.
+pwd :: FTPConnection -> IO (Maybe String, FTPResult)
+pwd h = do x <- sendcmd h ("PWD")
+           return (parseDirName x, x)
+
+-- | Log off the server and quit.
 quit :: FTPConnection -> IO FTPResult
 quit h = do
          r <- sendcmd h "QUIT"
          hClose (writeh h)
          -- hClose (readh_internal h)
          return r
-
-
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index f134079..7b77667 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -42,7 +42,8 @@ module MissingH.Network.FTP.Parser(parseReply, parseGoodReply,
                                   -- * Utilities
                                   unexpectedresp, isxresp,
                                   forcexresp,
-                                  forceioresp)
+                                  forceioresp,
+                                  parseDirName)
 where
 
 import Text.ParserCombinators.Parsec
@@ -241,4 +242,15 @@ respToSockAddr f =
                   Nothing -> fail ("Could not find remote endpoint in " ++ (show f))
                   Just (_, x, _, _) -> fromPortString x
 
-    
\ No newline at end of file
+    
+parseDirName :: FTPResult -> Maybe String
+parseDirName (257, name:_) =
+    let procq [] = []
+        procq ['"'] = []
+        procq ('"' : '"' : xs) = '"' : procq xs
+        procq (x:xs) = x : procq xs
+        in       
+        if head name /= '"'
+           then Nothing
+           else Just (procq (tail name))
+

-- 
haskell-testpack