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

Remove "POP3-" prefix from various internal procedure names.

This commit is contained in:
sperber 2003-01-21 08:18:05 +00:00
parent 35b837a3b0
commit 4abd90075b
1 changed files with 30 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
scheme/lib/pop3.scm
View File

@ -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,26 +143,25 @@
(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))
@ -170,8 +169,8 @@
(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)))
@ -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 '()))