2010/12/14

車輪の再々発明 - dd wrapper in Gauche

• perl - 車輪の再発明 - ddコマンドのラッパーddp

ddを子プロセスで起動してシグナル送ってprogressを見ようという話。 現実的には、 スクリプト書くならわざわざdd起動せんでも自前でコピーすればいいんだけど、 子プロセス制御のサンプルとしては実に手頃な課題と思った。 出力のサイズを求めるget-totalは弾さんのに準拠。

#!/usr/bin/gosh

(use srfi-1)
(use gauche.process)
(use text.progress)
(use file.util)

(define (main args)
  (let ([total (get-total (cdr args))]
        [proc (run-process `(dd ,@(cdr args)) :error :pipe)])
    (sys-nanosleep #e5e8)
    (unwind-protect
        (doit proc total
              (make-text-progress-bar :header "" :header-width 0
                                      :max-value total :num-width 20))
      (process-wait proc))
    (process-exit-status proc)))

(define *sig* (if (#/linux/ (gauche-architecture)) SIGUSR1 29 #|SIGINFO|#))

(define (doit proc total bar)
  (let loop ()
    (sys-nanosleep #e1e8)                 ;0.1s
    (process-send-signal proc *sig*)
    (rxmatch-case (read-line (process-output proc 'stderr))
      [test eof-object?]
      [#/(\d+) bytes/ [_ c] (let1 cnt (x->integer c)
                              (bar 'set cnt)
                              (when (< cnt total) (loop)))]
      [else (loop)]))
  (bar 'finish))

(define (get-total args)
  (or (and-let* ([m (any #/if=(\S+)/ args)]
                 [ (file-is-regular? (m 1)) ])
        (file-size (m 1)))
      (let ([bs  (any #/bs=(\d+)/ args)]
            [cnt (any #/count=(\d+)/ args)])
        (* (or (and bs  (x->integer (bs 1))) 256)
           (or (and cnt (x->integer (cnt 1))) 1)))))

cookbook的なポイントはこのあたりかな：

• アーキテクチャによる切り替え。(define *sig* ...) のところ。
• text.progressの使い方。
• 正規表現をpredicateとして使う。(any #/if=(\S+)/ args) とか。

泥縄的な話:

doitを呼び出す前に0.5秒のwaitを入れてるんだけど。 これを入れる前に、ofで指定するファイルが既に存在してかなり大きい場合に ddがコピーせずに終了してしまう (終了コードは、シグナル10を受けて終了) という現象が起きた。dd単体でstraceしてみると、出力ファイルのopenが 終わった後でシグナルハンドラを設定してるんで、もしかすると open(...|O_TRUNC) でファイルをtruncateしてる間にSIGUSR1を受けて 終了しちゃうのかもしれない。*BSDならSIGINFOがデフォルトで無視されるから 問題無いと思うが…

Tags: Programming, Gauche