Fix computation of default directories
This commit is contained in:
parent
c7693e9bc7
commit
b568965f6e
|
@ -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"))))
|
||||
|
|
|
@ -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"))))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue