@@ -337,10 +337,92 @@
        ;; '())
        )
   (if (common:api-changed?)
       (common:set-last-run-version)))
 
+(define (common:snapshot-file filepath #!key (subdir  ".") )
+  (if (file-exists? filepath)
+      (let* ((age-sec  (lambda (file)
+                         (if (file-exists? file)
+                             (- (current-seconds) (file-modification-time file))
+                             1000000000))) ;; return really old value if file doesn't exist.  we want to clobber it if old or not exist.
+             (ok-flag  #t)
+             (age-mins (lambda (file) (/ (age-sec   file) 60)))
+             (age-hrs  (lambda (file) (/ (age-min s file) 60)))
+             (age-days (lambda (file) (/ (age-hrs   file) 24)))
+             (age-wks  (lambda (file) (/ (age-days  file) 7)))
+             (docmd    (lambda (cmd)
+                         (cond
+                          (ok-flag
+                           (let ((res (system cmd)))
+                             (cond
+                              ((eq? 0 res)
+                               #t)
+                              (else
+                               (set! ok-flag #f)
+                               (debug:print 0 *default-log-port* "ERROR: Command failed with exit code "
+                                            (if (< res 0)
+                                                res
+                                                (/ res 8)) " ["cmd"]" )
+                               #f))))
+                          (else
+                           (debug:print 0 *default-log-port* "ERROR: Nor runnining command due to prior error. ["cmd"]")
+                           #f))))
+             (copy     (lambda (src dest) (docmd (conc "/bin/cp '"src"' '"dest"'"))))
+             (copy+zip (lambda (src dest) (docmd (conc "gzip -c - < '"src"' > '"dest"'"))))
+             (fullpath (realpath filepath))
+             (basedir  (pathname-directory fullpath))
+             (basefile (pathname-strip-directory fullpath))
+             ;;(prevfile (conc filepath ".prev.gz"))
+             (minsfile (conc basedir "/" subdir "/" basefile ".mins.gz"))
+             (hrsfile  (conc basedir "/" subdir "/" basefile ".hrs.gz"))
+             (daysfile (conc basedir "/" subdir "/" basefile ".days.gz"))
+             (wksfile  (conc basedir "/" subdir "/" basefile ".weeks.gz")))
+
+        ;; create subdir it not exists
+        (if (not (directory-exists? (conc basedir "/" subdir)))
+            (docmd (conc "/bin/mkdir -p '"(conc basedir "/" subdir)"'")))
+        
+        ;; copy&zip <file> to <file>.mins if not exists
+        (if (not (file-exists? minsfile))
+            (copy+zip filepath minsfile))
+        ;; copy <file>.mins to <file>.hrs if not exists
+        (if (not (file-exists? hrsfile))
+            (copy minsfile hrsfile))
+        ;; copy <file>.hrs to <file>.days if not exists
+        (if (not (file-exists? daysfile))
+            (copy hrsfile daysfile))
+        ;; copy <file>.days to <file>.weeks if not exists
+        (if (not (file-exists? wksfile))
+            (copy daysfile wksfile))
+
+
+        ;; if age(<file>.mins.gz) >= 1h:
+        ;;     copy <file>.mins.gz <file>.hrs.gz
+        ;;     copy <prev file> <file>.mins.gz
+        (when (>= (age-hrs minsfile) 1)
+          (copy minsfile hrsfile)
+          (copy+zip filepath  minsfile))
+        
+        ;; if age(<file>.hrs.gz) >= 1d:
+        ;;     copy <file>.hrs.gz <file>.days.gz
+        ;;     copy <file>.mins.gz <file>.hrs.gz
+        (when (>= (age-days hrsfile) 1)
+          (copy hrsfile daysfile)
+          (copy minsfile hrsfile))
+        
+        ;; if age(<file>.days.gz) >= 1w:
+        ;;     copy <file>.days.gz <file>.weeks.gz
+        ;;     copy <file>.hrs.gz <file>.days.gz
+        (when (>= (age-weeks daysfile) 1)
+          (copy daysfile wksfile)
+          (copy hrsfile daysfile))
+        #t)
+      #f))
+  
+        
+        
 ;; Rotate logs, logic: 
 ;;                 if > 500k and older than 1 week:
 ;;                     remove previous compressed log and compress this log
 ;; WARNING: This proc operates assuming that it is in the directory above the
 ;;          logs directory you wish to log-rotate.