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

(setq args (getopts "USAGE: bad-blocks mount-point
finds bad blocks on partition by filling it with files and testing them.
Once done, it leaves only the files enclosing the bad blocks, of the form 
BBxx.yy
This is useful for fickle errors that pass tradional (windows) fsck-like
progs, The process is cumulative, no files in the /BADBLOCK dir are ever 
removed or remplaced by this program. If a block failed once, it will be
marked as bad.
Note that the partition must not be de-fragmented under windows! To avoid this
problem, do under DOS a (X is the drive letter of the partition):
    attrib +S  X:\BADBLOCK\*.*
To prevent the defrag program to move the badblocks files around

WARNING: the program MUST be able to mount/unmount the filesystem, to flush
disk buffers. The mount point directory must be in the /stc/fstab.
files will be made in the BADBLOCK directory there.

If interrupted by ^C, cleans temp files.
"
    ("-s" filesize filesize "cluster size in bytes (default 8k = 8192)")
    ("-m" mount-point mount "mount point of the partition.
files will be made in the BADBLOCK directory there.
This partition must not be mounted")
    ("-p" power power "start with pass power (default 3 = 8M)
5=800M, 4=80M, 3=8M, 2=800k, 1=80k, 0=8k")
    ("-t" mintime mintime "if program takes more than mintime to read
file it is considered bad. mintime is in fact in K per second, defaults
to 500")
    ("-n" N i-limit "at most N files created in each pass. useful to test
filesystem performance for the -t mintime option by a:
bad-blocks -p 0 -n 10")
    ("-r" N repeat "repeat the operation N times")
    ("-q" () quiet "quiet operation. only new bad block files listed")
    ("-d" () debug "enter debugger on error")
))

(setq filesize (if filesize (Int filesize) 8192))
(setq BB-BAD 1)
(setq mount (getn args 0))
(if (not mount) (progn
    (PF "USAGE: bad-blocks mount-point, bad-blocks -help for help\n")
    (exit 1)
))
(setq power (if power (Int power) 3))
(setq mintime (if mintime (Int mintime) 500))
(setq repeat (if repeat (Int repeat) 1))
(if debug (kdb t))
(trap-signal 2 (PF String 
    "echo;echo bad-blocks: removing temp files;rm -f %0/BADBLOCK/BB*" mount) 1)
(setq verbose (not quiet))
  
(wait (system (+ "mount " mount " 2>/dev/null")))
(wait (system (+ "mkdir " mount "/BADBLOCK 2>/dev/null")))

(defun main (&aux
  )
  (dotimes (r repeat)
    (if (/= repeat 1)
      (PF "######################################################### PASS %0\n"
	(+ r 1)
    ))
    (setq contents (copy ""))
    (dotimes (i filesize) (put contents -1 (random 256)))
    (setq radix (+ mount "/BADBLOCK/BB"))
    (setq start-time (get-internal-run-time))
    
    (dotimes (p (+ power 1))
      (setq serie (- power p))
      (verbose? "Filling with files of size %0k" 
	(/ (* (** 10 serie) filesize) 1024)
      )
      (create-files (+ radix (String serie) ".") contents (** 10 serie))
      (sh umount ,mount)(sh mount ,mount)
      (verbose? "  Testing files")
      (test-files (+ radix (String serie) ".") contents (** 10 serie))
    )
    (verbose? "Time taken: %0 minutes" 
      (/ (- (get-internal-run-time) start-time) 60000))
  )
)

(defun create-files (name contents N &aux fd err s (i 1))
  (catch 'Done
    (verbose? :n "    ")
    (while t
      (verbose? :n "%0 " i)
      (setq fd (open (+ name (String i))
	  :if-exists :supersede :direction :output :error ()))
      (if (not fd) (progn 
	  (verbose? "(couldnt open)")
	  (throw 'Done))
      )
      (dotimes (j N)
	(if (/= (length contents) (write-chars contents () fd)) (progn
	    (trap-error 'Errors:StreamError (close fd))
	    (if (= 0 (get (file-stats (+ name (String i))) 'size 0)) (progn
		(sh rm ,(+ name (String i)))
		(verbose? " (couldnt write)")
	      )
	      (verbose? " (partial write)")
	    )
	    (throw 'Done)
      )))
      (trap-error 'Errors:StreamError (close fd))
      (incf i)
      (if (and i-limit (> i (Int i-limit))) (throw 'Done))
  ))
)

(defun test-files (name contents N &aux fd err s (i 1) size
    oldtime kps (l (length contents)) to-read
    (bad-files (vector)) n
  )
  (catch 'Done
    (verbose? :n "    ")
    (while t
      (catch 'bad-file
	(verbose? :n "%0 " i)
	(setq size (getn (file-stats (+ name (String i))) 'size))
	(setq oldtime (get-internal-run-time))
	(setq fd (open (+ name (String i)) :error ()))
	(if (or (not fd) (not size)) (progn 
	    (verbose? "(couldnt open)")
	    (throw 'Done))
	)
	(catch 'EOF
	  (dotimes (j N)
	    (file-position fd (* j l))
	    (if (> (* (+ 1 j) l) size) (progn
		(setq to-read (- size (* j l)))
		(if (/= (substring-ptr contents 0 to-read)
		    (read-chars to-read fd)
		  )
		  (throw 'bad-file 
		    (verbose? :n "***BAD*** ")
		    (lappend bad-files i)(incf i))
		)
		(setq j (+ N 1))
	      )
	      (if (/= contents (read-chars l fd))
		(throw 'bad-file 
		  (verbose? :n "***BAD*** ")
		  (lappend bad-files i)(incf i))
	    ))
	))
	
	(setq time (- (get-internal-run-time) oldtime))
	(if (<= time 0) (setq time 0.001))
	(setq kps (/ size time))
	(verbose? :n "[%0 kps] " kps)
	(if (and (< kps mintime) (> time 300))	  
	  (throw 'bad-file 
	    (verbose? :n "***MAYBE BAD*** ")
	    (lappend bad-files i)(incf i))
	)
	(close fd)
	(incf i)
  )))
  (if (= N 1)	;save bad files
    (progn
      ;; remove good files to make room
      (with (*current-directory* (+ mount "/BADBLOCK")
	  bad-filenames (list)
	  re (regcomp (+ 
	      (quote-string-for-regexp (+ mount "/BADBLOCK/")) "(.*)$"))
	  re-bad (regcomp "^BB")
	)
	(dolist (i bad-files)
	  (if (regexec re (+ name (String i)))
	    (lappend bad-filenames (regsub re 1))
	))
	(dolist (f (directory))
	  (if (not (and (regexec re-bad f) (seek bad-filenames f)))
	    (sh rm "-f" ,f)
      )))
      (dolist (i bad-files)
	(setq n i)
	(while (file-stats (+ mount "/BADBLOCK/BADBLOCK." (String n)))
	  (incf n)
	)
	(PF "new bad file %0 created\n"
	  (+ mount "/BADBLOCK/BADBLOCK." (String n))
	)
	(sh mv ,(+ name (String i)) ,(+ mount "/BADBLOCK/BADBLOCK." 
	    (String n)))
      )
      (if (not bad-files)
	(PF "no bad blocks found\n")
      )
      (verbose? "removing all temp files %0/BADBLOCK/BB*" mount)
      (wait (system (+ "rm -f " mount "/BADBLOCK/BB*"))) ;clean
      (if (= 0 (wait (system (+ "rmdir " mount "/BADBLOCK 2>/dev/null"))))
	(verbose? "no bad blocks files, removing %0/BADBLOCK directory"
	  mount
      ))
    )
    (dolist (i bad-files)		;else remove bad to fill with smaller
      (verbose? "removing bad file %0" (+ name (String i)))
      (wait (system (+ "rm -f " (+ name (String i)))))
    )
  )
)
  


(main)

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

