[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:45 UTC 2010
The following commit has been merged in the master branch:
commit a4b290b143432548d501603efc714fd8cc91ad9a
Author: John Goerzen <jgoerzen at complete.org>
Date: Sun Oct 24 09:42:55 2004 +0100
Added transmission code
Keywords:
(jgoerzen at complete.org--projects/missingh--head--1.0--patch-115)
diff --git a/ChangeLog b/ChangeLog
index 9080c58..4147f2c 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 03:42:55 GMT John Goerzen <jgoerzen at complete.org> patch-115
+
+ Summary:
+ Added transmission code
+ Revision:
+ missingh--head--1.0--patch-115
+
+
+ modified files:
+ ChangeLog libsrc/MissingH/Network.hs
+ libsrc/MissingH/Network/FTP/Client.hs
+ libsrc/MissingH/Network/FTP/Parser.hs
+
+
2004-10-24 02:55:47 GMT John Goerzen <jgoerzen at complete.org> patch-114
Summary:
diff --git a/libsrc/MissingH/Network.hs b/libsrc/MissingH/Network.hs
index 16412ac..8d44a48 100644
--- a/libsrc/MissingH/Network.hs
+++ b/libsrc/MissingH/Network.hs
@@ -31,7 +31,8 @@ This module provides various helpful utilities for dealing with networking
Written by John Goerzen, jgoerzen\@complete.org
-}
-module MissingH.Network(niceSocketsDo, connectTCP, connectTCPAddr
+module MissingH.Network(niceSocketsDo, connectTCP, connectTCPAddr,
+ listenTCPAddr
)
where
import Network
@@ -69,3 +70,10 @@ connectTCPAddr addr = do
connect s addr
return s
+listenTCPAddr :: SockAddr -> IO Socket
+listenTCPAddr addr = do
+ proto <- getProtocolNumber "tcp"
+ s <- socket AF_INET Stream proto
+ bindSocket s addr
+ listen s 1
+ return s
\ No newline at end of file
diff --git a/libsrc/MissingH/Network/FTP/Client.hs b/libsrc/MissingH/Network/FTP/Client.hs
index 64b6fe2..e30d845 100644
--- a/libsrc/MissingH/Network/FTP/Client.hs
+++ b/libsrc/MissingH/Network/FTP/Client.hs
@@ -48,7 +48,7 @@ Useful standards:
-}
-module MissingH.Network.FTP.Client(-- * Establishing/Removing connections
+module MissingH.Network.FTP.Client(-- * Establishing\/Removing connections
easyConnectTo, connectTo,
loginAnon, login, quit,
-- * Configuration
@@ -57,6 +57,8 @@ module MissingH.Network.FTP.Client(-- * Establishing/Removing connections
nlst, dir,
-- * File downloads
getlines, getbinary,
+ -- * File uploads
+ putlines, putbinary,
-- * File manipulation
rename, delete, size,
-- * Directory manipulation
@@ -78,6 +80,7 @@ import MissingH.Str
data FTPConnection = FTPConnection {readh :: IO String,
readh_internal :: Handle,
writeh :: Handle,
+ socket_internal :: Socket,
isPassive :: Bool}
{-
@@ -92,7 +95,6 @@ getresp h = do
logsend m = debugM "MissingH.Network.FTP.Client" ("FTP sent: " ++ m)
sendcmd h c = do logsend c
- hPutStr (writeh h) (c ++ "\r\n")
getresp h
{- | Connect to the remote FTP server and read but discard
@@ -121,6 +123,7 @@ connectTo h p =
hSetBuffering w LineBuffering
let h = FTPConnection {readh = readchars r,
readh_internal = r,
+ socket_internal = s,
writeh = w, isPassive = True}
--hIsReadable h >>= print
--hIsWritable h >>= print
@@ -171,9 +174,20 @@ makepasv :: FTPConnection -> IO SockAddr
makepasv h =
do
r <- sendcmd h "PASV"
- putStrLn "makepasv returning "
respToSockAddr r
+{- | Opens a port and sends it to the remote. -}
+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"
+ in
+ do addr <- getSocketName (socket_internal h)
+ mastersock <- listenTCPAddr (listenaddr addr)
+ newaddr <- getSocketName mastersock
+ result <- sendcmd h ("PORT " ++ toPortString newaddr)
+ return (mastersock, result)
+
{- | Establishes a connection to the remote.
FIXME: need support for rest
@@ -183,19 +197,20 @@ ntransfercmd h cmd =
let sock = if isPassive h
then do
addr <- makepasv h
- putStrLn "connecting"
s <- connectTCPAddr addr
- putStrLn "connected"
return s
- else fail "FIXME: No support for non-passive yet"
+ else do
+ masterresult <- makeport h
+ forceioresp 100 (snd masterresult)
+ acceptres <- accept (fst masterresult)
+ sClose (fst masterresult)
+ return (fst acceptres)
in do
s <- sock
newh <- socketToHandle s ReadWriteMode
- putStrLn "Have socket"
+ hSetBuffering newh (BlockBuffering (Just 4096))
r <- sendcmd h cmd
- putStrLn "Sending command"
forceioresp 100 r
- putStrLn "ntransfercmd returning"
return (newh, Nothing)
{- | Returns the socket part from calling 'ntransfercmd'. -}
@@ -203,6 +218,27 @@ transfercmd :: FTPConnection -> String -> IO Handle
transfercmd h cmd = do x <- ntransfercmd h cmd
return (fst x)
+{- | Stores the lines of data to the remote. The string gives the
+commands to issue. -}
+storlines :: FTPConnection -> String -> [String] -> IO FTPResult
+storlines h cmd input =
+ do
+ sendcmd h "TYPE A"
+ newh <- transfercmd h cmd
+ hPutStr newh (concatMap (++ "\r\n") input)
+ hClose newh
+ getresp h
+
+{- | Stores the binary data to the remote. The first string gives the
+commands to issue. -}
+storbinary :: FTPConnection -> String -> String -> IO FTPResult
+storbinary h cmd input =
+ do sendcmd h "TYPE I"
+ newh <- transfercmd h cmd
+ hPutStr newh input
+ hClose newh
+ getresp h
+
{- | Retrieves lines of data from the remote. The string gives
the command to issue. -}
retrlines :: FTPConnection -> String -> IO ([String], FTPResult)
@@ -243,6 +279,15 @@ getlines h fn = retrlines h ("RETR " ++ fn)
getbinary :: FTPConnection -> String -> IO (String, FTPResult)
getbinary h fn = retrbinary h ("RETR " ++ fn)
+{- | Puts data in the specified file in text mode. The first string
+is the filename. -}
+putlines :: FTPConnection -> String -> [String] -> IO FTPResult
+putlines h fn input = storlines h ("STOR " ++ fn) input
+
+{- | Puts data in the specified file in binary. Ths first string is the filename. -}
+putbinary :: FTPConnection -> String -> String -> IO FTPResult
+putbinary h fn input = storbinary h ("STOR " ++ fn) input
+
{- | Retrieves a list of files in the given directory.
FIXME: should this take a list of dirs? -}
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index 7b77667..c813c30 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -56,6 +56,7 @@ import Network.Socket(SockAddr(..), PortNumber(..), inet_addr)
import System.IO(Handle, hGetContents)
import System.IO.Unsafe
import Text.Regex
+import Data.Word
type FTPResult = (Int, [String])
-- import Control.Exception(Exception(PatternMatchFail), throw)
@@ -214,8 +215,11 @@ Example:
-}
toPortString :: SockAddr -> String
toPortString (SockAddrInet (PortNum port) hostaddr) =
- (genericJoin "," (getBytes hostaddr)) ++ "," ++
- (genericJoin "," (getBytes port))
+ let wport = fromInteger(toInteger(port))::Word32
+ whost = fromInteger(toInteger(hostaddr))::Word16
+ in
+ (genericJoin "," . getBytes $ whost) ++ "," ++
+ (genericJoin "," . getBytes $ wport)
toPortString _ =
error "toPortString only works on AF_INET addresses"
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list