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

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:
sperber 2001-06-20 09:21:37 +00:00
parent 9fd49a135d
commit 1247e7eed9
1 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
ftpd.scm
View File

@ -14,6 +14,7 @@
(define-record session (define-record session
control-input-port control-input-port
control-output-port control-output-port
anonymous-home
(logged-in? #f) (logged-in? #f)
(authenticated? #f) (authenticated? #f)
(anonymous? #f) (anonymous? #f)
@ -38,6 +39,8 @@
(define session-control-input-port (make-fluid-selector session:control-input-port)) (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-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-logged-in? (make-fluid-selector session:logged-in?))
(define session-authenticated? (make-fluid-selector session:authenticated?)) (define session-authenticated? (make-fluid-selector session:authenticated?))
(define session-anonymous? (make-fluid-selector session:anonymous?)) (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-data-socket (make-fluid-setter set-session:data-socket))
(define set-session-passive-socket (make-fluid-setter set-session:passive-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))) (let ((port (optional maybe-port 21)))
(bind-listen-accept-loop (bind-listen-accept-loop
protocol-family/internet protocol-family/internet
@ -77,7 +80,8 @@
(spawn (spawn
(lambda () (lambda ()
(handle-connection (socket:inport socket) (handle-connection (socket:inport socket)
(socket:outport socket)) (socket:outport socket)
(file-name-as-directory anonymous-home))
(call-with-current-continuation (call-with-current-continuation
(lambda (exit) (lambda (exit)
(with-errno-handler* (with-errno-handler*
@ -93,9 +97,10 @@
port))) port)))
(define (ftpd-inetd) (define (ftpd-inetd anonymous-home)
(handle-connection (current-input-port) (handle-connection (current-input-port)
(current-output-port))) (current-output-port)
(file-name-as-directory anonymous-home)))
(define (set-ftp-socket-options! socket) (define (set-ftp-socket-options! socket)
;; If the client closes the connection, we won't lose when we try to ;; 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)) (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 (call-with-current-continuation
(lambda (escape) (lambda (escape)
(with-handler (with-handler
@ -113,7 +118,8 @@
(display condition (current-error-port)) (display condition (current-error-port))
(escape 'fick-dich-ins-knie)) (escape 'fick-dich-ins-knie))
(lambda () (lambda ()
(let-fluid session (make-session input-port output-port) (let-fluid session (make-session input-port output-port
anonymous-home)
(lambda () (lambda ()
(display-banner) (display-banner)
(handle-commands)))))))) (handle-commands))))))))
@ -222,20 +228,13 @@
"Only anonymous logins allowed.")))) "Only anonymous logins allowed."))))
(define (handle-user-anonymous) (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)) (register-reply! 230 "Anonymous user logged in."))
(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.")))
(define (handle-pass password) (define (handle-pass password)
(cond (cond
@ -809,7 +808,7 @@
; Version ; Version
(define *ftpd-version* "$Revision: 1.11 $") (define *ftpd-version* "$Revision: 1.12 $")
(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*)))