(module test-fcp
  *
(import
 scheme
 chicken.base
 chicken.process-context
 chicken.string
 chicken.file
 chicken.pathname
 matchable
 regex
 srfi-1
 fcp)

;; ---------------------------------------------------------------------------
;; Usage: fcpapp [options] cmd [args]
;;
;; Options (must come before the command):
;;   --host HOST       FCP host to connect to     [default: localhost]
;;   --port NUM        FCP port to connect to     [default: 9481]
;;   --verbose LEVEL   0=quiet 1=normal 2=debug   [default: 0]
;;   -v                bump verbosity one level (repeatable)
;;   --help, -h        show usage
;;
;; Commands:
;;   retrieve URI destpath/file   get a file from the network
;;   insert path/file [SSK]       insert a file into the network
;;   genssk                       create an SSK
;;   genusk NAME VERNUM           create a USK
;;   registerdir PATH             register a directory with the DDA
;; ---------------------------------------------------------------------------

(define (usage)
  (display
"Usage: fcpapp [options] cmd [args]

Options (before the command):
  --host HOST        FCP host to connect to            (default: localhost)
  --port NUM         FCP port to connect to            (default: 9481)
  --verbose LEVEL    0=quiet 1=normal 2=debug          (default: 0)
  -v                 bump verbosity one level (repeatable)
  --help, -h         show this help and exit

Commands:
  retrieve URI destpath/file    get a file from the network
  insert path/file [SSK]        insert a file into the network
  genssk                        create an SSK
  genusk NAME VERNUM            create a USK
  registerdir PATH              register a directory with the DDA
")
  (flush-output))

(define (opt-error . msg)
  (apply print (append (list "[fcpapp] error: ") msg))
  (print "Try --help for usage.")
  (exit 2))

(define (to-num n what)
  (if (and (string-match "^[0-9]+$" n) (> (string->number n) 0))
      (string->number n)
      (opt-error (list what " must be a positive integer, got \"" n "\""))))

(define (arg? rest what)
  ;; rest = (flag value ...) — flag at the head; value is the 2nd element.
  (if (or (null? (cdr rest)) (equal? (cadr rest) "--"))
      (opt-error (list what " needs a value"))
      (cadr rest)))

;; Parse leading options. Returns (VERBOSITY . REMAINING-ARGS) where
;; REMAINING-ARGS starts with the command.
(define (parse-options args)
  (let loop ((rest args) (v (verbosity)))
    (if (null? rest)
	(cons v rest)
	(let ((arg (car rest)))
	  (cond
	   ((or (equal? arg "-h") (equal? arg "--help"))
	    (usage)
	    (exit 0))
	   ((equal? arg "-v")
	    (loop (cdr rest) (+ v 1)))
	   ((equal? arg "--verbose")
	    (loop (cddr rest) (to-num (arg? rest "--verbose") "--verbose")))
	   ((equal? arg "--host")
	    (host (arg? rest "--host"))
	    (loop (cddr rest) v))
	   ((equal? arg "--port")
	    (port (to-num (arg? rest "--port") "--port"))
	    (loop (cddr rest) v))
	   ((equal? arg "--")
	    (cons v (cdr rest)))
	   ((string-match "^-" arg)
	    (opt-error (list "unknown option \"" arg "\"")))
	   (else
	    (cons v rest)))))))

(define (usage-error)
  (usage)
  (exit 2))

;; ---------------------------------------------------------------------------
;; command dispatch
;; ---------------------------------------------------------------------------

(define (do-retrieve rest)
  (if (not (= (length rest) 2))
      (begin
	(print "ERROR: retrieve needs URI and destpath/file")
	(usage-error))
      (let* ((uri   (car rest))
	     (dest  (cadr rest))
	     (dir   (pathname-directory dest))
	     (fname (pathname-strip-directory dest)))
	(if (file-exists? dest)
	    (begin
	      (print "ERROR: destination file \"" dest "\" already exists, please remove it first")
	      (exit 1))
	    (retrieve-file uri dir fname)))))

(define (do-insert rest)
  (if (not (<= 1 (length rest) 2))
      (begin
	(print "ERROR: insert needs path/file [SSK]")
	(usage-error))
      (let ((fpath (car rest)))
	(if (not (file-exists? fpath))
	    (begin
	      (print "ERROR: \"" fpath "\" does not exist")
	      (exit 1))
	    (let* ((dir   (pathname-directory fpath))
		   (fname (pathname-strip-directory fpath)))
	      (cond
	       ((= (length rest) 1)
		(print (insert-file dir fname)))
	       (else
		(print (insert-file dir fname (cadr rest))))))))))

(define (do-genssk rest)
  (if (not (null? rest))
      (begin
	(print "ERROR: genssk takes no arguments")
	(usage-error))
      (let ((res (gen-ssk)))
	(print "RequestURI: " (alist-ref 'RequestURI res))
	(print "InsertURI:  " (alist-ref 'InsertURI res)))))

(define (do-genusk rest)
  (if (not (= (length rest) 2))
      (begin
	(print "ERROR: genusk needs NAME and VERNUM")
	(usage-error))
      (let ((res (gen-usk (car rest) (cadr rest))))
	(print "RequestURI: " (alist-ref 'RequestURI res))
	(print "InsertURI:  " (alist-ref 'InsertURI res)))))

(define (do-registerdir rest)
  (if (not (= (length rest) 1))
      (begin
	(print "ERROR: registerdir needs a PATH")
	(usage-error))
      (register-directory (car rest))))

(define (dispatch cmdargs)
  (cond
   ((string=? "retrieve" (car cmdargs))   (do-retrieve  (cdr cmdargs)))
   ((string=? "insert"  (car cmdargs))   (do-insert    (cdr cmdargs)))
   ((string=? "genssk"  (car cmdargs))   (do-genssk    (cdr cmdargs)))
   ((string=? "genusk"  (car cmdargs))   (do-genusk    (cdr cmdargs)))
   ((string=? "registerdir" (car cmdargs)) (do-registerdir (cdr cmdargs)))
   ((string=? "help"    (car cmdargs))   (usage))
   (else
    (print "ERROR: unknown command \"" (car cmdargs) "\"")
    (usage-error))))

;; ---------------------------------------------------------------------------
;; main
;; ---------------------------------------------------------------------------

(define (main)
  (let* ((args            (command-line-arguments))
	 (parsed          (parse-options args))
	 (verbosity-level (car parsed)))
    (verbosity verbosity-level)
    (let ((cmdargs (cdr parsed)))
      (if (null? cmdargs)
	  (usage-error)
	  (dispatch cmdargs)))))

(main)
)