[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 51d25e700045d1084b9a775a36c09c0cec6f5b3a
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Dec 23 08:52:48 2004 +0100

    Added stat, syst
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-151)

diff --git a/ChangeLog b/ChangeLog
index f13cf32..02160be 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-23 01:52:48 GMT	John Goerzen <jgoerzen at complete.org>	patch-151
+
+    Summary:
+      Added stat, syst
+    Revision:
+      missingh--head--0.7--patch-151
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Server.hs
+
+
 2004-12-22 22:43:42 GMT	John Goerzen <jgoerzen at complete.org>	patch-150
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index 21d6db4..b039022 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -165,6 +165,8 @@ commands =
     ,("PORT", (forceLogin cmd_port,  help_port))
     ,("RETR", (forceLogin cmd_retr,  help_retr))
     ,("STOR", (forceLogin cmd_stor,  help_stor))
+    ,("STAT", (forceLogin cmd_stat,  help_stat))
+    ,("SYST", (forceLogin cmd_syst,  help_syst))
     ]
 
 commandLoop :: FTPServer -> IO ()
@@ -499,6 +501,34 @@ cmd_stru h args =
         x -> do sendReply h 504 $ "Structure \"" ++ x ++ "\" not supported."
                 return True
 
+help_syst = ("Display system type", "")
+cmd_syst :: CommandHandler
+cmd_syst h _ =
+    -- I have no idea what this L8 means, but everyone else seems to do
+    -- this, so I do too..
+    do sendReply h 215 "UNIX Type: L8"
+       return True
+
+help_stat = ("Display sever statistics", "")
+cmd_stat :: CommandHandler
+cmd_stat h@(FTPServer _ _ state) _ =
+    do loc <- showSockAddr (local state)
+       rem <- showSockAddr (remote state)
+       auth <- readIORef (auth state)
+       datm <- readIORef (datatype state)
+       sendReply h 211 $ unlines $
+         [" *** Sever statistics and information"
+         ," *** Please type HELP for more details"
+         ,""
+         ,"Server Software     : MissingH, http://quux.org/devel/missingh"
+         ,"Connected From      : " ++ rem
+         ,"Connected To        : " ++ loc
+         ,"Data Transfer Type  : " ++ (show datm)
+         ,"Auth Status         : " ++ (show auth)
+         ,"End of status."]
+       return True
+          
+
 help_help =
     ("Display help on available commands",
      "When called without arguments, shows a summary of available system\n"

-- 
haskell-testpack