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

Reanem "response" -> "reply" in accordance with RFC 959.

This commit is contained in:
sperber 2003-01-16 09:16:29 +00:00
parent a138b994ba
commit 30f6f2a0a6
1 changed files with 31 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
scheme/lib/ftp.scm
View File

@ -108,7 +108,7 @@
(format #f "~%-- ~a: opened ftp connection to ~a" (format #f "~%-- ~a: opened ftp connection to ~a"
(date->string (date)) (date->string (date))
hostname)) hostname))
(ftp-read-response connection "220") ; the initial welcome banner (ftp-read-reply connection "220") ; the initial welcome banner
connection))) connection)))
;; Send user information to the remote host. Args are optional login ;; Send user information to the remote host. Args are optional login
@ -164,8 +164,8 @@
;;: on success return the new directory as a string ;;: on success return the new directory as a string
(define (ftp-pwd connection) (define (ftp-pwd connection)
(let* ((response (ftp-send-command connection "PWD" "2..")) ;; 257 (let* ((reply (ftp-send-command connection "PWD" "2..")) ; 257
(match (string-match "[0-9][0-9][0-9] \"(.*)\" " (or response "")))) (match (string-match "[0-9][0-9][0-9] \"(.*)\" " (or reply ""))))
(match:substring match 1))) (match:substring match 1)))
;;: connection x string -> status ;;: connection x string -> status
@ -181,9 +181,9 @@
;; for mirroring) ;; for mirroring)
;;: connection x string -> date ;;: connection x string -> date
(define (ftp-modification-time connection file) (define (ftp-modification-time connection file)
(let* ((response (ftp-send-command connection (let* ((reply (ftp-send-command connection
(format #f "MDTM ~a" file))) (format #f "MDTM ~a" file)))
(match (string-match "[0-9][0-9][0-9] ([0-9]+)" (or response ""))) (match (string-match "[0-9][0-9][0-9] ([0-9]+)" (or reply "")))
(timestr (and match (match:substring match 1)))) (timestr (and match (match:substring match 1))))
(and timestr (and timestr
(let ((year (substring timestr 0 4)) (let ((year (substring timestr 0 4))
@ -202,12 +202,12 @@
;; On success return the size of the file in bytes. ;; On success return the size of the file in bytes.
;;: connection x string -> integer ;;: connection x string -> integer
(define (ftp-size connection file) (define (ftp-size connection file)
(let* ((response (ftp-send-command connection (let* ((reply (ftp-send-command connection
(format #f "SIZE ~a" file) (format #f "SIZE ~a" file)
"2.."))) "2..")))
(and (string? response) (and (string? reply)
(string->number (substring response (string->number (substring reply
4 (- (string-length response) 1)))))) 4 (- (string-length reply) 1))))))
;; Abort the current data transfer. Maybe we should close the data ;; Abort the current data transfer. Maybe we should close the data
;; socket? ;; socket?
@ -248,7 +248,7 @@
(dump (socket:inport newsock)) (dump (socket:inport newsock))
(close-socket newsock) (close-socket newsock)
(close-socket sock) (close-socket sock)
(ftp-read-response connection "2..")))) (ftp-read-reply connection "2.."))))
;;: connection [ x string ] -> status ;;: connection [ x string ] -> status
(define (ftp-dir connection . maybe-dir) (define (ftp-dir connection . maybe-dir)
@ -261,7 +261,7 @@
(dump (socket:inport newsock)) (dump (socket:inport newsock))
(close-socket newsock) (close-socket newsock)
(close-socket sock) (close-socket sock)
(ftp-read-response connection "2..")))) (ftp-read-reply connection "2.."))))
;; maybe-local may be a filename to which the data should be written, ;; maybe-local may be a filename to which the data should be written,
@ -289,7 +289,7 @@
(dump (socket:inport newsock))) (dump (socket:inport newsock)))
(close-socket newsock) (close-socket newsock)
(close-socket sock) (close-socket sock)
(let ((status (ftp-read-response connection "2.."))) (let ((status (ftp-read-reply connection "2..")))
(if (string? local) (close OUT)) (if (string? local) (close OUT))
(if (eq? local #f) (if (eq? local #f)
(string-output-port-output OUT) (string-output-port-output OUT)
@ -317,7 +317,7 @@
(with-current-output-port (socket:outport newsock) (dump IN)) (with-current-output-port (socket:outport newsock) (dump IN))
(close (socket:outport newsock)) ; send the server EOF (close (socket:outport newsock)) ; send the server EOF
(close-socket newsock) (close-socket newsock)
(let ((status (ftp-read-response connection "2.."))) (let ((status (ftp-read-reply connection "2..")))
(close IN) (close IN)
(close-socket sock) (close-socket sock)
status))))) status)))))
@ -335,13 +335,13 @@
(dump IN)) (dump IN))
(close (socket:outport newsock)) ; send the server EOF (close (socket:outport newsock)) ; send the server EOF
(close-socket newsock) (close-socket newsock)
(let ((status (ftp-read-response connection "2.."))) (let ((status (ftp-read-reply connection "2..")))
(close IN) (close IN)
(close-socket sock) (close-socket sock)
status))))) status)))))
;; send a command verbatim to the remote server and wait for a ;; send a command verbatim to the remote server and wait for a
;; response. ;; reply.
;;: connection x string -> status ;;: connection x string -> status
(define (ftp-quot connection cmd) (define (ftp-quot connection cmd)
(ftp-send-command connection cmd)) (ftp-send-command connection cmd))
@ -416,37 +416,37 @@
(write-string command OUT) (write-string command OUT)
(write-crlf OUT) (write-crlf OUT)
(ftp-log connection (format #f "<- ~a" command)) (ftp-log connection (format #f "<- ~a" command))
(ftp-read-response connection expected)))) (ftp-read-reply connection expected))))
;; This is where we check that the server's 3 digit status code ;; This is where we check that the server's 3 digit status code
;; corresponds to what we expected. EXPECTED is a string of the form ;; corresponds to what we expected. EXPECTED is a string of the form
;; "250", which indicates we are expecting a 250 code from the server, ;; "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 ;; 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 ;; and don't care about the rest. If the server's reply 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 ;; pop3.scm to see how). Since this is implemented as a regexp, you
;; can also specify more complicated acceptable responses of the form ;; can also specify more complicated acceptable replies of the form
;; "2[4-6][0-9]". The code permits you to match the server's verbose ;; "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 ;; message too, but beware that the messages change from server to
;; server. ;; server.
(define (ftp-read-response connection . maybe-expected) (define (ftp-read-reply connection . maybe-expected)
(let-optionals* maybe-expected ((expected "2..")) (let-optionals* maybe-expected ((expected "2.."))
(let* ((sock (ftp-connection-command-socket connection)) (let* ((sock (ftp-connection-command-socket connection))
(IN (socket:inport sock)) (IN (socket:inport sock))
(response (read-crlf-line IN))) (reply (read-crlf-line IN)))
(ftp-log connection (format #f "-> ~a" response)) (ftp-log connection (format #f "-> ~a" reply))
(or (string-match expected response) (or (string-match expected reply)
(signal 'ftp-error response)) (signal 'ftp-error reply))
;; handle multi-line responses ;; handle multi-line replies
(if (equal? (string-ref response 3) #\-) (if (equal? (string-ref reply 3) #\-)
(let loop ((code (string-append (substring response 0 3) " ")) (let loop ((code (string-append (substring reply 0 3) " "))
(line (read-crlf-line IN))) (line (read-crlf-line IN)))
(ftp-log connection (format #f "-> ~a" line)) (ftp-log connection (format #f "-> ~a" line))
(set! response (string-join (list response line "\n"))) (set! reply (string-join (list reply line "\n")))
(or (string-match code line) (or (string-match code line)
(loop code (read-crlf-line IN))))) (loop code (read-crlf-line IN)))))
response))) reply)))
(define (ftp-build-command-string str . opt-args) (define (ftp-build-command-string str . opt-args)