#!/usr/bin/scsh \
-ds -s
!#
;;; CONFIGURATION

; benchmark results stored here
(define results-file "/root/results.txt")

; to-be-tested filesystem is mounted here
(define mountpoint "/mnt/test")

; device to store the filesystem 
;(define device "/dev/null")
(define device "/dev/hdb2")

(define use-filesystems '(ext2 ext3 reiser4 xfs jfs reiserfs))
;(define use-filesystems '(ext2 reiser4))
;(define use-filesystems '(mom dad))
;;; The tests to perform: first item is the name of your test (for the results output), second is what to run
(define tests '(
		"bigdir" ("cp" "-a" "/home/test/mozilla" "/mnt/test")
		"cp" ("cp" "-a" "/mnt/test/mozilla" "/mnt/test/mozilla-2")
		"cp2" ("cp" "-a" "/mnt/test/mozilla-2" "/mnt/test/mozilla-3")
		"cp3" ("cp" "-a" "/mnt/test/mozilla-3" "/mnt/test/mozilla-4")
		"cp4" ("cp" "-a" "/mnt/test/mozilla-4" "/mnt/test/mozilla-5")
		"cp5" ("cp" "-a" "/mnt/test/mozilla-2" "/mnt/test/mozilla-6")
		"rm" ("rm" "-rf" "/mnt/test/mozilla")
		"rm2" ("rm" "-rf" "/mnt/test/mozilla-2")
		"rm3" ("rm" "-rf" "/mnt/test/mozilla-3")
		"sync" ("sync")
;		"test1" ("sync")
;		"test2" ("sync")
;		"test3" ("sync")
;		"test3" ("find" "/mnt/test")
		))

;;; PROGRAM FOLLOWS
; output port
(define results (open-output-file results-file))
; helper method
(define join (lambda (source destination)
		   (letrec ((helper (lambda (source destination)
			     (if (null? source)
				 destination
				 (helper (cdr source) (cons (car source) destination))))))
		     (helper (reverse source) destination))))
; helper method
(define member? (lambda (item ls)
		  (cond
		   ((null? ls) #f)
		   (else (or (equal? (car ls) item)
			     (member? item (cdr ls)))))))

; the name of the filesystem currently being tested
(define currentfs "none")
;;; helper procedure, makes a filesystem
;;; @mkfs-proc a procedure to create the filesystem, takes a device name
;;; @type the filesystem name, so that mount can know what filesystem it is to use
(define mkfs (lambda (type mkfs-proc)
		 (run (umount ,device))
		 (mkfs-proc device)
		 (run (mount "-t" ,type ,device ,mountpoint))
		 (set! currentfs type)))
(define reiser4 (lambda ()
		  (mkfs "reiser4" (lambda (device) (run (| (yes) (mkfs.reiser4 ,device)) (> "/dev/null") (> 2 "/dev/null"))))))
(define ext2 (lambda ()
	     (mkfs "ext2" (lambda (device) (run (mkfs.ext2 ,device) (> "/dev/null") (> 2 "/dev/null"))))))
(define ext3 (lambda ()
	     (mkfs "ext3" (lambda (device) (run (mkfs.ext3 ,device) (> "/dev/null") (> 2 "/dev/null"))))))
(define jfs (lambda ()
	      (mkfs "jfs" (lambda (device) (run (| (yes) (mkfs.jfs ,device)) (> "/dev/null") (> 2 "/dev/null"))))))
(define reiserfs (lambda ()
	     (mkfs "reiserfs" (lambda (device) (run (| (yes) (mkfs.reiserfs ,device)) (> "/dev/null") (> 2 "/dev/null"))))))
(define xfs (lambda ()
	      (mkfs "xfs" (lambda (device) (run (mkfs.xfs "-f" ,device) (> "/dev/null") (> 2 "/dev/null"))))))

(define (make-filesystem-creators ls)
  (letrec ((helper (lambda (creators retval)
		     (if (null? creators)
			 retval
			 (begin
			   (cond
			    ((eqv? (car creators) 'reiser4) (set! retval (cons reiser4 retval)))
			    ((eqv? (car creators) 'ext2) (set! retval (cons ext2 retval)))
			    ((eqv? (car creators) 'ext3) (set! retval (cons ext3 retval)))
			    ((eqv? (car creators) 'xfs) (set! retval (cons xfs retval)))
			    ((eqv? (car creators) 'reiserfs) (set! retval (cons reiserfs retval)))
			    ((eqv? (car creators) 'jfs) (set! retval (cons jfs retval))))
			   (helper (cdr creators) retval))))))
    (helper ls '())))
(define filesystem-creators (make-filesystem-creators use-filesystems))
  
(letrec ((supported-filesystems (run/sexps (cat "/proc/filesystems")))
	 (check-use-filesystems-supported (lambda (use-ls)
					    (if (not (null? use-ls))
						(if (not (member? (car use-ls) supported-filesystems))
						    (error (string-append "filesystem not supported.  Please check your kernel for: " (symbol->string (car use-ls))))
						    (check-use-filesystems-supported (cdr use-ls)))))))
  (check-use-filesystems-supported use-filesystems))

(if (null? filesystem-creators)
    (error "no filesystems in filesystems-creators"))

; which filesystems to use (a list of procedures to make the right filesystem on 'device)
;;; All
;(define filesystem-creators (cons ext2 (cons ext3 (cons jfs (cons reiserfs (cons reiser4 (cons xfs '())))))))
; Just ext, ext3 and reiser4
;(define filesystem-creators (cons ext2 (cons ext3 (cons reiser4 '()))))
;;; Just ext2
;(define filesystem-creators (cons ext2 '()))
;;; Just ext2 and reiser4
;(define filesystem-creators (cons ext2 (cons reiser4 '())))
;(define filesystem-creators (cons reiser4 '()))

(define (run-tests filesystem-creators tests)
  (if (not (null? filesystem-creators))
      (begin
	(newline)
	(display "Creating filesystem...")
	((car filesystem-creators))
	(display (string-append currentfs " created."))
	(newline results)
	(display currentfs results)
	(letrec ((tester (lambda (tests scores)
			   (if (null? tests)
					;come up with a total
			       (letrec ((total (lambda (scores sum)
						 (if (null? scores)
						   sum
						   (total (cdr scores) (cons (+ (caar scores) (car sum))
									   (cons (+ (cadar scores) (cadr sum))
										 (cons (+ (caddar scores) (caddr sum))
										       '()))))))))
				 (let ((sum (total scores '(0 0 0))))
				   (display "\t" results)
				   (display (car sum) results)
				   (display "\t" results)
				   (display (cadr sum) results)
				   (display "\t" results)
				   (display (caddr sum) results)
				   (display "\t" results)
				   (display (+ (cadr sum) (caddr sum)) results)))
				   ;(if (not (zero? (car sum)))
				       ;(display (/ (+ (cadr sum) (caddr sum)) (car sum)) results)
				       ;(display 0 results))))
			       (begin
				 (display "\t" results)
;(= 2 1) sends stdout to port 2 (basically discards it)
;(= 1 3) sends stderr, which is where time puts its results, to stdout (what run/strings uses)
				 (newline)
				 (display (string-append "Started test " (car tests) "..."))
					;(display (run/sexps ,(join (cons 'time (cons "-f" (cons "%e %S %U" '()))) (cadr tests)) (= 2 1) (= 1 3)) results)
				 (let ((score (run/sexps ,(join (cons 'time (cons "-f" (cons "%e %S %U" '()))) (cadr tests)) (= 2 1) (= 1 3))))
				   (display (car score) results)
				   (display "\t" results)
				   (display (cadr score) results)
				   (display "\t" results)
				   (display (caddr score) results)
				   ;(if (zero? (car score))
				   ;    (display 0 results)
				   ;    (display (/ (+ (cadr score) (caddr score)) (car score)) results))
				   (display "done.")
				   (tester (cddr tests) (cons score scores))))))))
	  (tester tests '()))
	(run-tests (cdr filesystem-creators) tests))))


(display "Please make sure all necessary filesystem modules are loaded or compiled in, and filesystem-creators is set correctly. filesystem-creators contains these procedures: ")
(newline)
(display filesystem-creators)
(newline)
(display (string-append "Results in: " results-file))
(newline)
(display (string-append "Filesystems stored on: " device))
(newline)
(display (string-append "This will destroy all data on " device "!  Continue (Y/N)?"))
(let ((ans (read)))
  (if (equal? ans 'Y)
      (begin
	;print out a line with the names of the tests
	(display "fs" results)
	(letrec ((output-names (lambda (tests)
				 (display "\t" results)
				 (if (null? tests)
				     (display "total\tsys\tusr\ttotal cpu" results)
				     (begin
				       (display (car tests) results)
				       (display "\tsys\tusr" results)
				       (output-names (cddr tests)))))))
	  (output-names tests))
	(run-tests filesystem-creators tests))
      (display "User aborted.")))
(newline)