[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 ee49c03108e5f24dd641a7b531de717784e6772e
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Dec 23 02:30:28 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index e235209..f520c42 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-22 19:30:28 GMT	John Goerzen <jgoerzen at complete.org>	patch-145
+
+    Summary:
+      Checkpointing passive support
+    Revision:
+      missingh--head--0.7--patch-145
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+     libsrc/MissingH/Network/SocketServer.hs
+
+
 2004-12-22 17:01:31 GMT	John Goerzen <jgoerzen at complete.org>	patch-144
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index bc93057..b852a9c 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -44,12 +44,14 @@ module MissingH.Network.FTP.Server(
                                   )
 where
 import MissingH.Network.FTP.ParserServer
+import MissingH.Network.FTP.ParserClient
 import Network.BSD
 import Network.Socket
 import qualified Network
 import System.IO
 import MissingH.Logging.Logger
 import MissingH.Network
+import MissingH.Network.SocketServer
 import MissingH.Str
 import MissingH.Printf
 import MissingH.IO.HVIO
@@ -67,8 +69,9 @@ data AuthState = NoAuth
               | Authenticated String
                 deriving (Eq, Show)
 data DataChan = NoChannel
-              | PassiveMode Socket SockAddr
+              | PassiveMode SocketServer
               | PortMode SockAddr
+              | ActivePort Socket
 data FTPState = FTPState
               { auth :: IORef AuthState,
                 datatype :: IORef DataType,
@@ -157,6 +160,7 @@ commands =
     ,("PWD",  (forceLogin cmd_pwd,   help_pwd))
     ,("MODE", (forceLogin cmd_mode,  help_mode))
     ,("STRU", (forceLogin cmd_stru,  help_stru))
+    ,("PASV", (forceLogin cmd_pasv,  help_pasv))
     ]
 
 commandLoop :: FTPServer -> IO ()
@@ -262,6 +266,41 @@ cmd_type h@(FTPServer _ _ state) args =
          "AT" -> changetype ASCII
          _ -> do sendReply h 504 $ "Type \"" ++ args ++ "\" not supported."
                  return True
+
+closeconn :: FTPServer -> IO ()
+closeconn h@(FTPServer _ _ state) =
+    do dc <- readIORef (datachan state)
+       case dc of 
+           NoChannel -> return ()
+           PassiveMode ss -> closeSocketServer ss
+           PortMode _ -> return ()
+           ActivePort sock -> sClose sock
+       writeIORef (datachan state) NoChannel
+
+help_pasv = ("Initiate a passive-mode connection", "")
+cmd_pasv :: CommandHandler
+cmd_pasv h@(FTPServer _ _ state) args =
+    do closeconn h                      -- Close any existing connection
+       addr <- case (local state) of 
+                    (SockAddrInet _ ha) -> return ha
+                    _ -> fail "Require IPv4 sockets"
+       let ssopts = InetServerOptions 
+                    { listenQueueSize = 1,
+                      portNumber = aNY_PORT,
+                      interface = addr,
+                      reuse = False,
+                      family = AF_INET,
+                      sockType = Stream,
+                      protoStr = "tcp"
+                    }
+       ss <- setupSocketServer ssopts
+       sa <- getSocketName (sockSS ss)
+       portstring <- toPortString sa
+       sendReply h 227 $ "Entering passive mode (" ++ portstring ++ ")"
+       writeIORef (datachan state) (PassiveMode ss)
+       return True
+                 
+                                        
        
 help_noop = ("Do nothing", "")
 cmd_noop :: CommandHandler
diff --git a/libsrc/MissingH/Network/SocketServer.hs b/libsrc/MissingH/Network/SocketServer.hs
index 0776f1d..827f639 100644
--- a/libsrc/MissingH/Network/SocketServer.hs
+++ b/libsrc/MissingH/Network/SocketServer.hs
@@ -45,6 +45,7 @@ module MissingH.Network.SocketServer(-- * Generic Options and Types
                                      setupSocketServer,
                                      handleOne,
                                      serveForever,
+                                     closeSocketServer,
                                      -- * Combinators
                                      loggingHandler,
                                      threadedHandler,
@@ -60,7 +61,7 @@ import qualified MissingH.Logging.Logger
 
 {- | Options for your server. -}
 data InetServerOptions  = InetServerOptions {listenQueueSize :: Int,
-                                             portNumber :: Int,
+                                             portNumber :: PortNumber,
                                              interface :: HostAddress,
                                              reuse :: Bool,
                                              family :: Family,
@@ -83,7 +84,7 @@ type HandlerT = Socket -> SockAddr -> SockAddr -> IO ()
 simpleTCPOptions :: Int                -- ^ Port Number
                  -> InetServerOptions
 simpleTCPOptions p = InetServerOptions {listenQueueSize = 5,
-                                        portNumber = p,
+                                        portNumber = (fromIntegral p),
                                         interface = iNADDR_ANY,
                                         reuse = False,
                                         family = AF_INET,
@@ -104,10 +105,16 @@ setupSocketServer opts =
        setSocketOption s ReuseAddr (case (reuse opts) of
                                     True -> 1
                                     False -> 0)
-       bindSocket s (SockAddrInet (fromIntegral (portNumber opts)) 
+       bindSocket s (SockAddrInet (portNumber opts)
                      (interface opts))
        listen s (listenQueueSize opts)
        return $ SocketServer {optionsSS = opts, sockSS = s}
+
+{- | Close the socket server.  Does not terminate active
+handlers, if any. -}
+closeSocketServer :: SocketServer -> IO ()
+closeSocketServer ss =
+    sClose (sockSS ss)
        
 {- | Handle one incoming request from the given 'SocketServer'. -}
 handleOne :: SocketServer -> HandlerT -> IO ()

-- 
haskell-testpack