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

Fix some mis-indentations of RECEIVE.

This commit is contained in:
sperber 2003-01-15 15:40:33 +00:00
parent f7ca3d5393
commit fcbc62f29e
1 changed files with 52 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
scheme/lib/ftp.scm
View File

@ -244,11 +244,11 @@
(ftp-build-command-string "NLST" maybe-dir) (ftp-build-command-string "NLST" maybe-dir)
"1..") "1..")
(receive (newsock newsockaddr) (receive (newsock newsockaddr)
(accept-connection sock) (accept-connection sock)
(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-response connection "2.."))))
;;: connection [ x string ] -> status ;;: connection [ x string ] -> status
(define (ftp-dir connection . maybe-dir) (define (ftp-dir connection . maybe-dir)
@ -257,11 +257,11 @@
(ftp-build-command-string "LIST" maybe-dir) (ftp-build-command-string "LIST" maybe-dir)
"1..") "1..")
(receive (newsock newsockaddr) (receive (newsock newsockaddr)
(accept-connection sock) (accept-connection sock)
(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-response 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,
@ -284,16 +284,16 @@
(format #f "RETR ~a" remote-file) (format #f "RETR ~a" remote-file)
"150") "150")
(receive (newsock newsockaddr) (receive (newsock newsockaddr)
(accept-connection sock) (accept-connection sock)
(with-current-output-port OUT (with-current-output-port OUT
(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-response 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)
status))))) status)))))
;; FIXME: should have an optional argument :rename which defaults to ;; FIXME: should have an optional argument :rename which defaults to
@ -309,18 +309,18 @@
(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-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)) (IN (open-input-file local-file))
(cmd (format #f "STOR ~a" (or remote-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) (receive (newsock newsockaddr)
(accept-connection sock) (accept-connection sock)
(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-response connection "2..")))
(close IN) (close IN)
(close-socket sock) (close-socket sock)
status))))) status)))))
;;: connection x string [x string] -> 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)
@ -330,15 +330,15 @@
(cmd (format #f "APPE ~a" (or remote-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) (receive (newsock newsockaddr)
(accept-connection sock) (accept-connection sock)
(with-current-output-port (socket:outport newsock) (with-current-output-port (socket:outport newsock)
(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-response 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. ;; response.
@ -393,20 +393,20 @@
(let* ((hst-info (host-info (system-name))) (let* ((hst-info (host-info (system-name)))
(ip-address (car (host-info:addresses hst-info)))) (ip-address (car (host-info:addresses hst-info))))
(receive (hst-address srvc-port) (receive (hst-address srvc-port)
(socket-address->internet-address sockaddr) (socket-address->internet-address sockaddr)
(let* ((num32 ip-address) (let* ((num32 ip-address)
(num24 (arithmetic-shift num32 -8)) (num24 (arithmetic-shift num32 -8))
(num16 (arithmetic-shift num24 -8)) (num16 (arithmetic-shift num24 -8))
(num08 (arithmetic-shift num16 -8)) (num08 (arithmetic-shift num16 -8))
(byte0 (bitwise-and #b11111111 num08)) (byte0 (bitwise-and #b11111111 num08))
(byte1 (bitwise-and #b11111111 num16)) (byte1 (bitwise-and #b11111111 num16))
(byte2 (bitwise-and #b11111111 num24)) (byte2 (bitwise-and #b11111111 num24))
(byte3 (bitwise-and #b11111111 num32))) (byte3 (bitwise-and #b11111111 num32)))
(format #f "PORT ~a,~a,~a,~a,~a,~a" (format #f "PORT ~a,~a,~a,~a,~a,~a"
byte0 byte1 byte2 byte3 byte0 byte1 byte2 byte3
(arithmetic-shift srvc-port -8) ; high order byte (arithmetic-shift srvc-port -8) ; high order byte
(bitwise-and #b11111111 srvc-port) ; lower order byte (bitwise-and #b11111111 srvc-port) ; lower order byte
))))) )))))
(define (ftp-send-command connection command . maybe-expected) (define (ftp-send-command connection command . maybe-expected)