536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
|
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
|
-
+
-
+
|
;; wait for a port before creating the registration file
;;
(let* ((db-locked-in #f)
(areapath (tt-areapath ttdat))
(nosyncdbpath (conc areapath"/.mtdb"))
(cleanup (lambda ()
(if (tt-cleanup-proc ttdat)
((tt-cleanup-proc ttdat)))
((tt-cleanup-proc ttdat))) ;; removes .servinfo file
(dbfile:with-no-sync-db nosyncdbpath
(lambda (db)
(let* ((dbtmpname (dbr:dbstruct-dbtmpname dbstruct)))
(debug:print-info 0 *default-log-port* "Running clean up, including removing db file "dbtmpname)
;; (debug:print-info 0 *default-log-port* "Running clean up, including removing db file "dbtmpname)
(db:no-sync-del! db dbfname)
))))))
(set! *server-info* ttdat)
(let loop ((count 0))
(if (> count 240)
(begin
(debug:print 0 *default-log-port* "FATAL: Could not start a tcp server, giving up.")
|
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
|
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
|
-
+
|
(goodfiles '()))
;; filter the files here by looking in processes table (if we are not main.db)
;; and or look at the time stamp on the servinfo file, a running server will
;; touch the file every minute (again, this will only apply for main.db)
(for-each (lambda (fname)
(let* ((age (- (current-seconds)(file-modification-time fname))))
(if (> age 20) ;; can't trust it if over twenty seconds old
(if (> age 200) ;; can't trust it if over twenty seconds old
(begin
(debug:print 0 *default-log-port* "WARNING: removing stale servinfo file "fname)
(handle-exceptions
exn
(debug:print 0 *default-log-port* "WARNING: error attempting to remove stale servinfo file "fname)
(delete-file fname))) ;;
(set! goodfiles (cons fname goodfiles)))))
|