Remove "POP3-" prefix from various internal procedure names.
This commit is contained in:
parent
35b837a3b0
commit
4abd90075b
|
@ -70,7 +70,7 @@
|
||||||
hostname))
|
hostname))
|
||||||
|
|
||||||
;; read the challenge the server sends in its welcome banner
|
;; read the challenge the server sends in its welcome banner
|
||||||
(let* ((banner (pop3-read-response connection))
|
(let* ((banner (read-response connection))
|
||||||
(match (regexp-search (rx (: "+OK " (* (~ #\<))
|
(match (regexp-search (rx (: "+OK " (* (~ #\<))
|
||||||
#\< (submatch (+ (~ #\>))) #\>))
|
#\< (submatch (+ (~ #\>))) #\>))
|
||||||
banner))
|
banner))
|
||||||
|
@ -108,8 +108,8 @@
|
||||||
((pop3-connection-challenge connection)
|
((pop3-connection-challenge connection)
|
||||||
(pop3-apop-login connection login password))))
|
(pop3-apop-login connection login password))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(pop3-send-command connection (build-command "USER" login))
|
(send-command connection (build-command "USER" login))
|
||||||
(pop3-send-command connection (build-command "PASS" password))
|
(send-command connection (build-command "PASS" password))
|
||||||
(set-pop3-connection-login! connection login)
|
(set-pop3-connection-login! connection login)
|
||||||
(set-pop3-connection-password! connection password)
|
(set-pop3-connection-password! connection password)
|
||||||
(set-pop3-connection-state! connection 'connected))))))
|
(set-pop3-connection-state! connection 'connected))))))
|
||||||
|
@ -143,36 +143,35 @@
|
||||||
(digest (number->string
|
(digest (number->string
|
||||||
(md5-digest->number (md5-digest-for-string key))
|
(md5-digest->number (md5-digest-for-string key))
|
||||||
16))
|
16))
|
||||||
(status (pop3-send-command connection
|
(status (send-command connection
|
||||||
(build-command "APOP" login digest))))
|
(build-command "APOP" login digest))))
|
||||||
(set-pop3-connection-login! connection login)
|
(set-pop3-connection-login! connection login)
|
||||||
(set-pop3-connection-password! connection password)
|
(set-pop3-connection-password! connection password)
|
||||||
(set-pop3-connection-state! connection 'connected)
|
(set-pop3-connection-state! connection 'connected)
|
||||||
status))
|
status))
|
||||||
|
|
||||||
|
|
||||||
;; return number of messages and number of bytes waiting at the maildrop
|
;; return number of messages and number of bytes waiting at the maildrop
|
||||||
|
|
||||||
(define (pop3-stat connection)
|
(define (pop3-stat connection)
|
||||||
(pop3-check-transaction-state connection pop3-stat)
|
(check-transaction-state connection pop3-stat)
|
||||||
(let* ((response (pop3-send-command connection "STAT"))
|
(let* ((response (send-command connection "STAT"))
|
||||||
(match (regexp-search (rx (posix-string "([0-9]+) ([0-9]+)")) response)))
|
(match (regexp-search (rx (posix-string "([0-9]+) ([0-9]+)")) response)))
|
||||||
(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)))))
|
||||||
|
|
||||||
(define (pop3-get connection msgid)
|
(define (pop3-get connection msgid)
|
||||||
(pop3-check-transaction-state connection pop3-get)
|
(check-transaction-state connection pop3-get)
|
||||||
(let* ((status (pop3-send-command connection
|
(let* ((status (send-command connection
|
||||||
(build-command "RETR" (number->string msgid))))
|
(build-command "RETR" (number->string msgid))))
|
||||||
(port (socket:inport (pop3-connection-command-socket connection)))
|
(port (socket:inport (pop3-connection-command-socket connection)))
|
||||||
(headers (read-rfc822-headers port read-crlf-line))
|
(headers (read-rfc822-headers port read-crlf-line))
|
||||||
(body (multiline-response->lines port)))
|
(body (multiline-response->lines port)))
|
||||||
(values headers body)))
|
(values headers body)))
|
||||||
|
|
||||||
(define (pop3-headers connection msgid)
|
(define (pop3-headers connection msgid)
|
||||||
(pop3-check-transaction-state connection pop3-headers)
|
(check-transaction-state connection pop3-headers)
|
||||||
(let* ((status (pop3-send-command connection
|
(let* ((status (send-command connection
|
||||||
(build-command "TOP" (number->string msgid) "0")))
|
(build-command "TOP" (number->string msgid) "0")))
|
||||||
(port (socket:inport (pop3-connection-command-socket connection)))
|
(port (socket:inport (pop3-connection-command-socket connection)))
|
||||||
(headers (read-rfc822-headers port read-crlf-line)))
|
(headers (read-rfc822-headers port read-crlf-line)))
|
||||||
(exhaust-multiline-response port)
|
(exhaust-multiline-response port)
|
||||||
|
@ -182,8 +181,8 @@
|
||||||
;; 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.
|
||||||
|
|
||||||
(define (pop3-last connection)
|
(define (pop3-last connection)
|
||||||
(pop3-check-transaction-state connection pop3-last)
|
(check-transaction-state connection pop3-last)
|
||||||
(let ((response (pop3-send-command connection "LAST")))
|
(let ((response (send-command connection "LAST")))
|
||||||
(string->number (car ((infix-splitter) response)))))
|
(string->number (car ((infix-splitter) response)))))
|
||||||
|
|
||||||
;; mark the message number MSGID for deletion. Note that the messages
|
;; mark the message number MSGID for deletion. Note that the messages
|
||||||
|
@ -191,21 +190,21 @@
|
||||||
;; can be undeleted using the RSET command.
|
;; can be undeleted using the RSET command.
|
||||||
|
|
||||||
(define (pop3-delete connection msgid)
|
(define (pop3-delete connection msgid)
|
||||||
(pop3-check-transaction-state connection pop3-delete)
|
(check-transaction-state connection pop3-delete)
|
||||||
(pop3-send-command connection (build-command "DELE" (number->string msgid)))
|
(send-command connection (build-command "DELE" (number->string msgid)))
|
||||||
(values))
|
(values))
|
||||||
|
|
||||||
|
|
||||||
;; any messages which have been marked for deletion are unmarked
|
;; any messages which have been marked for deletion are unmarked
|
||||||
|
|
||||||
(define (pop3-reset connection)
|
(define (pop3-reset connection)
|
||||||
(pop3-check-transaction-state connection pop3-reset)
|
(check-transaction-state connection pop3-reset)
|
||||||
(pop3-send-command connection "RSET")
|
(send-command connection "RSET")
|
||||||
(values))
|
(values))
|
||||||
|
|
||||||
(define (pop3-quit connection)
|
(define (pop3-quit connection)
|
||||||
(pop3-check-transaction-state connection pop3-quit)
|
(check-transaction-state connection pop3-quit)
|
||||||
(let ((status (pop3-send-command connection "QUIT")))
|
(let ((status (send-command connection "QUIT")))
|
||||||
(close-socket (pop3-connection-command-socket connection))))
|
(close-socket (pop3-connection-command-socket connection))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -225,11 +224,11 @@
|
||||||
(define-condition-type 'pop3-error '(error))
|
(define-condition-type 'pop3-error '(error))
|
||||||
(define pop3-error? (condition-predicate 'pop3-error))
|
(define pop3-error? (condition-predicate 'pop3-error))
|
||||||
|
|
||||||
(define (pop3-check-transaction-state connection caller)
|
(define (check-transaction-state connection caller)
|
||||||
(if (not (eq? (pop3-connection-state connection) 'connected))
|
(if (not (eq? (pop3-connection-state connection) 'connected))
|
||||||
(error "not in transaction state" caller)))
|
(error "not in transaction state" caller)))
|
||||||
|
|
||||||
(define (pop3-read-response connection)
|
(define (read-response connection)
|
||||||
(let* ((sock (pop3-connection-command-socket connection))
|
(let* ((sock (pop3-connection-command-socket connection))
|
||||||
(in (socket:inport sock))
|
(in (socket:inport sock))
|
||||||
(line (read-crlf-line in)))
|
(line (read-crlf-line in)))
|
||||||
|
@ -237,7 +236,7 @@
|
||||||
line))
|
line))
|
||||||
|
|
||||||
;; this could perhaps be improved
|
;; this could perhaps be improved
|
||||||
(define (pop3-handle-response response command)
|
(define (handle-response response command)
|
||||||
(let ((match (regexp-search (rx (posix-string "^\\+OK(.*)")) response)))
|
(let ((match (regexp-search (rx (posix-string "^\\+OK(.*)")) response)))
|
||||||
(if match
|
(if match
|
||||||
(match:substring match 1)
|
(match:substring match 1)
|
||||||
|
@ -255,13 +254,13 @@
|
||||||
(newline log)
|
(newline log)
|
||||||
(force-output log)))))
|
(force-output log)))))
|
||||||
|
|
||||||
(define (pop3-send-command connection command)
|
(define (send-command connection command)
|
||||||
(let* ((sock (pop3-connection-command-socket connection))
|
(let* ((sock (pop3-connection-command-socket connection))
|
||||||
(out (socket:outport sock)))
|
(out (socket:outport sock)))
|
||||||
(write-string command out)
|
(write-string command out)
|
||||||
(write-crlf out)
|
(write-crlf out)
|
||||||
(pop3-log connection (string-append "<- " command))
|
(pop3-log connection (string-append "<- " command))
|
||||||
(pop3-handle-response (pop3-read-response connection) command)))
|
(handle-response (read-response connection) command)))
|
||||||
|
|
||||||
(define (multiline-response->lines port)
|
(define (multiline-response->lines port)
|
||||||
(let loop ((reverse-lines '()))
|
(let loop ((reverse-lines '()))
|
||||||
|
|
Loading…
Reference in New Issue