suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

net/imap: add TLS support

Browse Source 
Based on a patch from Thomas Spurden

original commit: 537f194c4e
This commit is contained in:
Matthew Flatt 2012-03-10 10:40:30 -07:00
parent 43ad58579f
commit 51972b8036
2 changed files with 64 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
collects/net/imap.rkt
View File

@ -1,6 +1,9 @@
#lang racket/base
(require racket/contract/base racket/tcp "private/rbtree.rkt")
(require racket/contract/base
racket/tcp
openssl
"private/rbtree.rkt")
;; define the imap struct and its predicate here, for use in the contract, below
(define-struct imap (r w exists recent unseen uidnext uidvalidity
@ -311,33 +314,62 @@
v))
v)))
(define (imap-connect* r w username password inbox)
(define (has-starttls? imap)
(let ([has? #f])
(check-ok (imap-send imap
"CAPABILITY"
(lambda (caps)
(when (member 'STARTTLS caps)
(set! has? #t)))))
has?))
(define (imap-login imap username password inbox)
(let ([reply (imap-send imap (list "LOGIN" username password) void)])
(if (and (pair? reply) (tag-eq? 'NO (car reply)))
(error 'imap-connect
"username or password rejected by server: ~s" reply)
(check-ok reply)))
(let-values ([(init-count init-recent) (imap-reselect imap inbox)])
(values imap init-count init-recent)))
(define (ports->tls-ports r w)
(ports->ssl-ports r w #:close-original? #t #:encrypt 'tls))
(define (imap-connect* r w username password inbox
#:tls? [tls? #f]
#:try-tls? [try-tls? #t])
(with-handlers ([void
(lambda (x)
(close-input-port r)
(close-output-port w)
(raise x))])
(let-values ([(r w)
(if tls?
(ports->tls-ports r w)
(values r w))])
(let ([imap (make-imap r w #f #f #f #f #f
(new-tree) (new-tree) #f)])
(check-ok (imap-send imap "NOOP" void))
(define imap-maybe-tls
(if (and (not tls?) try-tls? (has-starttls? imap))
(begin
(check-ok (imap-send imap "STARTTLS" void))
(let-values ([(ssl-in ssl-out) (ports->tls-ports r w)])
(make-imap ssl-in ssl-out #f #f #f #f #f (new-tree) (new-tree) #f)))
imap))
(imap-login imap-maybe-tls username password inbox)))))
(let ([imap (make-imap r w #f #f #f #f #f
(new-tree) (new-tree) #f)])
(check-ok (imap-send imap "NOOP" void))
(let ([reply (imap-send imap (list "LOGIN" username password) void)])
(if (and (pair? reply) (tag-eq? 'NO (car reply)))
(error 'imap-connect
"username or password rejected by server: ~s" reply)
(check-ok reply)))
(let-values ([(init-count init-recent) (imap-reselect imap inbox)])
(values imap init-count init-recent)))))
(define (imap-connect server username password inbox)
(define (imap-connect server username password inbox
#:tls? [tls? #f]
#:try-tls? [try-tls? #t])
;; => imap count-k recent-k
(let-values ([(r w)
(if debug-via-stdio?
(begin
(printf "stdin == ~a\n" server)
(values (current-input-port) (current-output-port)))
(tcp-connect server (imap-port-number)))])
(imap-connect* r w username password inbox)))
(begin
(printf "stdin == ~a\n" server)
(values (current-input-port) (current-output-port)))
(tcp-connect server (imap-port-number)))])
(imap-connect* r w username password inbox #:tls? tls? #:try-tls? try-tls?)))
(define (imap-reselect imap inbox)
(imap-selectish-command imap (list "SELECT" inbox) #t))

17
collects/net/scribblings/imap.scrbl
View File

@ -55,13 +55,20 @@ opaque), @racket[#f] otherwise.}
@defproc[(imap-connect [server string?]
[username (or/c string? bytes?)]
[password (or/c string? bytes?)]
[mailbox (or/c string? bytes?)])
[mailbox (or/c string? bytes?)]
[#:tls? tls? any/c #f]
[#:try-tls? try-tls? any/c #t])
(values imap-connection? exact-nonnegative-integer? exact-nonnegative-integer?)]{
Establishes an IMAP connection to the given server using the given
username and password, and selects the specified mailbox. The first
result value reprsents the connection.
username and password, and selects the specified mailbox. If
@racket[tls?] is true, a TLS connection is made to the server before
communicating using the IMAP protocol. If @racket[tls?] is @racket[#f]
but @racket[try-tls?] is true, then after the IMAP connection is
initially established, the connection is switched to a TLS connection
if the server supports it.
The first result value represents the connection.
The second and third return values indicate the total number of
messages in the mailbox and the number of recent messages (i.e.,
messages received since the mailbox was last selected), respectively.
@ -87,7 +94,9 @@ is @racket[143].}
[out output-port?]
[username (or/c string? bytes?)]
[password (or/c string? bytes?)]
[mailbox (or/c string? bytes?)])
[mailbox (or/c string? bytes?)]
[#:tls? tls? any/c #f]
[#:try-tls? try-tls? any/c #t])
(values imap-connection? exact-nonnegative-integer? exact-nonnegative-integer?)]{
Like @racket[imap-connect], but given input and output ports (e.g.,