Overview
Comment: | fix for crash with error (match) no matching pattern |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6569-refactor-server-key-chk |
Files: | files | file ages | folders |
SHA1: |
4c4d63c3e058981d520aa9b323fa0fe6 |
User & Date: | pjhatwal on 2021-01-27 15:30:12 |
Other Links: | branch diff | manifest | tags |
Context
2021-01-28
| ||
18:40 | fixes to crashes with server id mismatch check-in: 70f5d2ff31 user: pjhatwal tags: v1.6569-refactor-server-key-chk | |
2021-01-27
| ||
15:30 | fix for crash with error (match) no matching pattern check-in: 4c4d63c3e0 user: pjhatwal tags: v1.6569-refactor-server-key-chk | |
2021-01-26
| ||
18:34 | merged v1.6569-gt-crash-fix and fixed launch.scm to match check-in: 81f57a1e46 user: mmgraham tags: v1.6569-refactor-server-key-chk | |
Changes
Modified server.scm from [d960326e6f] to [2d034b6d97].
︙ | ︙ | |||
169 170 171 172 173 174 175 | ;; any changes to number of elements returned by this fuction will dirctly affect server:record->url,server:record->id,server:kill,server:get-num-alive which uses match let (define (server:logf-get-start-info logf) (let ((rx (regexp "^SERVER STARTED: (\\S+):(\\d+) AT ([\\d\\.]+) server-id: (\\S+)"))) ;; SERVER STARTED: host:port AT timesecs server id (handle-exceptions exn (begin | | > > | > > | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | ;; any changes to number of elements returned by this fuction will dirctly affect server:record->url,server:record->id,server:kill,server:get-num-alive which uses match let (define (server:logf-get-start-info logf) (let ((rx (regexp "^SERVER STARTED: (\\S+):(\\d+) AT ([\\d\\.]+) server-id: (\\S+)"))) ;; SERVER STARTED: host:port AT timesecs server id (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "failed to get server info from " logf ", exn=" exn) (list #f #f #f #f)) ;; no idea what went wrong, call it a bad server (with-input-from-file logf (lambda () (let loop ((inl (read-line)) (lnum 0)) (if (not (eof-object? inl)) (let ((mlst (string-match rx inl))) (if (not mlst) (if (< lnum 500) ;; give up if more than 500 lines of server log read (loop (read-line)(+ lnum 1)) (begin (debug:print-info 0 *default-log-port* "failed to get server info from first 500 lines of " logf ) (list #f #f #f #f))) (let ((dat (cdr mlst))) (list (car dat) ;; host (string->number (cadr dat)) ;; port (string->number (caddr dat)) (cadr (cddr dat)))))) (begin (debug:print-info 0 *default-log-port* "failed to get server info from " logf " at " (current-seconds)) (list #f #f #f #f))))))))) ;; get a list of servers with all relevant data ;; ( mod-time host port start-time pid ) ;; (define (server:get-list areapath #!key (limit #f)) (let ((fname-rx (regexp "^(|.*/)server-(\\d+)-(\\S+).log$")) (day-seconds (* 24 60 60))) |
︙ | ︙ | |||
243 244 245 246 247 248 249 250 251 252 253 254 255 | new-res) (loop (car tal)(cdr tal) new-res))))))))) (define (server:get-num-alive srvlst) (let ((num-alive 0)) (for-each (lambda (server) (match-let (((mod-time host port start-time server-id pid) server)) (let* ((uptime (- (current-seconds) mod-time)) (runtime (if start-time (- mod-time start-time) 0))) | > > > > | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 | new-res) (loop (car tal)(cdr tal) new-res))))))))) (define (server:get-num-alive srvlst) (let ((num-alive 0)) (for-each (lambda (server) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "failed to get server start-time and/or mod-time from " server ", exn=" exn)) (match-let (((mod-time host port start-time server-id pid) server)) (let* ((uptime (- (current-seconds) mod-time)) (runtime (if start-time (- mod-time start-time) 0))) (if (< uptime 5)(set! num-alive (+ num-alive 1))))))) srvlst) num-alive)) ;; given a list of servers get a list of valid servers, i.e. at least ;; 10 seconds old, has started and is less than 1 hour old and is ;; active (i.e. mod-time < 10 seconds ;; |
︙ | ︙ | |||
307 308 309 310 311 312 313 314 315 316 317 | (not (null? srvrs))) (let* ((len (length srvrs)) (idx (random len))) (list-ref srvrs idx)) #f))) (define (server:record->id servr) (match-let (((mod-time host port start-time server-id pid) servr)) (if server-id server-id | > > > > > | > > > > > | | 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 | (not (null? srvrs))) (let* ((len (length srvrs)) (idx (random len))) (list-ref srvrs idx)) #f))) (define (server:record->id servr) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "failed to get server id from " server ", exn=" exn) #f) (match-let (((mod-time host port start-time server-id pid) servr)) (if server-id server-id #f)))) (define (server:record->url servr) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "failed to get server url from " server ", exn=" exn) #f) (match-let (((mod-time host port start-time server-id pid) servr)) (if (and host port) (conc host ":" port) #f)))) (define (server:get-client-signature) ;; BB> why is this proc named "get-"? it returns nothing -- set! has not return value. (if *my-client-signature* *my-client-signature* (let ((sig (server:mk-signature))) (set! *my-client-signature* sig) *my-client-signature*))) |
︙ | ︙ | |||
439 440 441 442 443 444 445 446 447 | ;; ((nmsg)(nmsg-transport:ping (tasks:hostinfo-get-interface server) ))) (if res server-url #f))) (define (server:kill servr) (match-let (((mod-time hostname port start-time pid) servr)) | > > > > > | | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 | ;; ((nmsg)(nmsg-transport:ping (tasks:hostinfo-get-interface server) ))) (if res server-url #f))) (define (server:kill servr) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "failed to get host and/or port from " server ", exn=" exn) #f) (match-let (((mod-time hostname port start-time pid) servr)) (tasks:kill-server hostname pid)))) ;; called in megatest.scm, host-port is string hostname:port ;; ;; NOTE: This is NOT called directly from clients as not all transports support a client running ;; in the same process as the server. ;; (define (server:ping host-port-in server-id #!key (do-exit #f)) |
︙ | ︙ |
Modified tasks.scm from [2899fc0540] to [a73c5b318e].
︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 | (debug:print-info 0 *default-log-port* "syncing tests") (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) (debug:print-info 0 *default-log-port* "syncing test steps") (tasks:sync-test-steps dbh cached-info test-step-ids smallest-last-update-time) (debug:print-info 0 *default-log-port* "syncing test data") (tasks:sync-test-gen-data dbh cached-info test-data-ids smallest-last-update-time) (print "----------done---------------"))) | | | 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 | (debug:print-info 0 *default-log-port* "syncing tests") (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) (debug:print-info 0 *default-log-port* "syncing test steps") (tasks:sync-test-steps dbh cached-info test-step-ids smallest-last-update-time) (debug:print-info 0 *default-log-port* "syncing test data") (tasks:sync-test-gen-data dbh cached-info test-data-ids smallest-last-update-time) (print "----------done---------------"))) (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" (current-seconds)))) (debug:print-info 0 "smallest-time :" smallest-time " last-sync-time " last-sync-time) (if (not (and target run-name)) (if (or (and smallest-time (> smallest-time last-sync-time)) (and smallest-time (eq? last-sync-time 0))) (pgdb:write-sync-time dbh area-info smallest-time))))) ;;this needs to be changed (if (tasks:set-area dbh configdat) (tasks:sync-to-postgres configdat dest) (begin |
︙ | ︙ |