@@ -124,10 +124,111 @@
 	(begin
 	  (hash-table-set! *common:denoise* key currtime)
 	  #t)
 	#f)))
 
+;; environment vars handy stuff from common.scm
+;;
+(define getenv get-environment-variable)
+(define (safe-setenv key val)
+  (if (or (substring-index "!" key)
+	  (substring-index ":" key)  ;; variables containing : are for internal use and cannot be environment variables.
+	  (substring-index "." key)) ;; periods are not allowed in environment variables
+      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
+      (if (and (string? val)
+	       (string? key))
+	  (handle-exceptions
+	      exn
+	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val ", exn=" exn)
+	    (setenv key val))
+	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))
+
+;;======================================================================
+;; accept an alist or hash table containing envvar/env value pairs (value of #f causes unset) 
+;;   execute thunk in context of environment modified as per this list
+;;   restore env to prior state then return value of eval'd thunk.
+;;   ** this is not thread safe **
+(define (common:with-env-vars delta-env-alist-or-hash-table thunk)
+  (let* ((delta-env-alist (if (hash-table? delta-env-alist-or-hash-table)
+                              (hash-table->alist delta-env-alist-or-hash-table)
+                              delta-env-alist-or-hash-table))
+         (restore-thunks
+          (filter
+           identity
+           (map (lambda (env-pair)
+                  (let* ((env-var     (car env-pair))
+                         (new-val     (let ((tmp (cdr env-pair)))
+                                        (if (list? tmp) (car tmp) tmp)))
+                         (current-val (get-environment-variable env-var))
+                         (restore-thunk
+                          (cond
+                           ((not current-val) (lambda () (unsetenv env-var)))
+                           ((not (string? new-val)) #f)
+                           ((eq? current-val new-val) #f)
+                           (else 
+                            (lambda () (setenv env-var current-val))))))
+                    ;;(when (not (string? new-val))
+                    ;;    (debug:print 0 *default-log-port* " PROBLEM: not a string: "new-val"\n from env-alist:\n"delta-env-alist)
+                    ;;    (pp delta-env-alist)
+                    ;;    (exit 1))
+                        
+                    
+                    (cond
+                     ((not new-val)  ;; modify env here
+                      (unsetenv env-var))
+                     ((string? new-val)
+                      (setenv env-var new-val)))
+                    restore-thunk))
+                delta-env-alist))))
+    (let ((rv (thunk)))
+      (for-each (lambda (x) (x)) restore-thunks) ;; restore env to original state
+      rv)))
+
+(define home (getenv "HOME"))
+(define user (getenv "USER"))
+
+;;======================================================================
+;; return a nice clean pathname made absolute
+(define (common:nice-path dir)
+  (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
+    (if match ;; using ~ for home?
+	(common:nice-path (conc (common:read-link-f (cadr match)) "/" (caddr match)))
+	(normalize-pathname (if (absolute-pathname? dir)
+				dir
+				(conc (current-directory) "/" dir))))))
+
+(define (common:read-link-f path)
+  (handle-exceptions
+      exn
+      (begin
+	(debug:print-error 0 *default-log-port* "command \"/bin/readlink -f " path "\" failed. exn=" exn)
+	path) ;; just give up
+    (with-input-from-pipe
+	(conc "/bin/readlink -f " path)
+      (lambda ()
+	(read-line)))))
+
+;; for reasons I don't understand multiple calls to real-path in parallel threads
+;; must be protected by mutexes
+;;
+(define (common:real-path inpath)
+  ;; (process :cmd-run-with-stderr->list "readlink" "-f" inpath)) ;; cmd . params)
+  ;; (let-values 
+  ;;  (((inp oup pid) (process "readlink" (list "-f" inpath))))
+  ;;  (with-input-from-port inp
+  ;;    (let loop ((inl (read-line))
+  ;;       	(res #f))
+  ;;      (print "inl=" inl)
+  ;;      (if (eof-object? inl)
+  ;;          (begin
+  ;;            (close-input-port inp)
+  ;;            (close-output-port oup)
+  ;;            ;; (process-wait pid)
+  ;;            res)
+  ;;          (loop (read-line) inl))))))
+  (with-input-from-pipe (conc "readlink -f " inpath) read-line))
+
 ;; KEEP THIS ONE
 ;;
 ;; client:get-signature
 
 (define *my-client-signature* #f)
@@ -138,10 +239,47 @@
 	(set! *my-client-signature* sig)
 	*my-client-signature*)))
 
 (define *server-info* #f)
 (define *toppath* #f)
+
+(define (common:false-on-exception thunk #!key (message #f))
+  (handle-exceptions exn
+                     (begin
+                       (if message
+                           (debug:print-info 0 *default-log-port* message))
+                       #f) (thunk) ))
+
+(define (common:file-exists? path-string #!key (silent #f))
+  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings. Might be able to get rid of with chicken 5?
+  (common:false-on-exception (lambda () (file-exists? path-string))
+                             message: (if (not silent)
+                                          (conc "Unable to access path: " path-string)
+                                          #f)
+                             ))
+
+(define (common:directory-exists? path-string)
+  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings
+  (common:false-on-exception (lambda () (directory-exists? path-string))
+                             message: (conc "Unable to access path: " path-string)
+                             ))
+
+;;======================================================================
+;; does the directory exist and do we have write access?
+;;
+;;    returns the directory or #f
+;;
+(define (common:directory-writable? path-string)
+  (handle-exceptions
+      exn
+    (begin
+      (debug:print 0 *default-log-port* "Failed to identify access to " path-string ", exn=" exn)
+      #f)
+   (if (and (directory-exists? path-string)
+            (file-write-access? path-string))
+       path-string
+       #f)))
 
 ;;======================================================================
 ;; config file utils
 ;;======================================================================