Overview
| Comment: | Added host name to messages about server not started |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80 |
| Files: | files | file ages | folders |
| SHA1: |
21f45d51cf103a073f39f21e8db54d7b |
| User & Date: | mmgraham on 2023-04-09 13:27:11 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-04-10
| ||
| 11:58 | Merged fork check-in: 962cf22780 user: mrwellan tags: v1.80 | |
|
2023-04-09
| ||
| 13:27 | Added host name to messages about server not started check-in: 21f45d51cf user: mmgraham tags: v1.80 | |
|
2023-04-07
| ||
| 08:25 | Added switchable support for db on /tmp instead of inmem. Added couple asserts to help find why run-id and servers are not aligned in some cases. check-in: cfcc13973c user: matt tags: v1.80 | |
Changes
Modified dbfile.scm from [cf63c9cd5f] to [3323e46fc8].
| ︙ | ︙ | |||
1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 |
;; to get the lock
;;
(define (dbfile:simple-file-lock fname #!key (expire-time 300))
(let ((fmod-time (handle-exceptions
ext
(current-seconds)
(file-modification-time fname))))
(if (file-exists? fname)
(if (> (- (current-seconds) fmod-time) expire-time)
(begin
(handle-exceptions exn #f (delete-file* fname))
(dbfile:simple-file-lock fname expire-time: expire-time))
| > > > | > > > | | | | > > > | > > | 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 |
;; to get the lock
;;
(define (dbfile:simple-file-lock fname #!key (expire-time 300))
(let ((fmod-time (handle-exceptions
ext
(current-seconds)
(file-modification-time fname))))
;; if the file exists, if it has expired, delete it and call this function recursively.
(if (file-exists? fname)
(if (> (- (current-seconds) fmod-time) expire-time)
(begin
(dbfile:print-err "simple-file-lock: removing expired file: " fname)
(handle-exceptions exn #f (delete-file* fname))
(dbfile:simple-file-lock fname expire-time: expire-time))
#f
)
;; If it doesn't exist, write the host name and process id to the file
(let ((key-string (conc (get-host-name) "-" (current-process-id) ": " (argv)))
(oup (open-output-file fname)))
(with-output-to-port
oup
(lambda ()
(print key-string)))
(close-output-port oup)
;; sleep 3 seconds and make sure it still exists and contains the same host/process id.
;; if not, return #f
(thread-sleep! 0.25)
(if (file-exists? fname)
(handle-exceptions exn
#f
(with-input-from-file fname
(lambda ()
(equal? key-string (read-line)))))
(begin
(dbfile:print-err "dbfile:simple-file-lock created " fname " but it was gone 3 seconds later")
#f
)
)
)
)
)
)
(define (dbfile:simple-file-lock-and-wait fname #!key (expire-time 300))
(let ((end-time (+ expire-time (current-seconds))))
|
| ︙ | ︙ | |||
1350 1351 1352 1353 1354 1355 1356 |
(define (dbfile:simple-file-release-lock fname)
(handle-exceptions
exn
#f ;; I don't really care why this failed (at least for now)
(delete-file* fname)))
(define (dbfile:with-simple-file-lock fname proc #!key (expire-time 300))
| > | > > > | > | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 |
(define (dbfile:simple-file-release-lock fname)
(handle-exceptions
exn
#f ;; I don't really care why this failed (at least for now)
(delete-file* fname)))
(define (dbfile:with-simple-file-lock fname proc #!key (expire-time 300))
(let ((start-time (current-seconds))
(gotlock (dbfile:simple-file-lock-and-wait fname expire-time: expire-time))
(end-time (current-seconds))
)
(if gotlock
(let ((res (proc)))
(dbfile:simple-file-release-lock fname)
res)
(begin
(dbfile:print-err "dbfile:with-simple-file-lock: " fname " is locked by " )
(with-input-from-file fname
(lambda ()
(dbfile:print-err (read-line))))
(dbfile:print-err "wait time = " (- end-time start-time))
(dbfile:print-err "ERROR: simple file lock could not get a lock for " fname " in " expire-time " seconds")
#f
)
)
)
)
(define *get-cache-stmth-mutex* (make-mutex))
|
| ︙ | ︙ |
Modified tcp-transportmod.scm from [a71da4bf27] to [347b2c4dd7].
| ︙ | ︙ | |||
602 603 604 605 606 607 608 |
(assert mtexe "FATAL: tt:server-process-run called without mtexe defined.")
;; mtest -server - -m testsuite:ext-tests -db 6.db
(let* ((dbfname (dbmod:run-id->dbfname run-id))
(load (get-normalized-cpu-load))
(nrun (number-of-processes-running (conc "mtest.*server.*"testsuite".*"dbfname))))
(cond
((> load 2.0)
| | | | 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 |
(assert mtexe "FATAL: tt:server-process-run called without mtexe defined.")
;; mtest -server - -m testsuite:ext-tests -db 6.db
(let* ((dbfname (dbmod:run-id->dbfname run-id))
(load (get-normalized-cpu-load))
(nrun (number-of-processes-running (conc "mtest.*server.*"testsuite".*"dbfname))))
(cond
((> load 2.0)
(debug:print 0 *default-log-port* "Normalized load "load" on " (get-host-name) " is over the limit of 2.0. Not starting a server.")
(thread-sleep! 1))
((> nrun 100)
(debug:print 0 *default-log-port* nrun" servers running on " (get-host-name) ", not starting another.")
(thread-sleep! 1))
(else
(if (not (file-exists? (conc areapath"/logs")))
(create-directory (conc areapath"/logs") #t))
(let* ((logfile (conc areapath "/logs/server-"dbfname"-"(current-process-id)".log")) ;; -" curr-pid "-" target-host ".log"))
(cmdln (conc
mtexe
|
| ︙ | ︙ |