Megatest

Check-in [6c641b6f76]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added exception handlers back - within threads they have to be dealth with. Added handling of busy exception and it seems to be working better (buy not enough testing yet to be sure).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 6c641b6f769966fc118c764c6491b63e9d0a8b88
User & Date: matt on 2023-05-22 11:47:51
Other Links: branch diff | manifest | tags
Context
2023-05-22
12:09
Changed delay to linear function 0.25 * number of threads over 3. check-in: f42bab9286 user: matt tags: v1.80
11:47
Added exception handlers back - within threads they have to be dealth with. Added handling of busy exception and it seems to be working better (buy not enough testing yet to be sure). check-in: 6c641b6f76 user: matt tags: v1.80
10:32
Remove some exception handlers that were not fully specified check-in: 2f04a0e3c6 user: matt tags: v1.80
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified dbmod.scm from [bf0b6456e0] to [88ea4fc563].

︙︙
105
106
107
108
109
110
111


112













113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

	    (sync-proc last-update)

	    ;; MOVE THIS CALL TO INSIDE THE sync-proc CALL
	    (dbr:dbstruct-last-update-set! dbstruct curr-secs)
	    )))
    (assert (sqlite3:database? dbh) "FATAL: bad db handle in dbmod:with-db") 
    (if use-mutex (mutex-lock! *db-with-db-mutex*))


    (let* ((res (apply proc dbdat dbh params)))













      (if use-mutex (mutex-unlock! *db-with-db-mutex*))
      res)))

(define (db:with-db dbstruct run-id w/r proc . params)
  (dbmod:with-db dbstruct run-id w/r proc params))

;; 
(define (dbmod:open-cachedb-db init-proc dbfullname)
  (let* ((db      (if dbfullname
		      (dbmod:safely-open-db dbfullname init-proc #t)
		      (sqlite3:open-database ":memory:")))
	 (handler (sqlite3:make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)
    (init-proc db)
    db))

(define (dbmod:open-db dbstruct run-id dbinit)
  (or (dbr:dbstruct-dbdat dbstruct)
      (let* ((dbdat (make-dbr:dbdat








>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>











|








105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146

	    (sync-proc last-update)

	    ;; MOVE THIS CALL TO INSIDE THE sync-proc CALL
	    (dbr:dbstruct-last-update-set! dbstruct curr-secs)
	    )))
    (assert (sqlite3:database? dbh) "FATAL: bad db handle in dbmod:with-db") 
    (if use-mutex (mutex-lock! *db-with-db-mutex*))
    (let* ((res (let loop ((count 3))
		  (condition-case
		   (apply proc dbdat dbh params)
		   (exn (busy)
			(if (> count 0)
			    (begin
			      (debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, will try "count" more times.")
			      (thread-sleep! 1)
			      (loop (- count 1)))
			    (begin
			      (debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, giving up.")
			      (exit 1))))
		   (exn ()
			(dbfile:print-err exn "ERROR: Unknown error with database for run-id "run-id", message: "
					  ((condition-property-accessor 'exn 'message) exn))
			(exit 2))))))
      (if use-mutex (mutex-unlock! *db-with-db-mutex*))
      res)))

(define (db:with-db dbstruct run-id w/r proc . params)
  (dbmod:with-db dbstruct run-id w/r proc params))

;; 
(define (dbmod:open-cachedb-db init-proc dbfullname)
  (let* ((db      (if dbfullname
		      (dbmod:safely-open-db dbfullname init-proc #t)
		      (sqlite3:open-database ":memory:")))
	 (handler (sqlite3:make-busy-timeout 136000)))
    (sqlite3:set-busy-handler! db handler)
    (init-proc db)
    db))

(define (dbmod:open-db dbstruct run-id dbinit)
  (or (dbr:dbstruct-dbdat dbstruct)
      (let* ((dbdat (make-dbr:dbdat
︙︙

Modified tcp-transportmod.scm from [9720e8582c] to [11cd5cbd4c].

︙︙
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811


812
813
814
815
816
817
818
819
820
821
822

;; for the entire server system
;;
(define (tt:start-tcp-server ttdat)
  (setup-listener-portlogger ttdat) ;; set up tcp-listener
  (let* ((socket   (tt-socket  ttdat))
	 (handler  (tt-handler ttdat)) ;; the handler comes from our client setting a handler function
	 (handler-proc (lambda ()
			 (let* ((indat         (deserialize))
				(result        #f)
				(exn-result    #f)
				(stdout-result (with-output-to-string
						 (lambda ()
						   (let ((res ;; ndle-exceptions
							      ;;  exn
							      ;; let* ((errdat (condition->list exn)))
							      ;;  (set! exn-result errdat)
							      ;;  (debug:print 0 *default-log-port* "ERROR: handler exception, these are bad, will exit in five seconds.")
							      ;;  (pp errdat *default-log-port*)
							      ;;  ;; these are always bad, set up an exit thread
							      ;;  (thread-start! (make-thread (lambda ()
							      ;; 				(thread-sleep! 5)
							      ;; 				(exit))))
							      ;;  #f)
								(handler indat) ;; this is the proc being called by the remote client
								)) ;; )
						     (set! result res)))))
				(full-result (list result exn-result (if (equal? stdout-result "") #f stdout-result))))
			   ;; (handle-exceptions
			   ;;     exn
			   ;;   (begin
			   ;;     (debug:print 0 *default-log-port* "Serialization failure. full-result="full-result)


			   ;;     ;; (serialize '(#f #f #f)) ;; doesn't work - the first call to serialize caused failure
			   ;;     
			   ;;     )
			     (serialize full-result))))) ;; )
    ((make-tcp-server socket handler-proc)
     #f ;; yes, send error messages to std-err
     )))

;; create a tcp listener and return a populated udat struct with
;; my port, address, hostname, pid etc.
;; return #f if fail to find a port to allocate.








|




|
|
|
|
|
|
|
|
|
|
|

|

|
|
|
|
|
>
>
|
<
<
|








781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814


815
816
817
818
819
820
821
822

;; for the entire server system
;;
(define (tt:start-tcp-server ttdat)
  (setup-listener-portlogger ttdat) ;; set up tcp-listener
  (let* ((socket   (tt-socket  ttdat))
	 (handler  (tt-handler ttdat)) ;; the handler comes from our client setting a handler function
	 (handler-proc (lambda ()
			 (let* ((indat         (deserialize)) ;; could use: (thread-terminate! (current-thread))
				(result        #f)
				(exn-result    #f)
				(stdout-result (with-output-to-string
						 (lambda ()
						   (let ((res (handle-exceptions
							       exn
							       (let* ((errdat (condition->list exn)))
								 (set! exn-result errdat)
								 (debug:print 0 *default-log-port* "ERROR: handler exception, these are bad, will exit in five seconds.")
								 (pp errdat *default-log-port*)
								 ;; these are always bad, set up an exit thread
								 (thread-start! (make-thread (lambda ()
							      				       (thread-sleep! 5)
							      				       (exit))))
							       #f)
								(handler indat) ;; this is the proc being called by the remote client
								)))
						     (set! result res)))))
				(full-result    (list result exn-result (if (equal? stdout-result "") #f stdout-result))))
			   (handle-exceptions
			       exn
			     (begin
			       (debug:print 0 *default-log-port* "Serialization failure. full-result="full-result)
			       (thread-start! (make-thread (lambda ()
							     (thread-sleep! 5)
							     (exit)))))    ;; (serialize '(#f #f #f)) ;; doesn't work - the first call to serialize caused failure


			     (serialize full-result))))))
    ((make-tcp-server socket handler-proc)
     #f ;; yes, send error messages to std-err
     )))

;; create a tcp listener and return a populated udat struct with
;; my port, address, hostname, pid etc.
;; return #f if fail to find a port to allocate.
︙︙

This page was generated in about 0.106s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00