前回のポストから二ヶ月近く空いてしまった。要るもの追加してたら時間がかかったのと、まぁ家庭の事情というやつなので仕方ない(と自分に言い訳)
ここ数年、PostMan みたいなので REST API を叩くみたいなことをしていたのだが、それ以前は Scheme で書く元気があったのに急にやらなくなったなぁという気がしていた。原因をなんとなく考えて、多分 Sagittarius に付属している HTTP 周りのライブラリが貧弱かつイマイチ使い勝手が悪いというのが原因だと結論づけた。使い勝手に関しては完全に自分の主観なので、現状の素朴な実装の方がいい場合もあるかもしれないが、本業では Apache Http Client とか Spring Framework の WebClient とか使っているので真面目なアプリ/スクリプトを書く際はその辺の使用感が欲しいというのはある。
ということで作った。(net http-client) がライブラリ名である。こんな感じで使う。
(import (rnrs)
(srfi :13)
(rfc pem)
(rsa pkcs :8)
(rsa pkcs :12)
(rfc x.509)
(crypto)
(net http-client)
(util concurrent)
(security keystore)
(control threading))
(define pooling-config
(http-connection-pooling-config-builder
(connection-request-timeout 100)
(time-to-live 3)))
(define keys&certs
'(("eckey.pem" "eccert.pem")
("key.pem" "certificate.pem")))
(define (->private-key file)
(let-values (((param content) (parse-pem-file file)))
(pki->private-key (import-private-key PKCS8 content))))
(define (->certificate file)
(let-values (((param content) (parse-pem-file file)))
(make-x509-certificate content)))
(define (make-key-manager)
(define (idrix-eu p)
(define node (socket-parameter-socket-node p))
(cond ((string=? node "prod.idrix.eu") "eckey.pem")
(else #f)))
(define (badssl-com p)
(define node (socket-parameter-socket-node p))
(and (string-suffix? ".badssl.com" node)
"1"))
(let ((ks (load-keystore-file 'pkcs12 "badssl.com-client.p12" "badssl.com")))
(for-each (lambda (key&certs)
(keystore-set-key! ks (car key&certs)
(->private-key (car key&certs))
"password"
(map ->certificate (cdr key&certs))))
keys&certs)
(key-manager
(keystore-key-provider-add-key-retriever!
(make-keystore-key-provider ks "badssl.com" badssl-com)
"password" idrix-eu))))
(define client (http:client-builder
(cookie-handler (http:make-default-cookie-handler))
(key-manager (make-key-manager))
(connection-manager
(build-http-pooling-connection-manager pooling-config))
(follow-redirects (http:redirect normal))))
(define url0 "https://prod.idrix.eu/secure/")
(define url1 "https://client.badssl.com/")
(define (run url)
(define request (http:request-builder (uri url) (method 'GET)))
(http:client-send-async client request))
(define (print-it f)
(print (future-get (future-map http:response-status f)))
(let ((headers (future-get (future-map http:response-headers f))))
(for-each (lambda (k)
(for-each (lambda (v) (print k ": " v))
(http:headers-ref* headers k)))
(http:headers-names headers))
(newline))
(~> (future-map http:response-body f)
(lambda (f) (future-map utf8->string f))
future-get
print))
(print-it (run url0))
(print-it (run url1))
最近の HTTP ライブラリっぽく非同期で色々やるようにしてある。なので、その恩恵を受けるには
(util concurrent) を使う。同期でもリクエストを投げれるので同期処理が必要でも大丈夫。API はまだアルファ版なので、リリース時には変わっているかもしれないが、そこまで大きく変わることはないはず。ドキュメント書かないとな…
