;;; Copyright (c) 2013
;;; Michele La Monaca (mikele~lamonaca.net)
;;; All rights reserved.

(use eping)

(define *version* "1.0")

(define mode 'probe)
(define quiet #f)
(define count #f)
(define interval 1000)
(define timeout 1000)
(define ttl 64)
(define tos 0)
(define recv-min #f)
(define lost-max #f)
(define cons-recv-min #f)
(define cons-lost-max #f)
(define dont-fragment #f)
(define src-addr #f)
(define id #f)
(define seq-start 0)
(define size 56)
(define pattern "")
(define msg1 "%i is alive%n")
(define msg2 "")
(define dotcols 0)
(define host #f)
(define version #f)

(define (usage)
  (with-output-to-port (current-output-port)
    (lambda ()
      (print "eping HOST [-mode probe|stats|dot|mtu]
           [-count COUNT]
           [-interval INTERVAL]
           [-timeout TIMEOUT]
           [-ttl TTL]
           [-tos TOS]
           [-src-addr IP]
           [-dont-fragment]
           [-id ID]
           [-seq-start SEQ]
           [-size SIZE]
           [-pattern PATTERN]
           [-recv-min RMIN]
           [-lost-max LMAX]
           [-cons-recv-min CRMIN]
           [-cons-lost-max CLMAX]
           [-msg1 MSG1]
           [-msg2 MSG2]
           [-dotcols COLS]
           [-quiet]
           [-version]")))
  (exit 1))

(define (ip4-address? host)
  (let loop ((i 0) (bytes 0) (start_pos 0) (ok? #t))
    (if (or (eq? i (string-length host)) (eq? (string-ref host i) #\.))
      (let ((num (string->number (substring host start_pos i))))
        (if (and num (< num 256) (< bytes 4))
            (begin
              (set! bytes (+ bytes 1))
              (set! start_pos (+ i 1)))
            (set! ok? #f))))
    (if (< i (string-length host))
      (loop (+ i 1) bytes start_pos ok?)
      ok?)))

(let loop ((args (command-line-arguments)))
  (unless (null? args)
    (define arg (car args))
    (cond ((string=? arg "-mode")
           (if (pair? (cdr args))
             (set! mode (string->symbol (cadr args)))
             (usage))
           (if (memq mode '(dot mtu probe stats))
             (loop (cddr args))
             (usage)))
          ((or (string=? arg "-quiet")
               (string=? arg "-version")
               (string=? arg "-dont-fragment"))
           (let ((option (string->symbol (substring arg 1))))
             (eval `(set! ,option ,#t)))
           (loop (cdr args)))
          ((or (string=? arg "-msg1")
               (string=? arg "-msg2")
               (string=? arg "-pattern")
               (string=? arg "-src-addr"))
           (let ((option (string->symbol (substring arg 1))))
             (if (pair? (cdr args))
               (eval `(set! ,option ,(cadr args)))
               (usage)))
           (loop (cddr args)))
          ((or (string=? arg "-count")
               (string=? arg "-interval")
               (string=? arg "-timeout")
               (string=? arg "-dotcols")
               (string=? arg "-ttl")
               (string=? arg "-tos")
               (string=? arg "-id")
               (string=? arg "-seq-start")
               (string=? arg "-size")
               (string=? arg "-recv-min")
               (string=? arg "-lost-max")
               (string=? arg "-cons-recv-min")
               (string=? arg "-cons-lost-max"))
           (if (pair? (cdr args))
             (let ((option (string->symbol (substring arg 1)))
                   (value (string->number (cadr args))))
               (if value
                 (eval `(set! ,option ,value))
                 (usage)))
             (usage))
           (loop (cddr args)))
          (else
           (set! host arg)
           (if (eq? #\- (string-ref host 0))
             (usage)
             (loop (cdr args)))))))

(when version
  (print "eping v" *version*)
  (exit 0))
(unless host
  (usage))
(unless (or (not src-addr) (ip4-address? src-addr))
  (with-output-to-port (current-output-port)
    (lambda ()
      (print "Invalid src-addr: " src-addr)))
  (exit 1))

(if (eping host mode: mode
                count: count
                interval: interval
                timeout: timeout
                ttl: ttl
                tos: tos
                src-addr: src-addr
                dont-fragment: dont-fragment
                id: id
                seq-start: seq-start
                size: size
                pattern: pattern
                recv-min: recv-min
                lost-max: lost-max
                cons-recv-min: cons-recv-min
                cons-lost-max: cons-lost-max
                msg1: msg1
                msg2: msg2
                dotcols: dotcols
                quiet: quiet)
  (exit 0)
  (exit 1))