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

Optional separator for FORMAT-INTERNET-HOST-ADRESS (which had been 

ripped out at some point).
This commit is contained in:
sperber 2001-06-20 13:25:41 +00:00
parent 10567fd22e
commit 7b285f1fd3
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
ftpd.scm
View File

@ -499,22 +499,24 @@
(format-internet-host-address host-address ",") (format-internet-host-address host-address ",")
(format-port port)))))))) (format-port port))))))))
; This doesn't look right. But I can't look into the socket of the ;; This doesn't look right. But I can't look into the socket of the
; control connection if we're running under inetd---there's no way to ;; control connection if we're running under inetd---there's no way to
; coerce a port to a socket as there is in C. ;; coerce a port to a socket as there is in C.
(define (this-host-address) (define (this-host-address)
(car (host-info:addresses (host-info (system-name))))) (car (host-info:addresses (host-info (system-name)))))
(define (format-internet-host-address address) (define (format-internet-host-address address . maybe-separator)
(define (extract shift) (define (extract shift)
(number->string (number->string
(bitwise-and (arithmetic-shift address (- shift)) (bitwise-and (arithmetic-shift address (- shift))
255))) 255)))
(string-append (let ((separator (optional maybe-separator ".")))
(extract 24) "." (extract 16) "." (extract 8) "." (extract 0))) (string-append
(extract 24) separator (extract 16) separator
(extract 8) separator (extract 0))))
(define (format-port port) (define (format-port port)
(string-append (string-append
@ -808,7 +810,7 @@
; Version ; Version
(define *ftpd-version* "$Revision: 1.13 $") (define *ftpd-version* "$Revision: 1.14 $")
(define (copy-port->port-binary input-port output-port) (define (copy-port->port-binary input-port output-port)
(let ((buffer (make-string *window-size*))) (let ((buffer (make-string *window-size*)))