From 2ebb8d0e0fd88dd880ca2ec0a39533b2a5d6e0ed Mon Sep 17 00:00:00 2001 From: sperber Date: Thu, 16 Jan 2003 12:45:55 +0000 Subject: [PATCH] Replace remaining uses of FORMAT. --- scheme/lib/ftp.scm | 56 +++++++++++++++++++++++----------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/scheme/lib/ftp.scm b/scheme/lib/ftp.scm index 1032536..048605d 100644 --- a/scheme/lib/ftp.scm +++ b/scheme/lib/ftp.scm @@ -49,10 +49,6 @@ ;; * Unix-specific commands such as SITE UMASK, SITE CHMOD ;; * object-based interface? (like SICP message passing) ;; * improved error handling -;; * a lot of the calls to format could be replaced by calls to -;; string-join. Maybe format is easier to read? - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Communication is initiated by the client. The server responds to @@ -110,9 +106,10 @@ passive? log))) (ftp-log connection - (format #f "~%-- ~a: opened ftp connection to ~a" - (date->string (date)) - hostname)) + (string-append "-- " + (date->string (date)) + ": opened ftp connection to " + hostname)) (ftp-read-reply connection (exactly-code "220")) ; the initial welcome banner (ftp-login connection login password) connection))) @@ -134,14 +131,14 @@ (netrc-lookup-login (get-netrc-record) (ftp-connection-host-name connection))))) (let ((reply - (ftp-send-command connection (ftp-build-command-string "USER" login) + (ftp-send-command connection (build-command "USER" login) (lambda (code) (or (string=? code "331") ; "User name okay, need password." (string=? code "230")))))) ; "User logged in, proceed." (if (string-prefix? "331" reply) ; "User name okay, need password." (ftp-send-command connection - (ftp-build-command-string + (build-command "PASS" (or password (netrc-lookup-password (get-netrc-record) @@ -151,7 +148,7 @@ ;; 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) (let ((ttype (cond ((string? type) type) @@ -161,20 +158,23 @@ (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)))) + (ftp-send-command connection (build-command "TYPE" ttype)))) ;;: connection x string x string -> status (define (ftp-rename connection oldname newname) - (ftp-send-command connection (format #f "RNFR ~a" oldname) (code-with-prefix "35")) - (ftp-send-command connection (format #f "RNTO ~a" newname) (code-with-prefix "25"))) + (ftp-send-command connection (build-command "RNFR " oldname) + (code-with-prefix "35")) + (ftp-send-command connection (build-command "RNTO" newname) + (code-with-prefix "25"))) ;;: connection x string -> status (define (ftp-delete connection file) - (ftp-send-command connection (format #f "DELE ~a" file) (code-with-prefix "25"))) + (ftp-send-command connection (build-command "DELE" file) + (code-with-prefix "25"))) ;;: connection x string -> status (define (ftp-cd connection dir) - (ftp-send-command connection (format #f "CWD ~a" dir))) + (ftp-send-command connection (build-command "CWD" dir))) ;;: connection -> status (define (ftp-cdup connection) @@ -193,11 +193,11 @@ ;;: connection x string -> status (define (ftp-rmdir connection dir) - (ftp-send-command connection (format #f "RMD ~a" dir))) + (ftp-send-command connection (build-command "RMD " dir))) ;;: connection x string -> status (define (ftp-mkdir connection dir) - (ftp-send-command connection (format #f "MKD ~a" dir))) + (ftp-send-command connection (build-command "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 @@ -205,7 +205,7 @@ ;;: connection x string -> date (define (ftp-modification-time connection file) (let* ((reply (ftp-send-command connection - (format #f "MDTM ~a" file))) + (build-command "MDTM" file))) (timestr (substring reply 4 (string-length reply)))) (let ((year (substring timestr 0 4)) (month (substring timestr 4 6)) @@ -224,7 +224,7 @@ ;;: connection x string -> integer (define (ftp-size connection file) (let* ((reply (ftp-send-command connection - (format #f "SIZE ~a" file)))) + (build-command "SIZE" file)))) (string->number (substring reply 4 (string-length reply))))) @@ -260,7 +260,7 @@ (define (ftp-ls connection . maybe-dir) (let* ((sock (ftp-open-data-connection connection))) (ftp-send-command connection - (apply ftp-build-command-string "NLST" maybe-dir) + (apply build-command "NLST" maybe-dir) (code-with-prefix "1")) (receive (newsock newsockaddr) (accept-connection sock) @@ -274,7 +274,7 @@ (define (ftp-dir connection . maybe-dir) (let* ((sock (ftp-open-data-connection connection))) (ftp-send-command connection - (apply ftp-build-command-string "LIST" maybe-dir) + (apply build-command "LIST" maybe-dir) (code-with-prefix "1")) (receive (newsock newsockaddr) (accept-connection sock) @@ -294,7 +294,7 @@ (define (ftp-get connection remote-file act) (let* ((sock (ftp-open-data-connection connection))) (ftp-send-command connection - (ftp-build-command-string "RETR" remote-file) + (build-command "RETR" remote-file) (exactly-code "150")) (receive (newsock newsockaddr) (accept-connection sock) @@ -311,7 +311,7 @@ (define (ftp-put connection remote-file act) (let ((sock (ftp-open-data-connection connection))) - (ftp-send-command connection (ftp-build-command-string "STOR" remote-file) + (ftp-send-command connection (build-command "STOR" remote-file) (exactly-code "150")) (receive (newsock newsockaddr) (accept-connection sock) @@ -321,7 +321,7 @@ (define (ftp-append connection remote-file act) (let ((sock (ftp-open-data-connection connection))) - (ftp-send-command connection (ftp-build-command-string "APPE" remote-file) + (ftp-send-command connection (build-command "APPE" remote-file) (exactly-code "150")) (receive (newsock newsockaddr) (accept-connection sock) @@ -392,7 +392,7 @@ (out (socket:outport sock))) (write-string command out) (write-crlf out) - (ftp-log connection (format #f "<- ~a" command)) + (ftp-log connection (string-append "<- " command)) (apply ftp-read-reply connection maybe-expected))) (define any-code (lambda (code) #t)) @@ -415,7 +415,7 @@ (in (socket:inport sock)) (reply (read-crlf-line in)) (code (substring reply 0 3))) - (ftp-log connection (format #f "-> ~a" reply)) + (ftp-log connection (string-append "-> " reply)) (if (not (expected? code)) (signal 'ftp-error reply)) ;; handle multi-line replies @@ -424,13 +424,13 @@ (let loop () (let* ((line (read-crlf-line in)) (reply (string-join (list reply line "\n")))) - (ftp-log connection (format #f "-> ~a" line)) + (ftp-log connection (string-append "-> " line)) (if (string-prefix? end-prefix line) reply (loop))))) reply)))) -(define (ftp-build-command-string str . opt-args) +(define (build-command str . opt-args) (string-join (cons str opt-args))) (define (ftp-log connection line)