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 
original commit: e4e4d544f5
This commit is contained in:
Matthew Flatt 2012-11-21 06:49:24 -07:00
commit 0731559f69
7 changed files with 71 additions and 21 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)
(cond [(assoc s flag-names) => cadr] [else s]))
(define (log-warning . args)
;; (apply printf args)
(void))
(define log log-warning)
(define-logger imap)
(define make-msg-id
(let ([id 0])
@ -180,16 +177,16 @@
(define (get-response r id info-handler continuation-handler)
(let loop ()
(let ([l (read-bytes-line r eol)])
(log "raw-reply: ~s\n" l)
(log-imap-debug "raw-reply: ~s" l)
(cond [(eof-object? l)
(error 'imap-send "unexpected end-of-file from server")]
[(and id (starts-with? l id))
(let ([reply (imap-read (skip l id) r)])
(log "response: ~a\n" reply)
(log-imap-debug "response: ~a" reply)
reply)]
[(starts-with? l #"* ")
(let ([info (imap-read (skip l 2) r)])
(log "info: ~s\n" info)
(log-imap-debug "info: ~s" info)
(info-handler info))
(when id (loop))]
[(starts-with? l #"+ ")
@ -197,7 +194,7 @@
(error 'imap-send "unexpected continuation request: ~a" l)
((car continuation-handler) loop (imap-read (skip l 2) r)))]
[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))]))))
;; A cmd is
@ -210,7 +207,7 @@
(let ([r (imap-r imap)]
[w (imap-w imap)]
[id (make-msg-id)])
(log "sending ~a~a\n" id cmd)
(log-imap-debug "sending ~a~a" id cmd)
(fprintf w "~a" id)
(let loop ([cmd cmd])
(cond
@ -267,7 +264,7 @@
(set-imap-recent! imap (car i))]
[(tag-eq? (cadr i) 'EXPUNGE)
(let ([n (car i)])
(log "Recording expunge: ~s\n" n)
(log-imap-debug "Recording expunge: ~s" n)
;; add it to the tree of expunges
(expunge-insert! (imap-expunges imap) n)
;; decrement exists count:

3
collects/net/scribblings/cookie.scrbl
View File

@ -187,3 +187,6 @@ Imports nothing, exports @racket[cookie^].}
@defsignature[cookie^ ()]{}
Includes everything exported by the @racketmodname[net/cookie] module.
@close-eval[cookie-eval]

3
collects/net/scribblings/head.scrbl
View File

@ -241,3 +241,6 @@ Imports nothing, exports @racket[head^].}
@defsignature[head^ ()]{}
Includes everything exported by the @racketmodname[net/head] module.
@close-eval[head-eval]

9
collects/net/scribblings/uri-codec.scrbl
View File

@ -86,6 +86,12 @@ Encodes a string according to the rules in @cite["RFC3986"] for the userinfo fie
@defproc[(uri-userinfo-decode [str string?]) string?]{
Decodes a string according to the rules in @cite["RFC3986"] for the userinfo field.
}
@defproc[(uri-unreserved-encode [str string?]) string?]{
Encodes a string according to the rules in @cite["RFC3986"](section 2.3) for the unreserved characters.
}
@defproc[(uri-unreserved-decode [str string?]) string?]{
Decodes a string according to the rules in @cite["RFC3986"](section 2.3) for the unreserved characters.
}
@defproc[(form-urlencoded-encode [str string?]) string?]{
@ -179,3 +185,6 @@ Imports nothing, exports @racket[uri-codec^].}
@defsignature[uri-codec^ ()]{}
Includes everything exported by the @racketmodname[net/uri-codec] module.
@close-eval[uri-codec-eval]

27
collects/tests/net/available.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang racket/base
(require racket/tcp
racket/list
racket/match
racket/port
racket/contract)
(define (tcp-localhost-available?)
(with-handlers
([exn? (λ (x) #f)])
(define the-listener
(tcp-listen 0 5 #t))
(define-values (local-host port end-host end-port)
(tcp-addresses the-listener #t))
(thread
(λ ()
(tcp-accept the-listener)
(tcp-close the-listener)))
(tcp-connect "localhost" port)
#t))
(provide
(contract-out
[tcp-localhost-available? (-> boolean?)]))
(module+ main
(tcp-localhost-available?))

12
collects/tests/net/uri-codec.rkt
View File

@ -69,7 +69,17 @@
(uri-userinfo-decode "hello") => "hello"
(uri-userinfo-decode "hello%20there") => "hello there"
(uri-userinfo-decode "hello:there") => "hello:there"
;; tried to choose characters from each subset:
(uri-encode "M~(@; ") => "M~(%40%3B%20"
(uri-path-segment-encode "M~(@; ") => "M~(@%3B%20"
(uri-userinfo-encode "M~(@; ") => "M~(%40;%20"
(uri-unreserved-encode "M~(@; ") => "M~%28%40%3B%20"
;; matching decodes:
(uri-decode "M~(%40%3B%20") => "M~(@; "
(uri-path-segment-decode "M~(@%3B%20") => "M~(@; "
(uri-userinfo-decode "M~(%40;%20") => "M~(@; "
(uri-unreserved-decode "M~%28%40%3B%20") => "M~(@; "
))
;; tests adapted from Noel Welsh's original test suite

21
collects/tests/net/websocket.rkt
View File

@ -6,6 +6,7 @@
racket/async-channel
net/url
rackunit
tests/net/available
tests/eli-tester)
(define RANDOM-K 100)
@ -81,14 +82,14 @@
(define p (async-channel-get confirm))
(define conn
(ws-connect (string->url (format "ws://localhost:~a" p))))
(when conn
(test (ws-send! conn r)
(ws-recv conn) => r
(ws-send! conn "a")
(ws-recv conn) => "a"
(ws-close! conn)))
(test (ws-send! conn r)
(ws-recv conn) => r
(ws-send! conn "a")
(ws-recv conn) => "a"
(ws-close! conn))
(test (shutdown!)))]
(test #:failure-prefix "old"
(parameterize ([framing-mode 'old]) (test-echo-server))
#:failure-prefix "new"
(parameterize ([framing-mode 'new]) (test-echo-server))))))
(when (tcp-localhost-available?)
(test #:failure-prefix "old"
(parameterize ([framing-mode 'old]) (test-echo-server))
#:failure-prefix "new"
(parameterize ([framing-mode 'new]) (test-echo-server)))))))