remove introduced but nerving signal stuff from handlers

scheme/httpd/cgi-server.scm

@@ -75,74 +75,30 @@
 ;;; path for scripts 
 (define cgi-default-bin-path "/bin:/usr/bin:/usr/ucb:/usr/bsd:/usr/local/bin")
 
-(define-condition-type 'cgi-error '())
-(define cgi-error? (condition-predicate 'cgi-error))
-
-(define-condition-type 'cgi-illegal-content-length-error '(cgi-error))
-(define cgi-illegal-content-length-error? 
-  (condition-predicate 'cgi-illegal-content-length-error))
-
-(define-condition-type 'cgi-dot-dot-error? '(cgi-error))
-(define cgi-dot-dot-error? (condition-predicate 'cgi-dot-dot-error?))
-
-(define-condition-type 'cgi-nph-failed-error '(cgi-error))
-(define cgi-nph-failed-error? (condition-predicate 'cgi-nph-failed-error))
-(define cgi-nph-failed-error-filename cadr)
-
-(define-condition-type 'cgi-multi-status-line-error '(cgi-error))
-(define cgi-multi-status-line-error? (condition-predicate 'cgi-multi-status-line-error))
-
-(define (create-error-response condition req)
-  (cond 
-   ((cgi-illegal-content-length-error? condition)
-    (make-http-error-response http-status/bad-request req 
-			      "Illegal `Content-length:' header."))
-   ((cgi-dot-dot-error? condition)
-    (make-http-error-response http-status/bad-request req 
-			      "CGI scripts may not contain \"..\" elements."))
-   ((cgi-nph-failed-error? condition)
-    (make-http-error-response http-status/bad-request req
-			      (format #f "Could not execute CGI script ~a." 
-				      (cgi-nph-failed-error-filename condition))))
-   ((cgi-multi-status-line-error? condition)
-    (make-http-error-response http-status/internal-error req
-			      "CGI script generated multi-line status header."))
-   (else
-    (make-http-error-response http-status/bad-gateway req
-			      "Error while executing CGI."))))
-
 ;;; The path handler for CGI scripts. (car path) is the script to run.
 ;;; cgi-bin-path is used, if no PATH-variable isn't defined
 
 (define (cgi-handler bin-dir . maybe-cgi-bin-path)
   (let-optionals
-   maybe-cgi-bin-path
+      maybe-cgi-bin-path
-   ((cgi-bin-path cgi-default-bin-path))
+      ((cgi-bin-path cgi-default-bin-path))
     
-   (let ((request-invariant-cgi-env    ; environment variables that never change
+    (let ((request-invariant-cgi-env    ; environment variables that never change
-	  `(("PATH"              . ,(and (getenv "PATH") cgi-bin-path))
+	   `(("PATH"              . ,(and (getenv "PATH") cgi-bin-path))
-	    ("SERVER_SOFTWARE"   . ,sunet-version-identifier)
+	     ("SERVER_SOFTWARE"   . ,sunet-version-identifier)
-	    ("SERVER_NAME"       . ,(host-info:name (host-info (system-name))))
+	     ("SERVER_NAME"       . ,(host-info:name (host-info (system-name))))
-	    ("GATEWAY_INTERFACE" . "CGI/1.1"))))
+	     ("GATEWAY_INTERFACE" . "CGI/1.1"))))
-     (lambda (path req)
+      (lambda (path req)
-       (if (pair? path)	; Got to have at least one elt.
+	(if (pair? path)	; Got to have at least one elt.
-	   (call-with-current-continuation
+	    (compute-cgi path req bin-dir request-invariant-cgi-env)
-	    (lambda (exit)
+	    (make-http-error-response http-status/bad-request req "Empty CGI script"))))))
-	      (with-handler
-	       (lambda (condition more)
-		 (exit
-		  (if (cgi-error? condition)
-		      (create-error-response condition req)
-		      (make-http-error-response http-status/internal-error req))))
-	       (lambda ()
-		 (compute-cgi path req bin-dir request-invariant-cgi-env)))))
-	   (make-http-error-response http-status/bad-request req "Empty CGI script"))))))
 
 (define (compute-cgi path req bin-dir request-invariant-cgi-env)
   (let* ((prog (car path))
 
 	 (filename (or (dotdot-check bin-dir (list prog))
-		       (signal 'cgi-dot-dot-error)))
+		       (http-error http-status/bad-request req 
+				   "CGI scripts may not contain \"..\" elements.")))
 
 	 (nph? (string-prefix? "nph-" prog))	; PROG starts with "nph-" ? 
 					; why did we had (string-suffix? "-nph" prog) here?
@@ -167,7 +123,10 @@
 	(if nph?
 	    (let ((stat (wait (fork doit))))
 	      (if (not (zero? stat))
-		  (signal 'cgi-nph-failed-error filename) 
+		  (make-http-error-response 
+		   http-status/bad-request req
+		   (format #f "Could not execute CGI script ~a." 
+			   filename)) 
 		  stat))		;; FIXME! must return http-response object!
 	    (cgi-make-response (run/port* doit) req)))
        
@@ -253,7 +212,8 @@
 			   (cl-len (string-length cl)))
 		       (if first-digit
 			   `(("CONTENT_LENGTH" . ,(substring cl first-digit cl-len)))
-			   (signal 'cgi-illegal-content-length-error)))))
+			   (http-error http-status/bad-request req 
+				       "Illegal `Content-length:' header.")))))
 		  
 		  (else '()))
 	  
@@ -284,12 +244,12 @@
 		   ((null? (cdr stat-lines)) 	    ; One line status header.
 		    (car stat-lines))
 		   (else			    ; Vas ist das?
-		    (signal 'cgi-multi-status-line-error)))))
+		    (http-error http-status/internal-error req
-	 (extra-headers (delete-headers 
+				"CGI script generated multi-line status header.")))))
-			 (delete-headers
+	 (extra-headers (delete-headers (delete-headers (delete-headers headers 
-			  (delete-headers headers 'content-type)
+									'content-type)
-			  'location)
+							'location)
-			 'status)))
+					'status)))
     
     (http-syslog (syslog-level debug) "[cgi-server] headers: ~s~%" headers)
     (http-syslog (syslog-level debug) "[cgi-server] request:method=~a~%" 
@@ -302,7 +262,7 @@
      ctype
      extra-headers
      (make-writer-body
-      (lambda (out options)		; what about loc?
+      (lambda (out options)		; what about loc&status?
 	(copy-inport->outport script-port out)
 	(close-input-port script-port))))))
 

scheme/httpd/seval.scm

@@ -38,16 +38,6 @@
   (syntax-rules ()
     ((do/timeout secs body ...) (do/timeout* secs (lambda () body ...)))))
 
-(define-condition-type 'seval-error '())
-(define seval-error? (condition-predicate 'seval-error))
-
-(define-condition-type 'seval-no-content-length-error '(seval-error))
-(define seval-no-content-length-error? 
-  (condition-predicate 'seval-no-content-length-error))
-
-(define-condition-type 'seval-no-program '(seval-error))
-(define seval-no-program? (condition-predicate 'seval-no-program))
-
 ;;; The path handler for seval ops.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -55,28 +45,7 @@
   (let ((request-method (request:method req)))
     (cond 
      ((string=? request-method "POST")	; Could do others also.
-      (call-with-current-continuation
+      (seval path req))
-       (lambda (exit)
-	 (begin
-	   (with-handler
-	    (lambda (condition more)
-	      (exit
-	       (cond
-		((seval-no-content-length-error? condition)
-		 (make-http-error-response 
-		  http-status/bad-request req
-		  "No `Content-length:' field in POST request."))
-		((seval-no-program?  condition)
-		 (make-http-error-response http-status/bad-request req
-					   "No program in entity body."))
-		(else
-		 (make-http-error-response 
-		  http-status/internal-error req
-		  "Unknown error while evaluating seval-expression."
-		  condition)))))
-	    (lambda ()
-	      (seval path req)))))))
-     
      (else
       (make-http-error-response http-status/method-not-allowed req)))))
 
@@ -136,8 +105,8 @@
 	     (qs (read-string cl iport))			; Read in CL chars,
 	     (q (parse-html-form-query qs))		; and parse them up.
 	     (s (cond ((assoc "program" q) => cdr)
-		      (else (signal 'seval-no-program)))))
+		      (else (error "No program in entity body.")))))
 	(http-syslog (syslog-level debug)
 		     "Seval sexp: ~s" s)
 	(read (make-string-input-port s)))))
-   (else (signal 'seval-no-content-length-error))))
+   (else (error "No `Content-length:' field in POST request."))))

scheme/packages.scm

@@ -806,7 +806,6 @@
 	srfi-13			; STRING-SKIP
 	rfc822
 	toothless-eval			; EVAL-SAFELY
-	conditions signals
 	handle				; IGNORE-ERROR
 	parse-html-forms		; PARSE-HTML-FORM-QUERY
 	threads				; SLEEP
@@ -863,7 +862,6 @@
 	format-net              ; FORMAT-INTERNET-HOST-ADDRESS
 	sunet-utilities         ; host-name-or-empty
 	let-opt                 ; let-optionals
-	conditions handle signals	; define-condition-type, with-handler et al.
 	scheme)
   (files (httpd cgi-server)))
 

web-server/root/cgi-bin/comments.sh

@@ -1,5 +1,5 @@
 #!/bin/sh
 echo Content-Type: text/html
-echo
+echo Status: 200
 echo 
 echo "<h2> This is the cgi script. </h2>"