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

net/imap: log to an 'imap logger

Browse Source
This commit is contained in:
Matthew Flatt 2012-11-21 06:49:24 -07:00
parent a64a54abee
commit e4e4d544f5
1 changed files with 7 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/net/imap.rkt
View File

@ -97,10 +97,7 @@
(define (symbol->imap-flag s) (define (symbol->imap-flag s)
(cond [(assoc s flag-names) => cadr] [else s])) (cond [(assoc s flag-names) => cadr] [else s]))
(define (log-warning . args) (define-logger imap)
;; (apply printf args)
(void))
(define log log-warning)
(define make-msg-id (define make-msg-id
(let ([id 0]) (let ([id 0])
@ -180,16 +177,16 @@
(define (get-response r id info-handler continuation-handler) (define (get-response r id info-handler continuation-handler)
(let loop () (let loop ()
(let ([l (read-bytes-line r eol)]) (let ([l (read-bytes-line r eol)])
(log "raw-reply: ~s\n" l) (log-imap-debug "raw-reply: ~s" l)
(cond [(eof-object? l) (cond [(eof-object? l)
(error 'imap-send "unexpected end-of-file from server")] (error 'imap-send "unexpected end-of-file from server")]
[(and id (starts-with? l id)) [(and id (starts-with? l id))
(let ([reply (imap-read (skip l id) r)]) (let ([reply (imap-read (skip l id) r)])
(log "response: ~a\n" reply) (log-imap-debug "response: ~a" reply)
reply)] reply)]
[(starts-with? l #"* ") [(starts-with? l #"* ")
(let ([info (imap-read (skip l 2) r)]) (let ([info (imap-read (skip l 2) r)])
(log "info: ~s\n" info) (log-imap-debug "info: ~s" info)
(info-handler info)) (info-handler info))
(when id (loop))] (when id (loop))]
[(starts-with? l #"+ ") [(starts-with? l #"+ ")
@ -197,7 +194,7 @@
(error 'imap-send "unexpected continuation request: ~a" l) (error 'imap-send "unexpected continuation request: ~a" l)
((car continuation-handler) loop (imap-read (skip l 2) r)))] ((car continuation-handler) loop (imap-read (skip l 2) r)))]
[else [else
(log-warning "warning: unexpected response for ~a: ~a\n" id l) (log-imap-warning "warning: unexpected response for ~a: ~a" id l)
(when id (loop))])))) (when id (loop))]))))
;; A cmd is ;; A cmd is
@ -210,7 +207,7 @@
(let ([r (imap-r imap)] (let ([r (imap-r imap)]
[w (imap-w imap)] [w (imap-w imap)]
[id (make-msg-id)]) [id (make-msg-id)])
(log "sending ~a~a\n" id cmd) (log-imap-debug "sending ~a~a" id cmd)
(fprintf w "~a" id) (fprintf w "~a" id)
(let loop ([cmd cmd]) (let loop ([cmd cmd])
(cond (cond
@ -267,7 +264,7 @@
(set-imap-recent! imap (car i))] (set-imap-recent! imap (car i))]
[(tag-eq? (cadr i) 'EXPUNGE) [(tag-eq? (cadr i) 'EXPUNGE)
(let ([n (car i)]) (let ([n (car i)])
(log "Recording expunge: ~s\n" n) (log-imap-debug "Recording expunge: ~s" n)
;; add it to the tree of expunges ;; add it to the tree of expunges
(expunge-insert! (imap-expunges imap) n) (expunge-insert! (imap-expunges imap) n)
;; decrement exists count: ;; decrement exists count: