modules/ftp.lsp

   1 ;; @module ftp.lsp
   2 ;; @description FTP file transfer routines
   3 ;; @version 1.4 - comments redone for automatic documentation
   4 ;; @author Rudy Rucker, Lutz Mueller, 2003
   5 ;;
   6 ;; <h2>FTP file transfer routines</h2>
   7 ;; To use the module put a 'load' statement at beginning of your
   8 ;; program file:
   9 ;; <pre>
  10 ;; (load "/usr/share/newlisp/modules/ftp.lsp")
  11 ;; </pre>
  12 ;;
  13 ;; In case of failure the functions return 'nil' and further detail
  14 ;; may be found in the variable 'FTP:result'.
  15 ;;
  16 ;; To set debug mode, which shows all dialog with the server, set
  17 ;; 'FTP:debug-flag':
  18 ;; <pre>
  19 ;; (set 'FTP:debug-flag true)
  20 ;; </pre>
  21
  22 (context 'FTP)
  23
  24 ; debugging mode
  25 (set 'debug-mode nil)
  26
  27 ; mode of transfer
  28 (define GET 1)
  29 (define PUT 2)
  30
  31 ;; @syntax (FTP:get <str-user-id> <str-password> <str-host> <str-dir> <str-file-name>)
  32 ;; @param <str-user-id> The user ID for logon.
  33 ;; @param <str-password> The password for the user ID.
  34 ;; @param <str-host> The remote host name or IP as a string.
  35 ;; @param <str-dir> The subdirectory on the host.
  36 ;; @param <str-file-name> The name of the file to transfer.
  37 ;; @return 'true' on success, 'nil' on failure.
  38 ;; @example
  39 ;; (FTP:get "somebody" "secret" "host.com" "subdir" "aFile.tgz")  ;; download
  40 ;; (FTP:get "somebody" "secret" "192.168.1.120" "" "myfile.txt")  ;; download
  41
  42 ;; When leaving the string for the sub directory empty, the current directory "."
  43 ;; is assumed on the host.
  44
  45 (define (get user-id password host subdir file-name)
  46     (transfer user-id password host subdir file-name GET))
  47
  48 ;; @syntax (FTP:put <str-user-id> <str-password> <str-host> <str-dir> <str-file-name>)
  49 ;; @param <str-user-id> The user ID for logon.
  50 ;; @param <str-password> The password for the user ID.
  51 ;; @param <str-host> The remote host name or IP as a string.
  52 ;; @param <str-dir> The sub directory on the host.
  53 ;; @param <str-file-name> The name of the file to transfer.
  54 ;; @return 'true' on success, 'nil' on failure.
  55 ;; @example
  56 ;; (FTP:put "somebody" "secret" "host.com" "subdir" "file")  ;; upload
  57
  58 (define (put user-id password host subdir file-name)
  59     (transfer user-id password host subdir file-name PUT))
  60
  61 (define (transfer user-id password host subdir file-name mode)
  62   (if (= subdir "") (set 'subdir "."))
  63   (and
  64     (connect-to host 21)
  65     (send-get-result (append "USER " user-id "\r\n") "3")
  66     (send-get-result (append "PASS " password "\r\n") "2")
  67     (send-get-result (append "CWD " subdir "\r\n") "2")
  68     (send-get-result "TYPE I\r\n" "2")
  69     (set 'buff (send-get-result "PASV\r\n" "2"))
  70     (regex {(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)} buff)
  71     (set 'port (+ (* 256 (int $5)) (int $6)))
  72     (set 'ip (string $1 "." $2 "." $3 "." $4))
  73     (set 'socket2 (net-connect ip port))
  74
  75     (if (= mode PUT)
  76         (and
  77             (check-file file-name)
  78             (net-send socket (append "STOR " file-name "\r\n"))
  79             (send-get-result "STAT\r\n" "1")
  80             (set 'fle (open file-name "r"))
  81             (while (> (read-buffer fle 'buffer 512) 0)
  82                 (if debug-mode (print "."))
  83                 (net-send socket2 buffer 512))
  84             (close fle)) true)
  85
  86     (if (= mode GET)
  87         (and
  88             (net-send socket (append "RETR " file-name "\r\n"))
  89             (send-get-result "STAT\r\n" "1")
  90             (set 'fle (open file-name "w"))
  91             (while (net-receive socket2 'buffer 512)
  92                 (if debug-mode (print "."))
  93                 (write-buffer fle buffer))
  94             (close fle)) true)
  95
  96     (or (net-close socket2) true)
  97     (net-send socket "QUIT\r\n")
  98     (or (net-close socket) true)))
  99
 100 (define (send-get-result str code)
 101     (net-send socket str)
 102     (if debug-mode (println "sent:" str))
 103     (net-receive socket 'result 256 "\r\n")
 104     (if debug-mode (println result))
 105     (if (starts-with result code) result))
 106
 107 (define (connect-to host port)
 108     (set 'FTP:result nil)
 109     (set 'socket (net-connect host port))
 110     (if socket
 111         (net-receive socket 'result 256 "\r\n")
 112         (begin
 113             (set 'result "could not connect")
 114             nil)))
 115
 116 (define (check-file file-name)
 117     (if (file? file-name)
 118         true
 119         (begin
 120             (set 'result (append file-name " does not exist"))
 121             nil)))
 122
 123 (context 'MAIN)
 124
 125 ; test
 126 ;
 127 ;(set 'FTP:debug-mode true)
 128 ;
 129 ;(FTP:put "userid" "password" "site.com" "tmp" "testfile")
 130 ;
 131 ;(FTP:get "userid" "password" "site.com" "tmp" "testfile")
 132 ;
 133 ;(exit)
 134
 135
 136
 137 ; eof
 138
 139