;plt-scheme@list.cs.brown.edu

(require (lib "string.ss"))
(define (sub-list pos n L)
    (define (iter pos n L acc)
      (cond [(zero? n) (reverse acc)]
            [(zero? pos) (iter pos (- n 1) (cdr L) (cons (car L) acc))]
            [else (iter (- pos 1) n (cdr L) acc)]))
  (iter pos n L '()))

; assembler une liste non vide de chaînes en une liste contenant chaque chaîne séparée par '.'
(define (list->iplist L)
  (define (iter L acc)
    (if (null? (cdr L))
        (reverse (cons (car L) acc))
        (iter (cdr L) (append (list  "." (car L)) acc))))
  (iter L '()))

(define (make-connection host port)
  (let-values ([(in out) (tcp-connect host port)])
    (define (this method . args)
      (case method
        [(read-line)
         (let ([s (read-line in 'any)])
           (printf "~a~n" s)
           s)]
        [(read-until)
         (letrec ([read-until
                   (lambda ()
                     (let ([str-out (open-output-string)])
                       (do ([i 0 (+ i 1)])
                         ((= i 3) 'ok)
                         (let ([c (read-char in)])
                           (display c str-out)
                           (display c)))
                       (this 'read-line)
                       (if (not (string=? (get-output-string str-out) (car args)))
                           (read-until))))])
           (read-until))]
        [(send)
         (fprintf out "~a~n" (car args))
         (printf "=> ~a~n" (car args))]
        [(login)
         (this 'send (string-append "USER " (car args))) ;PASS not supported yet
         (this 'read-until "230")]
        [(anonymous-login)
         (this 'login "anonymous" "")]
        [(cd)
         (this 'send (string-append "CWD " (car args)))
         (this 'read-until "250")]
        [(grab)
         (this 'send "PASV")
         (let* ([L (regexp-match* (regexp "[0-9]+") (this 'read-line in 'any) 3)]
                [ip (apply string-append (list->iplist (sub-list 0 4 L)))]
                [port-list (begin (sub-list 4 2 L))]
                [port (+ (* 256 (string->number (car port-list)))
                         (string->number (cadr port-list)))]
                [file (car args)])
           (this 'send "TYPE I")
           (this 'read-until "200")
           (this 'send (string-append "REST " (number->string (cadr args))))
           (this 'read-until "350")
           (this 'send (string-append "RETR " file))
           (let-values ([(in out) (tcp-connect ip port)])
             (let ([f-out (open-output-file file 'replace)])
               (printf "=> [connects to ~a:~a]~n" host ip)
               (this 'read-until "150")
               (do ([c (read-char in) (read-char in)] [n 0 (+ n 1)])
                 ((= n (caddr args)) 'done)
                 (write-char c f-out))
               (close-output-port out)
               (close-input-port in))))]
        [(close)
         (this 'send "QUIT")
         (close-output-port out)
         (this 'read-until "221")
         (close-input-port in)]))
    this))

; Try to grab 93MBytes at the 2*93MBytes offset
(define a (make-connection "ftp.club-internet.fr" 21))
;(define a (make-connection "beucfixe" 21)) ; my test at home
(a 'anonymous-login)
(a 'cd "/pub/mirrors/ftp.redhat.com/redhat/linux/8.0/en/iso/i386/")
;(a 'cd "/c/temp/cmpgames/")
(a 'grab "psyche-i386-disc4.iso" (* 2 93 1024 1024) (* 93 1024 1024))
;(a 'grab "dx80frn.exe" (* 2 1 1024 1024) (* 1024 1024))
(a 'close)