Программа для резервного копирования / синхронизации данных.

Написал на Steel Bank Common Lisp.

Алгоритм простой:

• Если файл/директория есть в src но нет в dest - то он/она копируется в dest.
• Если файл/директория есть в dest но нет в src - то он/она удаляется из dest.
  
• Если файл есть в src и в dest, но размеры их не совпадают - то файл из src переписывает файл из dest.
• Алгоритм вызывается рекурсивно для всех поддиректорий.

Если не удалось скопировать файл/создать директорию - то выводится сообщение об ошибке и алгоритм продолжает работать дальше.

Работает, я считаю, довольно шустро - у меня синхронизация папки 1.4 гб с 53 тыс файлов занимает примерно 10 минут.


;;;; Created on 2009-10-18 13:12:10

(load "F:/Lisp/cl-fad-0.6.3/load.lisp")

(defmacro my-with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (gensym)))
     ,@body))

(defmacro exec-time (executions (&body body))
  (my-with-gensyms (start end time)
    `(progn
       (setf ,start (get-internal-real-time))
       (loop for i from 1 to ,executions do ,body)
       (setf ,end (get-internal-real-time))
       (setf ,time (float (/ (- ,end ,start) internal-time-units-per-second)))
       ,time)
    )
  )

(defun path-to-str (path)
  (format nil "~a" path))

(defun file-len (filepath)
  (with-open-file (in filepath) (file-length in)))

(defun dirs-and-files (path)
  (let* ((files-dirs (cl-fad:list-directory path))
         (dirs (remove-if-not #'cl-fad:directory-pathname-p files-dirs))
         (files (remove-if #'cl-fad:directory-pathname-p files-dirs)))    
    (values dirs files)))

(defun file-name (path)
  (let ((ext (pathname-type path)))
    (concatenate 'string (pathname-name path)
                 (if ext (concatenate 'string "." ext)))
    ))

(defun dir-name (path)
  (car (last (pathname-directory path))))

(defun new-deleted-existed (dest-paths src-paths is-files)
  (let* ((key-func (if is-files #'file-name #'dir-name))
         (new (set-difference src-paths dest-paths
                              :key key-func :test #'string-equal))
         (deleted (set-difference dest-paths src-paths
                              :key key-func :test #'string-equal))
         (existed (intersection src-paths dest-paths
                              :key key-func :test #'string-equal)))
    (values new deleted existed)))

(defun get-relative (base-path full-path)
  (let ((base-path-str (path-to-str base-path))
        (full-path-str (path-to-str full-path)))
    (pathname (subseq full-path-str (length base-path-str)))
    ))

(defun full-dest-path (base-dest-path base-src-path full-src-path)
  (let ((relative (get-relative base-src-path full-src-path)))
    (merge-pathnames relative base-dest-path)
    ))

(defmacro sefe-progn (&body body)
  `(handler-case (progn ,@body) (error (r) (format t "~a~%" r))))

(defun synchronize (dest src)  
  (let ((dest (pathname dest)) (src (pathname src))
        (dirs-src nil) (files-src nil) (dirs-dest nil) (files-dest nil)
        (new-files nil) (deleted-files nil) (existed-files nil)
        (new-dirs nil) (deleted-dirs nil) (existed-dirs nil))
    (setf (values dirs-src files-src) (dirs-and-files src))
    (setf (values dirs-dest files-dest) (dirs-and-files dest))
    (setf (values new-files deleted-files existed-files)
          (new-deleted-existed files-dest files-src T))
    (setf (values new-dirs deleted-dirs existed-dirs)
          (new-deleted-existed dirs-dest dirs-src nil))    
    (loop for new in new-files
          for new-dest = (full-dest-path dest src new)
          do (sefe-progn
               (format t "Copy FROM ~a TO ~a~%" new new-dest)
               (cl-fad:copy-file new new-dest)))  
    (loop for deleted in deleted-files
          do (sefe-progn
               (format t "Delete file ~a~%" deleted)
               (delete-file deleted)))
    (loop for existed in existed-files
          for existed-dest = (full-dest-path dest src existed)
          do (sefe-progn
              (if (/= (file-len existed) (file-len existed-dest))
                 (progn
                   (format t "Overwrite FROM ~a TO ~a~%" existed existed-dest)
                   (cl-fad:copy-file existed existed-dest :overwrite t)))))
    (loop for new in new-dirs
          for new-dest = (full-dest-path dest src new)  
          do (sefe-progn
               (format t "Create directory ~a~%" new-dest)
               (ensure-directories-exist new-dest)
               (synchronize new-dest new)))
    (loop for deleted in deleted-dirs
          do (sefe-progn
               (format t "Delete directory ~a~%" deleted)
               (cl-fad:delete-directory-and-files deleted)))
    (loop for existed in existed-dirs
          for existed-dest = (full-dest-path dest src existed)
          do (synchronize existed-dest existed))
    ))

(defun main (args)
  (let ((src (if (= 3 (length args))
              (nth 1 args) "F:/jFiles/workspaces/tests/file-sync/2"))
        (dest (if (= 3 (length args))
              (nth 2 args) "F:/jFiles/workspaces/tests/file-sync/1")))
    (cl-fad:pathname-as-directory "F:/jFiles/workspaces/tests/file-sync/2")
    (format t "Synchronize ~a ==> ~a~%" src dest)
    (let ((time
          (exec-time 1 (synchronize (cl-fad:pathname-as-directory dest)
                                    (cl-fad:pathname-as-directory src)))))
      (format t "Finished [execution time: ~as]" time))
    ))
     
(main *posix-argv*)
 

Теперь небольшая инструкция, как сделать так, чтобы программа заработала.

Для запуска вам понадобиться SBCL и библиотечка cl-fad которую я использовал для упрощения работы с файлами. В программе указан абсолютный путь к библиотеке "F:/Lisp/cl-fad-0.6.3/load.lisp" - необходимо будет заменить его на путь куда вы установите библиотеку. Сохранив код в файл, например sync.lisp, его можно запускать батником, например таким образом: call sbcl --script sync.lisp "F:/jFiles/" "O:/jFiles/". Возможна одна проблема - при запуске программа будет ругаться что библиотека cl-fad якобы откомпилирована более старой версией SBCL. Не пугайтесь - решается просто, надо пойти в директорию установки cl-fad и удалить файл packages.fasl. Тогда при повторном запуске cl-fad будет перекомпилирована.


Осталось добавить батник в планировщик заданий и радоваться жизни)