Factor PARSE-PORT-ARG out of FTPD into FTP-LIBRARY (in preparation of

passive mode support in FTP).
This commit is contained in:
sperber 2003-01-16 13:09:14 +00:00
parent df9cd86232
commit ec42abd6db
3 changed files with 47 additions and 44 deletions

View File

@ -880,52 +880,21 @@
(log (syslog-level debug) "successfully done nothing (200)") (log (syslog-level debug) "successfully done nothing (200)")
(register-reply! 200 "Done nothing, but successfully.")) (register-reply! 200 "Done nothing, but successfully."))
(define *port-arg-regexp* (define (ftpd-parse-port-arg stuff)
(make-regexp "^([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)$")) (with-fatal-error-handler*
(lambda (condition more)
(define (parse-port-arg string) (log (syslog-level debug) "reporting syntax error in argument (500)")
(log (syslog-level debug) "parsing port-string ~S" string) (signal-error! 500
(cond "Syntax error in argument to PORT."))
((regexp-exec *port-arg-regexp* string) (lambda ()
=> (lambda (match) (parse-port-arg stuff))))
(let ((components
(map (lambda (match-index)
(string->number
(match:substring match match-index)))
'(1 2 3 4 5 6))))
(if (any (lambda (component)
(> component 255))
components)
(begin
(log (syslog-level debug)
"rejecting PORT-command because of invalid arguments (port-component > 255) (501)")
(signal-error! 501
"Invalid arguments to PORT.")))
(apply
(lambda (a1 a2 a3 a4 p1 p2)
(let ((address (+ (arithmetic-shift a1 24)
(arithmetic-shift a2 16)
(arithmetic-shift a3 8)
a4))
(port (+ (arithmetic-shift p1 8) p2)))
(log (syslog-level debug)
"port-parse result: address ~D, port ~D (from compononets: address: ~A, ~A, ~A, ~A, port: ~A, ~A)"
address port
a1 a2 a3 a4 p1 p2)
(values address port)))
components))))
(else
(log (syslog-level debug) "reporting syntax error in argument (500)")
(signal-error! 500
"Syntax error in argument to PORT."))))
(define (handle-port stuff) (define (handle-port stuff)
(log-command (syslog-level info) "PORT" stuff) (log-command (syslog-level info) "PORT" stuff)
(ensure-authenticated-login) (ensure-authenticated-login)
(maybe-close-data-connection) (maybe-close-data-connection)
(call-with-values (call-with-values
(lambda () (parse-port-arg stuff)) (lambda () (ftpd-parse-port-arg stuff))
(lambda (address port) (lambda (address port)
(let ((socket (create-socket protocol-family/internet (let ((socket (create-socket protocol-family/internet
socket-type/stream))) socket-type/stream)))
@ -1207,7 +1176,9 @@
(dynamic-wind ensure-data-connection (dynamic-wind ensure-data-connection
thunk thunk
maybe-close-data-connection)) maybe-close-data-connection))
(define *window-size* 4096)
(define (ensure-data-connection) (define (ensure-data-connection)
(if (and (not (the-session-data-socket)) (if (and (not (the-session-data-socket))
(not (the-session-passive-socket))) (not (the-session-passive-socket)))

View File

@ -44,4 +44,33 @@
(write-string line output-port 0 length) (write-string line output-port 0 length)
(newline output-port) (newline output-port)
(loop))))) (loop)))))
(force-output output-port)) (force-output output-port))
(define *port-arg-regexp*
(make-regexp "^([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)$"))
(define (parse-port-arg string)
(cond
((regexp-exec *port-arg-regexp* string)
=> (lambda (match)
(let ((components
(map (lambda (match-index)
(string->number
(match:substring match match-index)))
'(1 2 3 4 5 6))))
(if (any (lambda (component)
(> component 255))
components)
(call-error "invalid PORT argument" parse-port-arg))
(apply
(lambda (a1 a2 a3 a4 p1 p2)
(let ((address (+ (arithmetic-shift a1 24)
(arithmetic-shift a2 16)
(arithmetic-shift a3 8)
a4))
(port (+ (arithmetic-shift p1 8) p2)))
(values address port)))
components))))
(else
(call-error "invalid PORT argument" parse-port-arg))))

View File

@ -86,7 +86,8 @@
(define-interface ftp-library-interface (define-interface ftp-library-interface
(export copy-port->port-binary (export copy-port->port-binary
copy-port->port-ascii copy-port->port-ascii
copy-ascii-port->port)) copy-ascii-port->port
parse-port-arg))
(define-interface ftp-interface (define-interface ftp-interface
(export ftp-connect (export ftp-connect
@ -408,6 +409,8 @@
(define-structure ftp-library ftp-library-interface (define-structure ftp-library ftp-library-interface
(open scheme-with-scsh (open scheme-with-scsh
(subset signals (call-error))
(subset srfi-1 (any))
crlf-io) crlf-io)
(files (lib ftp-library))) (files (lib ftp-library)))
@ -532,7 +535,7 @@
fluids thread-fluids fluids thread-fluids
locks locks
(subset srfi-13 (string-map string-trim-both string-index)) (subset srfi-13 (string-map string-trim-both string-index))
(subset srfi-1 (any partition)) (subset srfi-1 (partition))
crlf-io crlf-io
ls ls
ftp-library ftp-library