ftphs 1.0.9.1 → 1.0.9.2

raw patch · 6 files changed

+121/−87 lines, 6 filesdep +bytestringdep −testpackPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring

Dependencies removed: testpack

API changes (from Hackage documentation)

Files

• ftphs.cabal +14/−10
• src/Network/FTP/Client.hs +67/−35
• src/Network/FTP/Client/Parser.hs +8/−9
• src/Network/FTP/Server.hs +29/−29
• src/Network/FTP/Server/Parser.hs +3/−3
• testsrc/Network/FTP/Parsertest.hs +0/−1

@@ -1,10 +1,10 @@ Name: ftphs-Version: 1.0.9.1+Version: 1.0.9.2 License: LGPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen Stability: Stable-Copyright: Copyright (c) 2004-2013 John Goerzen+Copyright: Copyright (c) 2004-2017 John Goerzen license-file: COPYRIGHT extra-source-files: COPYING,                     Makefile,@@ -12,16 +12,20 @@ Homepage: http://software.complete.org/ftphs Category: Network Synopsis: FTP Client and Server Library-Description:  ftphs provides a Haskell library to implement a FTP client+Description: ftphs provides a Haskell library to implement a FTP client  and a FTP server.  .  ftphs has a number of features:  .-  * Easy to use operation-  * Full support of text and binary transfers-  * Optional lazy interaction-  * Server can serve up a real or a virtual filesystem tree-  * Standards compliant+ * Easy to use operation.+ .+ * Full support of text and binary transfers.+ .+ * Optional lazy interaction.+ .+ * Server can serve up a real or a virtual filesystem tree.+ .+ * Standards compliant.  Build-Type: Simple Cabal-Version: >=1.2.3@@ -40,13 +44,13 @@    UndecidableInstances, CPP, ScopedTypeVariables   Build-Depends: network, parsec, base >= 3 && < 5,                  mtl, regex-compat, -               hslogger, MissingH>=1.0.0+               hslogger, MissingH>=1.0.0, bytestring   GHC-Options: -O2  Executable runtests   if flag(buildtests)     Buildable: True-    Build-Depends: testpack, HUnit+    Build-Depends: HUnit   else     Buildable: False   Main-Is: runtests.hs

@@ -21,7 +21,7 @@    Copyright  : Copyright (C) 2004-2005 John Goerzen    License    : GNU LGPL, version 2.1 or above -   Maintainer : John Goerzen <jgoerzen@complete.org> +   Maintainer : John Goerzen <jgoerzen@complete.org>    Stability  : experimental    Portability: systems with networking @@ -33,7 +33,7 @@ Welcome to the FTP module for Haskell.  Here is a quick usage example to get you started.  This is a log of a real-session with ghci: +session with ghci:  (This would be similar in a @do@ block.  You could also save it to a file and run that with Hugs.)@@ -102,7 +102,7 @@ > -----BEGIN PGP SIGNATURE----- > Version: GnuPG v1.0.0 (GNU/Linux) > Comment: See http://www.kernel.org/signature.html for info-> +> > iD8DBQA54rf0yGugalF9Dw4RAqelAJ9lafFni4f/QyJ2IqDXzW2nz/ZIogCfRPtg > uYpWffOhkyByfhUt8Lcelec= > =KnLA@@ -200,41 +200,43 @@  module Network.FTP.Client(-- * Establishing\/Removing connections                                    easyConnectFTP, connectFTP,-                                   loginAnon, login, quit, +                                   loginAnon, login, quit,                                    -- * Configuration                                    setPassive, isPassive, enableFTPDebugging,                                    -- * Directory listing-                                   nlst, dir, +                                   nlst, dir,                                    -- * File downloads                                    getlines, getbinary,-                                   downloadbinary,+                                   downloadbinary, downloadlargebinary,                                    -- * File uploads                                    putlines, putbinary,                                    uploadbinary,                                    -- * File manipulation                                    rename, delete, size,                                    -- * Directory manipulation-                                   cwd, mkdir, rmdir, pwd, +                                   cwd, mkdir, rmdir, pwd,                                    -- * Low-level advanced commands                                    FTPConnection,                                    transfercmd, ntransfercmd,                                    retrlines, storlines, sendcmd                        ) where-import Network.FTP.Client.Parser-import Network.BSD-import Network.Socket-import System.IO.Binary+import           Control.Exception+import           Data.ByteString           (hGet, hPut)+import           Data.String.Utils import qualified Network-import System.IO-import System.IO.Unsafe-import System.Log.Logger-import Network.Utils-import Data.String.Utils-data FTPConnection = FTPConnection {readh :: IO String,-                                    writeh :: Handle,+import           Network.BSD+import           Network.FTP.Client.Parser+import           Network.Socket+import           Network.Utils+import           System.IO+import           System.IO.Binary+import           System.IO.Unsafe+import           System.Log.Logger+data FTPConnection = FTPConnection {readh           :: IO String,+                                    writeh          :: Handle,                                     socket_internal :: Socket,-                                    isPassive :: Bool}+                                    isPassive       :: Bool}  getresp h = do             c <- (readh h)@@ -261,7 +263,7 @@ The effect is global and persists until changed. -} enableFTPDebugging :: IO ()-enableFTPDebugging = +enableFTPDebugging =     do     updateGlobalLogger "Network.FTP.Client.Parser" (setLevel DEBUG)     updateGlobalLogger "Network.FTP.Client" (setLevel DEBUG)@@ -279,7 +281,7 @@     s <- connectTCP h p     newh <- socketToHandle s ReadWriteMode     hSetBuffering newh LineBuffering-    let h = FTPConnection {readh = readchars newh, +    let h = FTPConnection {readh = readchars newh,                            socket_internal = s,                            writeh = newh, isPassive = True}     resp <- getresp h@@ -314,7 +316,7 @@  {- | Sets whether passive mode is used (returns new connection object reflecting this) -}-setPassive :: FTPConnection -> Bool -> FTPConnection            +setPassive :: FTPConnection -> Bool -> FTPConnection setPassive f b = f{isPassive = b}  {- | Finds the addres sof the remote. -}@@ -337,7 +339,7 @@            result <- sendcmd h ("PORT " ++ ps)            return (mastersock, result) -{- | Establishes a connection to the remote. +{- | Establishes a connection to the remote.  FIXME: need support for rest -}@@ -347,10 +349,16 @@                then do                     addr <- makepasv h                     s <- connectTCPAddr addr-                    r <- sendcmd h cmd-                    forceioresp 100 r-                    return s-               else do +                    catch+                      (do+                        r <- sendcmd h cmd+                        forceioresp 100 r+                        return s)+                      ((\exc -> do+                        sClose s+                        throw exc+                      ) :: IOError -> IO Socket)+               else do                     masterresult <- makeport h                     r <- sendcmd h cmd                     forceioresp 100 r@@ -389,7 +397,7 @@        hClose newh        getresp h -{- | Retrieves lines of data from the remote. The string gives +{- | Retrieves lines of data from the remote. The string gives the command to issue. -} retrlines :: FTPConnection -> String -> IO ([String], FTPResult) retrlines h cmd =@@ -432,11 +440,11 @@ {- | 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 +putlines h fn input = storlines h ("STOR " ++ fn) input  {- | Puts data in the specified file in binary.  The first string is the filename. -} putbinary :: FTPConnection -> String -> String -> IO FTPResult-putbinary h fn input = storbinary h ("STOR " ++ fn) input +putbinary h fn input = storbinary h ("STOR " ++ fn) input  {- | Uploads a file from disk in binary mode. Note: filename is used for both local and remote. -} uploadbinary :: FTPConnection -> String -> IO FTPResult@@ -449,13 +457,37 @@                          writeBinaryFile fn r0                          return r1 -{- | Retrieves a list of files in the given directory. +{- | Similar to downloadbinary, but downloads the file in blocks of 4096 bytes+so that memory usage is limited when downloading large files.+Uses Data.ByteString's hGet to read data from the socket and hPut to write data+to the file, since it is more space and time efficient than String. -}+downloadlargebinary :: FTPConnection -> FilePath -> IO FTPResult+downloadlargebinary h fn = do+  ftp_data_h <- transfercmd h $ "RETR " ++ fn+  out_file_fh <- openFile fn WriteMode+  getAndWrite ftp_data_h out_file_fh+  getresp h+  where+    getAndWrite ftp_data_h out_file_fh = do+      eof_p <- hIsEOF ftp_data_h+      case eof_p of+        True -> do+          hClose ftp_data_h+          hFlush out_file_fh+          hClose out_file_fh+          return ()+        False -> do+          buf <- hGet ftp_data_h 4096+          hPut out_file_fh buf+          getAndWrite ftp_data_h out_file_fh +{- | 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 Nothing = retrlines h "NLST" >>= return . fst+nlst h Nothing        = retrlines h "NLST" >>= return . fst nlst h (Just dirname) = retrlines h ("NLST " ++ dirname) >>= return . fst  {- | Retrieve the system-specific long form of a directory list.@@ -464,7 +496,7 @@ dir :: FTPConnection        -> Maybe String                  -- ^ The directory to list.  If Nothing, list the current directory.        -> IO [String]-dir h Nothing = retrlines h "LIST" >>= return .  fst+dir h Nothing        = retrlines h "LIST" >>= return .  fst dir h (Just dirname) = retrlines h ("LIST " ++ dirname) >>= return . fst  {- | Rename or move a file. -}@@ -483,8 +515,8 @@  {- | Change the working directory. -} cwd :: FTPConnection -> String -> IO FTPResult-cwd h ".." = sendcmd h "CDUP"-cwd h "" = cwd h "."+cwd h ".."   = sendcmd h "CDUP"+cwd h ""     = cwd h "." cwd h newdir = sendcmd h ("CWD " ++ newdir)  {- | Get the size of a file.

@@ -21,7 +21,7 @@    Copyright  : Copyright (C) 2004 John Goerzen    License    : GNU LGPL, version 2.1 or above -   Maintainer : John Goerzen <jgoerzen@complete.org> +   Maintainer : John Goerzen <jgoerzen@complete.org>    Stability  : provisional    Portability: systems with networking @@ -137,7 +137,7 @@  multiReplyComponent :: Parser [String] multiReplyComponent = (try (do-                            notMatching (do +                            notMatching (do                                          codeString                                          sp                                         ) "found unexpected code"@@ -190,9 +190,9 @@     let logPlugin :: String -> String -> IO String         logPlugin [] [] = return []         logPlugin [] accum = do-                             logit accum +                             logit accum                              return []-        logPlugin (x:xs) accum = +        logPlugin (x:xs) accum =             case x of                    '\n' -> do logit (strip (accum))                               next <- unsafeInterleaveIO $ logPlugin xs []@@ -217,9 +217,9 @@     let wport = (fromIntegral (port))::Word16         in do            hn <- inet_ntoa hostaddr-           return ((replace "." "," hn) ++ "," ++ +           return ((replace "." "," hn) ++ "," ++                    (genericJoin "," . getBytes $ wport))-toPortString _ = +toPortString _ =     error "toPortString only works on AF_INET addresses"  -- | Converts a port string to a socket address.  This is the inverse calculation of 'toPortString'.@@ -245,15 +245,14 @@                   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       +        in         if head name /= '"'            then Nothing            else Just (procq (tail name))-

@@ -21,7 +21,7 @@    Copyright  : Copyright (C) 2004 John Goerzen    License    : GNU LGPL, version 2.1 or above -   Maintainer : John Goerzen <jgoerzen@complete.org> +   Maintainer : John Goerzen <jgoerzen@complete.org>    Stability  : experimental    Portability: systems with networking @@ -43,7 +43,7 @@ "System.IO.HVFS" and "System.IO.HVIO" modules.  In addition, basic networking and multitasking configuration is handled-via "Network.SocketServer" and logging via +via "Network.SocketServer" and logging via "System.Log.Logger".  This module is believed to be secure, but it not believed to be robust enough@@ -103,7 +103,7 @@  data DataType = ASCII | Binary               deriving (Eq, Show)-data AuthState = NoAuth +data AuthState = NoAuth               | User String               | Authenticated String                 deriving (Eq, Show)@@ -135,10 +135,10 @@         writethis [item] = ftpPutStrLn h (codes ++ " " ++ item)         writethis (item:xs) = do ftpPutStrLn h (codes ++ "-" ++ item)                                  writethis xs-        in +        in         writethis (map (rstrip) (lines text)) -{- | Main FTP handler; pass the result of applying this to one argument to +{- | Main FTP handler; pass the result of applying this to one argument to 'Network.SocketServer.handleHandler' -}  anonFtpHandler :: forall a. HVFSOpenable a => a -> Handle -> SockAddr -> SockAddr -> IO ()@@ -175,7 +175,7 @@ forceLogin :: CommandHandler -> CommandHandler forceLogin func h@(FTPServer _ _ state) args =     do state <- readIORef (auth state)-       case state of +       case state of           Authenticated _ -> func h args           x -> do sendReply h 530 "Command not possible in non-authenticated state."                   return True@@ -214,13 +214,13 @@                                     ("Closing due to error: " ++ (show (e::SomeException)))                             hClose fh                             return False-        in do continue <- (flip catch) errorhandler +        in do continue <- (flip catch) errorhandler                (do x <- parseCommand fh                    case x of                      Left err -> do sendReply h 500 $                                       " Couldn't parse command: " ++ (show err)                                     return True-                     Right (cmd, args) -> +                     Right (cmd, args) ->                          case lookupC cmd commands of                             Nothing -> do sendReply h 502 $                                            "Unrecognized command " ++ cmd@@ -244,7 +244,7 @@  help_user =     ("Provide a username",-     unlines $ +     unlines $      ["USER username will provide the username for authentication."      ,"It should be followed by a PASS command to finish the authentication."      ])@@ -268,7 +268,7 @@ cmd_pass h@(FTPServer _ _ state) passedargs =     do curstate <- readIORef (auth state)        case curstate of-         User "anonymous" -> +         User "anonymous" ->              do sendReply h 230 "Anonymous login successful."                 writeIORef (auth state) (Authenticated "anonymous")                 infoM logname "Anonymous authentication successful"@@ -291,7 +291,7 @@                  sendReply h 250 $ "New directory now " ++ newdir                  return True -help_cdup = +help_cdup =     ("Change to parent directory", "Same as CWD ..") cmd_cdup h _ = cmd_cwd h ".." @@ -322,16 +322,16 @@ help_port = ("Initiate a port-mode connection", "") cmd_port :: CommandHandler cmd_port h@(FTPServer _ _ state) args =-    let doIt clientsa = +    let doIt clientsa =             do writeIORef (datachan state) (PortMode clientsa)                str <- showSockAddr clientsa                sendReply h 200 $ "OK, later I will connect to " ++ str                return True         in         do closeconn h                      -- Close any existing connection-           trapIOError h (fromPortString args) $  (\clientsa -> +           trapIOError h (fromPortString args) $  (\clientsa ->                case clientsa of-                   SockAddrInet _ ha -> +                   SockAddrInet _ ha ->                       case (local state) of                           SockAddrInet _ ha2 -> if ha /= ha2                                                   then do sendReply h 501 "Will only connect to same client as command channel."@@ -361,10 +361,10 @@ cmd_pasv :: CommandHandler cmd_pasv h@(FTPServer _ _ state) args =     do closeconn h                      -- Close any existing connection-       addr <- case (local state) of +       addr <- case (local state) of                     (SockAddrInet _ ha) -> return ha                     _ -> fail "Require IPv4 sockets"-       let ssopts = InetServerOptions +       let ssopts = InetServerOptions                     { listenQueueSize = 1,                       portNumber = aNY_PORT,                       interface = addr,@@ -379,9 +379,9 @@        sendReply h 227 $ "Entering passive mode (" ++ portstring ++ ")"        writeIORef (datachan state) (PassiveMode ss)        return True-                 -                                        -       +++ help_noop = ("Do nothing", "") cmd_noop :: CommandHandler cmd_noop h _ =@@ -390,7 +390,7 @@  help_rnfr = ("Specify FROM name for a file rename", "") cmd_rnfr :: CommandHandler-cmd_rnfr h@(FTPServer _ _ state) args = +cmd_rnfr h@(FTPServer _ _ state) args =     if length args < 1        then do sendReply h 501 "Filename required"                return True@@ -423,7 +423,7 @@         if length args < 1            then do sendReply h 501 "Filename required"                    return True-           else trapIOError h (vOpen fs args WriteMode) +           else trapIOError h (vOpen fs args WriteMode)                   (\fhencap ->                     trapIOError h (do sendReply h 150 "File OK; about to open data channel"                                       runDataChan h (runit fhencap)@@ -462,7 +462,7 @@  genericTransmit :: FTPServer -> a -> (a -> FTPServer -> Socket -> IO ()) -> IO Bool genericTransmit h dat func =-    trapIOError h +    trapIOError h       (do sendReply h 150 "I'm going to open the data channel now."           runDataChan h (func dat)       ) (\_ ->@@ -485,7 +485,7 @@         if length args < 1            then do sendReply h 501 "Filename required"                    return True-           else trapIOError h (vOpen fs args ReadMode) +           else trapIOError h (vOpen fs args ReadMode)                     (\fhencap -> genericTransmitHandle h fhencap)  help_rnto = ("Specify TO name for a file name", "")@@ -498,11 +498,11 @@                case fr of                    Nothing -> do sendReply h 503 "RNFR required before RNTO"                                  return True-                   Just fromname -> +                   Just fromname ->                        do writeIORef (rename state) Nothing                           trapIOError h (vRenameFile fs fromname args)-                              $ \_ -> do sendReply h 250 -                                           ("File " ++ fromname ++ +                              $ \_ -> do sendReply h 250+                                           ("File " ++ fromname ++                                             " renamed to " ++ args)                                          return True @@ -608,8 +608,8 @@          ,"Auth Status         : " ++ (show auth)          ,"End of status."]        return True-           + help_help =     ("Display help on available commands",      "When called without arguments, shows a summary of available system\n"@@ -640,13 +640,13 @@                    return True            else let newargs = map toUpper args                     in case lookupC newargs commands of-                         Nothing -> do +                         Nothing -> do                                     sendReply h 214 $ "No help for \"" ++ newargs                                       ++ "\" is available.\nPlese send HELP"                                       ++ " without arguments for a list of\n"                                       ++ "valid commands."                                     return True                          Just (Command _ (_, (summary, detail))) ->-                             do sendReply h 214 $ newargs ++ ": " ++ summary ++ +                             do sendReply h 214 $ newargs ++ ": " ++ summary ++                                                "\n\n" ++ detail                                 return True

@@ -21,7 +21,7 @@    Copyright  : Copyright (C) 2004 John Goerzen    License    : GNU LGPL, version 2.1 or above -   Maintainer : John Goerzen <jgoerzen@complete.org> +   Maintainer : John Goerzen <jgoerzen@complete.org>    Stability  : provisional    Portability: systems with networking @@ -65,10 +65,10 @@ args :: Parser String args = try (do char ' '                r <- many anyChar-               eof +               eof                return r)        <|> return ""-       +  command :: Parser (String, String) command = do

@@ -19,7 +19,6 @@ module Network.FTP.Parsertest(tests) where import Test.HUnit import Network.FTP.Client.Parser-import Test.HUnit.Tools import Network.Socket  test_parseReply =