Run firefox in blank profile when e2e testing

e2e/marionette.scm

@@ -1,4 +1,4 @@
-(define-module (wipforth marionette)
+(define-module (e2e marionette)
   #:export (with-marionette
 			start-firefox
 			close-firefox
@@ -25,8 +25,11 @@
 		(when pid (close-firefox pid))))))
 
 (define (start-firefox)
-  (let* ((i/o (pipe))
+  (let* ((profile-dir (mkdtemp "/tmp/marionette-XXXXXX"))
-		 (pid (spawn "firefox" '("firefox" "--marionette" "--headless")
+		 (i/o (pipe))
+		 (pid (spawn "firefox"
+					 `("firefox" "--marionette" "--headless"
+					   "--profile" ,profile-dir "about:blank")
 					 #:output (cdr i/o)
 					 #:error (cdr i/o))))
 	(let loop ((line (read-line (car i/o))))

server.scm

@@ -1,5 +1,12 @@
+(define-module (server)
+  #:export (run start stop main))
+
 (use-modules
+ (ice-9 atomic)
  (ice-9 binary-ports)
+ (ice-9 threads)
+ (srfi srfi-9)
+ (web client)
  (web server)
  (web request)
  (web response)
@@ -38,6 +45,38 @@
 	(if path
 		(values (cons `(content-type . ,(mime-type path)) headers)
 				(get-bytevector-all (open-input-file path)))
-		(values (build-response #:code 404) ""))))
+		(values (build-response #:code 404) #f))))
 
-(run-server file-handler)
+(define* (run #:key (port 8080))
+  (run-server file-handler 'http `(#:port ,port)))
+
+(define-record-type <handle>
+  (make-handle close-flag thread port)
+  handle?
+  (close-flag handle-close-flag)
+  (thread handle-thread)
+  (port handle-port))
+
+(define (serve impl server should-close)
+  (let loop ()
+	(unless (atomic-box-ref should-close)
+	  (serve-one-client file-handler impl server '())
+	  (loop)))
+  (close-server impl server))
+
+(define* (start #:key (port 8080))
+  (let* ((impl (lookup-server-impl 'http))
+		 (server (open-server impl `(#:port ,port)))
+		 (should-close (make-atomic-box #f))
+		 (thread
+		  (call-with-new-thread
+		   (lambda () (serve impl server should-close)))))
+	(make-handle should-close thread port)))
+
+(define (stop handle)
+  (atomic-box-set! (handle-close-flag handle) #t)
+  (http-request (format #f "http://localhost:~a/" (handle-port handle)))
+  (join-thread (handle-thread handle)))
+
+(when (string=? (basename (current-filename)) (car (command-line)))
+  (run))