Megatest

Diff
Login

Differences From Artifact [937a4c1927]:

To Artifact [efd45bc21d]:


91
92
93
94
95
96
97
98
99
100



101
102
103
104
105


106
107
108
109
110
111
112
91
92
93
94
95
96
97



98
99
100





101
102
103
104
105
106
107
108
109







-
-
-
+
+
+
-
-
-
-
-
+
+







		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
    (handle-directory spiffy-directory-listing)
    ;; http-transport:handle-directory) ;; simple-directory-handler)
    ;; Setup the web server and a /ctrl interface
    ;;
    (vhost-map `(((* any) . ,(lambda (continue)
			       ;; open the db on the first call 
			       (let loop ()
				 (if (not db)
				     (if (not (sqlite3:database? *inmemdb*))
				 ;; This is were we set up the database connections
			       (set! *db*       (open-db))
			       (set! *inmemdb*  (open-in-mem-db))
					 (begin
					   (debug:print 0 "WARNING: db not ready yet. Waiting for it to be ready")
					   (thread-sleep! 5)
					   (loop)))
				     (set! db *inmemdb*))) ;; (open-db)))
			       (set! db *inmemdb*)
			       (db:sync-to *db* *inmemdb*)
			       (let* (($   (request-vars source: 'both))
				      (dat ($ 'dat))
				      (res #f))
				 (cond
				  ((equal? (uri-path (request-uri (current-request)))
					   '(/ "api"))
				   (send-response body:    (api:process-request db $) ;; the $ is the request vars proc
380
381
382
383
384
385
386

387
388


389
390
391
392
393
394
395
377
378
379
380
381
382
383
384


385
386
387
388
389
390
391
392
393







+
-
-
+
+







	 res)))))

(define (http-transport:client-connect iface port)
  (let* ((login-res   #f)
	 (uri-dat     (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/ctrl"))))
	 (uri-api-dat (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/api"))))
	 (serverdat   (list iface port uri-dat uri-api-dat)))
    (set! *runremote* serverdat) ;; may or may not be good ...
    (set! login-res (client:login serverdat))
    (if (and (not (null? login-res))
    (set! login-res (rmt:login))
    (if (and (list? login-res)
	     (car login-res))
	(begin
	  (debug:print-info 2 "Logged in and connected to " iface ":" port)
	  (set! *runremote* serverdat)
	  serverdat)
	(begin
	  (debug:print-info 0 "ERROR: Failed to login or connect to " iface ":" port)
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
510
511
512
513
514
515
516




517
518
519
520
521
522
523







-
-
-
-







	    (let* ((th2 (make-thread (lambda ()
				       (http-transport:run 
					(if (args:get-arg "-server")
					    (args:get-arg "-server")
					    "-"))) "Server run"))
		   (th3 (make-thread http-transport:keep-running "Keep running")))
;;		   (th1 (make-thread server:write-queue-handler  "write queue")))
	      ;; This is were we set up the database connections
	      (set! *db* (open-db))
	      (set! *inmemdb* (open-in-mem-db))
	      (db:sync-to *db* *inmemdb*)
	      (thread-start! th2)
	      (thread-start! th3)
	      ;; (thread-start! th1)
	      (set! *didsomething* #t)
	      (thread-join! th2))
	    (debug:print 0 "ERROR: Failed to setup for megatest")))
    (exit)))