dar.el -- disk archiver (DAR) interface for emacs: a frontend for a backup utility

[Stefan Reichör]

;;; dar.el --- disk archiver (DAR) interface for emacs

;; Copyright (C) 2005-2006 by Stefan Reichoer

;; Author: Stefan Reichoer, <address@hidden>

;; dar.el is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; dar.el is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; dar.el provides an Emacs interface for DAR from:
;; http://dar.linux.free.fr/

;; dar can be used to create backups and store them on harddisk
;; dar.el allows to define backup rules to create full and incremental
;; backups from various file trees.
;; A dry-run option allows to test your backup rules easily.

;; To use this package, put the following in your .emacs:
;; (require 'dar)
;; (setq dar-backup-rules
;;       '((all
;;          (backup-dir "~/bak/dar")
;;          (log-file "~/bak/dar/dar-el.log")
;;          (backup-interval-differential daily)
;;          (backup-interval-full monthly)
;;          )
;;         (create
;;          (compress bzip2)
;;          )
;;         ("xsteve-planner"
;;          (root "~/Plans/")
;;          (backup-interval-full weekly)
;;          )
;;         ("xsteve-wiki"
;;          (root "~/data/wiki/")
;;          (exclude-directories (".hg"))
;;          )
;;         ("xsteve-config"
;;          (root "~/xsteve-config/")
;;          (backup-interval-differential weekly)
;;         )))

;; The dar-backup-rules provide the rules for your backups.
;; The entry 'all is considered for all dar operations:
;;  - backup-dir: Specify the path for your backup files
;;  - log-file:   Specify the log file for archiving operations
;;  - backup-interval-differential: can be daily, weekly or monthly
;;  - backup-interval-full: can be daily, weekly or monthly

;; The entry 'create holds the rules for archive creation
;;  - (compress bzip2) enables bzip2 compression for the archived files

;; The entries xsteve-planner, xsteve-wiki and xsteve-config specify rule-sets
;;  - root: the root directory for the backup files
;;  - exclude-directories: A list of directories that should not be archived

;; The entries for create and all can be overridden for a specific rule

;; When you have written your dar-backup-rules, start viewing your
;; (initially empty list) via M-x dar-backups

;; The following commands are useful for the first experiments:
;; e ... dar-toggle-dry-run
;; v ... dar-toggle-verbose-run
;; r ... dar-toggle-rule-debug


;; The backup rule description above works for my use cases. Please
;; report your needs and enhancement ideas, I would like to see dar.el
;; as the full featured backup frontend for emacs.

;;; History:
;;

;;; Code:

(defvar dar-executable "dar" "Full path for the dar executable.")

(defvar dar-timestring-postfix "-%Y-%m-%d_%H-%M" "The format string that should 
be used as postfix for the dar archive names.
See `format-time-string' for details.")

;; some dar options
;; -v              verbose output
;; -e              dry run, fake execution, nothing is produced

;; special rules, these are similar used than the one in the /etc/darrc or 
~/.darrc file (see man dar)
;; 'create  for creation of archives
;; 'all     for all operations

;; Not yet implemented:
;; **EXTRACT**
;; **LIST**
;; **TEST**
;; **DIFF**
;; **ISOLATE**
;; **DEFAULT** if none of the operations above - not used in dar.el

;; This is another example for backup rules:

;; (setq dar-backup-rules
;;       '((all
;;          (backup-dir "~/bak/dar")
;;          (log-file "~/bak/dar/dar-el.log")
;;          (backup-interval-differential daily)
;;          (backup-interval-full monthly)
;;          )
;;         (create
;;          (compress bzip2)
;;          ;; (compress gzip)
;;          ;; (compress nil)
;;          ;; (compress (gzip 7))
;;          )
;;         ("xsteve-config"
;;          (root "~/xsteve-config/")
;;          (exclude-directories (".arch-ids" "ion3/.arch-ids" 
"app-defaults/.arch-ids" "{arch}"))
;;          ;;(extra-flags ("-e")) use a more usefull option than -e here...
;;          ;;(extra-create-flags ("-e")) use a more usefull option than -e 
here...
;;          )
;;         ("xsteve-mail"
;;          (root "~/gnus/nnml-mail")
;;          )))

;; backup interval specification
;; (backup-interval-full daily)
;; (backup-interval-full (daily))
;; (backup-interval-full (daily 3)) ;; every day. Earliest at 3am
;; (backup-interval-full weekly)
;; (backup-interval-full (weekly 1)) ;; every week. Earliest at day one of the 
week
;; (backup-interval-full monthly)
;; (backup-interval-full (monthly 15)) ;; every month. Earliest at day 15 of 
the month
;; (backup-interval-differential daily) ;; every day
;; TODO: differential backup should not be run, if the full is run on that day

(defvar dar-temp-dir
  (expand-file-name
   (or
    (when (boundp 'temporary-file-directory) temporary-file-directory)
    (when (fboundp 'temp-directory) (file-name-as-directory (temp-directory)))
    "/tmp/")) "The directory that is used to store temporary files for dar.")


;; internal variables
(defvar dar-rule-set nil)
(defvar dar-finish-message nil)
(defvar dar-write-to-log-file nil)
(defvar dar-running-command nil)
(defvar dar-marked-file-list nil)
(defvar dar-marked-ruleset-list nil)
(defvar dar-extracted-files nil)

(defvar dar-run-queue nil)

(defconst dar-backup-rule-start-regex "^\\[")

;; Some thoughts about a useful backup strategy
;; Do a full backup every week
;; do an differential backup every day

(defun dar-get-rule-elem-for-rule-set (rule-set elem)
  "Get the value of the setting ELEM for RULE-SET."
  (let ((rules (car (delete nil (mapcar
                                 '(lambda (entry)
                                    (if (equal rule-set (car entry)) (cdr 
entry)))
                                 dar-backup-rules)))))
    (cadr (assoc elem rules))))

;; (dar-get-rule-elem 'all 'log-file)


(defun dar-all-rule-set-names ()
  "Get a list of the available backup rule sets."
  (delete nil (mapcar '(lambda(arg) (unless (symbolp (car arg)) (car arg))) 
dar-backup-rules)))

;; (dar-all-rule-set-names)

(defun dar-get-rule-elem (rule-set elem &optional specific-default-rule-set)
  "Get elem for the given RULE-SET.
If SPECIFIC-DEFAULT-RULE-SET is given look there, if it is not defined in 
RULE-SET.
Otherweise look in the 'all rule-set instead."
  (or (dar-get-rule-elem-for-rule-set rule-set elem)
      (dar-get-rule-elem-for-rule-set specific-default-rule-set elem)
      (dar-get-rule-elem-for-rule-set 'all elem)))

;; (dar-get-rule-elem "xsteve-wiki" 'root)
;; (dar-get-rule-elem "xsteve-wiki" 'backup-dir)
;; (dar-get-rule-elem "xsteve-wiki" 'log-file)
;; (dar-get-rule-elem "xsteve-wiki" 'compress)
;; (dar-get-rule-elem "xsteve-wiki" 'compress 'create)

(defun dar-backup-dir (rule-set)
  "Get the backup directory for the given RULE-SET.
If it is not specified there, use it from the 'all rule-set instead."
  (expand-file-name (file-name-as-directory (dar-get-rule-elem rule-set 
'backup-dir))))

;; (dar-backup-dir "xsteve-wiki")

(defun dar-log-file-name (rule-set)
  "Get the backup directory for the given RULE-SET.
If it is not specified there, use it from the 'all rule-set instead."
  (expand-file-name (dar-get-rule-elem rule-set 'log-file)))

;;(dar-log-file-name "xsteve-wiki")

;;(format-time-string dar-timestring-postfix)

(defun dar-archive-base-name (file-name)
  "Remove the .<num>.dar suffix from a filename"
  (replace-regexp-in-string "\.[0-9]+\.dar$" "" file-name))

;; (dar-archive-base-name (dar-last-backup-file "xsteve-wiki" nil))

(defun dar-build-archive-name (rule-set &optional differential base-archive 
time)
  (let ((archive-type-string (if differential "--incr-" ""))
        (base-string (if base-archive (dar-build-base-name-string rule-set 
base-archive) "")))
    (concat rule-set (format-time-string (concat archive-type-string
                                                  dar-timestring-postfix) time) 
base-string)))

;; (dar-build-archive-name "xsteve-wiki" t)
;; (dar-build-archive-name "xsteve-wiki" t (dar-last-backup-file "xsteve-wiki" 
nil))
;; (dar-build-archive-name "xsteve-config" t (dar-last-backup-file 
"xsteve-config" nil))
;; (dar-build-archive-name "xsteve-config" t (dar-last-backup-file 
"xsteve-config" t))

(defun dar-build-base-name-string (rule-set archive-name)
  (let* ((without-rule-set (replace-regexp-in-string (concat rule-set "-") "" 
(file-name-nondirectory (dar-archive-base-name archive-name))))
         (without-base-ref (replace-regexp-in-string "--base.+$" "" 
without-rule-set)))
    (concat "--base-" without-base-ref)))

;; (dar-build-base-name-string "xsteve-wiki" (dar-last-backup-file 
"xsteve-wiki" nil))
;; (dar-build-base-name-string "xsteve-config" (dar-last-backup-file 
"xsteve-config" nil))

(defun dar-get-compress-command-line-flag (rule-set)
  (let ((compress-sy (dar-get-rule-elem rule-set 'compress 'create))
        (compress-level ""))
    (when (and compress-sy (listp compress-sy))
      (setq compress-level (number-to-string (cadr compress-sy)))
      (setq compress-sy (car compress-sy)))
    (cond ((eq compress-sy 'gzip)
           (concat "-z" compress-level))
          ((eq compress-sy 'bzip2)
           (concat "-y" compress-level))
          (t
           nil))))

;; (dar-get-compress-command-line-flag "xsteve-wiki")

(defun dar-get-exclude-directories-command-line-flag (rule-set)
  (mapcar '(lambda (path) (list "-P" path))
          (dar-get-rule-elem rule-set 'exclude-directories)))

;; (dar-get-exclude-directories-command-line-flag "xsteve-wiki")

(defun dar-get-extra-flags-command-line-flag (rule-set)
  (dar-get-rule-elem rule-set 'extra-flags))

;; (dar-get-extra-flags-command-line-flag "xsteve-config")

(defun dar-get-extra-create-flags-command-line-flag (rule-set)
  (dar-get-rule-elem rule-set 'extra-create-flags))

;; (dar-get-extra-create-flags-command-line-flag "xsteve-config")
;; (dar-get-extra-create-flags-command-line-flag "xsteve-wiki")

(defun dar-get-dry-run-flag ()
  (when dar-dry-run "-e"))

(defun dar-get-verbose-run-flag ()
  (when dar-verbose-run "-v"))

(defun dar-backup-file-list (rule-set &optional full-name type)
  "Get a list of available backup files for a RULE-SET.
If FULL-NAME is t, use the full path, otherwise only the file name.

TYPE can be one of 'differential or 'full. Any other value gives all names for 
that RULE-SET."
  (let ((file-list
         (directory-files (dar-backup-dir rule-set) full-name (concat rule-set 
".+\\.dar")))
        (filter-func
         (cond ((eq type 'differential)
                '(lambda (arg) (when (string-match "--incr-" arg) arg)))
               ((eq type 'full)
                '(lambda (arg) (unless (string-match "--incr-" arg) arg)))
               (t
                'identity))))
    (delete nil (mapcar filter-func file-list))))
;; (dar-backup-file-list "xsteve-wiki" nil 'differential)
;; (dar-backup-file-list "xsteve-wiki" nil 'full)
;; (dar-backup-file-list "xsteve-wiki" nil)

(defun dar-sorted-backup-file-list (rule-set &optional full-name type)
  "Return a list sorted by the creation time of backup files for RULE-SET."
  (let ((sorted-list (sort (dar-backup-file-list rule-set t type)
                           '(lambda (a b) (< (dar-seconds-since-last-write a) 
(dar-seconds-since-last-write b))))))
    (if full-name
        sorted-list
      (mapcar 'file-name-nondirectory sorted-list))))

;; (dar-sorted-backup-file-list "xsteve-wiki" nil 'full)

(defun dar-last-backup-file (rule-set &optional full-name type)
  "Return the last generated backup file for RULE-SET."
  (car (dar-sorted-backup-file-list rule-set full-name type)))


;; (dar-last-backup-file "xsteve-wiki" nil)
;; (dar-last-backup-file "xsteve-wiki" t)
;; (dar-last-backup-file "xsteve-wiki" t 'differential)
;; (dar-last-backup-file "xsteve-wiki" t 'full)

;; the same as ls-lisp-time-to-seconds
(defun dar-time-to-seconds (time)
  "Convert TIME to a floating point number."
  (+ (* (car time) 65536.0)
     (cadr time)
     (/ (or (nth 2 time) 0) 1000000.0)))

(defun dar-seconds-since-last-write (file-name)
  (if file-name
      (- (dar-time-to-seconds (current-time))
         (dar-time-to-seconds (nth 5 (file-attributes file-name))))
    "n/a"))


(defun dar-days-since-last-write (file-name)
  (if file-name
      (/ (dar-seconds-since-last-write file-name) (* 60 60 24))
    "n/a"))

(defun dar-float-as-string (float)
  (if (numberp float) (format "%1.1f" float) float))

;(dar-seconds-since-last-write (dar-last-backup-file "xsteve-wiki" t))
;(dar-days-since-last-write (dar-last-backup-file "xsteve-wiki" t))

(defun dar-days-since-last-backup (rule-set &optional type)
  (dar-days-since-last-write (dar-last-backup-file rule-set t type)))

;(dar-days-since-last-backup "xsteve-wiki")
;(dar-days-since-last-backup "xsteve-wiki" 'differential)
;(dar-days-since-last-backup "xsteve-wiki" 'full)

;; inspired by ls-lisp-format-file-size
(defun dar-file-size (file-name human-readable)
  (let ((file-size (nth 7 (file-attributes file-name))))
    (if (or (not human-readable)
            (< file-size 1024))
        (format (if (floatp file-size) "%1.0f" "%d") file-size)
      (do ((file-size (/ file-size 1024.0) (/ file-size 1024.0))
           ;; kilo, mega, giga, tera, peta, exa
           (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes)))
          ((< file-size 1024) (format "%1.0f%s"  file-size (car 
post-fixes)))))))

(defvar dar-trigger-action-string nil) ;; side effect of dar-trigger-action
(defun dar-trigger-action (days-since-last-action trigger-rule)
  (let ((current-hour (string-to-number (format-time-string "%H" 
(current-time))))
        (current-day (string-to-number (format-time-string "%d" 
(current-time))))
        (action-hour 0)
        (action-day 1))
    (when (listp trigger-rule)
      (cond ((eq (car trigger-rule) 'daily)
             (setq action-hour (cadr trigger-rule)))
            ((eq (car trigger-rule) 'weekly)
             (setq action-day (cadr trigger-rule)))
            ((eq (car trigger-rule) 'monthly)
             (setq action-day (cadr trigger-rule))))
      (setq trigger-rule (car trigger-rule)))
    (cond ((and (eq trigger-rule 'monthly)
                (or (and (> days-since-last-action 27) (>= action-day 
current-day))
                    (> days-since-last-action 31))
                (setq dar-trigger-action-string (format "Monthly trigger: 
days-since-last-action=%s, %S" (dar-float-as-string days-since-last-action) 
trigger-rule))
                t))
          ((and (eq trigger-rule 'weekly)
                (or (and (> days-since-last-action 6.9) (>= action-day 
current-day)) ;; fixme...
                    (> days-since-last-action 7.1))
                (setq dar-trigger-action-string (format "Weekly trigger: 
days-since-last-action=%s, %S" (dar-float-as-string days-since-last-action) 
trigger-rule))
                t))
          ((and (eq trigger-rule 'daily)
                (message "current-hour: %S action-hour: %S" current-hour 
action-hour)
                (or (and (> days-since-last-action 0.9) (>= current-hour 
action-hour))
                    (> days-since-last-action 1.1))
                (setq dar-trigger-action-string (format "Daily trigger: 
days-since-last-action=%s, %S" (dar-float-as-string days-since-last-action) 
trigger-rule))
                t))
          (t
           (setq dar-trigger-action-string "No trigger")
           nil))))

;; (dar-trigger-action 1.11 'daily)
;; (dar-trigger-action 1.0 '(daily 11))



(defun dar-flatten-list (list)
  "Flatten any lists within ARGS, so that there are no sublists."
  (loop for item in list
        if (listp item) nconc (svn-status-flatten-list item)
        else collect item))

(defun dar-run (cmd-id parameter-list &optional startup-function startup-param)
  "Run dar with PARAMETER-LIST as parameter."
  (if dar-running-command
      (progn
        (message "Entering %S %S in dar-run-queue, because %S is still running" 
cmd-id parameter-list dar-running-command)
        (add-to-list 'dar-run-queue (list cmd-id parameter-list 
startup-function startup-param) t)
        nil)
    (let ((dar-proc)
          (dar-parameter-list (dar-flatten-list parameter-list)))
      (with-current-buffer
          (get-buffer-create "*dar-output*")
        (toggle-read-only -1)
        (delete-region (point-min) (point-max))
        (insert (format "Running dar %s\n\n" (mapconcat 'identity 
dar-parameter-list " "))))
      (setq dar-proc (apply 'start-process "dar" "*dar-output*" dar-executable 
dar-parameter-list))
      (setq dar-running-command cmd-id)
      (set-process-sentinel dar-proc 'dar-process-sentinel)
      (when startup-function
        (apply startup-function startup-param))
      dar-proc)))

(defun dar-run-next-queued ()
  (interactive)
  (setq dar-running-command nil) ;; not sure if this is a good idea...
  (when dar-run-queue
    (apply 'dar-run (car dar-run-queue))
    (setq dar-run-queue (cdr dar-run-queue))))

(defun dar-process-sentinel (process event)
  ;;(princ (format "Process: %s had the event `%s'" process event))
  (save-excursion
    (set-buffer (process-buffer process))
    (dar-output-mode)
    (cond ((string= event "finished\n")
           (cond ((eq dar-running-command 'view)
                  (message "View dar file")
                  (when (get-buffer "*dar-view-file*")
                    (kill-buffer "*dar-view-file*"))
                  (pop-to-buffer "*dar-output*")
                  (rename-buffer "*dar-view-file*")
                  (goto-char (point-min))
                  (forward-line 1)
                  (dar-view-darfile-mode))
                 ((eq dar-running-command 'extract)
                  (when (file-readable-p (car dar-extracted-files))
                    (view-file-other-window (car dar-extracted-files))))
                 (t
                  (if (and dar-rule-set dar-finish-message)
                      (progn
                        (when (and dar-write-to-log-file (not dar-dry-run))
                          (dar-write-to-log-file dar-rule-set (format "%s 
completed successfully" dar-finish-message)))
                        (message (format "%s completed successfully" 
dar-finish-message))
                        (setq dar-rule-set nil))
                    (message "dar process finished"))))
           (setq dar-running-command nil))
          ((string= event "killed\n")
           (message "dar process killed")
           (setq dar-running-command nil))
          ((string-match "exited abnormally" event)
           (while (accept-process-output process 0 100))
           ;; find last error message and show it.
           (goto-char (point-max))
           (message "dar failed: %s" event)
           (setq dar-running-command nil))
          (t
           (message "dar process had unknown event: %s" event))))
  (when dar-run-queue
    (dar-run-next-queued)))


;; create an archive
;; dar -c ~/bak/dar/xsteve-wiki-2005-07-08 -R ~/data/wiki/

;; create an archive, compress the invidual files
;; dar -z -c ~/bak/dar/xsteve-wiki-2005-07-08 -R ~/data/wiki/

(defun dar-create-full-archive (rule-set)
  "Create an archive based on the RULE-SET."
  (interactive "sWhich backup should I create: ")
  (let* ((backup-dir (dar-backup-dir rule-set))
         (root (dar-get-rule-elem-for-rule-set rule-set 'root))
         (archive-name (concat backup-dir (dar-build-archive-name rule-set)))
         (msg (format "Creating full dar backup for %s as %s" rule-set 
archive-name)))
    (dar-run 'create-full
             (list (dar-get-compress-command-line-flag rule-set)
                   (dar-get-exclude-directories-command-line-flag rule-set)
                   (dar-get-dry-run-flag) ;; "-e"
                   (dar-get-verbose-run-flag) ;; "-v"
                   (dar-get-extra-flags-command-line-flag rule-set)
                   (dar-get-extra-create-flags-command-line-flag rule-set)
                   "-c" archive-name
                   "-R" (expand-file-name root))
             '(lambda (rule-set msg dar-dry-run)
                (with-current-buffer
                    (process-buffer dar-proc)
                  (set (make-local-variable 'dar-rule-set) rule-set)
                  (set (make-local-variable 'dar-write-to-log-file) t)
                  (set (make-local-variable 'dar-finish-message) (format "Full 
dar backup for %s" rule-set)))
                (message msg)
                (unless dar-dry-run
                  (dar-write-to-log-file rule-set msg)))
             (list rule-set msg dar-dry-run))))

;; (dar-create-full-archive "xsteve-wiki")
;; (dar-create-full-archive "xsteve-mail")
;; (dar-create-full-archive "xsteve-planner")

;; create an differential archive based on a base version
;; dar -z -c ~/bak/dar/xsteve-wiki--incr--2005-12-14 -R ~/data/wiki/ -A 
~/bak/dar/xsteve-wiki-2005-12-14

(defun dar-create-differential-archive (rule-set &optional base-type)
  "Create an archive based on the RULE-SET"
  (interactive "sWhich backup should I create: ")
  (let* ((backup-dir (dar-backup-dir rule-set))
         (root (dar-get-rule-elem-for-rule-set rule-set 'root))
         (base-archive (dar-archive-base-name (dar-last-backup-file rule-set t 
base-type)))
         (archive-name (concat backup-dir (dar-build-archive-name rule-set t 
base-archive)))
         (msg (format "Creating differential dar backup for %s as %s (based on 
%s)" rule-set archive-name base-archive)))
    (dar-run 'create-differential
             (list (dar-get-compress-command-line-flag rule-set)
                   (dar-get-exclude-directories-command-line-flag rule-set)
                   (dar-get-dry-run-flag) ;; "-e"
                   (dar-get-verbose-run-flag) ;; "-v"
                   (dar-get-extra-flags-command-line-flag rule-set)
                   (dar-get-extra-create-flags-command-line-flag rule-set)
                   "-c" archive-name
                   "-R" (expand-file-name root)
                   "-A" base-archive)
             '(lambda (rule-set msg dar-dry-run)
                (with-current-buffer
                    (process-buffer dar-proc)
                  (set (make-local-variable 'dar-rule-set) rule-set)
                  (set (make-local-variable 'dar-write-to-log-file) t)
                  (set (make-local-variable 'dar-finish-message) (format 
"Differential dar backup for %s" rule-set)))
                (message msg)
                (unless dar-dry-run
                  (dar-write-to-log-file rule-set msg)))
             (list rule-set msg dar-dry-run))))

;;(dar-create-differential-archive "xsteve-wiki")
;;(dar-create-differential-archive "xsteve-mail")

(defun dar-test-archive (file-name rule-set)
  (let* ((archive-name (dar-archive-base-name file-name))
         (msg (format "Running dar backup test for %s" archive-name))
         (dar-proc))
    (if archive-name
        (setq dar-proc (dar-run 'test
                                (list (dar-get-verbose-run-flag) ;;  "-v"
                                      "-t"
                                      (dar-get-extra-flags-command-line-flag 
rule-set)
                                      archive-name)))
      (message "No dar file at point."))
    (with-current-buffer
        (process-buffer dar-proc)
      (set (make-local-variable 'dar-rule-set) rule-set)
      (set (make-local-variable 'dar-write-to-log-file) nil)
      (set (make-local-variable 'dar-finish-message) msg))
    (message msg)))

(defun dar-diff-archive (file-name rule-set)
  (let* ((archive-name (dar-archive-base-name file-name))
         (root (dar-get-rule-elem-for-rule-set rule-set 'root))
         (msg (format "Running dar backup diff for %s" archive-name))
         (dar-proc))
    (if archive-name
        (setq dar-proc (dar-run 'diff
                                (list (dar-get-verbose-run-flag) ;;  "-v"
                                      (dar-get-extra-flags-command-line-flag 
rule-set)
                                      "-d"
                                      archive-name
                                      "-R" (expand-file-name root)
                                      )))
      (message "No dar file at point."))
    (with-current-buffer
        (process-buffer dar-proc)
      (set (make-local-variable 'dar-rule-set) rule-set)
      (set (make-local-variable 'dar-write-to-log-file) nil)
      (set (make-local-variable 'dar-finish-message) msg))
    (message msg)))

;; extract a file
;; -f ... flat, don't create directories
;; -O ... don't preserve ownership if not run as root so don't warn
;; -x ... extract
;; -g ... File to extract
;; -w ... overwrite files without warning
;; -r ... don't overwrite newer files
;;dar -f -O -w -x /home/srei/bak/dar/xsteve-wiki--incr--2006-02-21 -g 
EmacsSemantic.muse

(defun dar-extract-files (archive dest-dir names overwrite-mode)
  (let* ((archive-name (dar-archive-base-name archive))
         (overwrite-switch (cond ((eq overwrite-mode 'overwrite) "-w")
                                 ((eq overwrite-mode 'if-newer) "-r")
                                 (t nil)))
         (preserve-owner-switch "-O")
         (flat-switch "-f"))
    (setq dar-extracted-files (mapcar '(lambda (arg) (concat dar-temp-dir 
(file-name-nondirectory arg))) names))
    (dar-run 'extract
             (list "-v"
                   ;;"-e"
                   flat-switch
                   preserve-owner-switch
                   overwrite-switch
                   "-R" (expand-file-name dest-dir)
                   "-x" archive-name
                   (mapcar '(lambda (name) (list "-g" name)) names)))))

;; (dar-extract-files "/home/srei/bak/dar/xsteve-wiki--incr--2006-02-21" 
"~/tmp/tst" '("EmacsSemantic.muse") 'overwrite)

(defun dar-write-to-log-file (rule-set message)
  (with-current-buffer
      (find-file-noselect (dar-log-file-name rule-set))
    (let ((buffer-read-only nil))
      (goto-char (point-max))
      (insert (format "[%s]: %s\n" rule-set (format-time-string "%c" 
(current-time))))
      (dolist (line (split-string message "\n"))
        (insert "  ")
        (insert line)
        (newline))
      (newline)
      (save-buffer))))

;;(dar-write-to-log-file "xsteve-wiki" "hello world\nblah blah")

(defun dar-dired-jump ()
  "Jump to a dired buffer, containing the file at point."
  (interactive)
  (let ((file-full-path (dar-file-at-point)))
    (when file-full-path
      (let ((default-directory (file-name-directory file-full-path)))
        (dired-jump))
      (dired-goto-file file-full-path))))

;; taken from DVC.el
(defsubst dar-face-add (str face &optional keymap menu help)
  "Add to string STR the face FACE.
Optionally, also add the text properties KEYMAP, MENU and HELP.

If KEYMAP is a symbol, (symbol-value KEYMAP) is used
as a keymap; and `substitute-command-keys' result
against (format \"\\{%s}\" (symbol-name keymap)) is appended to HELP.

If HELP is nil and if MENU is non nil, the MENU title is used as HELP."
  (let* ((strcpy (copy-sequence str))
         (key-help (when (symbolp keymap)
                     (substitute-command-keys (format "\\{%s}" (symbol-name 
keymap)))))
         (prefix-help (if help help (when (and menu (stringp (cadr menu))) 
(cadr menu))))
         (long-help (if key-help
                        (if prefix-help (concat prefix-help "\n"
                                                "================" "\n"
                                                key-help) key-help)
                      help))
         (keymap (if (symbolp keymap) (symbol-value keymap) keymap)))
    (add-text-properties 0 (length strcpy)
                         `(face ,face
                                font-lock-face ,face
                                ,@(when keymap
                                    `(mouse-face highlight
                                                 keymap ,keymap
                                                 help-echo ,long-help))
                                ,@(when menu
                                    `(,dar-cmenu ,menu))
                                )
                         strcpy)
    strcpy))

(defun dar-face-add-with-condition (condition text face1 face2)
  "If CONDITION then add TEXT the face FACE1, else add FACE2."
  (if condition
      (dar-face-add text face1)
    (dar-face-add text face2)))

;; the dar-backup-mode
(defvar dar-backup-mode-map () "Keymap used in `dar-backup-mode' buffers.")
(defvar dar-backup-mode-mark-map () "Subkeymap used for mark/unmark in 
`dar-backup-mode' buffers.")

(cond ((not dar-backup-mode-map)
       (setq dar-backup-mode-map (make-sparse-keymap))
       (define-key dar-backup-mode-map "q" 'bury-buffer)
       (define-key dar-backup-mode-map "g" 'dar-backups)
       (define-key dar-backup-mode-map "I" 
'dar-backup-create-differential-archive)
       (define-key dar-backup-mode-map "F" 'dar-backup-create-full-archive)
       (define-key dar-backup-mode-map "B" 'dar-backup-create-archive)
       (define-key dar-backup-mode-map "L" 'dar-backup-view-log-file)
       (define-key dar-backup-mode-map "T" 'dar-backup-test-archive)
       (define-key dar-backup-mode-map "D" 'dar-backup-diff-archive)
       (define-key dar-backup-mode-map "s" 'dar-view-output-buffer)
       (define-key dar-backup-mode-map "v" 'dar-toggle-verbose-run)
       (define-key dar-backup-mode-map "e" 'dar-toggle-dry-run)
       (define-key dar-backup-mode-map "r" 'dar-toggle-rule-debug)
       (define-key dar-backup-mode-map "n" 'dar-backup-next-rule)
       (define-key dar-backup-mode-map "p" 'dar-backup-previous-rule)
       (define-key dar-backup-mode-map "m" 'dar-backup-mark)
       (define-key dar-backup-mode-map "u" 'dar-backup-unmark)
       (define-key dar-backup-mode-map (kbd "RET") 'dar-backup-view-dar-file)
       (define-key dar-backup-mode-map "x" 
'dar-backup-delete-marked-backup-files)
       (define-key dar-backup-mode-map (kbd "C-x C-j") 'dar-dired-jump)
       (when (not dar-backup-mode-mark-map)
         (setq dar-backup-mode-mark-map (make-sparse-keymap))
         (define-key dar-backup-mode-mark-map "!" 'dar-backup-unmark-all)
         (define-key dar-backup-mode-mark-map "*" 
'dar-backup-mark-all-rule-sets)
         (define-key dar-backup-mode-mark-map "x" 
'dar-backup-mark-obsolete-backup-files))
       (define-key dar-backup-mode-map "*" dar-backup-mode-mark-map)))

(easy-menu-define dar-backup-mode-menu dar-backup-mode-map
"`dar-backup-mode' menu"
                  '("Dar-Backup"
                    ["Create differential archive" 
dar-backup-create-differential-archive t]
                    ["Create full archive" dar-backup-create-full-archive t]
                    ["Test archive" dar-backup-test-archive t]
                    ["Diff archive against sources" dar-backup-diff-archive t]
                    ("Toggle dar run switches"
                     ["Toggle dry run" dar-toggle-dry-run t]
                     ["Toggle verbose run" dar-toggle-verbose-run t]
                     ["Toggle rule debugging" dar-toggle-rule-debug t]
                     )
                    ("Mark/Unmark"
                     ["Mark all rulesets" dar-backup-mark-all-rule-sets t]
                     ["Mark obsolete backup files" 
dar-backup-mark-obsolete-backup-files t]
                     ["Unmark all" dar-backup-unmark-all t]
                     )
                    ["View log file" dar-backup-view-log-file t]
                    ["View dar command output" dar-view-output-buffer t]
                    ))

(defun dar-backups-insert-entry (file-name)
  (insert (dar-face-add-with-condition (member file-name dar-marked-file-list) 
(format "  %s " (file-name-nondirectory file-name)) 'compilation-info nil))
  (insert (dar-face-add (format "<%s>" (dar-file-size file-name t)) 
'font-lock-variable-name-face))
  (newline)
  (setq overlay (make-overlay (line-beginning-position 0) (point)))
  (overlay-put overlay 'dar-info file-name))

(defun dar-backups-insert-ruleset (rule-set &optional nonewline)
  (insert (dar-face-add-with-condition (member rule-set 
dar-marked-ruleset-list) (format "[%s]" rule-set) 'font-lock-warning-face 
'font-lock-function-name-face))
  (unless nonewline
    (newline)))

(defun dar-backups ()
  (interactive)
  (switch-to-buffer (get-buffer-create "*dar-backups*"))
  (let ((pos (point))
        (overlay))
    (toggle-read-only -1)
    (delete-region (point-min) (point-max))
    (dolist (rule-set (dar-all-rule-set-names))
      (dar-backups-insert-ruleset rule-set)
      (dolist (a (dar-sorted-backup-file-list rule-set t))
        (dar-backups-insert-entry a))
      (newline))
    (when (< pos (point-max))
      (goto-char pos))
    (dar-backup-mode)))

(defun dar-backup-mode ()
"Major mode to view the list of made dar backups.
It allows the following actions:
 * create new backups based on `dar-backup-rules'.
 * view the contents of backup files
 * delete old backup files

The following keys are defined:
\\{dar-backup-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map dar-backup-mode-map)
  (setq major-mode 'dar-backup-mode)
  (dar-backup-mode-update-mode-line)
  (toggle-read-only 1))

(defun dar-file-at-point ()
  (let ((file-info nil))
    (dolist (overlay (overlays-at (point)))
      (setq file-info (or file-info
                          (overlay-get overlay 'dar-info))))
    file-info))


(defun dar-view-output-buffer ()
  (interactive)
  (pop-to-buffer "*dar-output*")
  (setq tab-width 8));; output is formated for tabwidth 8

(defun dar-current-rule-set ()
  (save-excursion
    (forward-line 1)
    (dar-backup-previous-rule)
    (if (looking-at "\\[\\(.+\\)\\]")
        (match-string-no-properties 1))))

(defun dar-current-rule-sets ()
  (or dar-marked-ruleset-list (list (dar-current-rule-set))))

(defvar dar-dry-run nil "Whether to run archive creation/extraction with the -e 
switch")
(defun dar-toggle-dry-run ()
  (interactive)
  (setq dar-dry-run (not dar-dry-run))
  (dar-backup-mode-update-mode-line))

(defvar dar-verbose-run nil "Whether to run archive creation/extraction with 
the -v switch")
(defun dar-toggle-verbose-run ()
  (interactive)
  (setq dar-verbose-run (not dar-verbose-run))
  (dar-backup-mode-update-mode-line))

(defvar dar-rule-debug nil "Whether to debug which rules would fire")
(defun dar-toggle-rule-debug ()
  (interactive)
  (setq dar-rule-debug (not dar-rule-debug))
  (dar-backup-mode-update-mode-line))

(defun dar-backup-mode-update-mode-line ()
  (let ((one-flag (or dar-dry-run dar-verbose-run dar-rule-debug))
        (flags (mapconcat 'identity (delete nil (list (if dar-dry-run "dry") 
(if dar-verbose-run "verbose") (if dar-rule-debug "rule-dbg"))) "/")))
    (setq mode-name (concat "dar-backup" (if one-flag (concat "[" flags "]") 
"")))
    (force-mode-line-update)))

(defun dar-backup-create-differential-archive ()
  (interactive)
  (let ((rule-sets (dar-current-rule-sets)))
    (when (> (length rule-sets) 1)
      (unless (y-or-n-p (format "Create differential archives for the rulesets 
%S? " rule-sets))
        (setq rule-sets nil)))
    (when rule-sets
      (dolist (rule-set rule-sets)
        (dar-create-differential-archive rule-set)))))

(defun dar-backup-create-full-archive ()
  (interactive)
  (let ((rule-sets (dar-current-rule-sets)))
    (when (> (length rule-sets) 1)
      (unless (y-or-n-p (format "Create full archives for the rulesets %S? " 
rule-sets))
        (setq rule-sets nil)))
    (when rule-sets
      (dolist (rule-set rule-sets)
        (dar-create-full-archive rule-set)))))

(defun dar-backup-create-archive ()
  (interactive)
  (let ((rule-sets (dar-current-rule-sets)))
    (when (and (> (length rule-sets) 1) (not dar-rule-debug))
      (unless (y-or-n-p (format "Create archives for the rulesets %S? " 
rule-sets))
        (setq rule-sets nil)))
    (when rule-sets
      (dolist (rule-set rule-sets)
        (message "Checking backup trigger rules for %S" rule-set)
        (message "  Last full backup %s days ago" (dar-float-as-string 
(dar-days-since-last-backup rule-set 'full)))
        (message "  Last diff backup %s days ago" (dar-float-as-string 
(dar-days-since-last-backup rule-set 'differential)))
        (if (dar-trigger-action (dar-days-since-last-backup rule-set 'full)
                                (dar-get-rule-elem rule-set 
'backup-interval-full))
            (progn
              (message "  %s: %s" rule-set dar-trigger-action-string)
              (message "    ==> Creating full backup for %s" rule-set)
              (unless dar-rule-debug
                (dar-create-full-archive rule-set)))
          (message "full test:  %s: %s" rule-set dar-trigger-action-string)
          (if (dar-trigger-action (dar-days-since-last-backup rule-set)
                                  (dar-get-rule-elem rule-set 
'backup-interval-differential))
              (progn
                (message "  %s: %s" rule-set dar-trigger-action-string)
                (message "    ==> Creating differential backup for %s" rule-set)
                (unless dar-rule-debug
                  (dar-create-differential-archive rule-set)))
            (message "differential test:  %s: %s" rule-set 
dar-trigger-action-string)))))))


(defun dar-backup-test-archive ()
  (interactive)
  (dar-test-archive (dar-file-at-point) (dar-current-rule-set)))

(defun dar-backup-diff-archive ()
  (interactive)
  (dar-diff-archive (dar-file-at-point) (dar-current-rule-set)))

(defun dar-backup-view-log-file ()
  (interactive)
  (find-file-other-window (dar-log-file-name (dar-current-rule-set)))
  (dar-log-file-mode))

(defun dar-backup-view-dar-file (arg)
  (interactive "P")
  (let ((file (dar-file-at-point))
        (only-saved (not arg)))
    (if file
        (dar-view-dar-file (dar-file-at-point) only-saved)
      (message "No dar file at point."))))

  (defun dar-backup-next-rule ()
  (interactive)
  (let ((pos (point)))
    (end-of-line)
    (if (re-search-forward dar-backup-rule-start-regex nil t)
        (beginning-of-line)
      (goto-char pos))))

(defun dar-backup-previous-rule ()
  (interactive)
  (let ((pos (point)))
    (beginning-of-line)
    (unless (re-search-backward dar-backup-rule-start-regex nil t)
      (goto-char pos))))

(defun dar-backup-mark ()
  (interactive)
  (let ((file-at-point (dar-file-at-point))
        (rule-set-at-point (dar-current-rule-set))
        (buffer-read-only nil))
    (cond (file-at-point
           (add-to-list 'dar-marked-file-list file-at-point t)
           ;;(message "dar-backup-mark: %s %S" file-at-point 
dar-marked-file-list)
           (delete-region (line-beginning-position) (+ (line-end-position) 1))
           (dar-backups-insert-entry file-at-point))
          (rule-set-at-point
           (add-to-list 'dar-marked-ruleset-list rule-set-at-point t)
           (save-excursion
             (delete-region (line-beginning-position) (line-end-position))
             (dar-backups-insert-ruleset rule-set-at-point t))
           ;;(message "dar-backup-mark: [%s] %S" rule-set-at-point 
dar-marked-ruleset-list)
           (dar-backup-next-rule)))))

(defun dar-backup-unmark ()
  (interactive)
  (let ((file-at-point (dar-file-at-point))
        (rule-set-at-point (dar-current-rule-set))
        (buffer-read-only nil))
    (cond (file-at-point
           (setq dar-marked-file-list (delete file-at-point 
dar-marked-file-list))
           ;;(message "dar-backup-unmark: %s %S" file-at-point 
dar-marked-file-list)
           (delete-region (line-beginning-position) (+ (line-end-position) 1))
           (dar-backups-insert-entry file-at-point))
          (rule-set-at-point
           (setq dar-marked-ruleset-list (delete rule-set-at-point 
dar-marked-ruleset-list))
           (save-excursion
             (delete-region (line-beginning-position) (line-end-position))
             (dar-backups-insert-ruleset rule-set-at-point t))
           (message "dar-backup-unmark: [%s] %S" rule-set-at-point 
dar-marked-ruleset-list)
           (dar-backup-next-rule)))))

(defun dar-backup-unmark-all ()
  (interactive)
  (setq dar-marked-file-list nil)
  (setq dar-marked-ruleset-list nil)
  (dar-backups))

(defun dar-backup-mark-all-rule-sets ()
  (interactive)
  (setq dar-marked-ruleset-list (dar-all-rule-set-names))
  (dar-backups))

(defun dar-backup-mark-obsolete-backup-files ()
  (interactive)
  (let ((old-files))
    (dolist (rule-set (dar-current-rule-sets))
      (setq old-files (cdr (member (car (dar-sorted-backup-file-list rule-set t 
'full)) (dar-sorted-backup-file-list rule-set t))))
      (setq dar-marked-file-list (append dar-marked-file-list old-files))))
  (dar-backups))

(defun dar-backup-delete-marked-backup-files ()
  "Delete the marked backup file. There is no way to recover this file."
  (interactive)
  (if dar-marked-file-list
      (when (yes-or-no-p (format "Delete %d marked backup files? " (length 
dar-marked-file-list)))
        (dolist (file dar-marked-file-list)
          (delete-file file)
          (setq dar-marked-file-list (delete file dar-marked-file-list))
          (message "Deleted %s" file))
        (dar-backups))
    (message "No backup files marked for deletion.")))

;; the dar-output-mode
(defvar dar-output-mode-map () "Keymap used in `dar-output-mode' buffers.")

(cond ((not dar-output-mode-map)
       (setq dar-output-mode-map (make-sparse-keymap))
       (define-key dar-output-mode-map "q" 'bury-buffer)
       ))

(defun dar-output-mode ()
  (interactive)
  (kill-all-local-variables)
  (use-local-map dar-view-darfile-mode-map)
  (setq major-mode 'dar-output-mode)
  (setq mode-name "dar-output")
  (setq tab-width 8)
  (toggle-read-only 1))


;; list archive contents
;; dar -l ~/bak/dar/xsteve-wiki-2005-07-08

;; dar -v -as -l xsteve-wiki--incr--2006-02-06 ... -v display statistics first, 
-as display only saved files in this dar archive

(defun dar-view-dar-file (file-name &optional only-saved)
  (interactive "fOpen dar file: ")
  (dar-run 'view (list (when only-saved "-as") "-l" (dar-archive-base-name 
file-name))))

;; (dar-view-dar-file "/home/srei/bak/dar/xsteve-wiki-2005-07-08.1.dar")
;; (dar-view-dar-file "/home/srei/bak/dar/xsteve-wiki-2006-02-03")
;; (dar-view-dar-file "/home/srei/bak/dar/xsteve-wiki--incr--2005-12-14.1.dar")

;; the dar-view-darfile-mode
(defvar dar-view-darfile-mode-map () "Keymap used in `dar-view-darfile-mode' 
buffers.")

(cond ((not dar-view-darfile-mode-map)
       (setq dar-view-darfile-mode-map (make-sparse-keymap))
       (define-key dar-view-darfile-mode-map "q" 'bury-buffer)
       (define-key dar-view-darfile-mode-map "v" 
'dar-view-extract-and-view-file)
       ))

(easy-menu-define dar-view-darfile-mode-menu dar-view-darfile-mode-map
"`dar-view-darfile-mode' menu"
                  '("Dar-File"
                    ["View dar command output" dar-view-output-buffer t]
                    ))

(defun dar-view-darfile-mode ()
  (interactive)
  (kill-all-local-variables)
  (use-local-map dar-view-darfile-mode-map)
  (setq major-mode 'dar-view-file-mode)
  (setq mode-name "dar-view")
  (setq tab-width 8)
  (toggle-read-only 1))

(defun dar-view-extract-and-view-file ()
  (interactive)
  (let ((dar-archive-name (save-excursion (goto-char (point-min))
                                          (when (looking-at "^Running dar .+-l 
\\(.+\\)") (match-string-no-properties 1))))
        (file-at-point (save-excursion (goto-char (line-end-position)) 
(search-backward "\t")
                                       (buffer-substring-no-properties (+ 
(point) 1) (line-end-position)))))
    ;;(message "dar-file: %s %s" dar-archive-name file-at-point)
    (dar-extract-files dar-archive-name dar-temp-dir (list file-at-point) 
'overwrite)))

;; 
--------------------------------------------------------------------------------
;; dar-log-file-mode
;; 
--------------------------------------------------------------------------------
(defvar dar-log-font-lock-keywords
  (list
   '("\\[\\(.+\\)\\]: \\(.+\\)" (1 font-lock-keyword-face) (2 
font-lock-function-name-face nil t)))
   "Expressions to highlight in `dar-log-file-mode' mode.")

(defvar dar-log-file-mode-map () "Keymap used in `dar-log-file-mode' buffers.")

(cond ((not dar-log-file-mode-map)
       (setq dar-log-file-mode-map (make-sparse-keymap))
       (define-key dar-log-file-mode-map "n" 'dar-log-file-next)
       (define-key dar-log-file-mode-map "p" 'dar-log-file-prev)
       (define-key dar-log-file-mode-map "q" 'dar-log-file-quit)
       ))

(defun dar-log-file-mode ()
  (interactive)
  (kill-all-local-variables)
  (use-local-map dar-log-file-mode-map)
  (setq major-mode 'dar-log-file-mode)
  (setq mode-name "dar-log")
  (setq font-lock-defaults '(dar-log-font-lock-keywords nil t))
  (toggle-read-only 1))

  (defun dar-log-file-next ()
  (interactive)
  (let ((pos (point)))
    (end-of-line)
    (if (re-search-forward "^\\[" nil t)
        (beginning-of-line)
      (goto-char pos))))

(defun dar-log-file-prev ()
  (interactive)
  (let ((pos (point)))
    (beginning-of-line)
    (unless (re-search-backward "^\\[" nil t)
      (goto-char pos))))

(defun dar-log-file-quit ()
  (interactive)
  (kill-buffer (current-buffer)))

(provide 'dar)

;;; arch-tag: fd8d8121-9d7f-45b6-aeba-1fda0aaf1a94
;;; dar.el ends here