Pass home directory of the anonymous user explicitly.
Don't setgid and setuid no more. It's wrong and evil in a multithreaded environment.
This commit is contained in:
parent
9fd49a135d
commit
1247e7eed9
39
ftpd.scm
39
ftpd.scm
|
@ -14,6 +14,7 @@
|
|||
(define-record session
|
||||
control-input-port
|
||||
control-output-port
|
||||
anonymous-home
|
||||
(logged-in? #f)
|
||||
(authenticated? #f)
|
||||
(anonymous? #f)
|
||||
|
@ -38,6 +39,8 @@
|
|||
|
||||
(define session-control-input-port (make-fluid-selector session:control-input-port))
|
||||
(define session-control-output-port (make-fluid-selector session:control-output-port))
|
||||
|
||||
(define session-anonymous-home (make-fluid-selector session:anonymous-home))
|
||||
(define session-logged-in? (make-fluid-selector session:logged-in?))
|
||||
(define session-authenticated? (make-fluid-selector session:authenticated?))
|
||||
(define session-anonymous? (make-fluid-selector session:anonymous?))
|
||||
|
@ -66,7 +69,7 @@
|
|||
(define set-session-data-socket (make-fluid-setter set-session:data-socket))
|
||||
(define set-session-passive-socket (make-fluid-setter set-session:passive-socket))
|
||||
|
||||
(define (ftpd . maybe-port)
|
||||
(define (ftpd anonymous-home . maybe-port)
|
||||
(let ((port (optional maybe-port 21)))
|
||||
(bind-listen-accept-loop
|
||||
protocol-family/internet
|
||||
|
@ -77,7 +80,8 @@
|
|||
(spawn
|
||||
(lambda ()
|
||||
(handle-connection (socket:inport socket)
|
||||
(socket:outport socket))
|
||||
(socket:outport socket)
|
||||
(file-name-as-directory anonymous-home))
|
||||
(call-with-current-continuation
|
||||
(lambda (exit)
|
||||
(with-errno-handler*
|
||||
|
@ -93,9 +97,10 @@
|
|||
|
||||
port)))
|
||||
|
||||
(define (ftpd-inetd)
|
||||
(define (ftpd-inetd anonymous-home)
|
||||
(handle-connection (current-input-port)
|
||||
(current-output-port)))
|
||||
(current-output-port)
|
||||
(file-name-as-directory anonymous-home)))
|
||||
|
||||
(define (set-ftp-socket-options! socket)
|
||||
;; If the client closes the connection, we won't lose when we try to
|
||||
|
@ -105,7 +110,7 @@
|
|||
(set-socket-option socket level/socket socket/oob-inline #t))
|
||||
|
||||
|
||||
(define (handle-connection input-port output-port)
|
||||
(define (handle-connection input-port output-port anonymous-home)
|
||||
(call-with-current-continuation
|
||||
(lambda (escape)
|
||||
(with-handler
|
||||
|
@ -113,7 +118,8 @@
|
|||
(display condition (current-error-port))
|
||||
(escape 'fick-dich-ins-knie))
|
||||
(lambda ()
|
||||
(let-fluid session (make-session input-port output-port)
|
||||
(let-fluid session (make-session input-port output-port
|
||||
anonymous-home)
|
||||
(lambda ()
|
||||
(display-banner)
|
||||
(handle-commands))))))))
|
||||
|
@ -222,20 +228,13 @@
|
|||
"Only anonymous logins allowed."))))
|
||||
|
||||
(define (handle-user-anonymous)
|
||||
(let ((ftp-info (user-info "ftp")))
|
||||
(set-session-logged-in? #t)
|
||||
(set-session-authenticated? #t)
|
||||
(set-session-anonymous? #t)
|
||||
(set-session-root-directory (session-anonymous-home))
|
||||
(set-session-current-directory "")
|
||||
|
||||
(set-gid (user-info:gid ftp-info))
|
||||
(set-uid (user-info:uid ftp-info))
|
||||
|
||||
(set-session-logged-in? #t)
|
||||
(set-session-authenticated? #t)
|
||||
(set-session-anonymous? #t)
|
||||
(set-session-root-directory
|
||||
(file-name-as-directory
|
||||
(user-info:home-dir ftp-info)))
|
||||
(set-session-current-directory "")
|
||||
|
||||
(register-reply! 230 "Anonymous user logged in.")))
|
||||
(register-reply! 230 "Anonymous user logged in."))
|
||||
|
||||
(define (handle-pass password)
|
||||
(cond
|
||||
|
@ -809,7 +808,7 @@
|
|||
|
||||
; Version
|
||||
|
||||
(define *ftpd-version* "$Revision: 1.11 $")
|
||||
(define *ftpd-version* "$Revision: 1.12 $")
|
||||
|
||||
(define (copy-port->port-binary input-port output-port)
|
||||
(let ((buffer (make-string *window-size*)))
|
||||
|
|
Loading…
Reference in New Issue