Code: Select all
#!/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 "\r\n")
(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 "\r\n") (exit 1))
(net-ret (append "USER " user "\r\n") "331")
(net-ret (append "PASS " pass "\r\n") "230")
(net-ret (append "CWD " dir "\r\n") "250")
(net-ret "TYPE I\r\n" "200")
(net-ret "PASV\r\n" "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 "\r\n"))
(setq S (in 0))
(net-ret "STAT\r\n" "150")
(net-send (out 0) (append "STOR " des-file "\r\n"))
(setq S (out 0))
(net-ret "STAT\r\n" "150")
(while (net-receive pin buffer 8192)
(and (print ".") (net-send pout buffer 8192)))
(net-close pin)
(net-send (in 0) "QUIT\r\n")
(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) "QUIT\r\n")
(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")