- (let server-loop ()
- (let-values (((in-port out-port) (tcp-accept listener)))
- (let* ((line (read-line in-port))
- (selector (string-trim-both line)))
- (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
- (print "Accepted connection from " remote-ip
- " on " (seconds->string))
- (condition-case
- (begin
- (with-output-to-port out-port
- (lambda ()
- (serve-selector (if (= (string-length selector) 0)
- "/"
- selector)
- config)))
- (print "... served selector '" selector "'. Closing connection."))
- (o (exn)
- (print-error-message o out-port)
- (print-error-message o)
- (print "Error while attempting to serve selector " selector ".")))))
- (close-input-port in-port)
- (close-output-port out-port))
- (server-loop))
- (tcp-close listener)))
-
+ (print "Gopher server listening on port " (config-port config) " ...")
+ (drop-privs config)
+ (server-loop listener config))
+ (tcp-close listener))
+
+(define (drop-privs config)
+ (let ((uid (config-user config))
+ (gid (config-group config)))
+ (if (not (null? gid)) ; Group first, since only root can switch groups.
+ (set! (current-group-id) gid))
+ (if (not (null? uid))
+ (set! (current-user-id) uid))))
+
+(define (server-loop listener config)
+ (let-values (((in-port out-port) (tcp-accept listener)))
+ (let* ((line (read-line in-port))
+ (selector (string-trim-both line)))
+ (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
+ (print "Accepted connection from " remote-ip
+ " on " (seconds->string))
+ (condition-case
+ (begin
+ (with-output-to-port out-port
+ (lambda ()
+ (serve-selector (if (= (string-length selector) 0)
+ "/"
+ selector)
+ config)))
+ (print "... served selector '" selector "'. Closing connection."))
+ (o (exn)
+ (print-error-message o out-port)
+ (print-error-message o)
+ (print "Error while attempting to serve selector " selector ".")))))
+ (close-input-port in-port)
+ (close-output-port out-port))
+ (server-loop listener config))