* 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:
parent
2fccbe9b3e
commit
c5eeb471f8
|
@ -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
182
ftp.scm
|
@ -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
42
modules.scm
|
@ -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
|
||||
|
@ -618,7 +657,6 @@
|
|||
let-opt
|
||||
scheme)
|
||||
(files ftp))
|
||||
|
||||
|
||||
;; pop3.scm is a module for accessing email on a maildrop server,
|
||||
;; using the POP3 protocol.
|
||||
|
|
Loading…
Reference in New Issue