#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH 

(setq USAGE "getftp file-descs...
where filedesc can be of the form:
    (1) host:path/file
    (2) path/file@host
    (3) ftp://host/path/file         (W3 form)
return status is number of failed transfers
the client will log as user anonymous, password $USER@")

(setq args (getopts USAGE
    ("-v" () verbose "verbose mode, dumps ftp log")
    ("-q" () quiet "quiet mode, only status returned")
    ("-r" () do-reget "do a reget of file instead of a get")
    ("-t" timeout timeout "timout in seconds (default 0 = none)")
    ("-c" () redo "continue retrying tranfers until all files transferred")
    ("-debug" () debug "debug mode")
))

(if (not (>= (length args) 1))
  (progn (PF "%0\n" USAGE) (exit 1))
)

(if (not timeout) (setq timeout 0))
(setq doftp:timeout (Int timeout))

(catch 'OK
  (dolist (loc #("/usr/ucb/ftp" "/bin/ftp" "/usr/bin/ftp"))
    (if (file-stats loc) (throw 'OK (setq ftp-binary loc)))
  )
  (setq ftp-binary "ftp")
)

(setq status 0)

(defun main ()
  (if redo 
    (with (files (copy args) toretry (list))
      (while files
	(dolist (file files)
	  (setq status 0)
	  (get-desc file)
	  (if (/= 0 status)
	    (lappend  toretry file)
	))
	(setq files toretry)
	(setq toretry (list))
      )
      (exit 0)
    )
      
    (progn
      (dolist (file args)
	(get-desc file)
      )
      (if debug (PV status))
      (apply exit (list status))		;circumvent bug
)))

(defun get-desc (desc &aux
    hpf					;host-path-file triplet
  )
  (setq hpf (or
      (match "^ftp:[/][/]([^/]+)([/](.*))[/]([^/]+)$" desc 1 2 3)
      (match "^([^:]+):()([^/]+)$" desc 1 2 3)
      (match "^([^:]+):(.*)[/]([^/]+)$" desc 1 2 3)
      (match "^()([^/@]+)@(.*)$" desc 3 1 2)
      (match "^([^@]*)[/]([^/@]+)@(.*)$" desc 3 1 2)
      (progn (PF "getftp error: unknown file description: %r0, ignored\n" desc)
	()
      )
  ))
  (if hpf (apply get-file hpf))
)

(defun get-file (host path file &aux
    log
    stats
    size
  )
  (setq log (doftp host (+ (getenv "USER") "@") (+ "/" path)
      (+ (if do-reget "reget " "get ") file)
  ))
  (if verbose (write-string log))
  (if (setq stats (file-stats file))
    (if (and (setq size (match (+ "Opening data connection for " 
	      (quote-string-for-regexp file)
	      "[(][^)]*[)] *[(]([0-9]+) +bytes[)]."
	    ) log 1
	))
	(/= (Int size) (getn stats 'size))
      )
      (progn
	(if (not quiet) (print-format "getftp: file %0 FAILED (truncated: only %2 bytes receieved instead of %1)!\n" file (getn stats 'size) size))
	(if (not (or verbose quiet)) (write-string log))
	(incf status)
      )	
      (if (not quiet) (print-format "getftp: file %0 Ok (%1 bytes)\n" file
	  (get stats 'size)
      ))
    )
    (progn
      (if (not quiet) (print-format "getftp: file %0 FAILED! (could not get it)\n" file))
      (if (not (or verbose quiet)) (write-string log))
      (incf status)
    )
  )    
))

(defun doftp (site site:password site:dir &rest commands &aux
    fd
    pid
    (tempfile (+ "/tmp/getftp_" (String *current-process-id*)))
    res
    timeoutpid
    terminated
  )
  (if (/= 0 doftp:timeout) (setq timeoutpid (system (list "sleep" (String
	    doftp:timeout
  )))))
  (setq pid (system (+ ftp-binary " -inv > " tempfile " 2>&1") :input 'fd))
  (print-format fd "open %0\n\nuser anonymous %1\nbinary\nprompt\ncd \"%2\"\n"
    site
    site:password
    site:dir
  )
  (flush fd)
  (if debug (print-format fd "pwd\ndir\n"))
  (doftp:command commands fd)
  (print-format fd "quit\n")
  (flush fd)
  (setq terminated (wait ()))
  (setq res (String (open tempfile :error "Could not find log file!")))
  (if (= timeoutpid (getn terminated 0)) (progn	;timeouted
      (sh kill ,pid)
      (sh sleep 2)
      (nconc res "\n *** TIMEOUTED *** \n")
  ))
  (wait (system (list "rm" "-f" tempfile)))
  res
)


(defun doftp:command (command fd)
  (if (typep command List)
    (dolist (com  command) (doftp:command com fd))
    (progn
      (if debug (PV com))
      (print-format fd "%0\n" com)
      (flush fd)
  ))
)


(main)


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