suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

net/ftp: ftp-current-directory

Browse Source 
* implement ftp-current-directory
* add test for ftp-current-directory
This commit is contained in:
Dominik Pantůček 2021-01-13 21:13:06 +01:00 committed by Sam Tobin-Hochstadt
parent 9079d1b3d7
commit 28105b7be6
2 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/net-lib/net/ftp.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require racket/date racket/file racket/port racket/tcp racket/list) (require racket/date racket/file racket/port racket/tcp racket/list racket/string)
(provide ftp-connection? (provide ftp-connection?
ftp-cd ftp-cd
@ -13,7 +13,8 @@
ftp-delete-file ftp-delete-file
ftp-make-directory ftp-make-directory
ftp-delete-directory ftp-delete-directory
ftp-rename-file) ftp-rename-file
ftp-current-directory)
;; opqaue record to represent an FTP connection: ;; opqaue record to represent an FTP connection:
(define-struct ftp-connection (in out)) (define-struct ftp-connection (in out))
@ -168,6 +169,15 @@
(ftp-connection-out ftp-ports) (ftp-connection-out ftp-ports)
#"250" void (void))) #"250" void (void)))
(define (ftp-current-directory ftp-ports)
(fprintf (ftp-connection-out ftp-ports) "PWD\r\n")
(ftp-check-response (ftp-connection-in ftp-ports)
(ftp-connection-out ftp-ports)
#"257"
(lambda (line acc)
(cadr (string-split (bytes->string/latin-1 line) "\"")))
(void)))
(define re:dir-line (define re:dir-line
(regexp (string-append (regexp (string-append
"^(.)(.*) ((?i:jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)" "^(.)(.*) ((?i:jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)"

3
pkgs/net-test/tests/net/ftp.rkt
View File

@ -53,6 +53,7 @@
(when (ftp-connection? conn) (when (ftp-connection? conn)
(define output (open-output-bytes)) (define output (open-output-bytes))
(test (ftp-cd conn "gnu") (test (ftp-cd conn "gnu")
(ftp-current-directory conn) => "/gnu"
(for ([f (in-list (ftp-directory-list conn))]) (for ([f (in-list (ftp-directory-list conn))])
(match-define (list* type ftp-date name ?size) f) (match-define (list* type ftp-date name ?size) f)
(test (ftp-make-file-seconds ftp-date))) (test (ftp-make-file-seconds ftp-date)))
@ -239,6 +240,7 @@
250-system. See: 250-system. See:
250-http://www.gnu.org/philosophy/categories.html#TheGNUsystem 250-http://www.gnu.org/philosophy/categories.html#TheGNUsystem
250 Directory successfully changed. 250 Directory successfully changed.
257 "/gnu" is the current directory
227 Entering Passive Mode (127,0,0,1,@pasv1-port) 227 Entering Passive Mode (127,0,0,1,@pasv1-port)
200 Switching to Binary mode. 200 Switching to Binary mode.
150 Here comes the directory listing. 150 Here comes the directory listing.
@ -263,6 +265,7 @@
@(lambda xs (regexp-replace* #rx"\n" (apply S xs) "\r\n")){ @(lambda xs (regexp-replace* #rx"\n" (apply S xs) "\r\n")){
USER anonymous USER anonymous
CWD gnu CWD gnu
PWD
PASV PASV
TYPE I TYPE I
LIST LIST