[Tip of the Day] Forward only ftp

[newdep]

Code Select Expand


#!/usr/bin/newlisp
;;
;; Forward-Only Ftp.
;; v0.1 premature alpha release by - nodep (c)opyleftathome -
;; hacked this script because I needed to move very big files
;; between 2 systems where I didnt had any shell access but only
;; ftp access. (yeah handy but it happens far too often ;-)
;;
;; ---
;; If you have to move very big files between 2 machines and only have
;; ftp access to them then you always have to store the file
;; on your local machine first befor forwarding to the other. (ugly!)
;;
;; And if your machine hasn't enough diskspace (lucky you) then
;; the only way to move the files between the machines is via
;; a network-forward via your machine.
;;
;; This tool connects ftp-server #1 and #2 (source & destination).
;; Your machine that runs this script is the forwarder
;; (No storing of data, forward only).
;;
;; Partly borrowed some ftp data from the newlisp ftp.lsp module.
;;
;; Runs Passive mode only
;; Buffer size 8192 bytes
;; Tested on Unix and NAS systems only
;; Script might not run on all ftp servers.
;; Windows users might need to change the read-key "n" into "r"
;; ---
;;


(define (net-ret str code)
    (net-send S str)
    (net-receive S B 256 "rn")
    (println B)
    (if (starts-with B code) B))

(define (net-init user pass host dir)
    (if (setq S (net-connect host 21))
        (net-receive S B 256 "rn") (exit 1))
    (net-ret (append "USER " user "rn") "331")
    (net-ret (append "PASS " pass "rn") "230")
    (net-ret (append "CWD "  dir  "rn") "250")
    (net-ret "TYPE Irn"                 "200")
    (net-ret "PASVrn"                   "227")
    (regex {(d+),(d+),(d+),(d+),(d+),(d+)} B)
    (list S (string $1 "." $2 "." $3 "." $4)
            (+ (* 256 (int $5)) (int $6))) )

(define (net-go)

    (setq in  (net-init src-user src-pass src-host src-dir))
    (setq pin (net-connect (in 1) (in 2)))

    (setq out  (net-init des-user des-pass des-host des-dir))
    (setq pout (net-connect (out 1) (out 2)))

    (net-send (in 0)  (append "RETR " src-file "rn"))
    (setq S (in 0))
    (net-ret "STATrn" "150")

    (net-send (out 0) (append "STOR " des-file "rn"))
    (setq S (out 0))
    (net-ret "STATrn" "150")

    (while (net-receive pin buffer 8192)
       (and (print ".") (net-send pout buffer 8192)))

    (net-close pin)
    (net-send (in 0) "QUITrn")
    (net-close (in 0))

    ;; wait for full flush this is a guessed time.
    ;; needed when data is buffered somewhere.
    (sleep 3000)

    (net-close pout)
    (net-send (out 0) "QUITrn")
    (net-close (out 0))

    (println "Done.")
)


;;; user input section

(println (dup "-" 70))
(println "* Forward only FTP v0.1")
(println (dup "-" 70))
(print "Source FTP Server: ")
(setq src-host (read-line))
(print "Source Username  : ")
(setq src-user (read-line))
(print "Source Password  : " )
  (while (!= (format "%c" (setq c (read-key))) "n")
    (push (format "%c" c) src-pass -1) (print "*"))
(setq src-pass (join src-pass))
(println)
(print "Source Directory : ")
(setq src-dir (read-line))
(print "Source File      : ")
(setq src-file (read-line))

(println (dup "-" 70))
(print "Destination FTP Server: ")
(setq des-host (read-line))
(print "Destination Username  : ")
(setq des-user (read-line))
(print "Destination Password  : " )
  (while (!= (format "%c" (setq c (read-key))) "n")
    (push (format "%c" c) des-pass -1) (print "*"))
(setq des-pass (join des-pass))
(println)
(print "Destination Directory : ")
(setq des-dir (read-line))
(print "Destination File      : ")
(setq des-file (read-line))
(println (dup "-" 70))

;; run
(net-go)
(exit)





(load "http://www.nodep.nl/downloads/newlisp/fftp.lsp">//http://www.nodep.nl/downloads/newlisp/fftp.lsp")

[newdep]

scripts seems to work nicely enough to continue working on.

updated version and some todo listings...

Enjoy..