Overview
| Comment: | enable custom value for max delay between archive time and test last update time |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.6569-refactor |
| Files: | files | file ages | folders |
| SHA1: |
86a3d1148e38daef29ee1b0baa27dac0 |
| User & Date: | pjhatwal on 2021-01-08 11:42:11 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-01-14
| ||
| 14:55 | check server-key on every request server gets check-in: f74b755ed8 user: pjhatwal tags: v1.6569-refactor-server-key-chk | |
|
2021-01-08
| ||
| 12:12 | cherrypicked changes from 1.65-archive Leaf check-in: b72620bfbb user: pjhatwal tags: v1.6569-pjhatwal-mess | |
| 11:46 | Create new branch named "v1.6569-refactor-archive-structure-change" check-in: bef664ccc1 user: pjhatwal tags: v1.6569-refactor-archive-structure-change | |
| 11:42 | enable custom value for max delay between archive time and test last update time Leaf check-in: 86a3d1148e user: pjhatwal tags: v1.6569-refactor | |
|
2020-09-18
| ||
| 17:30 | added check for file existence before file delete ==/14/1.9/WARN/orion,mars/== NOTE: This is the last v1.65 before the split off. I.e code from before this point IS in the far future v1.65 branch. Code from this point to that branch might NOT be in the branch. check-in: 2769e4b7c9 user: mmgraham tags: v1.65, v1.6569 | |
Changes
Modified archive.scm from [f391351322] to [a5f3e3b4ad].
| ︙ | ︙ | |||
389 390 391 392 393 394 395 396 397 398 399 400 401 402 |
(debug:print-info 1 *default-log-port* "creating triggers after updating linktree")
(rmt:create-all-triggers)
))
(define (archive:ls->list bup-exe archive-dir internal-path)
(let ((cmd (conc bup-exe " -d " archive-dir " ls -l " internal-path "| awk '{print $6}' | sort"))
(res '()))
(handle-exceptions
exn
#f ;; anything goes wrong - assume the process in NOT running.
(with-input-from-pipe
cmd
(lambda ()
(let* ((inl (read-lines)))
| > | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 |
(debug:print-info 1 *default-log-port* "creating triggers after updating linktree")
(rmt:create-all-triggers)
))
(define (archive:ls->list bup-exe archive-dir internal-path)
(let ((cmd (conc bup-exe " -d " archive-dir " ls -l " internal-path "| awk '{print $6}' | sort"))
(res '()))
(debug:print-info 0 *default-log-port* cmd)
(handle-exceptions
exn
#f ;; anything goes wrong - assume the process in NOT running.
(with-input-from-pipe
cmd
(lambda ()
(let* ((inl (read-lines)))
|
| ︙ | ︙ | |||
410 411 412 413 414 415 416 | (define (seconds->std-time-str sec) (time->string (seconds->local-time sec) "%Y-%m-%d-%H%M%S")) (define (archive:get-timestamp-dir bup-exe archive-dir testsuite-name run-id test-partial-path test-last-update) | | > | | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 |
(define (seconds->std-time-str sec)
(time->string
(seconds->local-time sec)
"%Y-%m-%d-%H%M%S"))
(define (archive:get-timestamp-dir bup-exe archive-dir testsuite-name run-id test-partial-path test-last-update)
(debug:print-info 0 *default-log-port* "Test last update time:" (seconds->std-time-str test-last-update))
(let* ((internal-path (conc testsuite-name "-" run-id))
(archive-update-delay (string->number (or (configf:lookup *configdat* "archive" "test-update-delay") "900" )))
(ts-list (archive:ls->list bup-exe archive-dir internal-path))
(ds-flag (vector-ref (seconds->local-time) 8)))
(let loop ((hed (car ts-list))
(tail (cdr ts-list)))
(if (and (null? tail) (equal? hed "latest"))
#f
(if (and (not (null? tail)) (equal? hed "latest"))
(loop (car tail) (cdr tail))
(let* ((archive-seconds (time-string->seconds hed ds-flag)))
(if (< (abs (- archive-seconds test-last-update)) archive-update-delay)
(let* ((test-list (archive:ls->list bup-exe archive-dir (conc internal-path "/" hed "/" test-partial-path))))
(if (> (length test-list) 0)
hed
(if (not (null? tail))
(loop (car tail) (cdr tail))
#f)))
(if (null? tail)
|
| ︙ | ︙ | |||
479 480 481 482 483 484 485 486 487 488 489 490 491 492 |
(include-paths (args:get-arg "-include"))
(exclude-pattern (args:get-arg "-exclude-rx"))
(exclude-file (args:get-arg "-exclude-rx-from")))
(if (not archive-timestamp-dir)
(debug:print-error 0 *default-log-port* "Archive not found for testsuite" (common:get-testsuite-name) " run/test/itempath" test-partial-path)
(begin
;; some sanity checks, move an existing path out of the way - iif it is not a toplevel with children
(if (and (not toplevel/children) ;; special handling needed for toplevel with children
prev-test-physical-path
(common:file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in?
(let* ((base (pathname-directory prev-test-physical-path))
(dirn (pathname-file prev-test-physical-path))
(newn (conc base "/." dirn)))
(debug:print-error 0 *default-log-port* "the old directory " prev-test-physical-path ", still exists! Moving it to " newn)
| > | 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 |
(include-paths (args:get-arg "-include"))
(exclude-pattern (args:get-arg "-exclude-rx"))
(exclude-file (args:get-arg "-exclude-rx-from")))
(if (not archive-timestamp-dir)
(debug:print-error 0 *default-log-port* "Archive not found for testsuite" (common:get-testsuite-name) " run/test/itempath" test-partial-path)
(begin
;; some sanity checks, move an existing path out of the way - iif it is not a toplevel with children
(debug:print-info 0 *default-log-port* "Archive time: " archive-timestamp-dir)
(if (and (not toplevel/children) ;; special handling needed for toplevel with children
prev-test-physical-path
(common:file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in?
(let* ((base (pathname-directory prev-test-physical-path))
(dirn (pathname-file prev-test-physical-path))
(newn (conc base "/." dirn)))
(debug:print-error 0 *default-log-port* "the old directory " prev-test-physical-path ", still exists! Moving it to " newn)
|
| ︙ | ︙ |