[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
dar.el -- disk archiver (DAR) interface for emacs: a frontend for a back
From: |
Stefan Reichör |
Subject: |
dar.el -- disk archiver (DAR) interface for emacs: a frontend for a backup utility |
Date: |
Tue, 09 May 2006 22:25:07 +0200 |
User-agent: |
Gnus/5.11 (Gnus v5.11) Emacs/22.0.50 (gnu/linux) |
;;; 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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- dar.el -- disk archiver (DAR) interface for emacs: a frontend for a backup utility,
Stefan Reichör <=