summaryrefslogtreecommitdiff
path: root/spiffy.scm
diff options
context:
space:
mode:
Diffstat (limited to 'spiffy.scm')
-rw-r--r--spiffy.scm33
1 files changed, 26 insertions, 7 deletions
diff --git a/spiffy.scm b/spiffy.scm
index 91e6bee..83f51cf 100644
--- a/spiffy.scm
+++ b/spiffy.scm
@@ -56,11 +56,10 @@
(chicken file posix) (chicken process signal) (chicken load)
(chicken process-context) (chicken process-context posix)
srfi-1 srfi-13 srfi-14 srfi-18
- posix-groups uri-common sendfile
- (rename intarweb (headers intarweb:headers)))
+ uri-common sendfile (rename intarweb (headers intarweb:headers)))
(define version 6)
-(define release 0)
+(define release 1)
;;; Request processing information
(define current-request (make-parameter #f))
@@ -544,6 +543,28 @@
(unless (eq? (build-platform) 'msvc)
(set-signal-handler! signal/int (lambda (sig) (exit 1))))
+;; Imports from the named module, if available
+(define (dynamic-import module symbol default)
+ (handle-exceptions _ default (eval `(let () (import ,module) ,symbol))))
+
+;; posix-groups is UNIX-only, so avoid a hard dependency on it.
+(define group-information
+ (dynamic-import
+ 'posix-groups 'group-information
+ (lambda (group)
+ (error 'group-information
+ "If you set (spiffy-group) or call switch-user/group directly with a group, you must install the posix-groups egg first!" group))))
+
+(define initialize-groups
+ (dynamic-import
+ 'posix-groups 'initialize-groups
+ (lambda (user info)
+ (cond-expand
+ (windows (void)) ; Skip it on Windows
+ (else
+ (error 'initialize-groups
+ "If you set (spiffy-user) or call switch-user/group directly with a user, you must install the posix-groups egg first!" user info))))))
+
(define (switch-user/group user group)
(when group ; group first, since only superuser can switch groups
(let ((ginfo (group-information group)))
@@ -580,10 +601,8 @@
(mutex-unlock! m)
(begin (mutex-unlock! m condition) (retry)))))
-;; Imports from the openssl egg, if available
-(define (dynamic-import module symbol default)
- (handle-exceptions _ default (eval `(let () (import ,module) ,symbol))))
-
+;; SSL is optional, don't force openssl on someone who just wants a
+;; plain HTTP server. It's also a pain to install on Windows.
(define ssl-port?
(dynamic-import 'openssl 'ssl-port? (lambda (v) #f)))