[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 524a4f35d52bccfc2d1506505a00cf42d8fa581b
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Dec 24 07:02:16 2004 +0100

    FTP server works
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-164)

diff --git a/ChangeLog b/ChangeLog
index 68fbba6..bd732b6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-24 00:02:16 GMT	John Goerzen <jgoerzen at complete.org>	patch-164
+
+    Summary:
+      FTP server works
+    Revision:
+      missingh--head--0.7--patch-164
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS/Utils.hs
+     libsrc/MissingH/Network/FTP/Server.hs
+
+
 2004-12-23 23:49:50 GMT	John Goerzen <jgoerzen at complete.org>	patch-163
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS/Utils.hs b/libsrc/MissingH/IO/HVFS/Utils.hs
index db8e31b..6a2083c 100644
--- a/libsrc/MissingH/IO/HVFS/Utils.hs
+++ b/libsrc/MissingH/IO/HVFS/Utils.hs
@@ -145,6 +145,6 @@ lsl fs fp =
                                       return (ss, x) 
                             ) c
               linedata <- mapM (showentry fp fs) pairs
-              return $ unlines linedata
+              return $ unlines $ ["total 1"] ++ linedata
                   
             
\ No newline at end of file
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index 011238f..df43844 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -57,6 +57,7 @@ import MissingH.Printf
 import MissingH.IO.HVIO
 import MissingH.IO.HVFS
 import MissingH.IO.HVFS.InstanceHelpers
+import MissingH.IO.HVFS.Utils
 import Data.Char
 import MissingH.Printf
 import Data.IORef
@@ -168,6 +169,7 @@ commands =
     ,("STAT", (forceLogin cmd_stat,  help_stat))
     ,("SYST", (forceLogin cmd_syst,  help_syst))
     ,("NLST", (forceLogin cmd_nlst,  help_nlst))
+    ,("LIST", (forceLogin cmd_list,  help_list))
     ]
 
 commandLoop :: FTPServer -> IO ()
@@ -401,7 +403,7 @@ rtransmitString thestr (FTPServer _ _ state) sock =
     let fixlines :: [String] -> [String]
         fixlines x = map (\y -> y ++ "\r") x
         copyit h =
-            hPutStrLn h $ unlines . fixlines . lines $ thestr
+            hPutStr h $ unlines . fixlines . lines $ thestr
         in
         do writeh <- socketToHandle sock WriteMode
            hSetBuffering writeh (BlockBuffering (Just 4096))
@@ -486,6 +488,16 @@ cmd_nlst h@(FTPServer _ fs _) args =
         trapIOError h (vGetDirectoryContents fs fn)
            (\l -> genericTransmitString h (unlines l))
 
+help_list = ("Get an annotated listing of files", "")
+cmd_list :: CommandHandler
+cmd_list h@(FTPServer _ fs _) args =
+    let fn = case args of
+                       "" -> "."
+                       x -> x
+        in
+        trapIOError h (lsl fs fn)
+                    (\l -> genericTransmitString h l)
+
 help_rmd = ("Remove directory", "")
 cmd_rmd :: CommandHandler
 cmd_rmd h@(FTPServer _ fs _) args =

-- 
haskell-testpack