make more pleasent error messages

scheme/httpd/cgi-server.scm

@@ -138,7 +138,8 @@
 	      (else
 	       (cgi-make-response (run/port* doit) path req)))))
        
-       (else (make-http-error-response http-status/method-not-allowed req))))))
+       (else 
+	(make-http-error-response http-status/method-not-allowed req request-method))))))
 
 
 (define (split-and-decode-search-spec s)

scheme/httpd/file-dir-handler.scm

@@ -161,7 +161,9 @@
 
 	      (else (make-http-error-response http-status/forbidden req)))))
 	 
-	 (else (make-http-error-response http-status/method-not-allowed req))))))
+	 (else 
+	  (make-http-error-response http-status/method-not-allowed req 
+				    request-method))))))
 
 (define (directory-index-serve-response fname file-path req)
   (file-serve-response (string-append fname "index.html") file-path req))
@@ -396,7 +398,8 @@
 			  (emit-tag port 'hr)
 			  (format port "~d files" n-files))))))))))))
      (else
-      (make-http-error-response http-status/method-not-allowed req)))))
+      (make-http-error-response http-status/method-not-allowed req 
+				request-method)))))
 
 (define (index-or-directory-serve-response fname file-path req)
   (let ((index-fname (string-append fname "index.html")))

scheme/httpd/info-gateway.scm

@@ -167,7 +167,9 @@
 	       (with-tag out address ()
 		 (write-string address out)))))))
 
-	 (else (http-error http-status/method-not-allowed req)))))))
+	 (else 
+	  (make-http-error-response http-status/method-not-allowed req 
+				    request-method)))))))
 
 (define split-header-line
   (let ((split (infix-splitter (make-regexp "(, *)|(  +)|( *\t *)")))

scheme/httpd/response.scm

@@ -99,6 +99,9 @@
 	 (generic-title (lambda (port)
 			  (title-html port
 				      (status-code->text status-code))))
+	 (send-message (lambda (port)
+			 (if message 
+			     (format port "<BR>~%Further Information: ~A<BR>~%" message))))
 	 (close-html (lambda (port)
 		       (for-each (lambda (x) (format port "<BR>~s~%" x)) extras)
 		       (write-string "</BODY>\n" port)))
@@ -135,17 +138,19 @@
 	 (generic-title port)
 	 (write-string "<P>Client sent a query that this server could not understand.\n"
 		       port)
-	 (if message (format port "<BR>~%Reason: ~A~%" message))
+	 (send-message port)
 	 (close-html port))))
 
      ((= status-code http-status/unauthorized)
       (create-response
-       (list (cons 'WWW-Authenticate message)) ; Vas is das?
+       (list (cons 'WWW-Authenticate message)) ; Vas is das? 
+       ;; Vas das is? See: http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.47
+       ;; message should be a challenge(?)
        (lambda (port options)
 	 (title-html port "Authorization Required")
 	 (write-string "<P>Browser not authentication-capable or\n" port)
 	 (write-string "authentication failed.\n" port)
-	 (if message (format port "~a~%" message))
+	 (send-message port)
 	 (close-html port))))
 
      ((= status-code http-status/forbidden)
@@ -157,7 +162,7 @@
 		 "Your client does not have permission to perform a ~A~%"
 		 (request:method req))
 	 (format port "operation on url ~a.~%" (request:uri req))
-	 (if message (format port "<P>~%~a~%" message))
+	 (send-message port)
 	 (close-html port))))
        
      ((= status-code http-status/not-found)
@@ -168,7 +173,7 @@
 	 (write-string 
 	  "<P>The requested URL was not found on this server.\n"
 	  port)
-	 (if message (format port "<P>~%~a~%" message))
+	 (send-message port)
 	 (close-html port))))
 
      ((= status-code http-status/internal-error)
@@ -183,7 +188,7 @@ misconfiguration and was unable to complete your request.
 Please inform the server administrator, ~A, of the circumstances leading to
 the error, and time it occured.~%"
 		 (httpd-options-server-admin options))
-	 (if message (format port "<P>~%~a~%" message))
+	 (send-message port)
 	 (close-html port))))
       
      ((= status-code http-status/not-implemented)
@@ -194,7 +199,17 @@ the error, and time it occured.~%"
 	 (format port "This server does not currently implement 
 the requested method (~A).~%"
 		 (request:method req))
-	 (if message (format port "<P>~a~%" message))
+	 (send-message port)
+	 (close-html port))))
+
+     ((= status-code http-status/bad-gateway)
+      (create-response
+       '()
+       (lambda (port options)
+	 (generic-title port)
+	 (format port "An error occured while waiting for the 
+response of a gateway.~%")
+	 (send-message port)
 	 (close-html port))))
 
      (else 
@@ -203,6 +218,7 @@ the requested method (~A).~%"
        '()
        (lambda (port options)
 	 (generic-title port)
+	 (send-message port)
 	 (close-html port)))))))
 
 (define (title-html out message)

scheme/httpd/rman-gateway.scm

@@ -68,7 +68,9 @@
 	       
 	       (with-tag out address ()
 		 (display address out)))))))
-	 (else (http-error http-status/method-not-allowed req)))))))
+	 (else 
+	  (make-http-error-response http-status/method-not-allowed req 
+				    request-method)))))))
 
 (define (cat-man-page key section out)
   (let ((title (if section

scheme/httpd/seval.scm

@@ -47,7 +47,7 @@
      ((string=? request-method "POST")	; Could do others also.
       (seval path req))
      (else
-      (make-http-error-response http-status/method-not-allowed req)))))
+      (make-http-error-response http-status/method-not-allowed req request-method)))))
 
 (define (seval path req)
     (make-response