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)")
(register-reply! 200 "Done nothing, but successfully."))
(define *port-arg-regexp*
(make-regexp "^([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)$"))
(define (parse-port-arg string)
(log (syslog-level debug) "parsing port-string ~S" 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)
(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 (ftpd-parse-port-arg stuff)
(with-fatal-error-handler*
(lambda (condition more)
(log (syslog-level debug) "reporting syntax error in argument (500)")
(signal-error! 500
"Syntax error in argument to PORT."))
(lambda ()
(parse-port-arg stuff))))
(define (handle-port stuff)
(log-command (syslog-level info) "PORT" stuff)
(ensure-authenticated-login)
(maybe-close-data-connection)
(call-with-values
(lambda () (parse-port-arg stuff))
(lambda () (ftpd-parse-port-arg stuff))
(lambda (address port)
(let ((socket (create-socket protocol-family/internet
socket-type/stream)))
@ -1208,6 +1177,8 @@
thunk
maybe-close-data-connection))
(define *window-size* 4096)
(define (ensure-data-connection)
(if (and (not (the-session-data-socket))
(not (the-session-passive-socket)))

View File

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