[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:39 UTC 2010
The following commit has been merged in the master branch:
commit 6242c0ce40bc1c38dbdccc12e32d9a8aaaa2d007
Author: John Goerzen <jgoerzen at complete.org>
Date: Sun Oct 24 03:03:06 2004 +0100
Checkpointing
Keywords:
(jgoerzen at complete.org--projects/missingh--head--1.0--patch-109)
diff --git a/ChangeLog b/ChangeLog
index 5936b28..c0f7b7e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,21 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
#
+2004-10-23 21:03:06 GMT John Goerzen <jgoerzen at complete.org> patch-109
+
+ Summary:
+ Checkpointing
+ Revision:
+ missingh--head--1.0--patch-109
+
+
+ modified files:
+ ChangeLog Makefile libsrc/MissingH/List.hs
+ libsrc/MissingH/Network/FTP/Client.hs
+ libsrc/MissingH/Network/FTP/Parser.hs libsrc/MissingH/Str.hs
+ testsrc/Listtest.hs testsrc/Network/FTP/Parsertest.hs
+
+
2004-10-23 19:54:14 GMT John Goerzen <jgoerzen at complete.org> patch-108
Summary:
diff --git a/Makefile b/Makefile
index 7d74cc5..0064861 100644
--- a/Makefile
+++ b/Makefile
@@ -51,7 +51,7 @@ test-ghc6: testsrc/runtests
testsrc/runtests
test-hugs:
- runhugs -P:$(PWD)/libsrc:$(PWD)/testsrc testsrc/runtests.hs
+ runhugs -98 -P:$(PWD)/libsrc:$(PWD)/testsrc testsrc/runtests.hs
interact-hugs:
hugs -98 -P:$(PWD)/libsrc
diff --git a/libsrc/MissingH/List.hs b/libsrc/MissingH/List.hs
index d54f79e..6837f34 100644
--- a/libsrc/MissingH/List.hs
+++ b/libsrc/MissingH/List.hs
@@ -40,7 +40,7 @@ module MissingH.List(-- * Tests
for association lists. -}
addToAL, delFromAL, flipAL,
-- * Conversions
- split, join, genericJoin, takeWhileList,
+ split, join, replace, genericJoin, takeWhileList,
dropWhileList, spanList, breakList,
-- * Miscellaneous
countElem, elemRIndex, alwaysElemRIndex
@@ -128,6 +128,15 @@ split delim str =
(drop (length delim) x)
+{- | Given a list and a replacement list, replaces each occurance of the search
+list with the replacement list in the operation list.
+
+Example: replace "," "." "127,0,0,1" -> "127.0.0.1"
+-}
+
+replace :: Eq a => [a] -> [a] -> [a] -> [a]
+replace old new l = join new . split old $ l
+
{- | Given a delimiter and a list of items (or strings), join the items
by using the delimiter.
diff --git a/libsrc/MissingH/Network/FTP/Client.hs b/libsrc/MissingH/Network/FTP/Client.hs
index aa65571..04ab1ee 100644
--- a/libsrc/MissingH/Network/FTP/Client.hs
+++ b/libsrc/MissingH/Network/FTP/Client.hs
@@ -51,6 +51,7 @@ Useful standards:
module MissingH.Network.FTP.Client(easyConnectTo, connectTo,
loginAnon, login,
setPassive,
+ nlst,
FTPConnection(isPassive),
)
where
@@ -156,6 +157,7 @@ makepasv :: FTPConnection -> IO SockAddr
makepasv h =
do
r <- sendcmd h "PASV"
+ putStrLn "makepasv returning "
return (respToSockAddr r)
{- | Establishes a connection to the remote.
@@ -167,13 +169,19 @@ ntransfercmd h cmd =
let sock = if isPassive h
then do
addr <- makepasv h
- connectTCPAddr addr
+ putStrLn "connecting"
+ s <- connectTCPAddr addr
+ putStrLn "connected"
+ return s
else fail "FIXME: No support for non-passive yet"
in do
s <- sock
newh <- socketToHandle s ReadWriteMode
+ putStrLn "Have socket"
r <- sendcmd h cmd
+ putStrLn "Sending command"
forceioresp 100 r
+ putStrLn "ntransfercmd returning"
return (newh, Nothing)
{- | Returns the socket part from calling 'ntransfercmd'. -}
@@ -188,3 +196,16 @@ retrlines h cmd = do
newh <- transfercmd h cmd
c <- hGetContents newh
return $ split "\r\n" c
+
+{- | Retrieves a list of files in the given directory.
+
+FIXME: should this take a list of dirs? -}
+nlst :: FTPConnection
+ -> Maybe String -- ^ The directory to list. If Nothing, list the current directory.
+ -> IO [String]
+nlst h dir =
+ let cmd = case dir of
+ Nothing -> "NLST"
+ Just x -> "NLST " ++ x
+ in do
+ retrlines h cmd
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index 2f31bb3..681bb42 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -175,13 +175,13 @@ parseReply input =
-- If the result code indicates an error, raise an exception instead
-- of just passing it back.
-parseGoodReply :: String -> FTPResult
+parseGoodReply :: String -> IO FTPResult
parseGoodReply input =
let reply = parseReply input
in
if (fst reply) >= 400
- then error ((show (fst reply)) ++ ": " ++ (join "\n" (snd reply)))
- else reply
+ then fail ((show (fst reply)) ++ ": " ++ (join "\n" (snd reply)))
+ else return reply
-- | Parse a FTP reply. Logs debug messages.
debugParseGoodReply :: String -> IO FTPResult
@@ -202,7 +202,7 @@ debugParseGoodReply contents =
in
do
loggedStr <- logPlugin contents []
- return (parseGoodReply loggedStr)
+ parseGoodReply loggedStr
{- | Converts a socket address to a string suitable for a PORT command.
@@ -225,7 +225,7 @@ fromPortString instr =
hostbytes = map read (take 4 inbytes)
portbytes = map read (drop 4 inbytes)
in
- SockAddrInet (fromInteger (fromBytes portbytes)) (fromBytes hostbytes)
+ SockAddrInet (fromInteger $ fromBytes portbytes) (fromBytes hostbytes)
respToSockAddrRe = mkRegex("([0-9]+,){5}[0-9]+")
-- | Converts a response code to a socket address
@@ -233,8 +233,10 @@ respToSockAddr :: FTPResult -> SockAddr
respToSockAddr f =
let r = forcexresp 200 f
in
- case matchRegexAll respToSockAddrRe (head (snd r)) of
- Nothing -> error ("Could not find remote endpoint in " ++ (show r))
- Just (_, x, _, _) -> fromPortString x
+ if (fst r) /= 227 then
+ error ("Not a 227 response: " ++ show r)
+ else case matchRegexAll respToSockAddrRe (head (snd r)) of
+ Nothing -> error ("Could not find remote endpoint in " ++ (show r))
+ Just (_, x, _, _) -> fromPortString x
\ No newline at end of file
diff --git a/libsrc/MissingH/Str.hs b/libsrc/MissingH/Str.hs
index 6f879ad..969074b 100644
--- a/libsrc/MissingH/Str.hs
+++ b/libsrc/MissingH/Str.hs
@@ -40,9 +40,9 @@ module MissingH.Str(-- * Whitespace Removal
-- * Conversions
-- | Note: Some of these functions are aliases for functions
-- in "MissingH.List".
- join, split
+ join, split, replace
) where
-import MissingH.List(startswith, endswith, join, split)
+import MissingH.List(startswith, endswith, join, split, replace)
import Text.Regex
wschars = " \t\r\n"
diff --git a/testsrc/Listtest.hs b/testsrc/Listtest.hs
index 1159944..2fe5cad 100644
--- a/testsrc/Listtest.hs
+++ b/testsrc/Listtest.hs
@@ -58,6 +58,16 @@ test_join =
f "|" ["foo"] "foo"
-- f 5 [[1, 2], [3, 4]] [1, 2, 5, 3, 4]
+test_replace =
+ let f old new inp exp = exp @=? replace old new inp in
+ do
+ f "" "" "" ""
+ f "foo" "bar" "" ""
+ f "foo" "bar" "foo" "bar"
+ f "foo" "bar" "footestfoothisisabarfoo" "bartestbarthisisabarbar"
+ f "," ", " "1,2,3,4" "1, 2, 3, 4"
+ f "," "." "1,2,3,4" "1.2.3.4"
+
test_genericJoin =
let f delim inp exp = exp @=? genericJoin delim inp in
do
@@ -133,6 +143,7 @@ tests = TestList [TestLabel "delFromAL" (TestCase test_delFromAL),
TestLabel "flipAL" (TestCase test_flipAL),
TestLabel "elemRIndex" (TestCase test_elemRIndex),
TestLabel "alwaysElemRIndex" (TestCase test_alwaysElemRIndex),
+ TestLabel "replace" (TestCase test_replace),
TestLabel "contains" (TestCase test_contains)]
diff --git a/testsrc/Network/FTP/Parsertest.hs b/testsrc/Network/FTP/Parsertest.hs
index 0081fa5..3ef7ad0 100644
--- a/testsrc/Network/FTP/Parsertest.hs
+++ b/testsrc/Network/FTP/Parsertest.hs
@@ -31,6 +31,7 @@ test_parseReply =
f "230-Test\r\nLine2\r\n 230 Line3\r\n230 Done\r\n"
(230, ["Test", "Line2", " 230 Line3", "Done"])
+{-
test_toPortString =
let f inp exp = exp @=? toPortString inp in
do
@@ -43,9 +44,9 @@ test_fromPortString =
in
do
f "170,187,204,221,18,52" (0x1234, 0xaabbccdd)
-
-tests = TestList [TestLabel "parseReply" (TestCase test_parseReply),
- TestLabel "toPortString" (TestCase test_toPortString),
- TestLabel "fromPortString" (TestCase test_fromPortString)
+-}
+tests = TestList [TestLabel "parseReply" (TestCase test_parseReply)
+ --TestLabel "toPortString" (TestCase test_toPortString),
+ --TestLabel "fromPortString" (TestCase test_fromPortString)
]
\ No newline at end of file
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list