* removed deprecated string-match (replaced by (rx (posix-string ...)))
* removed `QUIT-bug': we could not handle server responses after the QUIT command that do not have a space after the `+OK'; now we can.
This commit is contained in:
parent
51baa52dc9
commit
c5ea2c24b7
17
pop3.scm
17
pop3.scm
|
@ -1,6 +1,6 @@
|
||||||
;;; POP3.scm --- implement the POP3 maildrop protocol in the Scheme Shell
|
;;; POP3.scm --- implement the POP3 maildrop protocol in the Scheme Shell
|
||||||
;;
|
;;
|
||||||
;; $Id: pop3.scm,v 1.3 2002/03/29 16:31:20 interp Exp $
|
;; $Id: pop3.scm,v 1.4 2002/03/29 17:47:24 interp Exp $
|
||||||
;;
|
;;
|
||||||
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
|
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
|
||||||
|
|
||||||
|
@ -154,7 +154,7 @@
|
||||||
|
|
||||||
;; 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 (pop3:read-response connection))
|
||||||
(match (string-match "\\+OK .* (<[^>]+>)" banner))
|
(match (regexp-search (rx (posix-string "\\+OK .* (<[^>]+>)")) banner))
|
||||||
(challenge (and match (match:substring match 1))))
|
(challenge (and match (match:substring match 1))))
|
||||||
(set-pop3-connection:challenge connection challenge))
|
(set-pop3-connection:challenge connection challenge))
|
||||||
|
|
||||||
|
@ -226,7 +226,7 @@
|
||||||
(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 (string-match "([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)))))
|
||||||
|
|
||||||
|
@ -306,10 +306,13 @@
|
||||||
|
|
||||||
;; this could perhaps be improved
|
;; this could perhaps be improved
|
||||||
(define (pop3:handle-response response command)
|
(define (pop3:handle-response response command)
|
||||||
(let ((match (string-match "^\\+OK (.*)" response)))
|
(let ((match (regexp-search (rx (posix-string "^\\+OK(.*)")) response)))
|
||||||
(if match (match:substring match 1)
|
(if match
|
||||||
(let ((match2 (string-match "^-ERR (.*)" response)))
|
(match:substring match 1)
|
||||||
(signal '-ERR (match:substring match2 1) command)))))
|
(let ((match2 (regexp-search (rx (posix-string "^-ERR(.*)")) response)))
|
||||||
|
(if match2
|
||||||
|
(signal '-ERR (match:substring match2 1) command)
|
||||||
|
(signal '-ERR response command))))))
|
||||||
|
|
||||||
|
|
||||||
(define (pop3:log connection line)
|
(define (pop3:log connection line)
|
||||||
|
|
Loading…
Reference in New Issue