[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:52:39 UTC 2010
The following commit has been merged in the master branch:
commit c741126b71480889f3d9425295b7d85fc01cc46f
Author: John Goerzen <jgoerzen at complete.org>
Date: Tue Dec 21 23:24:37 2004 +0100
Compilation fixes
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.7--patch-125)
diff --git a/ChangeLog b/ChangeLog
index 58725ee..1bdd62e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
#
+2004-12-21 16:24:37 GMT John Goerzen <jgoerzen at complete.org> patch-125
+
+ Summary:
+ Compilation fixes
+ Revision:
+ missingh--head--0.7--patch-125
+
+
+ modified files:
+ ChangeLog libsrc/MissingH/Network/FTP/ParserServer.hs
+ libsrc/MissingH/Network/FTP/Server.hs
+
+
2004-12-21 16:17:59 GMT John Goerzen <jgoerzen at complete.org> patch-124
Summary:
diff --git a/libsrc/MissingH/Network/FTP/ParserServer.hs b/libsrc/MissingH/Network/FTP/ParserServer.hs
index 28c5135..f3f4d67 100644
--- a/libsrc/MissingH/Network/FTP/ParserServer.hs
+++ b/libsrc/MissingH/Network/FTP/ParserServer.hs
@@ -35,16 +35,7 @@ Written by John Goerzen, jgoerzen\@complete.org
-}
module MissingH.Network.FTP.ParserServer(
- parseReply, parseGoodReply,
- toPortString, fromPortString,
- debugParseGoodReply,
- respToSockAddr,
- FTPResult,
- -- * Utilities
- unexpectedresp, isxresp,
- forcexresp,
- forceioresp,
- parseDirName)
+ )
where
import MissingH.Network.FTP.ParserClient
import Text.ParserCombinators.Parsec
@@ -60,202 +51,10 @@ import Text.Regex
import Data.Word
type FTPResult = (Int, [String])
--- import Control.Exception(Exception(PatternMatchFail), throw)
-
logit :: String -> IO ()
-logit m = debugM "MissingH.Network.FTP.Parser" ("FTP received: " ++ m)
+logit m = debugM "MissingH.Network.FTP.ParserServer" ("FTP received: " ++ m)
----------------------------------------------------------------------
-- Utilities
----------------------------------------------------------------------
-unexpectedresp m r = "FTP: Expected " ++ m ++ ", got " ++ (show r)
-
-isxresp desired (r, _) = r >= desired && r < (desired + 100)
-
-forcexresp desired r = if isxresp desired r
- then r
- else error ((unexpectedresp (show desired)) r)
-
-forceioresp :: Int -> FTPResult -> IO ()
-forceioresp desired r = if isxresp desired r
- then return ()
- else fail (unexpectedresp (show desired) r)
-
-
-crlf :: Parser String
-crlf = string "\r\n" <?> "CRLF"
-
-sp :: Parser Char
-sp = char ' '
-
-code :: Parser Int
-code = do
- s <- codeString
- return (read s)
-
-codeString :: Parser String
-codeString = do
- first <- oneOf "123456789" <?> "3-digit reply code"
- remaining <- count 2 digit <?> "3-digit reply code"
- return (first : remaining)
-
-specificCode :: Int -> Parser Int
-specificCode exp = do
- s <- string (show exp) <?> ("Code " ++ (show exp))
- return (read s)
-
-line :: Parser String
-line = do
- x <- many (noneOf "\r\n")
- crlf
- -- return $ unsafePerformIO $ putStrLn ("line: " ++ x)
- return x
-
-----------------------------------------------------------------------
--- The parsers
-----------------------------------------------------------------------
-
-singleReplyLine :: Parser (Int, String)
-singleReplyLine = do
- x <- code
- sp
- text <- line
- return (x, text)
-
-expectedReplyLine :: Int -> Parser (Int, String)
-expectedReplyLine expectedcode = do
- x <- specificCode expectedcode
- sp
- text <- line
- return (x, text)
-
-startOfMultiReply :: Parser (Int, String)
-startOfMultiReply = do
- x <- code
- char '-'
- text <- line
- return (x, text)
-
-multiReplyComponent :: Parser [String]
-multiReplyComponent = (try (do
- notMatching (do
- codeString
- sp
- ) "found unexpected code"
- thisLine <- line
- -- return $ unsafePerformIO (putStrLn ("MRC: got " ++ thisLine))
- remainder <- multiReplyComponent
- return (thisLine : remainder)
- )
- ) <|> return []
-
-multiReply :: Parser FTPResult
-multiReply = try (do
- x <- singleReplyLine
- return (fst x, [snd x])
- )
- <|> (do
- start <- startOfMultiReply
- component <- multiReplyComponent
- end <- expectedReplyLine (fst start)
- return (fst start, snd start : (component ++ [snd end]))
- )
-
-----------------------------------------------------------------------
--- The real code
-----------------------------------------------------------------------
-
--- | Parse a FTP reply. Returns a (result code, text) pair.
-
-parseReply :: String -> FTPResult
-parseReply input =
- case parse multiReply "(unknown)" input of
- Left err -> error ("FTP: " ++ (show err))
- Right reply -> reply
-
--- | Parse a FTP reply. Returns a (result code, text) pair.
--- If the result code indicates an error, raise an exception instead
--- of just passing it back.
-
-parseGoodReply :: String -> IO FTPResult
-parseGoodReply input =
- let reply = parseReply input
- in
- if (fst reply) >= 400
- then fail ("FTP:" ++ (show (fst reply)) ++ ": " ++ (join "\n" (snd reply)))
- else return reply
-
--- | Parse a FTP reply. Logs debug messages.
-debugParseGoodReply :: String -> IO FTPResult
-debugParseGoodReply contents =
- let logPlugin :: String -> String -> IO String
- logPlugin [] [] = return []
- logPlugin [] accum = do
- logit accum
- return []
- logPlugin (x:xs) accum =
- case x of
- '\n' -> do logit (strip (accum))
- next <- unsafeInterleaveIO $ logPlugin xs []
- return (x : next)
- y -> do
- next <- unsafeInterleaveIO $ logPlugin xs (accum ++ [x])
- return (x : next)
- in
- do
- loggedStr <- logPlugin contents []
- parseGoodReply loggedStr
-
-{- | Converts a socket address to a string suitable for a PORT command.
-
-Example:
-
-> toPortString (SockAddrInet (PortNum 0x1234) (0xaabbccdd)) ->
-> "170,187,204,221,18,52"
--}
-toPortString :: SockAddr -> IO String
-toPortString (SockAddrInet port hostaddr) =
- let wport = (fromEnum(port))::Int
- in do
- hn <- inet_ntoa hostaddr
- return ((replace "." "," hn) ++ "," ++
- (genericJoin "," . drop 2 . getBytes $ wport))
-toPortString _ =
- error "toPortString only works on AF_INET addresses"
-
--- | Converts a port string to a socket address. This is the inverse calculation of 'toPortString'.
-fromPortString :: String -> IO SockAddr
-fromPortString instr =
- let inbytes = split "," instr
- hostname = join "." (take 4 inbytes)
- portbytes = map read (drop 4 inbytes)
- in
- do
- addr <- inet_addr hostname
- return $ SockAddrInet (fromInteger $ fromBytes portbytes) addr
-
-respToSockAddrRe = mkRegex("([0-9]+,){5}[0-9]+")
--- | Converts a response code to a socket address
-respToSockAddr :: FTPResult -> IO SockAddr
-respToSockAddr f =
- do
- forceioresp 200 f
- if (fst f) /= 227 then
- fail ("Not a 227 response: " ++ show f)
- else case matchRegexAll respToSockAddrRe (head (snd f)) of
- Nothing -> fail ("Could not find remote endpoint in " ++ (show f))
- Just (_, x, _, _) -> fromPortString x
-
-
-parseDirName :: FTPResult -> Maybe String
-parseDirName (257, name:_) =
- let procq [] = []
- procq ['"'] = []
- procq ('"' : '"' : xs) = '"' : procq xs
- procq (x:xs) = x : procq xs
- in
- if head name /= '"'
- then Nothing
- else Just (procq (tail name))
-
diff --git a/libsrc/MissingH/Network/FTP/Server.hs b/libsrc/MissingH/Network/FTP/Server.hs
index cde5244..98e6130 100644
--- a/libsrc/MissingH/Network/FTP/Server.hs
+++ b/libsrc/MissingH/Network/FTP/Server.hs
@@ -36,7 +36,7 @@ Written by John Goerzen, jgoerzen\@complete.org
module MissingH.Network.FTP.Server(
)
where
-import MissingH.Network.FTP.Parser
+import MissingH.Network.FTP.ParserServer
import Network.BSD
import Network.Socket
import qualified Network
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list