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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
start-extended-web-server
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] [--help]
with with
htdocs-dir directory of html files (default: web-server/root/htdocs) htdocs-dir directory of html files (default: root/htdocs)
cgi-bin-dir directory of cgi files (default: web-server/root/cgi-bin) cgi-bin-dir directory of cgi files (default: root/cgi-bin)
port port server is listening to (default: 8080) port port server is listening to (default: 8080)
log-file-name directory where to store the logfile in CLF log-file-name directory where to store the logfile in CLF
(default: /tmp/httpd.log) (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)) (display (usage) (current-error-port))
(exit 1)) (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) (define (raise-usage-error msg . info)
(display msg (current-error-port)) (display msg (current-error-port))
(for-each (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 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))) (let ((given (parse-arguments cmd-line-args)))
(map (lambda (p) (map (lambda (p)
(or (assoc (car p) given) 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)))) (error "Internal error, option not found" option alist))))
(define (main args) (define (main args)
(with-cwd "." (with-cwd
(file-name-directory (car args)) (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)) (cond ((zero? (user-uid))
(set-gid (->gid "nobody")) (set-gid (->gid "nobody"))
(set-uid (->uid "nobody")))) (set-uid (->uid "nobody"))))

25
start-surflet-server
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] [--help]
with with
htdocs-dir directory of html files (default: ./web-server/root/htdocs) htdocs-dir directory of html files (default: root/htdocs)
surflet-dir directory of SUrflet files (default: ./web-server/root/surflets) surflet-dir directory of SUrflet files (default: root/surflets)
images-dir directory of images files (default: ./web-server/root/img) images-dir directory of images files (default: root/img)
port port server is listening to (default: 8008) port port server is listening to (default: 8008)
log-file-name directory where to store the logfile in CLF log-file-name directory where to store the logfile in CLF
(default: /tmp/httpd.log) (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)) (display (usage) (current-error-port))
(exit 1)) (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) (define (raise-usage-error msg . info)
(display msg (current-error-port)) (display msg (current-error-port))
(display " --- " (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 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))) (let ((given (parse-arguments cmd-line-args)))
(map (lambda (p) (map (lambda (p)
(or (assoc (car p) given) 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) (define (main args)
(with-cwd (with-cwd
(file-name-directory (car args)) (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)) (cond ((zero? (user-uid))
(set-gid (->gid "nobody")) (set-gid (->gid "nobody"))
(set-uid (->uid "nobody")))) (set-uid (->uid "nobody"))))

21
start-web-server
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] [--help]
with with
htdocs-dir directory of html files (default: web-server/root/htdocs) htdocs-dir directory of html files (default: root/htdocs)
cgi-bin-dir directory of cgi files (default: web-server/root/cgi-bin) cgi-bin-dir directory of cgi files (default: root/cgi-bin)
port port server is listening to (default: 8080) port port server is listening to (default: 8080)
log-file-name directory where to store the logfile in CLF log-file-name directory where to store the logfile in CLF
(default: /tmp/httpd.log) (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)) (display (usage) (current-error-port))
(exit 1)) (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) (define (raise-usage-error msg . info)
(display msg (current-error-port)) (display msg (current-error-port))
(for-each (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 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))) (let ((given (parse-arguments cmd-line-args)))
(map (lambda (p) (map (lambda (p)
(or (assoc (car p) given) 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) (define (main args)
(with-cwd (with-cwd
(file-name-directory (car args)) (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: (format #t "Going to run Webserver with:
htdocs-dir: ~a htdocs-dir: ~a