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

* 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:
interp 2002-03-29 17:47:24 +00:00
parent 51baa52dc9
commit c5ea2c24b7
1 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pop3.scm
View File

@ -1,6 +1,6 @@
;;; 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>
@ -154,7 +154,7 @@
;; read the challenge the server sends in its welcome banner
(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))))
(set-pop3-connection:challenge connection challenge))
@ -226,7 +226,7 @@
(define (pop3:stat connection)
(pop3:check-transaction-state connection 'pop3: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))
(string->number (match:substring match 2)))))
@ -306,10 +306,13 @@
;; this could perhaps be improved
(define (pop3:handle-response response command)
(let ((match (string-match "^\\+OK (.*)" response)))
(if match (match:substring match 1)
(let ((match2 (string-match "^-ERR (.*)" response)))
(signal '-ERR (match:substring match2 1) command)))))
(let ((match (regexp-search (rx (posix-string "^\\+OK(.*)")) response)))
(if match
(match:substring match 1)
(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)