| ︙ | | |
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
-
+
-
+
|
(ipaddrstr (let ((ipstr (if (string=? "-" hostn)
;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
(server:get-best-guess-address hostname)
#f)))
(if ipstr ipstr hostn))) ;; hostname)))
(start-port (open-run-close tasks:server-get-next-port tasks:open-db))
(link-tree-path (configf:lookup *configdat* "setup" "linktree")))
(set! db *inmemdb*)
;; (set! db *inmemdb*)
(root-path (if link-tree-path
link-tree-path
(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
;; This is were we set up the database connections
(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
(send-response body: (api:process-request *inmemdb* $) ;; the $ is the request vars proc
headers: '((content-type text/plain)))
(mutex-lock! *heartbeat-mutex*)
(set! *last-db-access* (current-seconds))
(mutex-unlock! *heartbeat-mutex*))
;; This is the /ctrl path where data is handed to the server and
;; responses
;; ((equal? (uri-path (request-uri (current-request)))
|
| ︙ | | |
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
|
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
|
-
+
|
(api-req (make-request method: 'POST uri: api-uri))
(server-dat (vector iface port api-uri api-url api-req)))
server-dat))
;; run http-transport:keep-running in a parallel thread to monitor that the db is being
;; used and to shutdown after sometime if it is not.
;;
(define (http-transport:keep-running server-id)
(define (http-transport:keep-running server-id run-id)
;; if none running or if > 20 seconds since
;; server last used then start shutdown
;; This thread waits for the server to come alive
(let* ((server-info (let loop ((start-time (current-seconds))
(changed #t)
(last-sdat "not this"))
(let ((sdat #f))
|
| ︙ | | |
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
|
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
-
+
+
+
-
+
|
(if *inmemdb* (db:sync-touched *inmemdb* *run-id* force-sync: #t))
(set! sync-time (- (current-milliseconds) start-time))
(set! rem-time (quotient (- 4000 sync-time) 1000))
(debug:print 0 "SYNC: time= " sync-time ", rem-time=" rem-time)
;;
;; set_running after our first pass through
;; set_running after our first pass through and start the db
;;
(if (eq? server-state 'available)
(begin
(set! *inmemdb* (db:setup run-id))
(tasks:server-set-state! tdb server-id "running"))
(tasks:server-set-state! tdb server-id "running")))
(if (and (<= rem-time 4)
(> rem-time 0))
(thread-sleep! rem-time)
(thread-sleep! 4))) ;; fallback for if the math is changed ...
(if (< count 1) ;; 3x3 = 9 secs aprox
|
| ︙ | | |
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
|
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
|
-
+
+
+
+
+
-
+
+
+
|
(http-transport:run
(if (args:get-arg "-server")
(args:get-arg "-server")
"-")
run-id
server-id)) "Server run"))
(th3 (make-thread (lambda ()
(http-transport:keep-running server-id))
(http-transport:keep-running server-id run-id))
"Keep running")))
;; Database connection
;; don't start the db here
(set! *inmemdb* (db:setup run-id))
;; (set! *inmemdb* (db:setup run-id))
(thread-start! th2)
(thread-start! th3)
(set! *didsomething* #t)
(thread-join! th2)
(exit)))))
(define (http-transport:server-signal-handler signum)
|
| ︙ | | |