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

For POP3-GET return two values (headers and list of body lines) 

instead of dumping the message to (current-output-port).
This commit is contained in:
sperber 2003-01-20 16:52:25 +00:00
parent bdb1cc6b27
commit 1ee07495ba
1 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
scheme/lib/pop3.scm
View File

@ -159,14 +159,14 @@
(values (string->number (match:substring match 1)) (values (string->number (match:substring match 1))
(string->number (match:substring match 2))))) (string->number (match:substring match 2)))))
;; dump the message number MSGID to (current-output-port)
;;: connection x integer -> status
(define (pop3-get connection msgid) (define (pop3-get connection msgid)
(pop3-check-transaction-state connection pop3-get) (pop3-check-transaction-state connection pop3-get)
(let ((status (pop3-send-command connection (let* ((status (pop3-send-command connection
(build-command "RETR" (number->string msgid))))) (build-command "RETR" (number->string msgid))))
(pop3-dump (socket:inport (pop3-connection-command-socket connection))) (port (socket:inport (pop3-connection-command-socket connection)))
status)) (headers (read-rfc822-headers port read-crlf-line))
(body (multiline-response->lines port)))
(values headers body)))
(define (pop3-headers connection msgid) (define (pop3-headers connection msgid)
(pop3-check-transaction-state connection pop3-headers) (pop3-check-transaction-state connection pop3-headers)
@ -263,17 +263,16 @@
(pop3-log connection (string-append "<- " command)) (pop3-log connection (string-append "<- " command))
(pop3-handle-response (pop3-read-response connection) command))) (pop3-handle-response (pop3-read-response connection) command)))
(define (pop3-dump fd) (define (multiline-response->lines port)
(let loop () (let loop ((reverse-lines '()))
(let ((line (read-crlf-line fd))) (let ((line (read-crlf-line port)))
(if (and (not (eof-object? line)) (if (and (not (eof-object? line))
(not (string=? line "."))) (not (string=? line ".")))
(let ((line (if (string-prefix? ".." line) (let ((line (if (string-prefix? ".." line)
(substring line 1 (string-length line)) (substring line 1 (string-length line))
line))) line)))
(write-string line) (loop (cons line reverse-lines)))
(newline) (reverse reverse-lines)))))
(loop))))))
(define (exhaust-multiline-response port) (define (exhaust-multiline-response port)
(let loop () (let loop ()