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

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

diff --git a/ChangeLog b/ChangeLog
index 8911f56..dd4a501 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-22 19:49:29 GMT	John Goerzen <jgoerzen at complete.org>	patch-147
+
+    Summary:
+      Checkpointing port support
+    Revision:
+      missingh--head--0.7--patch-147
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+
+
 2004-12-22 19:36:07 GMT	John Goerzen <jgoerzen at complete.org>	patch-146
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index b852a9c..fb6ff73 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -161,6 +161,7 @@ commands =
     ,("MODE", (forceLogin cmd_mode,  help_mode))
     ,("STRU", (forceLogin cmd_stru,  help_stru))
     ,("PASV", (forceLogin cmd_pasv,  help_pasv))
+    ,("PORT", (forceLogin cmd_port,  help_port))
     ]
 
 commandLoop :: FTPServer -> IO ()
@@ -277,6 +278,30 @@ closeconn h@(FTPServer _ _ state) =
            ActivePort sock -> sClose sock
        writeIORef (datachan state) NoChannel
 
+help_port = ("Initiate a port-mode connection", "")
+cmd_port :: CommandHandler
+cmd_port h@(FTPServer _ _ state) args =
+    let doIt clientsa = 
+            do writeIORef (datachan state) (PortMode clientsa)
+               str <- showSockAddr clientsa
+               sendReply h 200 $ "OK, later I will connect to " ++ str
+               return True
+        in
+        do closeconn h                      -- Close any existing connection
+           trapIOError h (fromPortString args) $  (\clientsa -> 
+            do closeconn h
+               case clientsa of
+                   SockAddrInet _ ha -> 
+                      case (local state) of
+                          SockAddrInet _ ha2 -> if ha /= ha2
+                                                  then do sendReply h 501 "Will only connect to same client as command channel."
+                                                          return True
+                                                  else doIt clientsa
+                          _ -> do sendReply h 501 "Require IPv4 on client"
+                                  return True
+                   _ -> do sendReply h 501 "Require IPv4 in specified address"
+                           return True
+                                                  )
 help_pasv = ("Initiate a passive-mode connection", "")
 cmd_pasv :: CommandHandler
 cmd_pasv h@(FTPServer _ _ state) args =

-- 
haskell-testpack