| ︙ | | |
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
+
+
+
+
+
|
;;
(define (rmt:general-open-connection remdat apath dbname #!key (num-tries 5))
(assert (not (equal? dbname ".db/main.db")) "ERROR: general-open-connection should never be called with main as the db")
(let* ((mdbname (db:run-id->dbname #f))
(fullname (db:dbname->path apath dbname))
(conns (remotedat-conns remdat))
(mconn (rmt:get-conn remdat apath mdbname)))
(if (and mconn
(not (debug:print-logger)))
(begin
(debug:print-info 0 *default-log-port* "Turning on logging to main, look in logs dir for main log.")
(debug:print-logger rmt:log-to-main)))
(cond
((or (not mconn) ;; no channel open to main?
(< (conndat-expires mconn)(+ (current-seconds) 2))) ;; restablish connection if less than 2 seconds on the lease
(rmt:open-main-connection remdat apath)
(rmt:general-open-connection remdat apath mdbname))
((not (rmt:get-conn remdat apath dbname)) ;; no channel open to dbname?
(let* ((res (rmt:send-receive-real remdat apath mdbname 'get-server `(,apath ,dbname))))
|
| ︙ | | |
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
-
+
-
-
-
-
|
expires: (+ (current-seconds) 60))))
(else
(debug:print-info 0 *default-log-port* "return data from starting server did not match host port servkey pid ipaddr apath dbname " res)))
res)
(begin
(debug:print-info 0 *default-log-port* "Unexpected result: " res)
res)))))))
(if (and mconn
(not (debug:print-logger)))
(begin
(debug:print-info 0 *default-log-port* "Turning on logging to main, look in logs dir for main log.")
(debug:print-logger rmt:log-to-main)))
|
| ︙ | | |
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
-
-
+
+
+
+
|
(key #f)
(host (conndat-ipaddr conn))
(port (conndat-port conn))
(payload `((cmd . ,cmd)
(key . ,(conndat-srvkey conn))
(params . ,params)))
(res (send-receive-nn soc ;; (open-send-receive-nn (conc host":"port)
(sexpr->string payload))))
(string->sexpr res))))
(sexpr->string payload))))
(if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr
#f
(string->sexpr res)))))
;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.
;;
;; Purpose - call the main.db server and request a server be started
;; for the given area path and dbname
;;
|
| ︙ | | |
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
|
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
|
-
+
|
(rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))
) ;; )
(define (rmt:get-main-run-stats run-id)
(rmt:send-receive 'get-main-run-stats #f (list run-id)))
(define (rmt:log-to-main . params)
(rmt:send-receive 'log-to-main #f (cons #f params)))
(rmt:send-receive 'log-to-main #f params))
(define (rmt:get-var run-id varname)
(rmt:send-receive 'get-var run-id (list run-id varname)))
(define (rmt:del-var run-id varname)
(rmt:send-receive 'del-var run-id (list run-id varname)))
|
| ︙ | | |
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
|
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
|
+
-
+
|
;;======================================================================
;; S E R V E R
;; ======================================================================
(define (http-get-function fnkey)
(hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet")))
;; Main entry point to start a server. was start-server
(define (rmt:run hostn)
;; ;; Configurations for server
;; (tcp-buffer-size 2048)
;; (max-connections 2048)
(debug:print 2 *default-log-port* "Attempting to start the server ...")
(debug:print 2 *default-log-port* "PID: "(current-process-id)". Attempting to start the server ...")
(let* ((db #f) ;; (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
(hostname (get-host-name))
(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)))
|
| ︙ | | |