[Common Lisp] FTPでファイル転送

最近、複数のサーバーのいくつかのディレクトリにファイルを転送する、という作業が必要になりました。

expect + scp(ftp)なシェルスクリプトが作成されましたが、1ファイルごとに接続を行っていて遅かったので python + ftplib で書き直したりしました。

久々に Common Lisp を書こうと思ったので、ftpでの転送処理を題材にしてみます。

1 ライブラリを探す

さすがにftpを実装しようと試みたりはせず、ライブラリを探します。
quicklisp の system-apropos 関数を使ってそれっぽい名前のライブラリを探してみます。

 CL-USER> (ql:system-apropos "ftp")
#<SYSTEM ftp / cl-ftp-20101006-http / quicklisp 2013-06-15>

cl-ftp を使うことにします。

ファイルパスの処理も行いたいです。
組み込みの関数や cl-fad だとパスネームからファイル名+拡張子を取ってくる方法が分からなかったので、 ファイルパスの処理用のライブラリも探してみます。

(ql:system-apropos "path")
#<SYSTEM cl-paths / cl-vectors-20130312-git / quicklisp 2013-06-15>
#<SYSTEM cl-paths-ttf / cl-vectors-20130312-git / quicklisp 2013-06-15>
#<SYSTEM com.gigamonkeys.pathnames / monkeylib-pathnames-20120208-git / quicklisp 2013-06-15>
#<SYSTEM iolib.pathnames / iolib-0.7.3 / quicklisp 2013-06-15>
#<SYSTEM xpath / plexippus-xpath-20120909-darcs / quicklisp 2013-06-15>

iolib.pathnames を使ってみることにします。

ハッシュテーブルのキーと値に対するループ処理を行いたいです。
loopマクロでハッシュテーブルを使おうとすると記述が面倒なので、ユーティリティマクロを定義します。 が、自分で書くのは面倒なのでライブラリを使います。

Common Lispにはユーティリティライブラリがたくさん存在しますが、 今回は最近登場した Quickutil というユーティリティライブラリを使って、 使いたいユーティリティだけを読み込むことにします。

2 コードを書く

;; ** ライブラリ読み込み
;; quicklispで cl-ftp と iolib.pathnames を取得して読み込む。
(ql:quickload :ftp)
(ql:quickload :iolib.pathnames)

;; quickutilを読み込む。
;; 現時点(2013年7月6日)では、まだ quicklisp に登録されていないので、
;; git cloneしたりアーカイブをダウンロードしたりして
;; quicklisp/local-protects の中に保存しておく。
(ql:quickload :quickutil)

;; quickutil を使って dohash マクロと alist-hash-table 関数を読み込む
(qtlc:utilize-utilities '(:dohash :alist-hash-table))


;; ** 実装
(defun make-target-file-name (source-file target-dir)
  (let* ((fname (iolib.pathnames:file-path-file
                 (iolib.pathnames:file-path source-file)))
         (target-fname
           (iolib.pathnames:merge-file-paths fname target-dir)))
    target-fname))

(defun ftp-copy-file (conn file target-dir)
  (let ((target-fname (make-target-file-name file target-dir)))
    (format t " - copy to: ~A~%" target-fname)
    (ftp:store-file conn
                    file
                    (iolib.pathnames:file-path-namestring target-fname))))

;; Emacs: (put 'qtl:dohash 'common-lisp-indent-function 1)
(defun ftp-copy (remote-host copy-info-map &key port username password)
  (ftp:with-ftp-connection (conn :hostname remote-host
                                 :port port
                                 :passive-ftp-p t
                                 :username username
                                 :password password) 
    (format t "connect to [~A]~%" remote-host)
    (qtl:dohash (dir files copy-info-map)
      (dolist (file files)
        (ftp-copy-file conn file dir)))))

;; (転送先ディレクトリ . (転送するファイル ...))
;; リモートの tmp ディレクトリに
;; ローカルのカレントディレクトリにある 1.txt, 2.txt を転送する設定
(defparameter *copy-info-map*
  (qtl:alist-hash-table
   '(("tmp" "1.txt" "2.txt"))
  :test #'equal))

(defparameter *remote-hosts*
  '("localhost"))

(defun run ()
  (dolist (remote-host *remote-hosts*)
    (ftp-copy remote-host *copy-info-map*
              :port 10000
              :username "test"
              :password "test")))

;;  (run)

なお、作業マシンにはftpサーバーを入れてなかったので、 python の pyftpdlib で適当にでっちあげて実行しました。