Syntax highlighter

2021-09-06

Problem of future-map

I've introduced some future related procedures, in the context of concurrency, not the future in general as I'm not a prophet. The procedures will be available after the next release, version 0.9.8, which I'm planning to release very soon.

When I'm testing or writing scripts with future-map, one of the future related procedures, I've noticed there's a thread blocking issue. The future-map procedure creates a future object from a future object. At this moment, its implementation is pretty much naive, it gets the result of the giving future then apply the procedure passed to the future-map, after that make a new future object. There're no difficult things, it works pretty fine as long as the number of future-map calls is not that high. In other words, it's a toy quality...

The fundamental problem of the current implementation is that the new future depends on the result of the old future. This means the new future waits, blocks, the thread until the old future is done. If the underlying executor has only a couple of futures, this won't be a problem, just very useless to do it concurrently as all the future will be executed or return sequentially. Suppose I have an executor which has 3 threads in its thread pool. Then I call the future-map say 4 times. The execution thread and order of the process would look like this:
Thread1 Thread1 Thread2 Thread2 Thread3 Thread3 get the result Blocked get the result Blocked processing return the result processing return the result get the result Blocked processing return the result processing
As we can see, there are lots of red blocking parts. We can't, probably, help to have the blocking process but at least it should be able to schedule wisely, such as execute the future after the dependents are done or so.

At this moment, I don't have any solution how/what to do, so the problem most like stays on version 0.9.8...

2021-06-25

HTTP クライアントライブラリ

前回のポストから二ヶ月近く空いてしまった。要るもの追加してたら時間がかかったのと、まぁ家庭の事情というやつなので仕方ない(と自分に言い訳)

ここ数年、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))

頑張ってコネクションプールとかクライアント証明書とかの機能を実装していたので予定より一月遅れた(特に証明書周り、いろんなものが ECDSA 対応してなかった…)。

最近の HTTP ライブラリっぽく非同期で色々やるようにしてある。なので、その恩恵を受けるには (util concurrent) を使う。同期でもリクエストを投げれるので同期処理が必要でも大丈夫。

API はまだアルファ版なので、リリース時には変わっているかもしれないが、そこまで大きく変わることはないはず。ドキュメント書かないとな…

2021-05-06

ソケットライブラリ

Sagittarius は随分長らくソケット周りのライブラリが二つ(SRFI も入れると三つ)あった。(sagittarius socket)(rfc tls) である。どっちもそれなりに良くできていると思っているのだが、タイムアウト系の設定、特にコネクションタイムアウトを入れるのが大変だなぁという感じがしていた。(フラグが全部オプショナル引数なので、コネクションタイムアウトを後方互換を保ったまま入れるには引数の最後につける必要がある)。また、今時普通のソケットと TLS ソケットを分けて作るのも面倒が多いなぁと思いつつあったので、色々統合した感じのライブラリを作った。

(net socket) ライブラリはなんとなく今風な感じでソケットの作成を行うライブラリである。使い方はこんな感じ。

(import (rnrs)
        (net socket))

(define option (tls-socket-options
		(sni* '("google.com"))   ;; SNI
		(read-timeout 1000000))) ;; 1s (the unit is micro second)

(define socket (socket-options->client-socket option "google.com" "443"))

(socket-send socket (string->utf8 "HTTP/1.1\r\n\r\n"))
(utf8->string (socket-recv socket 500)) ;; -> some HTML

(socket-shutdown socket SHUT_RDWR)
(socket-close socket)

ソケット関連のオプションは全てオプションビルダーに押し込めて必要なら指定する感じ。最近(ここ数年、下手すれば十年くらい?)のライブラリはコンフィグをビルダーで作ってみたいな感じが多いので、それっぽくした。使い心地はまぁそれなりに悪くない感じなので、このスタイルとは個人的に相性がいいのだろう。

前回書いたレコードライブラリは主にこのライブラリを作るために作られたと言っても過言ではなかったりする。(まぁ、既に複数ライブラリで使用しているが)

なんでこんなライブラリを作ったかというと今風な HTTP クライアントが欲しかったから。それはまた別の記事で書くつもり。

2021-04-22

レコードビルダー

 R6RS のレコードは便利である。またポータブルに継承をしたい場合にはこれしか手がない。不便な点としてはフィールドが増えるとデフォルトのコンストラクタでは引数の数が増大するところだろう。何かしらのクライアントとか、コネクションみたいなものであれば、protocol を使って逃げる手もあるが、データ型だと面倒になってくる。引数の数が片手の数で足りなくなると尚更である。

ということで、そんな悩みを緩く解決するライブラリを作ってみた。これである。使い方は非常に簡単でこんな感じで使える。

(import (rnrs)
        (record builder))

(define-record-type base
  (fields a b))
(define-syntax base-builder
  (make-record-builder base ((a 'ok))))
  
(base-a (base-builder)) ;; -> ok

(define-record-type child
  (parent base)
  (fields c d))
(define-syntax child-builder
  (make-record-builder child ((a 'nok) (c 'ok))))
(base-a (child-builder)) ;; -> nok
(child-c (child-builder)) ;; -> ok
(base-a (base-builder (from (child-builder)))) ;; -> nok
デフォルト値なしかつ、作成時にフィールドを指定しなければ #f になる。

ライブラリ自体は一応ポータブルに書いたつもりではあるので、コピーすればそのまま他の R6RS 処理系でも使えるはず(直接 Record Type Descriptor を eq? せずに record-predicate 辺りを使ってやる必要がある気はするが、まぁ、確認してない)

なんでこんなライブラリを作ったかというと、この次に書く記事で必要になったからである。来週辺りに書けたらいいなぁ。

2020-11-02

XML signature

It's been a while writing a blog post. I wasn't really actively working on Sagittarius or Scheme, so there was nothing I can write. (and I was super busy with my life, incl. work). That's the excuse. I hope I will keep posting something, but I can't promise.

Even though I wasn't actively writing Scheme, I've been trying to enrich XML related libraries of Sagittarius. As we, probably, all know, Scheme has a great de-facto standard SXML and its libraries such as SSAX or SXPath. However, if you really need to handle serious XML which requires a lot of namespace handling, these libraries are not enough. So, I started working on writing a DOM library 2 years ago (though it's not even an introduction article :p). At that moment, the final destination of XML library was handling SAML, so XML signature.

After those 2 years, I've finally implemented a very simple XML signature library. While I was reaching this, I thought I needed to implement XPath, which is incomplete by the way, and spent more than a year for that. But at least, there's finally something I can show. Let's see how it looks like.


(import (rnrs)
        (text xml dom)
        (text xml dom writer)
        (text xml dsig)
        (rfc base64)
        (crypto)
        (rsa pkcs :10)
        (math))
;; RSA private key
(define private-key
  "MIIBPAIBAAJBAM7xaDmTsYZj1ZxJOVpAkCXKp/2SmprG1IA90cGs4wr1fiCRWHQ+\
   sdJwiX2j932CW7DpjOg4GEn2CrPwWIQLfdkCAwEAAQJBAInnc5YS5xVwiBPq8+5B
   4g1dHE+tl5uW7ls7VwGijXZp6Mi7D+GJJ57w6wo1vzjGNIFUAs07+17XBRpPeqaW
   MVECIQDz2t+jH7zB/wSbf3titZtyRIaYGCiV20sb9Xc/56QWHQIhANk/6Ncem83E
   wJpJTS3r+QFgkPVhQF0VEZJ0bI7fDAntAiEAuStZqH/AELu6Xu2V3uWyjTl1zuaB
   YxHrXeauT8tw8Q0CIQDVjbMuM1JodO33O/L4HywIpIoaC10fouRBGNzVnH/TCQIg
   ZoOzTnUmv2X4DaxbH4kfBg5/9e/mwK8wLZy2gn+a2A0=")
;; PKCS 10 format RSA public key
(define public-key
  "MFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAM7xaDmTsYZj1ZxJOVpAkCXKp/2SmprG\
   1IA90cGs4wr1fiCRWHQ+sdJwiX2j932CW7DpjOg4GEn2CrPwWIQLfdkCAwEAAQ==")
(define signing-key
  (import-private-key RSA
   (base64-decode-string private-key :transcoder #f)))
(define verify-key
  (subject-public-key-info->public-key
   (import-public-key PKCS10
    (base64-decode-string public-key :transcoder #f))))

(define keypair (make-keypair signing-key verify-key))

(define dom (xml-file->dom-tree "test1.xml"))

;; signing context, using exclude c14n canonicalisation, SHA256
;; and RSAWithSHA256 signature
(define sc (ds:make-signing-context ""
                                    *xmldsig:canonicalization-exc-c14n*
                                    *xmldsig:digest-sha256*
                                    *xmldsig:rsa-sha256*))
;; writing the signed DOM
(xmldsig:sign! dom sc keypair) ;; also return the given DOM
((make-dom-writer) dom)
#|
The above would write something like this (may change in the future 
due to the fact that the writing option is not decided yet)
<doc xmlns="http://www.ietf.org" xmlns:w3c="http://www.w3.org" xml:base="something/else">
    <e1>
        <e2 xmlns="" xml:base="bar/" xml:id="abc">
            <e3 id="E3" xml:base="foo"/>
        </e2>
    </e1>
<Signature xmlns="http://www.w3.org/2000/09/xmldsig#"><SignedInfo><CanonicalizationMethod Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#"/><SignatureMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#rsa-sha256"/><Reference URI=""><DigestMethod Algorithm="http://www.w3.org/2001/04/xmlenc#sha256"/><DigestValue>d1AgwW6w5CuCx4jqTM3zZBheHCg0AdEt93OiG599yHQ=</DigestValue></Reference></SignedInfo><SignatureValue>KrNNBtxw4ppGVOCWWndW6INDexdXs5Ei1/GqiUFwofjwrGmKmEw4hrCLG7p86StJ5kfGHYncezvr
exggfQSVZw==</SignatureValue><KeyInfo><KeyValue><RSAKeyValue><Modulus>zvFoOZOxhmPVnEk5WkCQJcqn/ZKamsbUgD3RwazjCvV+IJFYdD6x0nCJfaP3fYJbsOmM6DgYSfYK
s/BYhAt92Q==</Modulus><Exponent>AQAB</Exponent></RSAKeyValue></KeyValue></KeyInfo></Signature></doc>
|#
The test1.xml looks like this
<?xml version="1.0" encoding="utf-8" ?>
<doc xmlns="http://www.ietf.org" xmlns:w3c="http://www.w3.org" xml:base="something/else">
    <e1>
        <e2 xmlns="" xml:id="abc" xml:base="bar/">
            <e3 id="E3" xml:base="foo"/>
        </e2>
    </e1>
</doc>
I'm trying to keep the user level API as simple as possible. So the only thing users need to do is preparing a key pair and choosing the signing algorithms. At this moment, it doesn't handle references and transformers. But this is good enough as the first step. (And implementing transformer requires XPath, so may come veeeeery later). Now, I can sign an XML document, so the next step would be verifying the signature. I hope I can write a post soon enough before I forget what I've done.

It took me more than 2 years to reach here, during the period, I was more or less demotivated to write Scheme for some reason and recently, I decided to write something every day (only weekday, weekends are too busy with family life...). It was very small steps I've been making but at some point, I could reach somewhere. I'm a bit touched by this :D

2019-09-10

Saven: あなたの悩みを救うかもしれないビルドツール

Scheme にはSNOW!、Akku等のリポジトリ的がある。個人的にはこれらに乗っかってプログラムを組んだ方が楽だと思っているのではあるが、これらのリポジトリには登録されていないライブラリの依存関係を手作業でインストールするのは面倒。個人的によく使う r7rs-postgresql、r6rs-redis はどこのリポジトリにも入ってなかったりする。GitHub にコードがあるだけで、パッケージのパの字も考慮されていない(製作者の顔が見てみたいものだ)。リポジトリが使えれば楽だが、使えない状況である。となれば、今欲しいのはリポジトリではなくビルドツールではないだろうか?

ライブラリの依存関係は割と頭の痛い問題だ。例えば、r6rs-redis は r6rs-usocket に依存していて、r6rs-usocket は r6rs-pffi と r6rs-psystem に依存している。拙作の Pegasus はこの依存関係を考慮するように設計されているのだが、如何せんこれらのライブラリは Pegasus に登録されていない(製作者の以下略)。となると、手作業での依存関係解決が必要になる。作っているものが一つであればそれも問題ないのかもしれないが、複数になると一気にその手間は跳ね上がる。環境が変わればやり直しというのもジワジワと効いてくる。

Saven は依存関係を解消するビルドツールとして作られた。現状は GitHub 常にあるライブラリを解決できる。例えば、r6rs-mongodb と r6rs-pffi に依存するモジュール foo の定義はこんな感じで書ける
---
# sav.yaml
name: foo
dependencies:
  - type: github
    name: ktakashi/r6rs-mongodb
    paths:
      - src
  - type: github
    name: ktakashi/r6rs-pffi
    paths:
      - src
後は、sav buildsav test のように使える。複数ライブラリを構築したい場合にも使える。例えば、上記モジュール foo は親モジュール bar を持つとする。bar はこんな感じになる。
---
# sav.yaml
name: bar
modules:
  - foo
  - baz
さらに、モジュールの参照もこんな感じで可能
---
# sav.yaml
name: baz
dependencies:
  - type: module
    name: foo
    scope: test # Only used by tests

Saven を使えばビルド時、主にテスト時、に気になる依存関係を解決してくれる。まだまだ足りない機能の方が多いが、既にかなり楽ができるようになった。GitHub にしかないライブラリの依存を解決するのに、サブモジュール機能を使う必要がなくなったのは大きい。いつも通り欲しい機能順に実装されていく予定。

以下はどうでもいい話
Saven は Java の Maven にとてもインスパイアされている。
YAML 以外にも使えるフォーマットあるんだけど、なんとなく YAML が一番楽(今のところ)
Saven は英語の save がオランダ語化されたもので実際の単語だったりする。

2019-07-08

ベンチマークしてみる

こんなツイートを見かけた。
個人的にシンボルに変換するのはあり得ないかなと思ってはいるのだが、equal?と再帰はどっちが速いか分からない(特に Sagittarius では C 側で実装されているし)。ということでベンチマークを取ってみた。単純な比較でいいかなぁと思ったので、スクリプトは以下のようなものにした。
#!r6rs
(import (rnrs)
        (bench time))

(define string (let-values (((o e) (open-string-output-port)))
                 (do ((i 0 (+ i 1)))
                     ((= i 1000) (e))
                   (put-char o (integer->char i)))))
(define char-list0 (string->list string))
(define char-list1 (string->list string))

(define (->symbol cl)
  (let-values (((o e) (open-string-output-port)))
    (put-datum o cl)
    (string->symbol (e))))

(benchmark 1000 #t (lambda () (equal? char-list0 char-list1)))
(benchmark 1000 #t (lambda ()
                     (let loop ((cl0 char-list0) (cl1 char-list1))
                       (cond ((and (null? cl0) (null? cl1)))
                             ((or (null? cl0) (null? cl1)) #f)
                             ((char=? (car cl0) (car cl1))
                              (loop (cdr cl0) (cdr cl1)))
                             (else #f)))))
(benchmark 1000 #t
           (lambda () (eq? (->symbol char-list0) (->symbol char-list1))))
(bench time)はこんな感じ(Sagittarius 用)
#!r6rs
(library (bench time)
    (export benchmark)
    (import (rnrs)
            (time))
(define (benchmark count expected thunk)
  (define (do-benchmark count expected thunk)
    (do ((i 0 (+ i 1))) ((= i count))
      (unless (equal? expected (thunk)) (error 'benchmark "invalid result"))))
  (time (do-benchmark count expected thunk)))
)
Chez 用も大体似たようなもの。以下が結果。
$ scheme-env run chez@v9.5 --loadpath=. --program bench.scm
(time (do-benchmark count ...))
    3 collections
    0.024401110s elapsed cpu time, including 0.000328248s collecting
    0.024408000s elapsed real time, including 0.000335000s collecting
    25477792 bytes allocated, including 25192304 bytes reclaimed
(time (do-benchmark count ...))
    no collections
    0.002436587s elapsed cpu time
    0.002442000s elapsed real time
    0 bytes allocated
(time (do-benchmark count ...))
    29 collections
    0.144383753s elapsed cpu time, including 0.000803779s collecting
    0.144402000s elapsed real time, including 0.000838000s collecting
    249044288 bytes allocated, including 244363280 bytes reclaimed

$ sash -L. bench.scm

;;  (do-benchmark count expected thunk)
;;  0.111818 real    0.213437 user    0.025128 sys

;;  (do-benchmark count expected thunk)
;;  0.037333 real    0.037329 user    4.0e-600 sys

;;  (do-benchmark count expected thunk)
;;  0.191468 real    0.268644 user    0.019184 sys
以外にも再帰が一番速いっぽい。Chez でやってもそうならまぁそうだろう的な適当な意見だけど。予想通りシンボルにするのは遅い。->symbolを見ればわかると思うが、普通にオーバーヘッドが大きいというのがある。メモ化するとかすれば何とかなるかもしれないが、equal? でハッシュテーブルを作ったら意味ないだろうし、あまりいい実装が思い浮かばなかったので省略している。

特にまとめはない。