Megatest

Check-in [8a3f889655]
Login
Overview
Comment:small tweaks - not there yet
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-revolution
Files: files | file ages | folders
SHA1: 8a3f889655a9efe92831700267b0f7e6cef6ac05
User & Date: matt on 2023-11-17 20:16:26
Other Links: branch diff | manifest | tags
Context
2023-11-20
19:18
Chipping away at server issues check-in: 30862628e2 user: mrwellan tags: v1.80-revolution
2023-11-17
20:16
small tweaks - not there yet check-in: 8a3f889655 user: matt tags: v1.80-revolution
2023-11-16
15:49
Moved sync to inside the server check-in: f249e200e4 user: mrwellan tags: v1.80-revolution
Changes

Modified tcp-transportmod.scm from [8a99124972] to [b10f8d79d9].

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)))
		    (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)
						(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.")







|



|







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







|







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