Megatest

Diff
Login

Differences From Artifact [a7eb8f34d2]:

To Artifact [fd3e9e2a92]:


51
52
53
54
55
56
57

58

59
60
61
62
63
64
65
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66







+
-
+







	chicken.process
	chicken.process-context
	chicken.process-context.posix
	chicken.sort
	chicken.string
	chicken.time
	chicken.time.posix
	system-information

	
	(prefix base64 base64:)
;; 	csv-xml
	directory-utils
	matchable
	regex
	s11n
	srfi-1
415
416
417
418
419
420
421
422

423
424
425
426
427
428
429
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430







-
+







        (archiver       (let ((s (configf:lookup *configdat* "archive" "archiver")))
			   (if s (string->symbol s) 'bup)))
        (rsync-exe (or (configf:lookup *configdat* "archive" "rsync") "rsync"))   
        (print-prefix      "Running: ") 
        (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target-patt run-patt "megatest-db"))
	(archive-dir  (if archive-info (cdr archive-info) #f))
	(archive-id   (if archive-info (car archive-info) -1))
        (home-host (common:get-homehost))
   (home-host (get-host-name)) ;; common:get-homehost)) ;; TODO: Fix this.
        (archive-time (seconds->std-time-str (current-seconds)))
        (archive-staging-db (conc *toppath* "/.db-snapshot/archive_" archive-time))
        (tmp-db-path (conc (common:get-db-tmp-area) "/megatest.db"))
        (dbfile             (conc  archive-staging-db "/megatest.db"))) 
        (create-directory archive-staging-db #t)
        (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc (car home-host) ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix)))
            (if (eq? exit-code 0)