cl-ftp-1.3.3/0000755000000000000000000000000010630402116011372 5ustar rootrootcl-ftp-1.3.3/LICENSE0000644000175000017500000000256707655741106012063 0ustar mrdmrdCopyright (c) 2002-2003 Matthew Danish. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-ftp-1.3.3/ftp.lisp0000644000175000017500000004763310001641707012524 0ustar mrdmrd;;;; -*- Mode: Lisp -*- ;;;; Author: Matthew Danish ;;;; See LICENSE file for copyright details. ;;;; FTP client functionality #+allegro (eval-when (:compile-toplevel :load-toplevel :execute) (require :sock)) ; just in case (defpackage #:org.mapcar.ftp.client (:use #:common-lisp #:socket #:split-sequence) (:nicknames #:ftp.client #:ftp) (:export #:ftp-connection #:with-ftp-connection #:connect-to-server #:close-connection #:send-list-command #:send-nlst-command #:with-transfer-socket #:call-with-transfer-socket #:ftp-error #:invalid-code #:transient-negative-completion #:permanent-negative-completion #:ftp-error-code #:error-message #:expected #:received #:passive-ftp-p #:code-cut-off-p #:ftp-hostname #:ftp-port #:ftp-username #:ftp-password #:ftp-session-stream #:data-to-string #:retrieve-file #:store-file #:receive-response #:data-ready-p #:retrieve-filename-list #:retrieve-file-info-list)) (in-package #:org.mapcar.ftp.client) (eval-when (:compile-toplevel :load-toplevel :execute) (define-condition ftp-error () ((ftp-error-code :initarg :ftp-error-code :initform "\"unspecified\"" :reader ftp-error-code) (error-message :initarg :error-message :initform "\"unspecified\"" :reader error-message)) (:report (lambda (c s) (format s "FTP error ~A raised: ~A" (ftp-error-code c) (error-message c))))) (define-condition invalid-code (ftp-error) ((expected :reader expected :initarg :expected) (received :reader received :initarg :received)) (:report (lambda (c s) (format s "Expected FTP code ~A, got FTP code ~A" (expected c) (received c))))) (define-condition transient-negative-completion (ftp-error) () (:report (lambda (c s) (format s "Received transient error code ~A: ~A" (ftp-error-code c) (error-message c))))) (define-condition permanent-negative-completion (ftp-error) () (:report (lambda (c s) (format s "Received permanent error code ~A: ~A" (ftp-error-code c) (error-message c))))) (defclass ftp-connection () ((hostname :initarg :hostname :reader ftp-hostname) (port :initarg :port :initform 21 :reader ftp-port) (username :initarg :username :initform "anonymous" :reader ftp-username) (password :initarg :password :initform "cl-ftp@cclan.net" :reader ftp-password) (session-stream :initarg :session-stream :initform nil :reader ftp-session-stream) (passive-ftp-p :initarg :passive-ftp-p :initform nil :accessor passive-ftp-p) (code-cut-off-p :initarg :code-cut-off-p :initform t :accessor code-cut-off-p) (socket)))) (defmacro with-ftp-connection-slots ((conn) &body body) `(with-slots (socket hostname port username password session-stream passive-ftp-p code-cut-off-p) ,conn ,@body)) (defmethod print-object ((obj ftp-connection) stream) (with-ftp-connection-slots (obj) (print-unreadable-object (obj stream) (format stream "FTP connection to ~A:~A username: ~A" hostname port username)))) (defun raise-ftp-error (error-code error-msg &key (expected-code nil)) (cond ((and (>= error-code 400) (< error-code 500)) (error 'transient-negative-completion :ftp-error-code error-code :error-message error-msg)) ((and (>= error-code 500) (< error-code 600)) (error 'permanent-negative-completion :ftp-error-code error-code :error-message error-msg)) (expected-code (error 'invalid-code :expected expected-code :received error-code :ftp-error-code error-code :error-message error-msg)) (t (error 'ftp-error :ftp-error-code error-code :error-message error-msg)))) (defun data-to-string (data) (format nil "~{~A~%~}" data)) (defmethod expect-code-or-lose ((conn ftp-connection) (expected-code integer)) (multiple-value-bind (data code) (receive-response conn :block t) (unless (eql code expected-code) (raise-ftp-error code (data-to-string data) :expected-code expected-code)) data)) (defmethod initialize-instance :after ((conn ftp-connection) &rest initargs) (declare (ignorable initargs)) (connect-to-server conn)) (defmethod connect-to-server ((conn ftp-connection)) (with-ftp-connection-slots (conn) (unless (and hostname port (integerp port) (stringp hostname)) (error "You must specify a hostname string and an integer port")) (when (and (slot-boundp conn 'socket) (streamp socket)) (close socket)) (setf socket (make-socket :remote-host hostname :remote-port port)) (unless socket (error "Error connecting to ~A:~A" hostname port)) (when (and username password (stringp username) (stringp password)) (expect-code-or-lose conn 220) (send-raw-line conn (format nil "USER ~A" username)) (expect-code-or-lose conn 331) (send-raw-line conn (format nil "PASS ~A" password)) (expect-code-or-lose conn 230)) (values))) (defmacro with-ftp-connection ((conn &key hostname port username password passive-ftp-p session-stream (code-cut-off-p t code-cut-off-p-p) (if-failed :error)) &body body) `(let ((,conn (make-instance 'ftp-connection ,@(if hostname `(:hostname ,hostname) ()) ,@(if port `(:port ,port) ()) ,@(if username `(:username ,username) ()) ,@(if password `(:password ,password) ()) ,@(if passive-ftp-p `(:passive-ftp-p ,passive-ftp-p) ()) ,@(if session-stream `(:session-stream ,session-stream) ()) ,@(if code-cut-off-p-p `(:code-cut-off-p ,code-cut-off-p) ())))) (if (null ,conn) (if (eql ,if-failed :error) (error "Connection to ~A:~A failed" ,hostname ,port) ,if-failed) (unwind-protect (progn ,@body) (close-connection ,conn))))) (defmethod log-session ((conn ftp-connection) (data string)) (with-ftp-connection-slots (conn) (when (and session-stream (streamp session-stream)) (write-string data session-stream)) (values))) (defmethod log-session ((conn ftp-connection) (data list)) (log-session conn (data-to-string data))) (defmethod close-connection ((conn ftp-connection)) (with-ftp-connection-slots (conn) (close socket))) (defmethod send-raw-line ((conn ftp-connection) (line string)) (with-ftp-connection-slots (conn) (let ((line (format nil "~A~C~C" line #\Return #\Newline))) (log-session conn line) (write-string line socket)) (force-output socket) (values))) (defmethod data-ready-p ((conn ftp-connection)) (with-ftp-connection-slots (conn) (listen socket))) (defun clean-ftp-response (data) (mapcar #'(lambda (line) (string-trim '(#\Return #\Newline) line)) data)) (defun maybe-cut-off-code (cut-off-p data code) (if cut-off-p data (mapcar #'(lambda (x) (if (and (> (length x) 3) (eql (parse-integer x :end 3 :junk-allowed t) code)) (subseq x 4) x)) data))) (defmethod receive-response ((conn ftp-connection) &key (block nil)) (with-ftp-connection-slots (conn) (when (and (not block) (not (data-ready-p conn))) (return-from receive-response nil)) (let* ((initial-line (read-line socket)) (ftp-code (parse-integer initial-line :end 3)) (continue-p (char= (char initial-line 3) #\-)) (lines (list (if code-cut-off-p (subseq initial-line 4) initial-line)))) (loop while continue-p do (let* ((line (read-line socket)) (line-length (length line)) (line-code (when (> line-length 3) (parse-integer line :end 3 :junk-allowed t)))) (push (if (and code-cut-off-p (eql line-code ftp-code)) (subseq line 4);; cut-off the code, if present line) lines) ;; continue until reaching a line that begins with the code ;; and has a #\Space after it (when (and (eql line-code ftp-code) (char= #\Space (char line 3))) (setf continue-p nil)))) (let ((data (clean-ftp-response (nreverse lines)))) (log-session conn data) (values (maybe-cut-off-code code-cut-off-p data ftp-code) ftp-code))))) (defmethod send-port-command ((conn ftp-connection) (ip string) (port-num integer)) (multiple-value-bind (quot rem) (truncate port-num 256) (send-raw-line conn (format nil "PORT ~A,~A,~A" (substitute #\, #\. ip) quot rem)))) (defmethod receive-pasv-response ((conn ftp-connection)) (with-ftp-connection-slots (conn) (multiple-value-bind (data code) (receive-response conn :block t) (unless (eql code 227) (raise-ftp-error code (data-to-string data) :expected-code 227)) (let ((start (position #\( (first data) :from-end t)) (end (position #\) (first data) :from-end t))) (unless (and start end) (error "Unable to parse PASV response")) (let ((numbers (split-sequence #\, (first data) :start (1+ start) :end end))) (values (format nil "~{~A~^.~}" (subseq numbers 0 4)) (+ (ash (parse-integer (fifth numbers)) 8) (parse-integer (sixth numbers))))))))) (defmethod setup-port ((conn ftp-connection) &key (format :binary)) (with-ftp-connection-slots (conn) (let ((server-socket (loop for p = (+ 1025 (random 10000)) for s = (ignore-errors (make-socket :connect :passive :local-port p :format format)) when s return s)) (local-ip (ipaddr-to-dotted (local-host socket)))) (send-port-command conn local-ip (local-port server-socket)) server-socket))) (defmethod establish-data-transfer ((conn ftp-connection) (command string) &key (rest nil) (type :binary)) (with-ftp-connection-slots (conn) (send-raw-line conn (format nil "TYPE ~A" (ecase type ((:binary :image) "I") (:ascii "A")))) (expect-code-or-lose conn 200) (cond (passive-ftp-p (send-raw-line conn "PASV") (multiple-value-bind (dtp-hostname dtp-port) (receive-pasv-response conn) (let ((data-socket (make-socket :remote-host dtp-hostname :remote-port dtp-port :format (ecase type ((:binary :image) :binary) (:ascii :text))))) (when (and rest (integerp rest)) (send-raw-line conn (format nil "REST ~A" rest))) (send-raw-line conn command) data-socket))) (t (let ((server-socket (setup-port conn :format (ecase type ((:binary :image) :binary) (:ascii :text))))) (unwind-protect (progn (when (and rest (integerp rest)) (send-raw-line conn (format nil "REST ~A" rest))) (expect-code-or-lose conn 200) (send-raw-line conn command) (accept-connection server-socket)) (close server-socket))))))) (defmethod flush-response ((conn ftp-connection)) (loop while (receive-response conn))) (defmethod call-with-transfer-socket ((conn ftp-connection) (command string) (fn function) &rest args) (flush-response conn) (let ((transfer-socket (apply #'establish-data-transfer conn command args))) (unwind-protect (funcall fn transfer-socket) (progn (close transfer-socket) (loop (multiple-value-bind (data code) (receive-response conn :block t) (declare (ignorable data)) (when (and (integerp code) (eql code 226)) (return-from call-with-transfer-socket t)) (when (and (integerp code) (>= code 500)) (return-from call-with-transfer-socket nil)))))))) (defmacro with-transfer-socket ((socket conn command &rest args) &body body) `(call-with-transfer-socket ,conn ,command #'(lambda (,socket) ,@body) ,@args)) (defmethod send-list-command ((conn ftp-connection) (output null) &optional (pathname ".")) (with-output-to-string (s) (send-list-command conn s pathname))) (defmethod send-list-command ((conn ftp-connection) (output t) &optional (pathname ".")) (send-list-command conn *standard-output* pathname)) (defmethod send-list-command ((conn ftp-connection) (output stream) &optional (pathname ".")) (flet ((read-all (s) (loop (handler-case (write-line (read-line s) output) (end-of-file () (return (values))))))) (with-transfer-socket (s conn (format nil "LIST ~A" pathname) :type :ascii) (read-all s)))) (defmethod send-nlst-command ((conn ftp-connection) (output null) &optional (pathname ".")) (with-output-to-string (s) (send-nlst-command conn s pathname))) (defmethod send-nlst-command ((conn ftp-connection) (output t) &optional (pathname ".")) (send-nlst-command conn *standard-output* pathname)) (defmethod send-nlst-command ((conn ftp-connection) (output stream) &optional (pathname ".")) (flet ((read-all (s) (loop (handler-case (write-line (read-line s) output) (end-of-file () (return (values))))))) (with-transfer-socket (s conn (format nil "NLST ~A" pathname) :type :ascii) (read-all s)))) (defmethod retrieve-filename-list ((conn ftp-connection) &optional (pathname ".")) (let* ((data (send-nlst-command conn nil pathname)) (split-data (split-sequence #\Newline data :remove-empty-subseqs t))) (mapcar #'(lambda (x) (string-trim '(#\Return) x)) split-data))) (defmethod retrieve-file-info-list ((conn ftp-connection) &optional (pathname ".")) (let ((names (retrieve-filename-list conn pathname)) (file-info-list nil) (orig-dir (send-pwd-command conn)) (base-dir nil)) (send-cwd-command conn pathname) (setf base-dir (send-pwd-command conn)) (unwind-protect (dolist (name names file-info-list) (handler-case (progn (send-cwd-command conn name) (push (list :directory name) file-info-list)) (ftp-error () (push (list :file name) file-info-list))) (send-cwd-command conn base-dir)) (send-cwd-command conn orig-dir)))) (defmethod retrieve-file ((conn ftp-connection) (remote-filename string) local-filename &key (type :binary) (rest nil)) (with-open-file (local-stream local-filename :direction :output :element-type (ecase type ((:binary :image) '(unsigned-byte 8)) (:ascii 'character))) (retrieve-file conn remote-filename local-stream :type type :rest rest))) (defmethod retrieve-file ((conn ftp-connection) (remote-filename string) (local-stream stream) &key (type :binary) (rest nil)) (with-transfer-socket (s conn (format nil "RETR ~A" remote-filename) :type type :rest rest) (handler-case (ecase type ((:binary :image) (loop (write-byte (read-byte s) local-stream))) (:ascii (loop (write-char (read-char s) local-stream)))) (end-of-file () (values))))) (defmethod store-file ((conn ftp-connection) local-filename (remote-filename string) &key (type :binary) (rest nil)) (with-open-file (local-stream local-filename :direction :input :element-type (ecase type ((:binary :image) '(unsigned-byte 8)) (:ascii 'character))) (store-file conn local-stream remote-filename :type type :rest rest))) (defmethod store-file ((conn ftp-connection) (local-stream stream) (remote-filename string) &key (type :binary) (rest nil)) (with-transfer-socket (s conn (format nil "STOR ~A" remote-filename) :type type :rest rest) (handler-case (ecase type ((:binary :image) (loop (write-byte (read-byte local-stream) s))) (:ascii (loop (write-char (read-char local-stream) s)))) (end-of-file () (values))))) (defmacro def-simple-command (cmd (conn &rest args) &body body) (let ((name (intern (format nil "SEND-~A-COMMAND" cmd)))) `(progn (defmethod ,name ((,conn ftp-connection) ,@args) (flush-response ,conn) ,@body) (export ',name)))) (def-simple-command size (conn (remote-filename string)) (send-raw-line conn (format nil "SIZE ~A" remote-filename)) (parse-integer (first (expect-code-or-lose conn 213)))) (def-simple-command cwd (conn (remote-dir string)) (send-raw-line conn (if (string-equal remote-dir "..") "CDUP" (format nil "CWD ~A" remote-dir))) (expect-code-or-lose conn 250)) (def-simple-command cdup (conn) (send-raw-line conn "CDUP") (expect-code-or-lose conn 250)) (defun parse-257-response (string) (let ((start (1+ (position #\" string))) (last (1- (length string)))) (with-output-to-string (out) (do ((i start (1+ i))) ((>= i last) (values)) (if (char= (char string i) #\") (cond ((char= (char string (1+ i)) #\") (write-char #\" out) (incf i)) (t (return (values)))) (write-char (char string i) out)))))) (def-simple-command pwd (conn) (send-raw-line conn "PWD") (parse-257-response (data-to-string (expect-code-or-lose conn 257)))) (def-simple-command mkd (conn (dir-name string)) (send-raw-line conn (format nil "MKD ~A" dir-name)) (parse-257-response (data-to-string (expect-code-or-lose conn 257)))) cl-ftp-1.3.3/api.html0000644000175000017500000002151210064052300012457 0ustar mrdmrd CL-FTP API

Overview

CL-FTP is a library which provides FTP client functionality to a Common Lisp program. CL-FTP uses the ACL-COMPAT package for network sockets and the SPLIT-SEQUENCE package for some parsing needs.

License

This software, and documentation, is (c) 2002 Matthew Danish. Redistribution and modification is permitted under a MIT-style license. See the LICENSE file for more details.

Programmers Interface

Examples

(with-ftp-connection (conn :hostname "foo") (retrieve-file conn "bar" "baz"))

Further examples should be included with your copy of this software. See simple-client.lisp for a simple FTP client written with CL-FTP.

cl-ftp-1.3.3/ftp.asd0000644000175000017500000000075107655740712012333 0ustar mrdmrd;;;; -*- Mode: Lisp -*- ;;;; Author: Matthew Danish ;;;; See LICENSE file for copyright details. (asdf:defsystem ftp :name "cl-ftp" :author "Matthew Danish " :version "1.3" :maintainer "Matthew Danish " :licence "MIT/X style" :description "FTP library" :long-description "Provides FTP client functionality" :components ((:file "ftp")) :depends-on (split-sequence #-allegro acl-compat)) cl-ftp-1.3.3/api.lml0000644000175000017500000002345507565754127012343 0ustar mrdmrd;;;; -*- Mode: Lisp -*- ;;;; Author: Matthew Danish ;;;; See LICENSE file for copyright details. ;;;; CL-FTP API documentation (defpackage #:org.mapcar.ftp.client.docs (:use #:common-lisp #:lml)) (in-package #:org.mapcar.ftp.client.docs) (defmacro api-list (&body body) `(ul ,@(loop for item in body collect `(li ,item)))) (defun stringify (x) (let ((*print-case* :downcase)) (if (null x) "()" (format nil "~A" x)))) (defmacro with-class-info ((class-name superclasses &rest slot-docs) &body other-info) `(p (i "Class ") (b ,(stringify class-name)) (i " derived from ") ,(stringify superclasses) " -- " (br) (i "Initargs:") (br) (ul ,@(loop for (slot-name slot-desc slot-default) in slot-docs collect `(li (tt ,(format nil ":~A" slot-name)) " -- " ,slot-desc " -- " (i "Default: ") ,(if (eql slot-default :n/a) "Not specified" (format nil "~S" slot-default))))) ,@other-info)) (defmacro with-macro-info ((macro-name &rest lambda-list) &body other-info) `(p (i "Macro ") (b ,(stringify macro-name)) " " (tt ,(stringify lambda-list)) (br) ,@other-info)) (defmacro with-function-info ((function-name &rest lambda-list) &body other-info) `(p (i "Function ") (b ,(stringify function-name)) " " (tt ,(stringify lambda-list)) (br) ,@other-info)) (defmacro with-condition-info ((condition-name supers &rest slot-docs) &body other-info) `(p (i "Condition ") (b ,(stringify condition-name)) (i " derived from ") ,(stringify supers) " -- " (br) (i "Slots:") (br) (ul ,@(loop for (slot-name slot-desc slot-reader slot-initarg slot-default) in slot-docs collect `(li (tt ,(stringify slot-name)) " -- " ,slot-desc " -- " (i " Default: ") ,(if (eql slot-default :n/a) "Not specified" (format nil "~S" slot-default))))) ,@other-info)) (defmacro with-ftp-connection-functions (&rest slots) `(progn ,@(loop for (fn description . args) in slots collect `(with-function-info (,fn ,@(if args args '(connection-variable))) ,description)))) (page api (head (title "CL-FTP API")) (body (h1 "Overview") (p "CL-FTP is a library which provides FTP client functionality to a Common Lisp program. CL-FTP uses the ACL-COMPAT package for network sockets and the SPLIT-SEQUENCE package for some parsing needs.") (h1 "License") (p "This software, and documentation, is (c) 2002 Matthew Danish. Redistribution and modification is permitted under a MIT-style license. See the LICENSE file for more details.") (h1 "Programmers Interface") (api-list (with-class-info (ftp-connection () (:hostname "The remote hostname" :n/a) (:port "The remote port" 21) (:username "The login username" "anonymous") (:password "The login password" "cl-ftp@cclan.net") (:passive-ftp-p "Use passive FTP if non-nil" nil) (:session-stream "Send FTP session output to this stream, if non-nil" nil) (:code-cut-off-p "When non-nil, cut-off FTP codes in logging output" t)) "Represents an FTP connection and associated state. The INITIALIZE-INSTANCE :AFTER method takes care of connection and login, if possible.") (with-ftp-connection-functions (ftp-hostname "The remote hostname") (ftp-port "The remote port") (ftp-username "The login username") (ftp-password "The login password") (ftp-session-stream "The session stream for the FTP connection") (passive-ftp-p "Non-nil iff given FTP connection is to use passive FTP for data transfers") ((setf passive-ftp-p) "Value should be non-nil to use passive FTP for data transfers with the given FTP connection" value connection-variable) (code-cut-off-p "Non-nil iff FTP codes are to be cut-off when logging") ((setf code-cut-off-p) "Alter value of code-cut-off-p" value connection-variable)) (with-condition-info (ftp-error () (ftp-error-code "Code associated with message" ftp-error-code :ftp-error-code :n/a) (error-message "FTP server's error message" error-message :error-message :n/a)) ) (with-condition-info (invalid-code (ftp-error) (expected "Expected code" expected :expected :n/a) (received "Received code" received :received :n/a)) ) (with-condition-info (transient-negative-completion (ftp-error)) "Signalled when a transient error is received from the FTP server. This means that the input was fine, but something else went wrong. Feel free to resend.") (with-condition-info (permanent-negative-completion (ftp-error)) "Signalled when a permanent error is received from the FTP server. This means that the input was not acceptable and should not be re-sent.") (with-function-info (connect-to-server connection-variable) "Attempts to connect to the server using the information provided by connection-variable. If connection-variable represents an existing connection, then that connection will be closed and a new one established.") (with-function-info (close-connection connection-variable) "Closes the given FTP connection") (with-macro-info (with-ftp-connection (connection-variable &key hostname port username password passive-ftp-p session-stream (if-failed :error)) &body body) "Opens and ensures proper close of an FTP connection. Binds connection-variable to the FTP-CONNECTION object in the scope of body. Arguments are similar to that of the initargs for the class FTP-CONNECTION.") (with-macro-info (with-transfer-socket (transfer-socket connection-variable command-string &key rest (type :binary)) &body body) "Opens a data transfer socket in the scope of body, using the given FTP connection and executing the given FTP command-string. If :REST is specified, then the FTP \"REST\" command will be sent with the value of the argument. :TYPE may be :BINARY or :ASCII. Closes the transfer-socket upon dynamic exit of body.") (with-function-info (call-with-transfer-socket connection-variable command-string function &key rest (type :binary)) "Similar to WITH-TRANSFER-SOCKET, except that function is a function which accepts a single argument; namely the transfer-socket") (with-function-info (retrieve-file connection-variable remote local &key (type :binary) rest) "Retrieves a file given a remote filename, and a local filename or stream. :TYPE is either :ASCII or :BINARY, and :REST specifies an integer amount to seek into the file before retrieving it.") (with-function-info (store-file connection-variable local remote &key (type :binary)) "Stores a file given a local filename or stream and a remote filename. :TYPE is either :ASCII or :BINARY.") (with-function-info (receive-response connection-variable &key (block nil)) "Receives a response from the FTP server. Returns a list of strings as the first value and the response code as the second. If :BLOCK is T, then will block until response received. Otherwise return NIL if nothing is available currently.") (with-function-info (data-to-string data-list) "Converts a list of strings, such as that produced by receive-response, to one string with newlines after each formerly-list-element.") (with-function-info (data-ready-p connection-variable) "Non-nil iff data is waiting to be read from the control connection.") (with-function-info (send-list-command connection-variable output &optional (pathname ".")) "Sends the FTP LIST command. If OUTPUT is NIL, returns a string. If OUTPUT is T, prints to *standard-output*. Otherwise, it treats OUTPUT as the output stream.") (with-function-info (send-nlst-command connection-variable output &optional (pathname ".")) "Sends the FTP NLST command. If OUTPUT is NIL, returns a string. If OUTPUT is T, prints to *standard-output*. Otherwise, it treats OUTPUT as the output stream.") (with-function-info (retrieve-filename-list connection-variable &optional (pathname ".")) "Retrieves a list of filenames for the given pathname.") (with-function-info (retrieve-file-info-list connection-variable &optional (pathname ".")) "Retrieves a list of the form (type name) where type is :DIRECTORY or :FILE and name is a filename in the given directory named by pathname. Note: this is implemented by attempting CWDs, and may break if the FTP server does strange things.") (with-function-info (send-size-command connection-variable remote-filename) "Sends the FTP SIZE command on the given remote-filename. Returns an integer size. Signals error if no such file.") (with-function-info (send-cwd-command connection-variable remote-directory) "Sends the FTP CWD command, to change to the given remote-directory. If remote-directory is \"..\", CDUP is sent instead. Signals error if not possible.") (with-function-info (send-cdup-command connection-variable) "Sends the FTP CDUP command.") (with-function-info (send-pwd-command connection-variable) "Sends the FTP PWD command and returns the current working directory as a string.") (with-function-info (send-mkd-command connection-variable remote-directory) "Sends the FTP MKD command to make a remote directory. Returns directory name as string. Signals error if not possible.")) (h1 "Examples") (p (tt "(with-ftp-connection (conn :hostname \"foo\") (retrieve-file conn \"bar\" \"baz\"))")) (p "Further examples should be included with your copy of this software. See simple-client.lisp for a simple FTP client written with CL-FTP."))) cl-ftp-1.3.3/makedocs.sh0000644000175000017500000000010107565751663013167 0ustar mrdmrd#!/bin/sh clisp < ;;;; See LICENSE file for copyright details. ;;;; Simple FTP client using CL-FTP (defpackage #:org.mapcar.ftp.simple-client (:use #:common-lisp #:org.mapcar.ftp.client) (:nicknames #:simple-client) (:export #:connect)) (in-package #:org.mapcar.ftp.simple-client) (defparameter *command-table* '(("quit" ftp-quit "Quit the client") ("ls" ftp-list "List files (-l option for long form)") ("dir" ftp-long-list "List files, long form") ("cd" ftp-cd "Change current directory: cd [dir]") ("get" ftp-get "Get file: get remote-file [local-name]") ("put" ftp-put "Put file: put local-file [remote-name]") ("pwd" ftp-pwd "Print working directory") ("help" ftp-help "Help!"))) (defun ftp-help (conn args) (declare (ignorable conn args)) (dolist (c *command-table*) (format t "~&~A: ~A~%" (first c) (third c)))) (defun ftp-pwd (conn args) (declare (ignorable args)) (write-line (send-pwd-command conn))) (defun ftp-get (conn args) (let ((remote (first args)) (local (or (second args) (first args)))) (if (retrieve-file conn remote local) (write-line "File transferred") (write-line "Something went wrong")))) (defun ftp-put (conn args) (let ((remote (or (second args) (first args))) (local (first args))) (if (store-file conn local remote) (write-line "File transferred") (write-line "Something went wrong")))) (defun ftp-cd (conn args) (write-line (data-to-string (send-cwd-command conn (if (and args (stringp (first args))) (first args) "/"))))) (defun ftp-list (conn args) (when (find "-l" args :test #'string-equal) (ftp-long-list conn args)) (send-nlst-command conn t)) (defun ftp-long-list (conn args) (declare (ignorable args)) (send-list-command conn t)) (defun ftp-quit (conn args) (declare (ignorable conn args)) (throw 'ftp-quit t)) (defun process-line (command) ;; Kinda ugly, but easy (let ((*read-eval* nil) (*readtable* (copy-readtable)) (parts nil) (stream (make-string-input-stream command))) (setf (readtable-case *readtable*) :preserve) (handler-case (loop (push (string (read stream)) parts)) (end-of-file () nil)) (nreverse parts))) (defun ftp-shell (conn) (loop (format t "~&CL-FTP > ") (let* ((command (read-line)) (scommand (process-line command)) (fn (second (assoc (first scommand) *command-table* :test #'string-equal)))) (if fn (handler-case (funcall fn conn (rest scommand)) (ftp-error (c) (format t "~&~A: ~A~%" (ftp-error-code c) (error-message c)))) (format t "~&Unknown command!~%"))))) (defun connect (hostname &key (port 21) (username "anonymous") (password "cl-ftp@cclan.net")) (catch 'ftp-quit (with-ftp-connection (conn :hostname hostname :port port :username username :password password) (ftp-shell conn))))