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

Rewrite FTP-BUILD-PORT-STRING in terms of FORMAT-INTERNET-HOST-ADDRESS 

and FORMAT-PORT.
This commit is contained in:
sperber 2003-01-16 09:23:05 +00:00
parent 30f6f2a0a6
commit 045ded0d30
2 changed files with 7 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
scheme/lib/ftp.scm
View File

@ -392,22 +392,12 @@
(define (ftp-build-PORT-string sockaddr) (define (ftp-build-PORT-string sockaddr)
(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) (string-append "PORT "
(num24 (arithmetic-shift num32 -8)) (format-internet-host-address ip-address ",")
(num16 (arithmetic-shift num24 -8)) ","
(num08 (arithmetic-shift num16 -8)) (format-port srvc-port)))))
(byte0 (bitwise-and #b11111111 num08))
(byte1 (bitwise-and #b11111111 num16))
(byte2 (bitwise-and #b11111111 num24))
(byte3 (bitwise-and #b11111111 num32)))
(format #f "PORT ~a,~a,~a,~a,~a,~a"
byte0 byte1 byte2 byte3
(arithmetic-shift srvc-port -8) ; high 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)
(let-optionals* maybe-expected ((expected "2..")) (let-optionals* maybe-expected ((expected "2.."))

1
scheme/packages.scm
View File

@ -412,6 +412,7 @@
(subset srfi-13 (string-join)) (subset srfi-13 (string-join))
let-opt let-opt
sunet-utilities sunet-utilities
format-net
crlf-io) crlf-io)
(files (lib ftp))) (files (lib ftp)))