Overview
Comment: | Return to using portlogger for getting candidate port numbers. Got dependencies fixed so make -j now works |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
c8631e33deb1d8b29de4509b547b798a |
User & Date: | matt on 2023-04-06 06:25:17 |
Other Links: | branch diff | manifest | tags |
Context
2023-04-06
| ||
06:35 | Turn on portlogger check-in: 5cf2865c15 user: matt tags: v1.80 | |
06:25 | Return to using portlogger for getting candidate port numbers. Got dependencies fixed so make -j now works check-in: c8631e33de user: matt tags: v1.80 | |
01:48 | Changed a missed .megatest to .mtdb. Removed useless thread. Removed old commented code. check-in: 909cd71d01 user: matt tags: v1.80 | |
Changes
Modified Makefile from [dd8860eb70] to [497ade23e7].
︙ | |||
22 23 24 25 26 27 28 | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | - + - + + + + - + + + + - + + | CSCOPTS= INSTALL=install SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm \ server.scm configf.scm db.scm keys.scm margs.scm \ process.scm runs.scm tasks.scm tests.scm genexample.scm \ http-transport.scm tdb.scm client.scm mt.scm \ ezsteps.scm lock-queue.scm rmt.scm api.scm \ |
︙ | |||
72 73 74 75 76 77 78 | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | - - + + | # I'm not sure the cp is a good idea, changed a lot of things and it may not have been necessary... # mofiles/%.o %.import.scm : %.scm megatest-fossil-hash.scm # @[ -e mofiles ] || mkdir -p mofiles # csc $(CSCOPTS) -I mofiles -I $* -J -c $< -o $*.o # cp $*.o mofiles/$*.o # @touch $*.import.scm # ensure it is touched after the .o is made |
︙ | |||
127 128 129 130 131 132 133 | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | - | items.o \ keys.o \ launch.o \ lock-queue.o \ margs.o \ mt.o \ ods.o \ |
︙ | |||
187 188 189 190 191 192 193 194 | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | + - + | tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm mofiles-made : $(MOFILES) make $(MOIMPFILES) touch mofiles-made |
︙ |
Modified dbmod.scm from [b286c5dacd] to [8ac607e451].
︙ | |||
533 534 535 536 537 538 539 540 541 542 | 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | ;;====================================================================== ;; Moved from dbfile ;;====================================================================== ;; wait up to aprox n seconds for a journal to go away ;; (define (tasks:wait-on-journal path n #!key (remove #f)(waiting-msg #f)) (if (not (string? path)) (debug:print-error 0 *default-log-port* "Called tasks:wait-on-journal with path=" path " (not a string)") (let ((fullpath (conc path "-journal"))) (handle-exceptions exn (begin (print-call-chain (current-error-port)) (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (debug:print 5 *default-log-port* " exn=" (condition->list exn)) (debug:print 0 *default-log-port* "tasks:wait-on-journal failed. Continuing on, you can ignore this call-chain") #t) ;; if stuff goes wrong just allow it to move on (let loop ((journal-exists (file-exists? fullpath)) (count n)) ;; wait ten times ... (if journal-exists (begin (if (and waiting-msg (eq? (modulo n 30) 0)) (debug:print 0 *default-log-port* waiting-msg)) (if (> count 0) (begin (thread-sleep! 1) (loop (file-exists? fullpath) (- count 1))) (begin (debug:print 0 *default-log-port* "ERROR: removing the journal file " fullpath ", this is not good. Look for disk full, write access and other issues.") (if remove (system (conc "rm -rf " fullpath))) #f))) #t)))))) ) |
Modified megatest.scm from [93e1fcbbf1] to [39b3d98b1d].
︙ | |||
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | + + + | (declare (uses env)) (declare (uses diff-report)) (declare (uses db)) (declare (uses dbfile)) (declare (uses dbfile.import)) (declare (uses dbmod)) (declare (uses dbmod.import)) (declare (uses portlogger)) (declare (uses portlogger.import)) (declare (uses tcp-transportmod)) (declare (uses tcp-transportmod.import)) (declare (uses rmtmod)) (declare (uses rmtmod.import)) ;; (declare (uses debugprint)) ;; (declare (uses debugprint.import)) ;; (declare (uses ftail)) ;; (import ftail) (import (prefix mtargs args:) debugprint dbmod commonmod dbfile portlogger tcp-transportmod rmtmod ) (define *db* #f) ;; this is only for the repl, do not use in general!!!! (include "common_records.scm") |
︙ |
Modified portlogger.scm from [c0a80358a3] to [0097927637].
︙ | |||
13 14 15 16 17 18 19 | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | - - - - - + + + + + + + + - + - + - + - - + | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; |
︙ | |||
122 123 124 125 126 127 128 | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | - + - - - - - - + | (sqlite3:fold-row (lambda (var curr) (or curr var curr)) #f db "SELECT (port) FROM ports WHERE state='released' LIMIT 1;"))) |
︙ | |||
184 185 186 187 188 189 190 | 181 182 183 184 185 186 187 188 | + | state) state)) ((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed))))) (sqlite3:finalize! db) result)) ;; (print (apply portlogger:main (cdr (argv)))) ) |
Modified tasks.scm from [a5276386f9] to [e380911710].
︙ | |||
41 42 43 44 45 46 47 | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | (include "task_records.scm") (include "db_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== |
︙ |
Modified tcp-transportmod.scm from [e059c94f36] to [0351f1bbdd].
︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | + | ;;====================================================================== (declare (unit tcp-transportmod)) (declare (uses debugprint)) (declare (uses commonmod)) (declare (uses dbfile)) (declare (uses dbmod)) (declare (uses portlogger)) (use address-info) (module tcp-transportmod * (import scheme |
︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | + | tcp-server tcp debugprint commonmod dbfile dbmod portlogger ) ;;====================================================================== ;; client ;;====================================================================== ;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic |
︙ | |||
234 235 236 237 238 239 240 | 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 | + + + - + - - - - - - - - - - - - - - | (if (file-exists? servinf) (begin (debug:print 0 *default-log-port* "INFO: no ping response from server "host":"port" for "dbfname) (if (and (file-exists? servinf) (> (- (current-seconds)(file-modification-time servinf)) 60)) (begin (debug:print 0 *default-log-port* "INFO: "servinf" file seems old and no ping response, removing it.") (handle-exceptions exn #f |
︙ | |||
499 500 501 502 503 504 505 | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 | - + + + | ;; (define (wait-and-close uconn) ;; (thread-join! (udat-cmd-thread uconn)) ;; (tcp-close (udat-socket uconn))) ;; ;; (define (tt:shutdown-server ttdat) |
︙ | |||
659 660 661 662 663 664 665 666 667 668 669 670 671 672 | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 | + + + + + + + + + + + + + | exn (if (< port 65535) (begin (thread-sleep! 0.25) (setup-listener uconn (+ port 1))) #f) (connect-listener uconn port))) (define (setup-listener-portlogger uconn) (let ((port (portlogger:open-run-close portlogger:find-port))) (assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn) (handle-exceptions exn (if (< port 65535) (begin (portlogger:open-run-close portlogger:set-failed port) (thread-sleep! 0.25) (setup-listener uconn (portlogger:open-run-close portlogger:find-port))) #f) (connect-listener uconn port)))) (define (connect-listener uconn port) ;; (tcp-listener-socket LISTENER)(socket-name so) ;; sockaddr-address, sockaddr-port, sockaddr->string (let* ((tlsn (tcp-listen port 1000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]]) (addr (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname))) (tt-port-set! uconn port) |
︙ |