scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Support passive mode in FTP.

This commit is contained in:
sperber 2003-01-16 13:32:43 +00:00
parent ec42abd6db
commit 54ece65f35
2 changed files with 84 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
scheme/lib/ftp.scm
View File

@ -256,32 +256,33 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;: connection [ x string ] -> status
(define (ftp-ls connection . maybe-dir)
(let* ((sock (ftp-open-data-connection connection)))
(ftp-send-command connection
(apply build-command "NLST" maybe-dir)
(code-with-prefix "1"))
(receive (newsock newsockaddr)
(accept-connection sock)
(let ((lines (port->lines (socket:inport newsock))))
(close-socket newsock)
(close-socket sock)
(ftp-read-reply connection)
lines))))
(with-data-connection
connection
(lambda ()
(ftp-send-command connection
(apply build-command "NLST" maybe-dir)
(code-with-prefix "1")))
(lambda (data-socket)
(port->lines (socket:inport data-socket)))))
(define (find-port-arg string)
(cond
((regexp-search (rx (: (+ digit) (= 5 (: #\, (+ digit))))) string)
=> (lambda (match)
(match:substring match 0)))))
;;: connection [ x string ] -> status
(define (ftp-dir connection . maybe-dir)
(let* ((sock (ftp-open-data-connection connection)))
(ftp-send-command connection
(apply build-command "LIST" maybe-dir)
(code-with-prefix "1"))
(receive (newsock newsockaddr)
(accept-connection sock)
(let ((lines (port->lines (socket:inport newsock))))
(close-socket newsock)
(close-socket sock)
(ftp-read-reply connection)
lines))))
(with-data-connection
connection
(lambda ()
(ftp-send-command connection
(apply build-command "LIST" maybe-dir)
(code-with-prefix "1")))
(lambda (data-socket)
(port->lines (socket:inport data-socket)))))
(define (port->lines port)
(let loop ((reverse-lines '()))
@ -291,16 +292,14 @@
(loop (cons line reverse-lines))))))
(define (ftp-get connection remote-file act)
(let* ((sock (ftp-open-data-connection connection)))
(ftp-send-command connection
(build-command "RETR" remote-file)
(exactly-code "150"))
(receive (newsock newsockaddr)
(accept-connection sock)
(act (socket:inport newsock))
(close-socket newsock)
(close-socket sock)
(ftp-read-reply connection))))
(with-data-connection
connection
(lambda ()
(ftp-send-command connection
(build-command "RETR" remote-file)
(exactly-code "150")))
(lambda (data-socket)
(act (socket:inport data-socket)))))
;; FIXME: should have an optional argument :rename which defaults to
;; false, which would make us upload to a temporary name and rename at
@ -309,24 +308,22 @@
;; space on device".
(define (ftp-put connection remote-file act)
(let ((sock (ftp-open-data-connection connection)))
(ftp-send-command connection (build-command "STOR" remote-file)
(exactly-code "150"))
(receive (newsock newsockaddr)
(accept-connection sock)
(act (socket:outport newsock))
(close-socket newsock)
(close-socket sock))))
(with-data-connection
connection
(lambda ()
(ftp-send-command connection (build-command "STOR" remote-file)
(exactly-code "150")))
(lambda (data-socket)
(act (socket:outport data-socket)))))
(define (ftp-append connection remote-file act)
(let ((sock (ftp-open-data-connection connection)))
(ftp-send-command connection (build-command "APPE" remote-file)
(exactly-code "150"))
(receive (newsock newsockaddr)
(accept-connection sock)
(act (socket:outport newsock))
(close-socket newsock)
(close-socket sock))))
(with-data-connection
connection
(lambda ()
(ftp-send-command connection (build-command "APPE" remote-file)
(exactly-code "150"))
(lambda (data-socket)
(act (socket:outport data-socket))))))
;; send a command verbatim to the remote server and wait for a
;; reply.
@ -338,21 +335,44 @@
;; ------------------------------------------------------------------------
;; no exported procedures below
(define (ftp-open-data-connection connection)
(let* ((sock (create-socket protocol-family/internet
socket-type/stream))
(sockaddr (internet-address->socket-address
internet-address/any
0))) ; 0 to accept any port
(set-socket-option sock level/socket socket/reuse-address #t)
(set-socket-option sock level/socket socket/linger 120)
(bind-socket sock sockaddr)
(listen-socket sock 0)
(ftp-send-command connection ; send PORT command
(ftp-build-PORT-string (socket-local-address sock)))
sock))
(define (with-data-connection connection command-thunk proc)
(if (ftp-connection-passive-mode? connection)
(let* ((pasv-reply (ftp-send-command connection "PASV" (exactly-code "227")))
(port-arg (find-port-arg pasv-reply)))
(call-with-values
(lambda () (parse-port-arg port-arg))
(lambda (address port)
(let ((data-socket (create-socket protocol-family/internet
socket-type/stream)))
(set-socket-option data-socket level/socket socket/reuse-address #t)
(connect-socket data-socket
(internet-address->socket-address
address port))
(command-thunk)
(let ((retval (proc data-socket)))
(close-socket data-socket)
(ftp-read-reply connection)
retval)))))
(let* ((sock (create-socket protocol-family/internet
socket-type/stream))
(sockaddr (internet-address->socket-address
internet-address/any
0))) ; 0 to accept any port
(set-socket-option sock level/socket socket/reuse-address #t)
(set-socket-option sock level/socket socket/linger 120)
(bind-socket sock sockaddr)
(listen-socket sock 0)
(ftp-send-command connection ; send PORT command
(ftp-build-PORT-string (socket-local-address sock)))
(command-thunk)
(receive (data-socket data-socket-address)
(accept-connection sock)
(let ((retval (proc data-socket)))
(close-socket data-socket)
(close-socket sock)
(ftp-read-reply connection)
retval)))))
;; TODO: Unix-specific commands
;; SITE UMASK 002

3
scheme/packages.scm
View File

@ -427,7 +427,8 @@
let-opt
sunet-utilities
format-net
crlf-io)
crlf-io
ftp-library)
(files (lib ftp)))
(define-structure netrc netrc-interface