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,8 +114,14 @@ 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 | ||||
|  cgi-bin-dir:   ~a | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue
	
	 mainzelm
						mainzelm