parent
99819b7a47
commit
4ef92c949a
|
@ -107,8 +107,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 (format #f "USER ~a" login))
|
(pop3-send-command connection (build-command "USER" login))
|
||||||
(pop3-send-command connection (format #f "PASS ~a" password))
|
(pop3-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,7 +143,7 @@
|
||||||
(md5-digest->number (md5-digest-for-string key))
|
(md5-digest->number (md5-digest-for-string key))
|
||||||
16))
|
16))
|
||||||
(status (pop3-send-command connection
|
(status (pop3-send-command connection
|
||||||
(format #f "APOP ~a ~a" 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)
|
||||||
|
@ -163,14 +163,16 @@
|
||||||
;;: 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 (format #f "RETR ~a" msgid))))
|
(let ((status (pop3-send-command connection
|
||||||
|
(build-command "RETR" (number->string msgid)))))
|
||||||
(pop3-dump (socket:inport (pop3-connection-command-socket connection)))
|
(pop3-dump (socket:inport (pop3-connection-command-socket connection)))
|
||||||
status))
|
status))
|
||||||
|
|
||||||
;;: 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 (format #f "TOP ~a 0" msgid))))
|
(let ((status (pop3-send-command connection
|
||||||
|
(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)))
|
||||||
status))
|
status))
|
||||||
|
|
||||||
|
@ -188,7 +190,7 @@
|
||||||
;;: 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 (format #f "DELE ~a" 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
|
||||||
|
@ -230,7 +232,7 @@
|
||||||
(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)))
|
||||||
(pop3-log connection (format #f "-> ~a" line))
|
(pop3-log connection (string-append "-> " line))
|
||||||
line))
|
line))
|
||||||
|
|
||||||
;; this could perhaps be improved
|
;; this could perhaps be improved
|
||||||
|
@ -257,7 +259,7 @@
|
||||||
(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 (format #f "<- ~a" command))
|
(pop3-log connection (string-append "<- " command))
|
||||||
(pop3-handle-response (pop3-read-response connection) command)))
|
(pop3-handle-response (pop3-read-response connection) command)))
|
||||||
|
|
||||||
(define (pop3-dump fd)
|
(define (pop3-dump fd)
|
||||||
|
@ -272,4 +274,7 @@
|
||||||
(newline)
|
(newline)
|
||||||
(loop))))))
|
(loop))))))
|
||||||
|
|
||||||
|
(define (build-command str . opt-args)
|
||||||
|
(string-join (cons str opt-args)))
|
||||||
|
|
||||||
;; EOF
|
;; EOF
|
||||||
|
|
|
@ -449,7 +449,7 @@
|
||||||
handle
|
handle
|
||||||
conditions handle-fatal-error
|
conditions handle-fatal-error
|
||||||
signals
|
signals
|
||||||
(subset srfi-13 (string-index string-prefix?))
|
(subset srfi-13 (string-index string-prefix? string-join))
|
||||||
let-opt
|
let-opt
|
||||||
crlf-io)
|
crlf-io)
|
||||||
(files (lib pop3)))
|
(files (lib pop3)))
|
||||||
|
|
Loading…
Reference in New Issue