#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH
;;Skeleton of a typical klone script
;;(stack-dump-on-error t)
;;(kdb t)

(setq args (getopts "USAGE: file-test file" 
    ("-bs" bytes blocksize "block size in bytes, default = 8k (8192)")
    ("-o" bytes offset "starts at offset (in bytes)")
    ("-bo" blocks boffset "starts at offset (in blocks)")
    ("-bb" block subst-blocks "blocks to substitute.
If this option is set, the commands acts like the CAT(1) command,
but substitutes (bad) blocks by blocks contained in files of the 
names BB.block in the current dir" :multiple t)
    ("-x" block creat-blocks "blocks to extract.
If this option is set, extracts the blocks into files BB.block
in the current dir" :multiple t)
    ("-s" bytes file-size "size of file, if cannot be determined (case of /dev/cdrom)")
    ("-v" () verbose "verbose operation")
))

(if blocksize (setq blocksize (Int blocksize)) (setq blocksize 8192))
(if (not offset) (setq offset 0) (setq offset (Int offset)))
(if boffset (setq offset (* blocksize (Int boffset))))
(if file-size (setq file-size (Int file-size)))

(defun main (&aux
    (name (get args 0 "no argument"))
    (size (if file-size file-size (getn (file-stats name) 'size)))
  )
  (if (not size) (fatal-error 1 "Cannot access file %0\n" name))
  (if subst-blocks (cat-with-subst-blocks subst-blocks name size offset)
    creat-blocks (create-blocks creat-blocks name size offset)
    (process-file name size offset)
  )
)

(defun process-file (name size offset &aux
    (fd (open name))
    (oldtime (get-internal-run-time))
    newtime
    time
    (badblocks (vector))
    chars
  )
  (sh sync)
  (while (< offset size)
    (file-position fd offset)
    (if verbose
      (verbose? :n "reading at offset %0 (block %1)"
	offset (/ offset blocksize) 
      )
    )
    (setq chars (read-chars blocksize fd))
    (setq time (- (setq newtime (get-internal-run-time)) oldtime))
    (setq oldtime newtime)
    (if (or (/= blocksize (length chars)) (> time 500)) (progn
	(print-format *standard-error* 
	  "  Bad block #%0 bad! (offsets %1 to %2)\n" 
	  (/ offset blocksize) offset (+ offset blocksize)
	)
	(lappend badblocks (/ offset blocksize))
    ))
    (incf offset blocksize)
  )
  (if badblocks (progn
      (print-format "List of bad blocks: %0\n" badblocks)
      (print-format "Get replacement blocks by:\n  file-test ")
      (dolist (block badblocks)
	(print-format "-x %0 " block)
      )
      (print-format "%0\nand cat the file by:\n  file-test " name)
      (dolist (block badblocks)
	(print-format "-bb %0 " block)
      )
      (print-format "%0\n" name)
    )
    (print-format "No bad blocks found in %0\n" name)
  )

)

(defun cat-with-subst-blocks (blocks name size offset &aux
    (fd (open name))
    block
    buf
  )
  (while (< offset size)
    (setq block (/ offset blocksize))
    (verbose? :n "%0 " block)
    (if (seek blocks (String block))
      (progn
	(print-format *stderr* " [replacing block %0] " block)
	(setq buf (String (open (print-format String "BB.%0" block))))
      )
      (progn
	(file-position fd offset)
	(setq buf (read-chars blocksize fd))
      )
    )
    (write-chars buf)
    
    (incf offset blocksize)
  )
)

(defun create-blocks (creat-blocks name size offset &aux
    (fd (open name))
    block
    buf
    out
  )
  (dolist (block creat-blocks)
    (setq block (Int block))
    (setq out (open (+ "BB." (String block)) 
	:direction :output :if-exists :supersede)
    )
    (file-position fd (* block blocksize))
    (setq buf (read-chars blocksize fd))
    (write-chars buf () out)
    (close out)
  )
)

(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***

