[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

John Goerzen jgoerzen at complete.org
Fri Apr 23 14:45:54 UTC 2010


The following commit has been merged in the master branch:
commit d15788709d784cec294c88f81d47716ec2dd32ef
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Oct 25 02:48:36 2004 +0100

    Updated FTP logs and standardized failures
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-121)

diff --git a/ChangeLog b/ChangeLog
index fc5638b..7fb3174 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,20 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-24 20:48:36 GMT	John Goerzen <jgoerzen at complete.org>	patch-121
+
+    Summary:
+      Updated FTP logs and standardized failures
+    Revision:
+      missingh--head--1.0--patch-121
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/List.hs
+     libsrc/MissingH/Network/FTP/Client.hs
+     libsrc/MissingH/Network/FTP/Parser.hs
+
+
 2004-10-24 06:47:43 GMT	John Goerzen <jgoerzen at complete.org>	patch-120
 
     Summary:
diff --git a/libsrc/MissingH/List.hs b/libsrc/MissingH/List.hs
index 6837f34..b5541f5 100644
--- a/libsrc/MissingH/List.hs
+++ b/libsrc/MissingH/List.hs
@@ -43,7 +43,7 @@ module MissingH.List(-- * Tests
                      split, join, replace, genericJoin, takeWhileList,
                      dropWhileList, spanList, breakList,
                      -- * Miscellaneous
-                     countElem, elemRIndex, alwaysElemRIndex
+                     countElem, elemRIndex, alwaysElemRIndex, seqList
                      -- -- * Sub-List Selection
                      -- sub,
                     ) where
@@ -222,3 +222,8 @@ alwaysElemRIndex item list =
     case elemRIndex item list of
                               Nothing -> -1
                               Just x -> x
+
+{- | Forces the evaluation of the entire list. -}
+seqList :: [a] -> [a]
+seqList [] = []
+seqList (x:xs) = seq (seqList xs) (x:xs)
diff --git a/libsrc/MissingH/Network/FTP/Client.hs b/libsrc/MissingH/Network/FTP/Client.hs
index 8f22326..aa1f035 100644
--- a/libsrc/MissingH/Network/FTP/Client.hs
+++ b/libsrc/MissingH/Network/FTP/Client.hs
@@ -43,8 +43,8 @@ run that with Hugs.)
 
 The above loads the module.
 
-Next, we enable the debugging.  This will turn on all the "FTP sent" and
-"FTP received" messages you'll see.
+Next, we enable the debugging.  This will turn on all the @FTP sent@ and
+ at FTP received@ messages you'll see.
 
 > Prelude MissingH.Network.FTP.Client> enableFTPDebugging
 
@@ -151,6 +151,15 @@ or make sure you consume the 'nlst' data first.
 Here is a partial list of commands effected: 'nlst', 'dir', 'getbinary',
 'getlines', 'downloadbinary'.
 
+The 'MissingH.List.seqList' function could be quite helpful here.  For instance:
+
+> x <- nlst h Nothing
+> map (\fn -> ...download files from FTP... ) (seqList x)
+
+If you omit the call to 'MissingH.List.seqList', commands to download files
+will be issued before the entire directory listing is read.  FTP cannot handle
+this.
+
 The corrolary is:
 
 /Actions that yield lazy data for data uploading must not issue FTP
@@ -158,6 +167,19 @@ commands themselves./
 
 This will be fairly rare.  Just be aware of this.
 
+This module logs messages under @MissingH.Network.FTP.Client@ for outgoing
+traffic and @MissingH.Network.FTP.Parser@ for incoming traffic, all with the
+'MissingH.Logging.DEBUG' priority, so by default, no log messages are seen.
+The 'enableFTPDebugging' function will adjust the priorities of these
+two handlers so debug messages are seen.  Only control channel conversations
+are logged.  Data channel conversations are never logged.
+
+All exceptions raised by this module have a string beginning with
+@\"FTP: \"@.  Most errors will be IO userErrors.  In a few extremely rare
+cases, errors may be raised by the Prelude error function, though these
+will also have a string beginning with @\"FTP: \"@.  Exceptions raised by
+the underlying networking code will be passed on to you unmodified.
+
 Useful standards:
 
 * RFC959, <http://www.cse.ohio-state.edu/cgi-bin/rfc/rfc0959.html>
@@ -295,11 +317,11 @@ login h user pass acct =
     ur <- sendcmd h ("USER " ++ user)
     if isxresp 300 ur then
        case pass of
-            Nothing -> error "FTP server demands password, but no password given"
+            Nothing -> fail "FTP: Server demands password, but no password given"
             Just p -> do pr <- sendcmd h ("PASS " ++ p)
                          if isxresp 300 pr then
                             case acct of
-                                Nothing -> error "FTP server demands account, but no account given"
+                                Nothing -> fail "FTP: server demands account, but no account given"
                                 Just a -> do ar <- sendcmd h ("ACCT " ++ a)
                                              forceioresp 200 ar
                                              return ar
@@ -322,7 +344,7 @@ makepasv h =
 makeport :: FTPConnection -> IO (Socket, FTPResult)
 makeport h =
     let listenaddr (SockAddrInet _ h) = SockAddrInet aNY_PORT h
-        listenaddr _ = error "Can't use port mode to non-TCP server"
+        listenaddr _ = error "FTP: Can't use port mode to non-TCP server"
         in
         do addr <- getSocketName (socket_internal h)
            mastersock <- listenTCPAddr (listenaddr addr) 1
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index 743f33b..62dcceb 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -68,7 +68,7 @@ logit m = debugM "MissingH.Network.FTP.Parser" ("FTP received: " ++ m)
 -- Utilities
 ----------------------------------------------------------------------
 
-unexpectedresp m r = "Expected " ++ m ++ ", got " ++ (show r)
+unexpectedresp m r = "FTP: Expected " ++ m ++ ", got " ++ (show r)
 
 isxresp desired (r, _) = r >= desired && r < (desired + 100)
 
@@ -170,7 +170,7 @@ multiReply = try (do
 parseReply :: String -> FTPResult
 parseReply input =
     case parse multiReply "(unknown)" input of
-         Left err -> error (show err)
+         Left err -> error ("FTP: " ++ (show err))
          Right reply -> reply
 
 -- | Parse a FTP reply.  Returns a (result code, text) pair.
@@ -182,7 +182,7 @@ parseGoodReply input =
     let reply = parseReply input
         in
         if (fst reply) >= 400
-        then fail ((show (fst reply)) ++ ": " ++ (join "\n" (snd reply)))
+        then fail ("FTP:" ++ (show (fst reply)) ++ ": " ++ (join "\n" (snd reply)))
         else return reply
 
 -- | Parse a FTP reply.  Logs debug messages.

-- 
haskell-testpack



More information about the Pkg-haskell-commits mailing list