#!/usr/local/bin/klone

(setq USAGE "getit file-descs...
where filedesc can be of the form:
    (1) host:path/file
    (2) path/file@host
return status is number of failed transfers")

(setq args (getopts USAGE
    ("-v" () verbose "verbose mode, dumps ftp log")
    ("-q" () quiet "quiet mode, only status returned")
    ("-debug" () debug "debug mode")
))

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

(setq status 0)

(defun main ()
  (dolist (file args)
    (get-desc file)
  )
  (if debug (PV status))
  (apply exit (list status))		;circumvent bug
)

(defun get-desc (desc &aux
    hpf
  )
  (setq hpf (or
      (match "^([^:]+):()([^/]+)$" desc 1 2 3)
      (match "^([^:]+):(.*)[/]([^/]+)$" desc 1 2 3)
      (match "^()([^/@]+)@(.*)$" desc 3 1 2)
      (match "^([^@]*)[/]([^/@]+)@(.*)$" desc 3 1 2)
      (progn (PF "getit 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)
      (+ "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 "getit: 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 "getit: file %0 Ok (%1 bytes)\n" file
	  (get stats 'size)
      ))
    )
    (progn
      (if (not quiet) (print-format "getit: 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/getit_" (String *current-process-id*)))
    res
  )
  (setq pid (system (+ "/usr/ucb/ftp -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)
  (wait pid)
  (setq res (String (open tempfile :error "Could not find log file!")))
  (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: ***
