Fix computation of default directories

This commit is contained in:
mainzelm 2004-05-13 08:34:03 +00:00
parent c7693e9bc7
commit b568965f6e
3 changed files with 34 additions and 37 deletions

View File

@ -29,8 +29,8 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
[--help]
with
htdocs-dir directory of html files (default: web-server/root/htdocs)
cgi-bin-dir directory of cgi files (default: web-server/root/cgi-bin)
htdocs-dir directory of html files (default: root/htdocs)
cgi-bin-dir directory of cgi files (default: root/cgi-bin)
port port server is listening to (default: 8080)
log-file-name directory where to store the logfile in CLF
(default: /tmp/httpd.log)
@ -42,13 +42,6 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
(display (usage) (current-error-port))
(exit 1))
(define default-options
`((htdocs-dir . ,(absolute-file-name "web-server/root/htdocs"))
(cgi-bin-dir . ,(absolute-file-name "web-server/root/cgi-bin"))
(port . 8080)
(log-file-name . "/tmp/httpd.log")
(requests . 5)))
(define (raise-usage-error msg . info)
(display msg (current-error-port))
(for-each
@ -105,7 +98,7 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
cons
'()))))
(define (make-options-from-args cmd-line-args)
(define (make-options-from-args cmd-line-args default-options)
(let ((given (parse-arguments cmd-line-args)))
(map (lambda (p)
(or (assoc (car p) given) p))
@ -119,9 +112,15 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
(error "Internal error, option not found" option alist))))
(define (main args)
(with-cwd "."
(with-cwd
(file-name-directory (car args))
(let ((options (make-options-from-args (cdr args))))
(let* ((default-options
`((htdocs-dir . ,(absolute-file-name "root/htdocs"))
(cgi-bin-dir . ,(absolute-file-name "root/cgi-bin"))
(port . 8080)
(log-file-name . "/tmp/httpd.log")
(requests . 5)))
(options (make-options-from-args (cdr args) default-options)))
(cond ((zero? (user-uid))
(set-gid (->gid "nobody"))
(set-uid (->uid "nobody"))))

View File

@ -34,9 +34,9 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o surflet-server -
[--help]
with
htdocs-dir directory of html files (default: ./web-server/root/htdocs)
surflet-dir directory of SUrflet files (default: ./web-server/root/surflets)
images-dir directory of images files (default: ./web-server/root/img)
htdocs-dir directory of html files (default: root/htdocs)
surflet-dir directory of SUrflet files (default: root/surflets)
images-dir directory of images files (default: root/img)
port port server is listening to (default: 8008)
log-file-name directory where to store the logfile in CLF
(default: /tmp/httpd.log)
@ -49,14 +49,6 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o surflet-server -
(display (usage) (current-error-port))
(exit 1))
(define default-options
`((htdocs-dir . ,(absolute-file-name "root/htdocs"))
(surflet-dir . ,(absolute-file-name "root/surflets"))
(images-dir . ,(absolute-file-name "root/img"))
(port . 8008)
(log-file-name . "/tmp/httpd.log")
(requests . 5)))
(define (raise-usage-error msg . info)
(display msg (current-error-port))
(display " --- " (current-error-port))
@ -118,7 +110,7 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o surflet-server -
cons
'()))))
(define (make-options-from-args cmd-line-args)
(define (make-options-from-args cmd-line-args default-options)
(let ((given (parse-arguments cmd-line-args)))
(map (lambda (p)
(or (assoc (car p) given) p))
@ -139,7 +131,14 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o surflet-server -
(define (main args)
(with-cwd
(file-name-directory (car args))
(let ((options (make-options-from-args (cdr args))))
(let* ((default-options
`((htdocs-dir . ,(absolute-file-name "root/htdocs"))
(surflet-dir . ,(absolute-file-name "root/surflets"))
(images-dir . ,(absolute-file-name "root/img"))
(port . 8008)
(log-file-name . "/tmp/httpd.log")
(requests . 5)))
(options (make-options-from-args (cdr args) default-options)))
(cond ((zero? (user-uid))
(set-gid (->gid "nobody"))
(set-uid (->uid "nobody"))))

View File

@ -25,8 +25,8 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
[--help]
with
htdocs-dir directory of html files (default: web-server/root/htdocs)
cgi-bin-dir directory of cgi files (default: web-server/root/cgi-bin)
htdocs-dir directory of html files (default: root/htdocs)
cgi-bin-dir directory of cgi files (default: root/cgi-bin)
port port server is listening to (default: 8080)
log-file-name directory where to store the logfile in CLF
(default: /tmp/httpd.log)
@ -37,13 +37,6 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
(display (usage) (current-error-port))
(exit 1))
(define default-options
`((htdocs-dir . ,(absolute-file-name "web-server/root/htdocs"))
(cgi-bin-dir . ,(absolute-file-name "web-server/root/cgi-bin"))
(port . 8080)
(log-file-name . "/tmp/httpd.log")
(requests . 5)))
(define (raise-usage-error msg . info)
(display msg (current-error-port))
(for-each
@ -100,7 +93,7 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
cons
'()))))
(define (make-options-from-args cmd-line-args)
(define (make-options-from-args cmd-line-args default-options)
(let ((given (parse-arguments cmd-line-args)))
(map (lambda (p)
(or (assoc (car p) given) p))
@ -121,7 +114,13 @@ exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e mai
(define (main args)
(with-cwd
(file-name-directory (car args))
(let ((options (make-options-from-args (cdr args))))
(let* ((default-options
`((htdocs-dir . ,(absolute-file-name "root/htdocs"))
(cgi-bin-dir . ,(absolute-file-name "root/cgi-bin"))
(port . 8080)
(log-file-name . "/tmp/httpd.log")
(requests . 5)))
(options (make-options-from-args (cdr args) default-options)))
(format #t "Going to run Webserver with:
htdocs-dir: ~a