@@ -236,17 +236,17 @@ (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 #f) ;; FIXME! (server:choose-server *toppath* 'homehost)) + (home-host (get-host-name)) ;; FIXME! (server:choose-server *toppath* 'homehost)) (archive-time (seconds->std-time-str (current-seconds))) (archive-staging-db (conc *toppath* "/.db-snapshot/archive_" archive-time)) (tmp-db-path (conc (dbfile:make-tmpdir-name *toppath* "") "/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))) + (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc home-host ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix))) (if (eq? exit-code 0) (case archiver ((bup) ;; Archive using bup (let* ((bup-init-params (list "-d" archive-dir "init")) (bup-index-params (list "-d" archive-dir "index" archive-staging-db))