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)))
|