@@ -363,11 +363,11 @@ (> (file-size fullname) 200000)) (and (string-match "^server-.*.log" file) (> (- (current-seconds) (file-modification-time fullname)) (* 8 60 60)))) (let ((gzfile (conc fullname ".gz"))) - (if (common:file-exists? gzfile) + (if (file-exists? gzfile) (begin (debug:print-info 0 *default-log-port* "removing " gzfile) (delete-file gzfile))) (debug:print-info 0 *default-log-port* "compressing " file) (system (conc "gzip " fullname))) @@ -393,11 +393,11 @@ "WARNING: Version mismatch!\n" " expected: " (common:version-signature) "\n" " got: " (common:get-last-run-version)) (cond ((get-environment-variable "MT_SKIP_DB_MIGRATE") #t) - ((and (common:file-exists? mtconf) (common:file-exists? dbfile) (not read-only) + ((and (file-exists? mtconf) (file-exists? dbfile) (not read-only) (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db (debug:print 0 *default-log-port* " I see you are the owner of megatest.config, attempting to cleanup and reset to new version") (handle-exceptions exn (begin @@ -404,14 +404,14 @@ (debug:print 0 *default-log-port* "Failed to switch versions.") (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (print-call-chain (current-error-port)) (exit 1)) (common:cleanup-db dbstruct))) - ((not (common:file-exists? mtconf)) + ((not (file-exists? mtconf)) (debug:print 0 *default-log-port* " megatest.config does not exist in this area. Cannot proceed with megatest version migration.") (exit 1)) - ((not (common:file-exists? dbfile)) + ((not (file-exists? dbfile)) (debug:print 0 *default-log-port* " megatest.db does not exist in this area. Cannot proceed with megatest version migration.") (exit 1)) ((not (eq? (current-user-id)(file-owner mtconf))) (debug:print 0 *default-log-port* " You do not own megatest.db in this area. Cannot proceed with megatest version migration.") (exit 1)) @@ -524,11 +524,11 @@ ;; (define (common:simple-file-lock fname #!key (expire-time 300)) (handle-exceptions exn #f ;; don't really care what went wrong right now. NOTE: I have not seen this one actually fail. - (if (common:file-exists? fname) + (if (file-exists? fname) (if (> (- (current-seconds)(file-modification-time fname)) expire-time) (begin (delete-file* fname) (common:simple-file-lock fname expire-time: expire-time)) #f) @@ -535,11 +535,11 @@ (let ((key-string (conc (get-host-name) "-" (current-process-id)))) (with-output-to-file fname (lambda () (print key-string))) (thread-sleep! 0.25) - (if (common:file-exists? fname) + (if (file-exists? fname) (with-input-from-file fname (lambda () (equal? key-string (read-line)))) #f))))) @@ -922,19 +922,19 @@ #f (let loop ((hed (car cmds)) (tal (cdr cmds))) (let ((res (with-input-from-pipe (conc "which " hed) read-line))) (if (and (string? res) - (common:file-exists? res)) + (file-exists? res)) res (if (null? tal) #f (loop (car tal)(cdr tal)))))))) (define (common:get-install-area) (let ((exe-path (car (argv)))) - (if (common:file-exists? exe-path) + (if (file-exists? exe-path) (handle-exceptions exn #f (pathname-directory (pathname-directory @@ -1175,11 +1175,11 @@ (begin (mutex-unlock! *homehost-mutex*) (debug:print 0 *default-log-port* "ERROR: Failed to read .homehost file after trying five times. Giving up and exiting, message: " ((condition-property-accessor 'exn 'message) exn)) (exit 1))) (let ((hhf (conc *toppath* "/.homehost"))) - (if (common:file-exists? hhf) + (if (file-exists? hhf) (with-input-from-file hhf read-line) (if (file-write-access? *toppath*) (begin (with-output-to-file hhf (lambda () @@ -2581,14 +2581,14 @@ ;; (define (common:load-views-config) (let* ((view-cfgdat (make-hash-table)) (home-cfgfile (conc (get-environment-variable "HOME") "/.mtviews.config")) (mthome-cfgfile (conc *toppath* "/.mtviews.config"))) - (if (common:file-exists? mthome-cfgfile) + (if (file-exists? mthome-cfgfile) (read-config mthome-cfgfile view-cfgdat #t)) ;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas - (if (common:file-exists? home-cfgfile) + (if (file-exists? home-cfgfile) (read-config home-cfgfile view-cfgdat #t)) view-cfgdat)) ;;====================================================================== ;; H I E R A R C H I C A L H A S H T A B L E S @@ -2708,11 +2708,11 @@ (pdbpath (or (configf:lookup mtconf "setup" "pdbpath") pktsdir))) (cond ((not (and pktsdir toppath pdbpath)) (debug:print 0 *default-log-port* "ERROR: settings are missing in your megatest.config for area management.") (debug:print 0 *default-log-port* " you need to have pktsdir in the [setup] section.")) - ((not (common:file-exists? pktsdir)) + ((not (file-exists? pktsdir)) (debug:print 0 *default-log-port* "ERROR: pkts directory not found " pktsdir)) ((not (equal? (file-owner pktsdir)(current-effective-user-id))) (debug:print 0 *default-log-port* "ERROR: directory " pktsdir " is not owned by " (current-effective-user-name))) (else (let* ((pdb (open-queue-db pdbpath "pkts.db" @@ -2725,11 +2725,11 @@ mtconf (lambda (pktsdirs pktsdir pdb) (for-each (lambda (pktsdir) ;; look at all (cond - ((not (common:file-exists? pktsdir)) + ((not (file-exists? pktsdir)) (debug:print 0 *default-log-port* "ERROR: packets directory " pktsdir " does not exist.")) ((not (directory? pktsdir)) (debug:print 0 *default-log-port* "ERROR: packets directory path " pktsdir " is not a directory.")) ((not (file-read-access? pktsdir)) (debug:print 0 *default-log-port* "ERROR: packets directory path " pktsdir " is not readable.")) @@ -2868,18 +2868,18 @@ ;;;; return list (path fullpath configname) (define (common:find-config configname #!key (toppath #f)) (if toppath (let ((cfname (conc toppath "/" configname))) - (if (common:file-exists? cfname) + (if (file-exists? cfname) (list toppath cfname configname) (list #f #f #f))) (let* ((cwd (string-split (current-directory) "/"))) (let loop ((dir cwd)) (let* ((path (conc "/" (string-intersperse dir "/"))) (fullpath (conc path "/" configname))) - (if (common:file-exists? fullpath) + (if (file-exists? fullpath) (list path fullpath configname) (let ((remcwd (take dir (- (length dir) 1)))) (if (null? remcwd) (list #f #f #f) ;; #f #f) (loop remcwd)))))))))