scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

* changed names in ftp client from ftp:... to ftp-... 

* added ftp-obsolete package, maps the obsolete names to the new
* added ftp-error? as an exported procedure
This commit is contained in:
interp 2002-04-25 09:52:42 +00:00
parent 2fccbe9b3e
commit c5eeb471f8
3 changed files with 171 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
doc/latex/ftp.tex
View File

@ -1,7 +1,7 @@
\section{FTP client}\label{sec:ftp}
\begin{description}
\item[Used files:] ftp.scm
\item[Name of the package:] ftp
\item[Used files:] ftp.scm, ftp-obsolete.scm
\item[Name of the package:] ftp, ftp-obsolete
\end{description}
\subsection{What users want to know}
@ -19,16 +19,16 @@ procedures return a ``status'', which is either the server's reply as
a string, or \sharpf{} to signify failure.
The server's response is always checked. If the server's response
doesn't match the expected code from the server, an catchable
\ex{ftp:error} is raised.
doesn't match the expected code from the server, a catchable
\ex{ftp-error} is raised.
\FIXME{The source says you can look at pop3.scm to find out how to
catch the ftp:error raised by some procedures this. We have not had
catch the ftp-error raised by some procedures this. We have not had
a look there, yet.}
\subsubsection*{Entry points }
\defun{ftp:connect} {host \ovar{logfile}} {connection}
\defun{ftp-connect} {host \ovar{logfile}} {connection}
\begin{desc}
Open a command connection with the remote machine \semvar{host}.
Optionally start logging the conversation with the server to
@ -38,7 +38,7 @@ a look there, yet.}
\ex{og-rxw})!
\end{desc}
\defun{ftp:login} {connection \ovar{login \ovar{passwd}}} {status}
\defun{ftp-login} {connection \ovar{login \ovar{passwd}}} {status}
\begin{desc}
Log in to the remote host. If a \semvar{login} and \semvar{password}
are not provided, they are first searched for in the user's
@ -46,7 +46,7 @@ a look there, yet.}
``user@host''
\end{desc}
\defun{ftp:type} {connection type} {status}
\defun{ftp-type} {connection type} {status}
\begin{desc}
Change the transfer mode for future data connections. This may be
either \ex{'ascii }or \ex{'text}, respectively, for transfering text
@ -54,7 +54,7 @@ a look there, yet.}
\semvar{type} is a string it is sent verbatim to the server.
\end{desc}
\defun{ftp:rename} {connection oldname newname} {status}
\defun{ftp-rename} {connection oldname newname} {status}
\begin{desc}
Change the name of \semvar{oldname} on the remote host to
\semvar{newname} (assuming sufficient permissions). \semvar{oldname}
@ -65,34 +65,34 @@ a look there, yet.}
the root of the servers's filesystem.
\end{desc}
\defun{ftp:delete} {connection file} {status}
\defun{ftp-delete} {connection file} {status}
\begin{desc}
Delete \semvar{file} from the remote host (assuming the user has
appropriate permissions).
\end{desc}
\defun{ftp:cd} {connection dir} {status}
\defun{ftp-cd} {connection dir} {status}
\begin{desc}
Change the current directory on the server.
\end{desc}
\defun{ftp:cdup} {connection} {status}
\defun{ftp-cdup} {connection} {status}
\begin{desc}
Move to the parent directory on the server.
\end{desc}
\defun{ftp:pwd} {connection} {string}
\defun{ftp-pwd} {connection} {string}
\begin{desc}
Return the current directory on the remote host, as a string.
\end{desc}
\defun{ftp:ls} {connection} {status}
\defun{ftp-ls} {connection} {status}
\begin{desc}
Provide a listing of the current directory's contents, in short
format, \ie as a list of filenames.
\end{desc}
\defun{ftp:dir} {connection} {status}
\defun{ftp-dir} {connection} {status}
\begin{desc}
Provide a listing of the current directory's contents, in long
format. Most servers (\Unix, MS Windows, MacOS) use a standard
@ -100,7 +100,7 @@ a look there, yet.}
information, but other servers (VMS, \ldots) use their own format.
\end{desc}
\defun{ftp:get} {connection remote-file \ovar{local-file}} {status $|$ string}
\defun{ftp-get} {connection remote-file \ovar{local-file}} {status $|$ string}
\begin{desc}
Download \semvar{remote-file} from the FTP server. If
\semvar{local-file} is a string, save the data to
@ -112,7 +112,7 @@ a look there, yet.}
\sharpf{} return the data as a string.
\end{desc}
\defun{ftp:put} {connection local-file \ovar{remote-file}} {status}
\defun{ftp-put} {connection local-file \ovar{remote-file}} {status}
\begin{desc}
Upload \semvar{local-file} to the FTP server. If
\semvar{remote-file} is specified, then save the data to
@ -122,25 +122,25 @@ a look there, yet.}
`/'), or relative to the current directory.
\end{desc}
\defun{ftp:append}{connection local-file \ovar{remote-file}}{status}
\defun{ftp-append}{connection local-file \ovar{remote-file}}{status}
\begin{desc}
Does the same as \ex{ftp:get}, but appends the data to the remote
Does the same as \ex{ftp-get}, but appends the data to the remote
file, if it exists.
\end{desc}
\defun{ftp:rmdir} {connection dir} {status}
\defun{ftp-rmdir} {connection dir} {status}
\begin{desc}
Remove the directory \semvar{dir} from the remote host (assuming
sufficient permissions).
\end{desc}
\defun{ftp:mkdir} {connection dir} {status}
\defun{ftp-mkdir} {connection dir} {status}
\begin{desc}
Create a new directory named \semvar{dir} on the remote host
(assuming sufficient permissions).
\end{desc}
\defun{ftp:modification-time} {connection file} {date}
\defun{ftp-modification-time} {connection file} {date}
\begin{desc}
Request the time of the last modification of \semvar{file} on the
remote host, and on success return a Scsh date record. This command
@ -148,30 +148,35 @@ a look there, yet.}
useful for mirroring.
\end{desc}
\defun{ftp:size} {connection file} {integer}
\defun{ftp-size} {connection file} {integer}
\begin{desc}
Return the size of \semvar{file} in bytes.
\end{desc}
\defun{ftp:abort} {connection} {status}
\defun{ftp-abort} {connection} {status}
\begin{desc}
Abort the current data transfer. Not particularly useful with this
im\-ple\-men\-ta\-tion since the data transfer commands only return
once the transfer is complete.
\end{desc}
\defun{ftp:quit} {connection} {status}
\defun{ftp-quit} {connection} {status}
\begin{desc}
Close the connection to the remote host. The \semvar{connection}
object is useless after a quit command.
\end{desc}
\defun{ftp:quot}{connection command}{status}
\defun{ftp-quot}{connection command}{status}
\begin{desc}
Send a \semvar{command} verbatim to the remote server and wait for a
response.
\end{desc}
\defun{ftp-error?}{thing}{boolean}
\begin{desc}
Returns \sharpt, if \semvar{thing} is a \ex{ftp-error} object,
otherwise \sharpf.
\end{desc}
\subsubsection*{Unimplemented}
@ -215,6 +220,14 @@ be very tricky; it only requires using passive mode. Might want to add
something like the \ex{/usr/bin/ftp} command \ex{restrict}, which
implements data port range restrictions.
\subsubsection*{Obsolete procedures}
Names in further versions of \ex{ftp} contained a colon (`\ex{:}')
after the prefix `\ex{ftp-}'. This is now changed to a hyphen
('\ex{-}'), accordingly to SUnet's philosophy. If you need the old
names, use the \ex{ftp\=obsolete}-package that maps the names to the
new ones.
\subsubsection*{Portablitity}
@ -253,7 +266,7 @@ Items of the following list are necessary in order to use this module:
\item Improved error handling.
\item A lot of the calls to format could be replaced by calls to
string-join. Maybe format is easier to read?
\item The \ex{ftp:rename} command should have an optional argument
\item The \ex{ftp-rename} command should have an optional argument
\ex{:rename} which defaults to \sharpf, which would make us upload
to a temporary name and rename at the end of the upload. This
atomicity is important for ftp or http servers which are serving a

182
ftp.scm
View File

@ -1,6 +1,6 @@
;;; ftp.scm -- an FTP client library for the Scheme Shell
;;
;; $Id: ftp.scm,v 1.4 2002/03/19 18:42:23 interp Exp $
;; $Id: ftp.scm,v 1.5 2002/04/25 09:52:42 interp Exp $
;;
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
@ -17,25 +17,25 @@
;;; Entry points =======================================================
;;
;; (ftp:connect host [logfile]) -> connection
;; (ftp-connect host [logfile]) -> connection
;; Open a command connection with the remote machine HOST.
;; Optionally start logging the conversation with the server to
;; LOGFILE, which will be appended to if it already exists, and
;; created otherwise. Beware, the LOGFILE contains passwords in
;; clear text (it is created with permissions og-rxw) !
;;
;; (ftp:login connection [login passwd]) -> status
;; (ftp-login connection [login passwd]) -> status
;; Log in to the remote host. If a login and password are not
;; provided, they are first searched for in the user's ~/.netrc
;; file, or default to user "anonymous" and password "user@host"
;;
;; (ftp:type connection type) -> status
;; (ftp-type connection type) -> status
;; Change the transfer mode for future data connections. This may
;; be either 'ascii or 'text, respectively, for transfering text files,
;; or 'binary for transfering binary files. If type is a string it
;; is sent verbatim to the server.
;;
;; (ftp:rename connection oldname newname) -> status
;; (ftp-rename connection oldname newname) -> status
;; Change the name of oldname on the remote host to newname
;; (assuming sufficient permissions). oldname and newname are
;; strings; if prefixed with "/" they are taken relative to the
@ -44,30 +44,30 @@
;; "anonymous" or "ftp"), the server root is different from the
;; root of the servers's filesystem.
;;
;; (ftp:delete connection file) -> status
;; (ftp-delete connection file) -> status
;; Delete file from the remote host (assuming the user has
;; appropriate permissions).
;;
;; (ftp:cd connection dir) -> status
;; (ftp-cd connection dir) -> status
;; Change the current directory on the server.
;;
;; (ftp:cdup connection) -> status
;; (ftp-cdup connection) -> status
;; Move to the parent directory on the server.
;;
;; (ftp:pwd connection) -> string
;; (ftp-pwd connection) -> string
;; Return the current directory on the remote host, as a string.
;;
;; (ftp:ls connection) -> status
;; (ftp-ls connection) -> status
;; Provide a listing of the current directory's contents, in short
;; format, ie as a list of filenames.
;;
;; (ftp:dir connection) -> status
;; (ftp-dir connection) -> status
;; Provide a listing of the current directory's contents, in long
;; format. Most servers (Unix, MS Windows, MacOS) use a standard
;; format with one file per line, with the file size and other
;; information, but other servers (VMS, ...) use their own format.
;;
;; (ftp:get connection remote-file [local-file]) -> status | string
;; (ftp-get connection remote-file [local-file]) -> status | string
;; Download remote-file from the FTP server. If local-file is a
;; string, save the data to local-file on the local host;
;; otherwise save to a local file named remote-file. remote-file
@ -76,36 +76,36 @@
;; output data to (current-output-file), and if it is #f return
;; the data as a string.
;;
;; (ftp:put connection local-file [remote-file]) -> status
;; (ftp-put connection local-file [remote-file]) -> status
;; Upload local-file to the FTP server. If remote-file is
;; specified, the save the data to remote-file on the remote host;
;; otherwise save to a remote file named local-file. local-file
;; and remote-file may be absolute file names (with a leading
;; `/'), or relative to the current directory.
;;
;; (ftp:rmdir connection dir) -> status
;; (ftp-rmdir connection dir) -> status
;; Remove the directory DIR from the remote host (assuming
;; sufficient permissions).
;;
;; (ftp:mkdir connection dir) -> status
;; (ftp-mkdir connection dir) -> status
;; Create a new directory named DIR on the remote host (assuming
;; sufficient permissions).
;;
;; (ftp:modification-time connection file) -> date
;; (ftp-modification-time connection file) -> date
;; Request the time of the last modification of FILE on the remote
;; host, and on success return a Scsh date record. This command is
;; not part of RFC959 and is not implemented by all servers, but
;; is useful for mirroring.
;;
;; (ftp:size connection file) -> integer
;; (ftp-size connection file) -> integer
;; Return the size of FILE in bytes.
;;
;; (ftp:abort connection) -> status
;; (ftp-abort connection) -> status
;; Abort the current data transfer. Not particularly useful with
;; this implementation since the data transfer commands only
;; return once the transfer is complete.
;;
;; (ftp:quit connection) -> status
;; (ftp-quit connection) -> status
;; Close the connection to the remote host. The connection object
;; is useless after a quit command.
@ -199,7 +199,7 @@
;; beware, the log file contains password information!
;;: string [ x string x port] -> connection
(define (ftp:connect host . args)
(define (ftp-connect host . args)
(let-optionals* args ((logfile #f))
(let* ((LOG (and logfile
(open-output-file logfile
@ -217,12 +217,12 @@
(connection (make-ftp-connection hostname
sock
LOG "" "")))
(ftp:log connection
(ftp-log connection
(format #f "~%-- ~a: opened ftp connection to ~a"
(date->string (date)) ; doesn't seem to be buggy in v0.6
;"Dummy date" ; (format-time-zone) is buggy in v0.5.1
hostname))
(ftp:read-response connection "220") ; the initial welcome banner
(ftp-read-response connection "220") ; the initial welcome banner
connection)))
;; Send user information to the remote host. Args are optional login
@ -230,7 +230,7 @@
;; try to determine a login and password for the server. If not found we
;; default to login "anonymous" with password user@host.
;;: connection [ x string x password ] -> status
(define (ftp:login connection . args)
(define (ftp-login connection . args)
(let ((netrc-record (netrc:parse)))
(let-optionals* args
((login
@ -241,60 +241,60 @@
(ftp-connection:host-name connection))))
(set-ftp-connection:login connection login)
(set-ftp-connection:password connection password)
(ftp:send-command connection (format #f "USER ~a" login) "...") ; "331"
(ftp:send-command connection (format #f "PASS ~a" password) "2..")))) ; "230"
(ftp-send-command connection (format #f "USER ~a" login) "...") ; "331"
(ftp-send-command connection (format #f "PASS ~a" password) "2..")))) ; "230"
;; Type must be one of 'binary or 'text or 'ascii, or a string which will be
;; sent verbatim
;;: connection x symbol|string -> status
(define (ftp:type connection type)
(define (ftp-type connection type)
(let ((ttype (cond
((string? type) type)
((eq? type 'binary) "I")
((or (eq? type 'ascii)
(eq? type 'text)) "A")
(else
(call-error "type must be one of 'binary or 'text or 'ascii" ftp:type type)))))
(ftp:send-command connection (format #f "TYPE ~a" ttype))))
(call-error "type must be one of 'binary or 'text or 'ascii" ftp-type type)))))
(ftp-send-command connection (format #f "TYPE ~a" ttype))))
;;: connection x string x string -> status
(define (ftp:rename connection oldname newname)
(ftp:send-command connection (format #f "RNFR ~a" oldname) "35.")
(ftp:send-command connection (format #f "RNTO ~a" newname) "25."))
(define (ftp-rename connection oldname newname)
(ftp-send-command connection (format #f "RNFR ~a" oldname) "35.")
(ftp-send-command connection (format #f "RNTO ~a" newname) "25."))
;;: connection x string -> status
(define (ftp:delete connection file)
(ftp:send-command connection (format #f "DELE ~a" file) "25."))
(define (ftp-delete connection file)
(ftp-send-command connection (format #f "DELE ~a" file) "25."))
;;: connection x string -> status
(define (ftp:cd connection dir)
(ftp:send-command connection (format #f "CWD ~a" dir)))
(define (ftp-cd connection dir)
(ftp-send-command connection (format #f "CWD ~a" dir)))
;;: connection -> status
(define (ftp:cdup connection)
(ftp:send-command connection "CDUP" "250"))
(define (ftp-cdup connection)
(ftp-send-command connection "CDUP" "250"))
;;: on success return the new directory as a string
(define (ftp:pwd connection)
(let* ((response (ftp:send-command connection "PWD" "2..")) ;; 257
(define (ftp-pwd connection)
(let* ((response (ftp-send-command connection "PWD" "2..")) ;; 257
(match (string-match "[0-9][0-9][0-9] \"(.*)\" " (or response ""))))
(match:substring match 1)))
;;: connection x string -> status
(define (ftp:rmdir connection dir)
(ftp:send-command connection (format #f "RMD ~a" dir)))
(define (ftp-rmdir connection dir)
(ftp-send-command connection (format #f "RMD ~a" dir)))
;;: connection x string -> status
(define (ftp:mkdir connection dir)
(ftp:send-command connection (format #f "MKD ~a" dir)))
(define (ftp-mkdir connection dir)
(ftp-send-command connection (format #f "MKD ~a" dir)))
;; On success return a Scsh date record. This message is not part of
;; rfc959 but seems to be supported by many ftp servers (it's useful
;; for mirroring)
;;: connection x string -> date
(define (ftp:modification-time connection file)
(let* ((response (ftp:send-command connection
(define (ftp-modification-time connection file)
(let* ((response (ftp-send-command connection
(format #f "MDTM ~a" file)))
(match (string-match "[0-9][0-9][0-9] ([0-9]+)" (or response "")))
(timestr (and match (match:substring match 1))))
@ -314,8 +314,8 @@
;; On success return the size of the file in bytes.
;;: connection x string -> integer
(define (ftp:size connection file)
(let* ((response (ftp:send-command connection
(define (ftp-size connection file)
(let* ((response (ftp-send-command connection
(format #f "SIZE ~a" file)
"2..")))
(and (string? response)
@ -325,12 +325,12 @@
;; Abort the current data transfer. Maybe we should close the data
;; socket?
;;: connection -> status
(define (ftp:abort connection)
(ftp:send-command connection "ABOR"))
(define (ftp-abort connection)
(ftp-send-command connection "ABOR"))
;;: connection -> status
(define (ftp:quit connection)
(ftp:send-command connection "QUIT" "221")
(define (ftp-quit connection)
(ftp-send-command connection "QUIT" "221")
(close-socket (ftp-connection:command-socket connection)))
@ -351,30 +351,30 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;: connection [ x string ] -> status
(define (ftp:ls connection . maybe-dir)
(let* ((sock (ftp:open-data-connection connection)))
(ftp:send-command connection
(ftp:build-command-string "NLST" maybe-dir)
(define (ftp-ls connection . maybe-dir)
(let* ((sock (ftp-open-data-connection connection)))
(ftp-send-command connection
(ftp-build-command-string "NLST" maybe-dir)
"1..")
(receive (newsock newsockaddr)
(accept-connection sock)
(dump (socket:inport newsock))
(close-socket newsock)
(close-socket sock)
(ftp:read-response connection "2.."))))
(ftp-read-response connection "2.."))))
;;: connection [ x string ] -> status
(define (ftp:dir connection . maybe-dir)
(let* ((sock (ftp:open-data-connection connection)))
(ftp:send-command connection
(ftp:build-command-string "LIST" maybe-dir)
(define (ftp-dir connection . maybe-dir)
(let* ((sock (ftp-open-data-connection connection)))
(ftp-send-command connection
(ftp-build-command-string "LIST" maybe-dir)
"1..")
(receive (newsock newsockaddr)
(accept-connection sock)
(dump (socket:inport newsock))
(close-socket newsock)
(close-socket sock)
(ftp:read-response connection "2.."))))
(ftp-read-response connection "2.."))))
;; maybe-local may be a filename to which the data should be written,
@ -383,8 +383,8 @@
;; or nothing to output to a local file with the same name as the
;; remote file.
;;: connection x string [x string | #t | #f] -> status | string
(define (ftp:get connection remote-file . maybe-local)
(let* ((sock (ftp:open-data-connection connection))
(define (ftp-get connection remote-file . maybe-local)
(let* ((sock (ftp-open-data-connection connection))
(local (if (pair? maybe-local)
(car maybe-local)
'empty))
@ -393,7 +393,7 @@
((eq? local #f) (make-string-output-port))
(else
(open-output-file remote-file)))))
(ftp:send-command connection
(ftp-send-command connection
(format #f "RETR ~a" remote-file)
"150")
(receive (newsock newsockaddr)
@ -402,7 +402,7 @@
(dump (socket:inport newsock)))
(close-socket newsock)
(close-socket sock)
(let ((status (ftp:read-response connection "2..")))
(let ((status (ftp-read-response connection "2..")))
(if (string? local) (close OUT))
(if (eq? local #f)
(string-output-port-output OUT)
@ -419,36 +419,36 @@
;; the file to appear on the remote machine. If omitted the file takes
;; the same name on the FTP server as on the local host.
;;: connection x string [ x string ] -> status
(define (ftp:put connection local-file . maybe-remote-file)
(define (ftp-put connection local-file . maybe-remote-file)
(let-optionals* maybe-remote-file ((remote-file #f))
(let* ((sock (ftp:open-data-connection connection))
(let* ((sock (ftp-open-data-connection connection))
(IN (open-input-file local-file))
(cmd (format #f "STOR ~a" (or remote-file local-file))))
(ftp:send-command connection cmd "150")
(ftp-send-command connection cmd "150")
(receive (newsock newsockaddr)
(accept-connection sock)
(with-current-output-port (socket:outport newsock) (dump IN))
(close (socket:outport newsock)) ; send the server EOF
(close-socket newsock)
(let ((status (ftp:read-response connection "2..")))
(let ((status (ftp-read-response connection "2..")))
(close IN)
(close-socket sock)
status)))))
;;: connection x string [x string] -> status
(define (ftp:append connection local-file . maybe-remote-file)
(define (ftp-append connection local-file . maybe-remote-file)
(let-optionals* maybe-remote-file ((remote-file #f))
(let* ((sock (ftp:open-data-connection connection))
(let* ((sock (ftp-open-data-connection connection))
(IN (open-input-file local-file))
(cmd (format #f "APPE ~a" (or remote-file local-file))))
(ftp:send-command connection cmd "150")
(ftp-send-command connection cmd "150")
(receive (newsock newsockaddr)
(accept-connection sock)
(with-current-output-port (socket:outport newsock)
(dump IN))
(close (socket:outport newsock)) ; send the server EOF
(close-socket newsock)
(let ((status (ftp:read-response connection "2..")))
(let ((status (ftp-read-response connection "2..")))
(close IN)
(close-socket sock)
status)))))
@ -456,14 +456,14 @@
;; send a command verbatim to the remote server and wait for a
;; response.
;;: connection x string -> status
(define (ftp:quot connection cmd)
(ftp:send-command connection cmd))
(define (ftp-quot connection cmd)
(ftp-send-command connection cmd))
;; ------------------------------------------------------------------------
;; no exported procedures below
(define (ftp:open-data-connection connection)
(define (ftp-open-data-connection connection)
(let* ((sock (create-socket protocol-family/internet
socket-type/stream))
(sockaddr (internet-address->socket-address
@ -473,8 +473,8 @@
(set-socket-option sock level/socket socket/linger 120)
(bind-socket sock sockaddr)
(listen-socket sock 0)
(ftp:send-command connection ; send PORT command
(ftp:build-PORT-string (socket-local-address sock)))
(ftp-send-command connection ; send PORT command
(ftp-build-PORT-string (socket-local-address sock)))
sock))
@ -496,11 +496,11 @@
login
password)
(define-condition-type 'ftp:error '(error))
(define ftp:error? (condition-predicate 'ftp:error))
(define-condition-type 'ftp-error '(error))
(define ftp-error? (condition-predicate 'ftp-error))
(define (ftp:build-PORT-string sockaddr)
(define (ftp-build-PORT-string sockaddr)
(let* ((hst-info (host-info (system-name)))
(ip-address (car (host-info:addresses hst-info))))
(receive (hst-address srvc-port)
@ -520,14 +520,14 @@
)))))
(define (ftp:send-command connection command . maybe-expected)
(define (ftp-send-command connection command . maybe-expected)
(let-optionals* maybe-expected ((expected "2.."))
(let* ((sock (ftp-connection:command-socket connection))
(OUT (socket:outport sock)))
(write-string command OUT)
(write-crlf OUT)
(ftp:log connection (format #f "<- ~a" command))
(ftp:read-response connection expected))))
(ftp-log connection (format #f "<- ~a" command))
(ftp-read-response connection expected))))
;; This is where we check that the server's 3 digit status code
@ -535,37 +535,37 @@
;; "250", which indicates we are expecting a 250 code from the server,
;; or "2.." which means that we only require the first digit to be 2
;; and don't care about the rest. If the server's response doesn't
;; match EXPECTED, we raise an ftp:error (which is catchable; look at
;; match EXPECTED, we raise an ftp-error (which is catchable; look at
;; pop3.scm to see how). Since this is implemented as a regexp, you
;; can also specify more complicated acceptable responses of the form
;; "2[4-6][0-9]". The code permits you to match the server's verbose
;; message too, but beware that the messages change from server to
;; server.
(define (ftp:read-response connection . maybe-expected)
(define (ftp-read-response connection . maybe-expected)
(let-optionals* maybe-expected ((expected "2.."))
(let* ((sock (ftp-connection:command-socket connection))
(IN (socket:inport sock))
(response (read-line IN)))
(ftp:log connection (format #f "-> ~a" response))
(ftp-log connection (format #f "-> ~a" response))
(or (string-match expected response)
(signal 'ftp:error response))
(signal 'ftp-error response))
;; handle multi-line responses
(if (equal? (string-ref response 3) #\-)
(let loop ((code (string-append (substring response 0 3) " "))
(line (read-line IN)))
(ftp:log connection (format #f "-> ~a" line))
(ftp-log connection (format #f "-> ~a" line))
(set! response (string-join (list response line "\n")))
(or (string-match code line)
(loop code (read-line IN)))))
response)))
(define (ftp:build-command-string str . opt-args)
(define (ftp-build-command-string str . opt-args)
(if (string? opt-args)
(string-join (list str arg))
str))
(define (ftp:log connection line)
(define (ftp-log connection line)
(let ((LOG (ftp-connection:logfd connection)))
(and LOG
(write-string line LOG)

42
modules.scm
View File

@ -582,7 +582,7 @@
;; ftp.scm is a module for transfering files between networked
;; machines using the File Transfer Protocol
(define-interface ftp-interface
(define-interface ftp-obsolete-interface
(export ftp:connect
ftp:login
ftp:type
@ -604,6 +604,45 @@
ftp:append
ftp:quot))
(define-structure ftp-obsolete ftp-obsolete-interface
(open netrc
scsh
defrec-package
receiving
handle
conditions
signals
error-package
ecm-utilities
string-lib
let-opt
ftp
scheme)
(files ftp-obsolete))
(define-interface ftp-interface
(export ftp-connect
ftp-login
ftp-type
ftp-rename
ftp-delete
ftp-cd
ftp-cdup
ftp-pwd
ftp-rmdir
ftp-mkdir
ftp-modification-time
ftp-size
ftp-abort
ftp-quit
ftp-ls
ftp-dir
ftp-get
ftp-put
ftp-append
ftp-quot
ftp-error?))
(define-structure ftp ftp-interface
(open netrc
scsh
@ -619,7 +658,6 @@
scheme)
(files ftp))
;; pop3.scm is a module for accessing email on a maildrop server,
;; using the POP3 protocol.
(define-interface pop3-interface