[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 e2aa3568cca5439770015fcde248b9fc580c67df
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sun Oct 24 01:18:39 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index adb0302..f834458 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-23 19:18:39 GMT	John Goerzen <jgoerzen at complete.org>	patch-107
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--1.0--patch-107
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Client.hs
+     libsrc/MissingH/Network/FTP/Parser.hs
+
+
 2004-10-23 16:57:55 GMT	John Goerzen <jgoerzen at complete.org>	patch-106
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Client.hs b/libsrc/MissingH/Network/FTP/Client.hs
index ee147a9..5f52f87 100644
--- a/libsrc/MissingH/Network/FTP/Client.hs
+++ b/libsrc/MissingH/Network/FTP/Client.hs
@@ -49,55 +49,89 @@ Useful standards:
 -}
 
 module MissingH.Network.FTP.Client(easyConnectTo, connectTo,
-                                   loginAnon, login
+                                   loginAnon, login, 
+                                   setPassive,
+                                   FTPConnection(isPassive),
                        )
 where
 import MissingH.Network.FTP.Parser
+import Network.BSD
 import Network.Socket
 import qualified Network
 import System.IO
+import System.IO.Unsafe
 import MissingH.Logging.Logger
 
-type FTPConnection = Handle
+data FTPConnection = FTPConnection {readh :: IO String,
+                                    writeh :: Handle,
+                                    isPassive :: Bool}
+                   deriving Eq
 
 {-
 getresp h = do c <- hGetContents h
                return (parseGoodReply c)
 -}
 
-getresp = debugParseGoodReplyHandle
-unexpectedresp m r = error ("Expected " ++ m ++ ", got " ++ (show r))
+getresp h = do
+            c <- (readh h)
+            debugParseGoodReply c
+
+unexpectedresp m r = "Expected " ++ m ++ ", got " ++ (show r)
 
 isxresp desired (r, _) = r >= desired && r < (desired + 100)
 
 forcexresp desired r = if isxresp desired r
                        then r
-                       else error (show desired)
+                       else error ((unexpectedresp (show desired)) r)
+
+forceioresp :: Int -> FTPResult -> IO ()
+forceioresp desired r = if isxresp desired r
+                        then return ()
+                        else fail (unexpectedresp (show desired) r)
 
-sendcmd h c = do hPutStr h (c ++ "\r\n")
+logsend m = debugM "MissingH.Network.FTP.Client" ("FTP sent: " ++ m)
+sendcmd h c = do logsend c
+                 hPutStr (writeh h) (c ++ "\r\n")
                  getresp h
 
 {- | Connect to the remote FTP server and read but discard
    the welcome.  Assumes
    default FTP port, 21, on remote. -}
 easyConnectTo :: Network.HostName -> IO FTPConnection
-easyConnectTo h = do x <- connectTo h (Network.PortNumber 21)
-                     let h = (fst x)
-                     -- hPutStr h "foo"
-                     return h
+easyConnectTo h = do x <- connectTo h 21
+                     return (fst x)
 
 {- | Connect to remote FTP server and read the welcome. -}
-connectTo :: Network.HostName -> Network.PortID -> IO (FTPConnection, FTPResult)
+connectTo :: Network.HostName -> PortNumber -> IO (FTPConnection, FTPResult)
 connectTo h p =
+    let readchars :: Handle -> IO String
+        readchars h = do
+                      c <- hGetChar h
+                      next <- unsafeInterleaveIO $ readchars h
+                      return (c : next)
+        in
     do
     updateGlobalLogger "MissingH.Network.FTP.Parser" (setLevel DEBUG)
-    h <- Network.connectTo h p
+    updateGlobalLogger "MissingH.Network.FTP.Client" (setLevel DEBUG)
+    proto <- getProtocolNumber "tcp"
+    he <- getHostByName h
+    s <- socket AF_INET Stream proto
+    connect s (SockAddrInet p (hostAddress he))
+    r <- socketToHandle s ReadMode
+    hSetBuffering r LineBuffering
+    w <- socketToHandle s WriteMode
+    hSetBuffering w LineBuffering
+    let h = FTPConnection {readh = readchars r, writeh = w, isPassive = True}
     --hIsReadable h >>= print
     --hIsWritable h >>= print
     -- hSetBuffering h LineBuffering
-    r <- getresp h
+    resp <- getresp h
+    forceioresp 200 resp
+    --foo <- return (forcexresp 200 resp)
+    --print foo
     -- hPutStr h "foo"
-    r `seq` return (h, r)
+    -- resp `seq` return (h, resp)
+    return (h, resp)
     --return (h, r)
 
 {- | Log in anonymously. -}
@@ -121,10 +155,21 @@ login h user pass acct =
                             case acct of
                                 Nothing -> error "FTP server demands account, but no account given"
                                 Just a -> do ar <- sendcmd h ("ACCT " ++ a)
-                                             return (forcexresp 200 ar)
+                                             forceioresp 200 ar
                                              return ar
-                            else return $ forcexresp 200 pr
-       else return $ forcexresp 200 ur
+                            else return $! forcexresp 200 pr
+       else return $! forcexresp 200 ur
+
+{- | Sets whether passive mode is used (returns new
+connection object reflecting this) -}
 
-            
-      
\ No newline at end of file
+setPassive :: FTPConnection -> Bool -> FTPConnection            
+setPassive f b = f{isPassive = True}
+
+{- | Establishes a passive connection to the remote. -}
+
+makepasv :: FTPConnection -> 
+makspasv h =
+    do
+    r <- sendcmd("PASV")
+    
\ No newline at end of file
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index 82cf1cf..e056ba1 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -37,7 +37,7 @@ Written by John Goerzen, jgoerzen\@complete.org
 module MissingH.Network.FTP.Parser(parseReply, parseGoodReply,
                                    toPortString, fromPortString,
                                    debugParseGoodReply,
-                                   debugParseGoodReplyHandle,
+                                   respToSockAddr,
                                    FTPResult)
 where
 
@@ -185,12 +185,6 @@ debugParseGoodReply contents =
         loggedStr <- logPlugin contents []
         return (parseGoodReply loggedStr)
 
--- | Parse a FTP reply.  Log debug messages.
-debugParseGoodReplyHandle :: Handle -> IO FTPResult
-debugParseGoodReplyHandle h = do
-                              c <- hGetContents h
-                              debugParseGoodReply c
-
 {- | Converts a socket address to a string suitable for a PORT command.
 
 Example:
@@ -212,4 +206,7 @@ fromPortString instr =
         hostbytes = map read (take 4 inbytes)
         portbytes = map read (drop 4 inbytes)
         in
-        SockAddrInet (PortNum (fromBytes portbytes)) (fromBytes hostbytes)
+        SockAddrInet (fromBytes portbytes) (fromBytes hostbytes)
+
+-- | Converts a response code to a socket address
+respToSockAddr :: FTPResult -> SockAddr

-- 
haskell-testpack