--- tcp-server.scm	2005-09-26 02:16:08.000000000 +0000
+++ generic-server.scm	2005-10-10 17:55:50.000000000 +0000
@@ -37,13 +37,23 @@
   (fixnum)
   ;(no-bound-checks)
   (uses extras tcp srfi-18)
-  (export make-tcp-server) )
-
+  (export make-tcp-server
+	  tcp-server-prepare-hard-close-procedure
+	  tcp-server-accept-connection-procedure
+	  tcp-server-get-addresses-procedure) )
 
 ;;; Constants:
 
 (define-constant default-request-count-limit 10000)
 
+;;; Parameters:
+
+(define tcp-server-prepare-hard-close-procedure
+  (make-parameter tcp-abandon-port))
+(define tcp-server-accept-connection-procedure
+  (make-parameter tcp-accept))
+(define tcp-server-get-addresses-procedure
+  (make-parameter tcp-addresses))
 
 ;;; Main loop:
 
@@ -59,8 +69,8 @@
       (close-output-port out)
       (close-input-port in) )
     (define (hard-close in out)
-      (tcp-abandon-port in)
-      (tcp-abandon-port out)
+      ((tcp-server-prepare-hard-close-procedure) in)
+      ((tcp-server-prepare-hard-close-procedure) out)
       (close-input-port in)
       (close-output-port out) )
     (define (thread-fork thunk)
@@ -81,12 +91,14 @@
       (dribble "waiting for requests...")
       (let ([count 0])
 	(define (serve)
-	  (let-values ([(in out) (tcp-accept listener)])
+	  (let-values ([(in out)
+			((tcp-server-accept-connection-procedure) listener)])
 	    (thread-fork
 	     (lambda ()
 	       (let ([id (thread-name (current-thread))])
 		 (when verbose
-		   (let-values ([(_ you) (tcp-addresses in)])
+		   (let-values ([(_ you)
+				 ((tcp-server-get-addresses-procedure) in)])
 		     (dribble "request ~A from ~A; ~A (of ~A) started..." count you id current-number-of-threads) ) )
 		 (let ([k (dispatch-request in out)])
 		   (set! count (add1 count))