Parameterize RMAN-HANDLER over locations of the various binaries.

scheme/httpd/rman-gateway.scm

@@ -2,24 +2,18 @@
 
 ;;; This file is part of the Scheme Untergrund Networking package.
 
-;;; Copyright (c) 1996 by Mike Sperber.
+;;; Copyright (c) 1996-2003 by Mike Sperber.
 ;;; For copyright information, see the file COPYING which comes with
 ;;; the distribution.
 
-;;; This uses RosettaMan and is currently based on version 2.5a6
+;;; This uses RosettaMan
-;;; (RosettaMan is based at
+;;; (based at ftp.cs.berkeley.edu:/ucb/people/phelps/tcltk/rman.tar.Z)
-;;;   ftp.cs.berkeley.edu:/ucb/people/phelps/tcltk/rman.tar.Z)
 
-;(define rman/rman '("/afs/wsi/rs_aix41/bin/rman" -fHTML))
+(define (rman-handler man-binary
-(define rman/man '(man))
+		      nroff-binary
-(define rman/nroff '(nroff -man))
+		      rman-binary
-;(define rman/gzcat '("/afs/wsi/rs_aix41/bin/zcat"))
+		      gzcat-binary
-;(define rman/zcat '("/afs/wsi/rs_aix41/bin/zcat"))
+		      finder referencer address . maybe-man)
-(define rman/rman '("/usr/bin/rman" -fHTML))
-(define rman/gzcat '("/usr/bin/zcat"))
-(define rman/zcat '("/usr/bin/zcat"))
-
-(define (rman-handler finder referencer address . maybe-man)
   (let ((parse-man-url
 	 (cond
 	  ((procedure? finder) finder)
@@ -64,7 +58,9 @@
 	     (lambda (out options)
 	       (receive (man-path entry and-then) 
 		   (parse-man-url (request-url req))
-		 (emit-man-page entry man man-path and-then reference-template out))
+		 (emit-man-page man-binary nroff-binary rman-binary
+				gzcat-binary
+				entry man man-path and-then reference-template out))
 	       
 	       (with-tag out address ()
 		 (display address out)))))))
@@ -84,19 +80,24 @@
 	(copy-inport->outport (current-input-port)
 			      out)))))
 
-(define (emit-man-page entry man man-path and-then reference-template out)
+(define (emit-man-page man-binary nroff-binary rman-binary
+		       gzcat-binary
+		       entry man man-path and-then reference-template out)
   (receive (key section) (parse-man-entry entry)
     (let ((status
 	   (cond
 	    ((procedure? and-then)
-	     (run (| (begin (man section key man-path))
+	     (run (| (begin (man man-binary nroff-binary gzcat-binary
+				 section key man-path))
 		     (begin (and-then key section)))
 		  (= 1 ,out)
 		  (= 2 ,out)))
 	    (else
-	      (run (| (begin (man section key man-path))
+	     (run (| (begin (man man-binary nroff-binary gzcat-binary
-		      (,@rman/rman ,@and-then
+				 section key man-path))
-				   -r ,(reference-template entry section)))
+		     (,rman-binary "-fHTML"
+				   ,@and-then
+				   "-r" ,(reference-template entry section)))
 		  (= 1 ,out)
 		  (= 2 ,out))))))
 
@@ -113,15 +114,19 @@
 		     (match:substring match 2))))
        (else (values s #f))))))
 
-(define (man section key man-path)
+(define (man man-binary nroff-binary gzcat-binary section key man-path)
   (cond
    ((procedure? man-path) (man-path))
-   ((find-man-file key section "cat" man-path) => cat-n-decode)
+   ((find-man-file key section "cat" man-path) =>
-   ((find-man-file key section "man" man-path) => nroff-n-decode)
+    (lambda (file)
+      (cat-n-decode gzcat-binary file)))
+   ((find-man-file key section "man" man-path) =>
+    (lambda (file)
+      (nroff-n-decode nroff-binary file)))
    (else
     (if (not (zero?
 	      (with-env (("MANPATH" . ,(string-join man-path ":")))
-	        (run (,@rman/man ,@(if section `(,section) '()) ,key)
+			(run (,man-binary "-man" ,@(if section `(,section) '()) ,key)
 		     stdports))))
 	(http-error http-status/not-found #f "man page not found")))))
 
@@ -166,20 +171,20 @@
       (split-file-name
        (file-name-directory file)))))))
 
-(define (cat-n-decode file)
+(define (cat-n-decode gzcat-binary file)
   (let ((ext (file-name-extension file)))
     (cond
-     ((string=? ".gz" ext) (run (,@rman/gzcat ,file) stdports))
+     ((string=? ".gz" ext) (run (,gzcat-binary ,file) stdports))
-     ((string=? ".Z" ext) (run (,@rman/zcat ,file) stdports))
+     ((string=? ".Z" ext) (run (,gzcat-binary ,file) stdports))
      (else (call-with-input-file
 	       file
 	     (lambda (port)
 	       (copy-inport->outport port (current-output-port))))))))
 
-(define (nroff-n-decode file)
+(define (nroff-n-decode nroff-binary gzcat-binary file)
-  (if (not (zero? (run (| (begin (cat-n-decode file))
+  (if (not (zero? (run (| (begin (cat-n-decode gzcat-binary file))
 			  (begin
 			    (with-cwd (file->man-directory file)
-				      (exec-epf (,@rman/nroff)))))
+				      (exec-epf (,nroff-binary "-man")))))
 		       stdports)))
       (http-error http-status/not-found #f "man page not found")))