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

Parse headers in POP3-HEADERS.

This commit is contained in:
sperber 2003-01-20 16:44:47 +00:00
parent d2c43bb132
commit bdb1cc6b27
1 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
scheme/lib/pop3.scm
View File

@ -168,13 +168,14 @@
(pop3-dump (socket:inport (pop3-connection-command-socket connection))) (pop3-dump (socket:inport (pop3-connection-command-socket connection)))
status)) status))
;;: connection x integer -> status
(define (pop3-headers connection msgid) (define (pop3-headers connection msgid)
(pop3-check-transaction-state connection pop3-headers) (pop3-check-transaction-state connection pop3-headers)
(let ((status (pop3-send-command connection (let* ((status (pop3-send-command connection
(build-command "TOP" (number->string msgid) "0")))) (build-command "TOP" (number->string msgid) "0")))
(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)))
(exhaust-multiline-response port)
headers))
;; Return highest accessed message-id number for the session. This ;; Return highest accessed message-id number for the session. This
;; ain't in the RFC, but seems to be supported by several servers. ;; ain't in the RFC, but seems to be supported by several servers.
@ -274,6 +275,13 @@
(newline) (newline)
(loop)))))) (loop))))))
(define (exhaust-multiline-response port)
(let loop ()
(let ((line (read-crlf-line port)))
(if (and (not (eof-object? line))
(not (string=? line ".")))
(loop)))))
(define (build-command str . opt-args) (define (build-command str . opt-args)
(string-join (cons str opt-args))) (string-join (cons str opt-args)))