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

Signal correct error (not a CALL-ERROR) from 

POP3-CHECK-TRANSACTION-STATE!; also pass correct caller to it.
This commit is contained in:
sperber 2003-01-20 15:12:03 +00:00
parent d27381ba4c
commit 7d91324b9a
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
scheme/lib/pop3.scm
View File

@ -153,7 +153,7 @@
;; return number of messages and number of bytes waiting at the maildrop ;; return number of messages and number of bytes waiting at the maildrop
;;: connection -> integer x integer ;;: connection -> integer x integer
(define (pop3-stat connection) (define (pop3-stat connection)
(pop3-check-transaction-state connection 'pop3-stat) (pop3-check-transaction-state connection pop3-stat)
(let* ((response (pop3-send-command connection "STAT")) (let* ((response (pop3-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))
@ -162,7 +162,7 @@
;; dump the message number MSGID to (current-output-port) ;; dump the message number MSGID to (current-output-port)
;;: connection x integer -> status ;;: 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))) (pop3-dump (socket:inport (pop3-connection-command-socket connection)))
@ -170,7 +170,7 @@
;;: connection x integer -> 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))) (pop3-dump (socket:inport (pop3-connection-command-socket connection)))
@ -180,7 +180,7 @@
;; 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.
;;: connection -> integer ;;: connection -> integer
(define (pop3-last connection) (define (pop3-last connection)
(pop3-check-transaction-state connection 'pop3-last) (pop3-check-transaction-state connection pop3-last)
(let ((response (pop3-send-command connection "LAST"))) (let ((response (pop3-send-command connection "LAST")))
(string->number (car ((infix-splitter) response))))) (string->number (car ((infix-splitter) response)))))
@ -189,19 +189,19 @@
;; can be undeleted using the RSET command. ;; can be undeleted using the RSET command.
;;: connection x integer -> status ;;: connection x integer -> status
(define (pop3-delete connection msgid) (define (pop3-delete connection msgid)
(pop3-check-transaction-state connection 'pop3-delete) (pop3-check-transaction-state connection pop3-delete)
(pop3-send-command connection (build-command "DELE" (number->string msgid)))) (pop3-send-command connection (build-command "DELE" (number->string msgid))))
;; any messages which have been marked for deletion are unmarked ;; any messages which have been marked for deletion are unmarked
;;: connection -> status ;;: connection -> status
(define (pop3-reset connection) (define (pop3-reset connection)
(pop3-check-transaction-state connection 'pop3-reset) (pop3-check-transaction-state connection pop3-reset)
(pop3-send-command connection "RSET")) (pop3-send-command connection "RSET"))
;;: connection -> status ;;: connection -> status
(define (pop3-quit connection) (define (pop3-quit connection)
(pop3-check-transaction-state connection 'pop3-quit) (pop3-check-transaction-state connection pop3-quit)
(let ((status (pop3-send-command connection "QUIT"))) (let ((status (pop3-send-command connection "QUIT")))
(close-socket (pop3-connection-command-socket connection)) (close-socket (pop3-connection-command-socket connection))
status)) status))
@ -226,7 +226,7 @@
(define (pop3-check-transaction-state connection caller) (define (pop3-check-transaction-state connection caller)
(if (not (eq? (pop3-connection-state connection) 'connected)) (if (not (eq? (pop3-connection-state connection) 'connected))
(call-error "not in transaction state" caller))) (error "not in transaction state" caller)))
(define (pop3-read-response connection) (define (pop3-read-response connection)
(let* ((sock (pop3-connection-command-socket connection)) (let* ((sock (pop3-connection-command-socket connection))