Syntax highlighter

2023-06-14

英語の勉強のお供に?

同僚のスクリーンセーバが英単語とその意味を表示するやつなのをみて、こういうのあると便利かなぁと思い始めたのでなんとなく似た感じのものを作ってみた。まぁそこまで似ているというほどでもないのだが、起動するとコンソールに単語の意味と例文をなんちゃってカード形式で表示するというもの。ちなみに単語はUrban Dictionaryの非公式APIを使って取得していたりするので、このスクリプトがある日突然使えなくなっても泣かないようにしないといけない。

Gistに載せたのはコピペしたものなので、色がついてたり太字になってたり下線がついてたりするのが見えないのが残念。実際にどのように見えるのかは実行すればわかるということで。

別段特筆すべきこともないのだが、これを書くために使ったライブラリ達(当然だが全部Sagittariusに付属している)

  • (net http-client): モダン(なつもり)な非同期HTTPライブラリ
  • (text json jmespath): JMESPathライブラリ
  • (rfc uri-template): RFC 6570準拠なURIテンプレートライブラリ
  • (sagittarius combinators): コンビネーターライブラリ
  • (util concurrent): 並列処理ライブラリ
処理のために書いた小道具とかもライブラリにするといいのかもと思いつつ(非同期http-getとか、コンソールの色付けとか)あまりいいアイデアもないのでとりあえず放置。

2023-05-04

Remote debugger(ish)

In the previous post, I've mentioned that I needed to collect all threads to see which one is hanging. After implementing it, I've also noticed that all threads were hanging. So I've decided to implement a better remote debugger(ish).

CAVEAT

The functions and interface are experimental, so it might get changed in the future.

Suppose we have this script:

(import (rnrs)
        (srfi :1)
        (srfi :18)
        (sagittarius)
        (sagittarius debug))

;; Creating a remote debugger. You can specify a specific port number as well
(define remote-debugger (make-remote-debugger "0"))
;; Showing the port.
(print "Debugger port: " (remote-debugger-port remote-debugger))

(define ((sleep-in-deep name time))
  (define (before-sleep)
    (format #t "~a wants to sleep~%" name))
  (define (after-sleep time)
    (format #t "~a slept for ~a but wants to sleep more~%" name time))
  (define (sleep time) (thread-sleep! time))
  (before-sleep)
  (sleep time)
  (after-sleep time))

(define threads
  (map thread-start!
       (map (lambda (i)
              (make-thread (sleep-in-deep i (* i 1800))
                           (string-append "sleep-" (number->string i))))
            (iota 3))))
(for-each thread-join! threads)

It doesn't do anything but just sleeps. Now, if you run the script, it shows this kind of message on the cosole.

Debugger port: 50368
0 wants to sleep
0 slept for 0 but wants to sleep more
2 wants to sleep
1 wants to sleep

At this moment, remote debugger is just a type of remote REPL, so open Emacs and run sagittarius (can be older one). Then do like this

sash> (import (sagittarius remote-repl))
sash> (connect-remote-repl "localhost" "50368")

connect: localhost:50368 (enter ^D to exit) 

It's connected, then I want to check hanging threads.

sash> (for-each print (sleeping-threads))
#<thread root runnable 0x10ac6dc80>
#<thread remote-debugger-thread-1295 runnable 0x10bdb8640>
#<thread sleep-1 runnable 0x10bdb8000>
#<thread sleep-2 runnable 0x10c6e0c80>
#<unspecified>

I have 4 threads hanging. root is the main thread, so I can ignore. remote-debugger-thread-1295, the number varies, is a remote debugger's server thread, I can ignore this as well. So, the rest of the threads are the targets. I want to filter it for the later usage. I can simply do this:

sash> (define t* (filter (lambda (t) (and (string? (thread-name t)) (string-prefix? "sleep-" (thread-name t)))) (sleeping-threads)))

Now, let's see the backtrace of the threads.

(for-each print (map thread->pretty-backtrace-string t*))
Thread sleep-1
stack trace:
  [1] thread-sleep!
  [2] sleep-in-deep
    src: (thread-sleep! time)
    "sleep.scm":15

Thread sleep-2
stack trace:
  [1] thread-sleep!
  [2] sleep-in-deep
    src: (thread-sleep! time)
    "sleep.scm":15

#<unspecified>

It seems the sleep-in-deep is calling the thread-sleep! procedure. Okay, what's the value of the time?

To see those variables, I need to collect the backtrace of the threads. Like this:

sash> (define bt* (map thread-backtrace t*))

A backtrace contains multiple frames, in this example, each backtrace of the threads contains 2 frames. I want to see the first one which is the thread-sleep! frame. So, doing this:

sash> (for-each print (map (lambda (bt) (thread-backtrace-arguments bt 1)) bt*))
((local (0 . 1800)))
((local (0 . 3600)))
#<unspecified>

1800 and 3600 seconds! That's why the threads are hanging (obviously...).

In this example, I only showed how to see the arguments (local variables and free variables), but the remote debugger has a bit more functionality, such as inspecting objects and accessing its slots. Using this debugger, I found the root cause of the bug made me suffer for a couple of weeks.

2023-04-26

Thread monitoring

When I write multi thread programs, it's always a trouble to debug whenever a thread hangs. That's because:

  1. You don't see what's going on. I don't put logging when I write a library and I don't usually use raw thread.
  2. The problem is gone away if I put a debug print
  3. And/or it happens only once in a hundred

So, I started thinking that if I want to resolve this, it has to be a fundamental solution instead of AdHoc one.

Now, what could be a fundamental solution for this? Before forming ideas, which may not even be applicable, I need to think what's the requirements to debug hanged threads. So, things what I want to see are:

  1. State of the thread If it's running, sleeping, waiting whatsoever
  2. Where the location is or which procedure is being called.
  3. Who the caller of the procedure is

Looking at these, it's basically thread introspection. This means, I need to know the thread, even though once a thread is created, then we just release it to dark space hoping he can manage his wellness (I feel like a parent looking at my own child leaving the house 😢). If you need to be a worrying parent, you need to let your children have a GPS to track where they are. Okay then, let Sagittarius be a good parent for his own children (threads).

The idea came up in my mind is to change the VM architecture. Currently, a VM, as we all know it's an abbreviation of Virtual Machine, is a thread. So, whenever a thread is created, then we have a new VM. Now, there must be a manager to holds / monitor the threads. I don't dare to change names, so let's the manager kernel. Then the architecture should look like this:

+------------------------------------+
|              kernel                |
+---+--------------------------------+
    | threads
  +-+-+------+---+
  |   | main | * |
  +---+------+-|-+
               |
             +-+-+-------+---+
             | * | child | * |
             +---+-------+-|-+
                           |
                         +-+-+-------+---+
                         | * | child | * |
                         +---+-------+---+

Threads should be stored in a double-linked list and each threads should have the reference of the kernel to make my life easier. With this architecture, it seems I can add extra thread to monitor other siblings from Scheme world.

I feel I'm overlooking something but probably a good starting point.

2023-01-03

New crypto library

Last year, I've written a portable cryptographic library Springkussen. And then I've also noticed that (crypto) and (math) libraries are not really well designed. For example, a cipher object must support both encryption and signing operations which can only be applied to RSA operations. So, I decided to rewrite Sagittarius' cryptograpihc library and now I can show what it looks like.

Library structure

The old (crypto) and (math) libraries are basically aggregated libraries. This means it exports a lot of bindings even if you don't need them. The new cryptographic libraries are per components, for example, if you only need cipher operations, then you only need to import (sagittarius crypto ciphers) library. So, users need to combine the libraries to achieve the target operation.

(math) library is also integrated to (sagittarius crypto *). For example, message digest operations are located in (sagittarius crypto digests).

Most of the cryptographic operations are now provided by one of the (sagittarius crypto *) libraries. The existing libraries are replaced by them and some of them are deprecated. For example, (rfc x.509) library now re-exports the (sagittarius crypto *) procedures.

Example of block cipher operations

This is an example of how to use block cipher operations provided by (sagittarius crypto ciphers) library. Suppose, you want to encrypt a message with a randomly generated key and export the key as plain text. (Don't do this kind of operation in production, exporting a plain key is not a good practice...)

The library doesn't provide key operations, such as generating a symmetric key. So, you need to import (sagittarius crypto keys) library as well. To combine them, you can do it like this:

(import (rnrs)
        (sagittarius crypto ciphers)
        (sagittarius crypto keys))

;; Generate a random key suitable for AES-256
(define key (generate-symmetric-key *scheme:aes-256*))

;; Using ECB mode, with PKCS7 padding
;; Don't do it in production code :)
(define aes-cipher (make-block-cipher *scheme:aes-256* *mode:ecb* pkcs7-padding))

(define msg (string->utf8 "Hello new crypto library"))

;; No parameter needed
(block-cipher-init! aes-cipher (cipher-direction encrypt) key)
(block-cipher-encrypt-last-block aes-cipher msg)
;; -> bytevector length of 32 (2 blocks), the result is always different

;; Clean up
(block-cipher-done! aes-cipher)

;; A symmetric key is exportable, so you can export
(exportable->bytevector key)
;; -> bytevector length of 32

To see how the current development branch looks, you can also use the Docker image of edge tag. If you put the above script into crypto.scm file, then you can execute it with the below command:

docker run -it --mount src=$(pwd),target=/scripts,type=bind ktakashi/sagittarius:edge scripts/crypto.scm

Though the cache is not available, so loading a script may take a lot of time...

2022-06-20

AMQP

Sagittarius supports AMQP, Advanced Message Queue Protocol, since probably 0.6.x, I don't recall which version, to be honest. The reason I wanted to support this was because I was using QM, I think IBM MQ, at that moment at my work and wanted to send a message from a command-line, instead of using a Web browser. Unfortunately, the version of MQ was too old and didn't support AMQP yet. So, I couldn't use it for the purpose that I wanted. Nevertheless, it's there and it's supported.

Now, I want to write a demo application to show what Sagittarius can do out of the box. One of the main reasons I've made Sagittarius is that I can use it for daily commercial work. So, I thought it's nice to have a demo of integration with external systems, not only for HTTP but also some other protocols which Sagittarius supports out of the box. Then, I realised that the current implementation of AMQP client is not really efficient nor doesn't work as I expected.

To explain what doesn't work, I first need to explain how the AMQP connection and session work. An AMCP connection is a physical connection, which holds an actual socket. Now, under a connection, there are sessions. A session is a virtual separation of input and output channels. This means if a connection has multiple sessions, input or output messages need to be dispatched properly to the associated session. It's easier to see it in a diagram:

Session under connection

  Client App                                        Broker
+-------------+                                +-------------+
|             |################################|             |
|   +---+     |--------------------------------|    +---+    |
|   | C |     |            Session             |    | Q |    |
|   +---+     |--------------------------------|    +---+    |
|             |################################|             |
+-------------+                                +-------------+

Multiple sessions

    Session<------+                           +------>Session
(ICH=1, OCH=1)    |                           |    (ICH=1, OCH=1)
                 \|/                         \|/
    Session<--> Connection <---------> Connection <-->Session
(ICH=2, OCH=3)   /|\                         /|\   (ICH=3, OCH=2)
                  |                           |
    Session<------+                           +------>Session
(ICH=3, OCH=2)                                     (ICH=2, OCH=3)

        Key: ICH -> Input Channel, OCH -> Output Channel 
      

For the original diagram and the specification, you can refer 2.1.2 Communication Endpoints

The point is that the physical connection is only one, however virtual connection/session can be multiple simultaneously. However, the current implementation of AMQP on Sagittarius can't handle this due to the fact that the socket is shared by the sessions (or underlying receivers).

So, if I want to do it properly, the design must be changed sort of like this:

      +------------------+
      |    Connection    |  +--> Session1
<IN>  |  +------------+  |  |
======+==+=> socket  -+--+--+--> Session2
      |  +------------+  |  |
      |     |     /|\    |  +--> Session3
      +-----+------+-----+
            |      |
           \|/     |
       +---------------+
       |  Frame reader |
       +---------------+

And possibly, the reading frame process is running on a background thread, once the connection is established.

Let's see what I can do...

2022-05-19

Markdown support

On Sagittarius, I was, well still am, using scribble, which the parser is ported from Chibi Scheme, to write the document. Recently, though it's been already a couple of years, I've been thinking that using one of the documentation formats might be better so that users can read better on the repository if they want to use the latest version.

So, I've updated (text markdown) library to support better Markdown. The library is based on commonmark-java, and more or less compliant with Commonmark specifications. The library keeps the old behaviour, which generates a sort of old intermediate format and HTML, though that should be considered deprecated.

The basic usage of the library can be like this:

(import (rnrs)
        (text markdown)
        (text sxml serializer))

(define (main args)
  (let ((file (cadr args)))
    (call-with-input-file file
      (lambda (in)
        (let ((node (parse-markdown markdown-parser in)))
          (srl:sxml->html-noindent
           (markdown-converter:convert default-markdown-converter 'html node)
           (current-output-port)))))))

So parse-markdown procedure parses the input textual port according to the given markdown-parser, which is one of the default parsers provided by the library. The other default parser is commonmark-parser, which strictly conforms Commonmark specification.

markdown-parser

This supports most of the GFM, footnotes and definition list

commonmark-parser

This only supports things listed on Commonmark specification. So, no table, no strikethrough or others.

The above script is actually used to generate this post. This means, obviously, the markdown-parser is used (as the code already shows :D)

NOTE: Below is the convenient (also for my memo) command to generate an HTML post.

# For Mac
sash blogpost-markdown.scm post.md | pbcopy

There's also a library called (text markdown extensions) and (text markdown converters). These libraries provide an API / framework to provide custom extensions, such as GFM, which is mostly supported by the library.

Next step

Sagittarius document requires a bit more tweaks. Below are the requirements

  • Table of contents
  • Index table
  • eval expression
  • Page split per section
  • Proper anchor per pages
  • Navigation bar

Most of the things are done already, just a bit more. I think after this is done, I can finally release 0.9.9.

2021-11-26

JWT と愉快な仲間たち

多分2017年くらいにやるかと思って放置していた JWT 周りのサポートをようやく重い腰をあげて完了した。一応、現時点て RFC になってるものは全部入れたはず(EdDSA とか ES256K とか)。ドラフトの ECDH-1PU はそのうちファイナルになったらサポートするかもしれない。

こんな感じで使える。

(import (rnrs)
        (rfc jwt)
        (rfc jwk)
        (rfc jwe)
        (rfc jws)
        (rfc uuid)
        (crypto)
        (srfi :19)
        (math ec) ;; for ec-parameters
        (sagittarius combinators))

(define keypair (generate-key-pair Ed25519))
(define alg 'EdDSA)
;; If you want to use other algorighm and keys
;; (define keypair (generate-key-pair ECDSA :ec-parameter NIST-P-256))
;; (define alg 'ES256)
;; (define keypair (generate-key-pair RSA :size 2048))
;; (define alg 'PS512)

(define claims
  (jwt-claims-builder
   (iss "Sagittarius Scheme")
   (aud "All saints")
   (sub "Use Sagittarius")
   (iat (current-time))
   (nbf (add-duration (current-time) (make-time time-duration 0 -1)))
   (exp (add-duration (current-time) (make-time time-duration 0 600)))
   (jti (uuid->string (make-v4-uuid)))))

(define jws-header
  (jws-header-builder
   (alg alg)))

(define payload (string->utf8 (jwt-claims->json-string claims)))
(define jws-object (make-jws-object jws-header payload))

(define signer (private-key->jws-signer (keypair-private keypair)))

(define jwk
  (public-key->jwk (keypair-public keypair)
                   (jwk-config-builder (kid "my key"))))
(define jwks (make-jwk-set (list jwk)))

(let ((jwt-object (jws:sign jws-object signer)))
  ;; Share the JWT to 3rd party
  ;; (jws:serialize jwt-object)
  ;; (jwk-set->json-string jwks)

  ;; Verify the JWT token with the public key
  (let* ((kid-matcher (jwk-matcher:kid "my key"))
         (verifier (public-key->jws-verifier
                    (jwk-set:find-key jwks kid-matcher)))
         (jwt-consumer (jwt-consumer-builder
                        (verifier verifier)
                        (claims-validator
                         (compose jwt:iss-required-validator
                                  jwt:sub-required-validator
                                  jwt:aud-required-validator
                                  jwt:exp-required-validator
                                  jwt:nbf-required-validator
                                  jwt:iat-required-validator
                                  jwt:jti-required-validator
                                  (jwt:iss-value-validator "Sagittarius Scheme"
                                                           "Sagittarius")
                                  (jwt:sub-value-validator "Use Sagittarius")
                                  (jwt:aud-value-validator "All saints")
                                  (jwt:nbf-validator)
                                  (jwt:exp-validator)))))
         (claims (jwt:consume jwt-consumer jwt-object)))
    ;; use the user claim
    (jwt-claims-aud claims))) ;; retrieve 'aud' field
上記はおそらく 90% 以上くらいの JWT ユーザーが使っているであろう JWS を用いたもの。(個人的に JWE を JWT として使ってるのアプリを見たことがない)
っで、以下が JWE を作る方法
(import (rnrs)
        (rfc jwe)
        (rfc jwk))

(define jwk-bob
  (json-string->jwk
   "{\"kty\":\"EC\",
     \"crv\":\"P-256\",
     \"x\":\"weNJy2HscCSM6AEDTDg04biOvhFhyyWvOHQfeF_PxMQ\",
     \"y\":\"e8lnCO-AlStT-NJVX-crhB7QRYhiix03illJOVAOyck\",
     \"d\":\"VEmDZpDXXK8p8N0Cndsxs924q6nS1RXFASRl6BfUqdw\"}"))

(define jwe-header
  (jwe-header-builder
   (alg 'ECDH-ES+A128KW)
   (enc 'A128GCM)
   (apu "QWxpY2U")
   (apv "Qm9i")))

;; Alice wants to encrypt with Bob's public key
(define alice-encryptor (make-ecdh-jwe-encryptor (jwk->public-key jwk-bob)))

;; Bob needs to decrypt Alice's message with his private key
(define bob-decryptor (make-ecdh-jwe-decryptor jwk-bob))

(define secret-key (string->utf8 "down the rabbit hole"))

(let ((jwe-object (jwe:encrypt alice-encryptor jwe-header secret-key)))
  (jwe:serialize jwe-object)
  (let ((secret-key (jwe:decrypt bob-decryptor jwe-object)))
    (utf8->string secret-key)))
基本的な使用感は Java の Nimbus JOSE + JWT を参考にしているが、JWT Consumer は多分違う。ライブラリがいくつにも分かれているのは単なる趣味。よく使われる JWS を整合性チェックに用いるのは (rfc jwk)(rfc jws) だけで済むとかまぁ、そういう感じにしたかったからという。

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? でハッシュテーブルを作ったら意味ないだろうし、あまりいい実装が思い浮かばなかったので省略している。

特にまとめはない。

2019-05-24

R6RS ライブラリ周りの解説

ツイッターで R6RS のライブラリ解決の挙動について言及している呟きを見かけたので、ちょっと書いてみることにした。あくまで Sagittarius 内部ではこうしているというだけで、これが唯一解ではないことに注意。

R6RS 的なライブラリファイルの位置付け

R6RS 的にはライブラリはファイルである必要はない。ライブラリは式の定義が書かれていると記載されているだけで特にそれがどこにあるかということには言及していないからだ。これを都合よく解釈すれば、処理系の判断でライブラリを In Memory にしておいても問題ないし、マシン語の塊にしておいても問題ないということである。またライブラリは Top level のプログラムではないので、スクリプトファイルにその定義を置くことは許されていない(っが Sagittarius では利便性のため許していたりする)。

このことから、ライブラリを外部ファイルに置くというのは実は処理系依存の挙動であると言える。言い換えると、R6RS が提供する標準ライブラリ以外を使ったプログラムは処理系依存ということになるし、ライブラリ自体を記述することは処理系依存になるということでもある。

要するに R6RS 的にはライブラリという枠組みは用意するけど、それらをどう扱うかは適当に都合よく解釈してねということだ。ある意味 Scheme っぽい。これを踏まえつつ、Sagittarius ではライブラリの解決がどう行われるかを記述していく。

import 句

Top level のプログラムはプログラムの開始に import 句を一つ必ずもつ必要がある。import 句はこの宇宙のどこかにある指定されたライブラリを探し出す必要がある。Sagittarius では探索範囲を load path または In Memory としかつ、必要であればライブラリ名をファイル名に変換して探索する。処理としては
  1. ライブラリ名で読み込み済みライブラリを検索
  2. 見つかったらそれを返す
  3. 見つからなかったら、ライブラリ名をファイル名に変換し、 load path 上を探し load する
  4. 1を試し、見つからなかったらエラー
というようなことをしている。
ライブラリ名の変換はファイルシステムの制約も入ってくるので、シンボルはエスケープしたりしている。

余談だが、load する代わりに read して eval した方がいいような気がする。load だと、ライブラリ以外の式も評価されてしまうというオマケが付くからなのだが、これに依存したコード書いてたか記憶がない…

library

ライブラリは書式以外は処理系依存であるということは上記ですでに触れたので、ここでは de-facto な挙動と完全処理系依存の挙動を記して、どうすればある程度ポータブルにライブラリを記述できるかを示すことにする。

De-facto な挙動

  1. R6RSのライブラリは拡張子 .sls を使う
  2. 特定の処理系のみに読み込んで欲しい場合は .sagittarius.sls の様な .処理系名.sls 形式を使う
  3. ライブラリファイル名は空白をファイルセパレータに置き換える。例 (rnrs base) なら rnrs/base.sls になる。

処理系依存な挙動

  1. load path の指定。処理系ごとに指定の仕方が違う。既定の場所も処理系ごとに違う。
  2. 複数ライブラリを一ファイルに押し込める
    1. 処理系によっては許している(例: Sagittarius)
    2. 基本ポータブルにしたいなら使わないか、処理系依存の処理を押し込めたファイルのみに適用する
  3. meta キーワード
    R6RS で定められているが、処理系ごとに挙動が違う。以下のどちらかになる
    1. 完全無視
    2. フェーズを意識する
    ので、よりポータブルにしたいなら、フェーズを意識して書いた方が良い。

meta キーワード

上記で meta キーワードについて多少触れたので折角なのでもう少し突っ込んでみることにする。
いくつかの処理系、知っている限りでは plt-r6rs と André van Tonder の展開器を使っている処理系だけだが、ではマクロ展開のフェーズ管理を厳密に行う。端的に言えば、マクロ展開時に import された束縛と実行時に import された束縛は別物として扱われるということである。例えば以下のコード
(import (rnrs)
 (only (srfi :1) make-list))

(define-syntax foo
  (lambda (x)
    (define (ntimes i n)  ;; >- expand (meta 1) phase
      (make-list (syntax->datum n) (syntax->datum i)))
    (syntax-case x ()
     ((_ y n)
      (with-syntax (((y* ...) (ntimes #'y #'n)))
        #'(display '(y* ...)))))))
(foo x 5)
フェーズに厳しい処理系だと上記はエラーになるが、フェーズに緩い(または自動でフェーズを検出する)処理系だと上記は(x x x x x) を表示する。これをポータブルに書くには SRFI-1 を import する部分を以下のように書き換える必要がある。
(for (only (srfi :1) make-list) expand)
Sagittarius はフェーズに緩いので、マクロが展開される環境 ≒ 実行時環境になっている(厳密には違うが、処理系自体を弄らない限り意識することなないはず)。

フェーズは低レベルマクロを使用しかつその中で (rnrs) 以外のライブラリを使うもしくは、(meta 2) 以上のコードを書く際に意識する必要がある。(meta 2) はマクロ内で内部マクロを使いかつその内部マクロで別ライブラリの束縛を参照する必要があるので、普通にコードを書いていたらまずお目にかからないだろう。ちなみに、マクロ内で (meta 0) の束縛を参照するのはエラーなので、マクロ内部での内部定義はコピペが横行しやすい。

割とどうでもいいのだが、(rnrs) またはその下にぶら下がっているライブラリ(例: (rnrs base))は (meta 0)(meta 1) で export されているのだが、これを他のライブラリでやる方法は R6RS の範囲では定められていなかったりする。

論旨がまとまらなくなってきたからこの辺で終わり。

2019-04-12

R6RS MongoDB with transaction

I've made a portable R6RS MongoDB library, I think, last year. Now I needed to support transaction so decided to implement it. Since MongoDB 4.0.0, it supports transactions. However, their document doesn't say which command to use or how. The only thing it mentions is I need to set up replica sets.

If you there's no documentation, then what you can do is reverse engineering. So, I've written a couple of scripts to set up MongoDB with transaction and proxy server which observes the commands.

The followings are the scripts I made to investigate:
The first one sets up the server which receives client command and sends to the MongoDB server. It does also dump both requests and responses. The second one sets up the docker network and instances of MongoDB with replica sets and executes the script files with mongo shell. Then the third one prints wire protocol commands in, sort of, a human-readable format.

With this investigation, I've figured out that I need to add lsid, txnNumber, autocommit and startTransaction. Okay, I've never seen them on the document, so I have no idea how these options works, but just followed the example. Then, here comes the transaction support.

How to use
This is an example of a transaction:
#!r6rs
(import (rnrs)
 (mongodb))

(define conn (make-mongodb-connection "localhost" 27017))
(define collection "txn")

(open-mongodb-connection! conn)

;; create the collection a head
(mongodb-database-run-command db `(("create" ,collection)))

(let* ((session (mongodb-session-start conn)) ;; start session
       (db (mongodb-session-database session "test"))) ;; create a database with session
  (guard (e (else (mongodb-session-abort-transaction session)))
    (mongodb-session-start-transaction! session) ;; start transaction
    ;; okay insert documents using usual database procedure
    ;; NB: has to be command, not other procedures...
    (mongodb-database-insert-command db collection
         '#((("id" 1) ("foo" "bar"))))
    (mongodb-database-insert-command db collection
         '#((("id" 2) ("foo" "bar"))))
    ;; and commit
    (mongodb-session-commit-transaction! session))
  ;; session must be end
  (mongodb-session-end! session))

(let* ((db (make-mongodb-database conn "test"))
       (r (mongodb-database-query db collection '())))
  (mongodb-query-result-documents r))
I haven't implement any utilities of transaction related procedures. So at this moment, you need to bare with low-level APIs.

How it works
Maybe you don't want to know, but it's nice to mention. When a session is created, then it also creates a session id. Then the database retrieved from the session adds the session id to query messages (OP_QUERY, not OP_MSG). Once mongodb-session-start-transaction! procedure is called, then it allocates transaction number and after this, the database also adds transaction information.

If the MongoDB server doesn't support the transaction, then the session automatically detects it and doesn't send any session or transaction related command.

And again, I'm not sure if I implemented correctly or not.

Once the official document of the transaction commands is written, I'll come back and review.

2019-04-01

JSON 周りのライブラリ

宝クジが大当たりしました。

四月馬鹿お終い。

Sagittarius は意外にも JSON 周りのライブラリが充実している。開発者である僕の本業が Web 系だからというのも要因の一つだと思う。一昔前の XML みたいな位置に JSON がいるのが大きい。最近書いてるアプリでこれらのライブラリをふんだんに使って我ながら便利な物を書いたものだと感心したので宣伝を兼ねて自慢することにする(これくらいの勢いじゃないとブログ書くネタがないともいう)。

簡単なクエリ
(text json pointer) は簡単な JSON クエリを提供する RFC6901 を実装したもの。対象となる JSON の構造や配列の要素番号が予め分かっている時に使える。こんな感じ
(import (rnrs) (text json pointer) (text json))

(define id-pointer (json-pointer "/id"))
(id-pointer (call-with-input-file "a.json" json-read))
これで JSON オブジェクトが id フィールドを持っていれば引っ張ってくる。id-pointer はクロージャなので再利用可能。

複雑なクエリ
(text json jmespath) は割と複雑なクエリ言語を提供する。前にも紹介記事を書いてるので簡単な使い方はそっちを参照。JSON Pointer では書けないようなクエリを書く際はこっちを使う。例えば、JSON オブジェクトを要素にする配列から name フィールドと description フィールドのみを返すようなクエリはこんな感じで書ける
(import (rnrs) (text json jmespath) (text json))

(define name&desc (jmespath "[].[name, description]"))
(name&desc (call-with-input-file "b.json" json-read))
;; -> (("name of a object" "description of a object") ...)
これ以外にも便利な使い方や、組み込みのクエリー関数があって便利。

変更
(text json patch) は RFC6902 JSON Patch を提供する。他言語での実装と違うのは入力を変更しない点。関数型とかそう言うのではなく、副作用で実装するのは無理ゲー(と言うか不可能)だったからと言うのが真実。こんな感じで使う
(import (rnrs) (text json patch) (text json))

(define id-patcher (json-patcher '(#(("op" . "add) ("path" . "/id") ("value" . 1234)))))
(id-patcher (call-with-input-file "c.json" json-read))
;; -> #(("id" . 1234) ...)
id-patcher はクロージャなので再利用可能。

与太話
これらのライブラリは Scheme に於けるベクタ操作の貧弱さに辟易したので開発されたとも言える。Sagittarius でデファクトとして使っている JSON の S式表現は元々 Chicken Scheme にあった実装を持ってきている。理由は何故かは知らないが、これが JSON オブジェクトをベクタで表していたのが事の発端とも言える。これらのライブラリは元の表現が普通に  alist でやられていたらきっと産まれなかっただろうので、人間万事塞翁が馬みたいな気持ちになるなる(何度変えてやろうかと呪ったか分からん…)
結果を見ればこの上なく便利なライブラリが出来上がったとも言えるのであの時のどす黒い感情はうまく浄化されたのだろう。ということにしておく。

2019-03-15

R7RS-large タンジェリン

タンジェリンってみかんじゃないのか…

2月にR7RS-largeのタンジェリンエディションがでた。ブログ記事を書こうとずっと思っていたのだが、所謂「life gets in」な状態だったので中々時間も取れずズルズルと一月以上経ってしまった(言い訳)。前回のR7RS-largeはレッドエディションだったのだが、レッドの次はオレンジなのに、いきなりタンジェリンになった。理由はこの辺(要するに準備できなかったらしい)。

さて、前置きが長いとダレるのでまずは結果。温州みかんになれたSRFIは以下:
  • SRFI 115 (combinator-based regular expressions) - (scheme regex)
  • SRFI 141 (comprehensive integer division operators) - (scheme division)
  • SRFI 143 (fixnum operators) - (scheme fixnum)
  • SRFI 144 (flonum operators, R6RS plus ) - (scheme flonum)
  • SRFI 146 (persistent tree and hash mappings) - (scheme mapping) (scheme mapping hash)
  • SRFI 151 (comprehensive bitwise operations on integers) - (scheme bitwise)
  • SRFI 158 (backward-compatible additions to SRFI 127 on generators) - (scheme generator) : 既存の置き換え
  • SRFI 159 (combinator formatting) - (scheme format)
  • SRFI 160 (comprehensive homogeneous vector library, including inexact-complex vectors) - (scheme vector @)
(scheme vector @)@ の部分には u8, s8, u16, s16, u32, s32, u64, s64, f32, f64, c64, c128 が入る。(こいつらを vector と呼ぶと混乱する気がするがいいのかね?) 現在のHEADでSagittariusはSRFI 159とSRFI 160を除く全てをサポートした。除外しているSRFIについては記事の最後に理由(愚痴?)を書く。

この辺りのエディションから比較的新しいSRFIがR7RS-largeに取り入れられるようになるのかな?オレンジが何を入れようとしているのかよく分かっていないのであくまで個人的な感想である。そうは言っても、SRFI 143、144、151はR6RSの拡張みたいなものなので、R7RS-largeでも必要とされたと思えばいいのかもしれない。SRFI 158は多少毛色が違うというか、こうする事で既に決定したライブラリを拡張できるというのを示したとも言えるかもしれない。一度決定したらずっとそのまま言われるよりは柔軟でいい。

SRFI 115は古めのSRFIではあるのだが、どれくらいの処理系がサポートしているのかよく分かっていない。Chibi(参照実装元)とSagittariusはサポートしているが、他にあるのかな?(まぁ、そんな事言い出したら今回入ったSRFI自体どれくらいの処理系がサポートしているのやら…)

SRFI 146は個人的に好きでなかったのだが、この機会にサポートすることにした。ライブラリ名の規則が分かりづらいというのが主な理由だったのだが、いまだに妙な気分ではある。

新たに8つのライブラリが追加されたR7RS-largeだけど、どの処理系が追随するかはよく分かっていない。Chibiは次のリリースでタンジェリンをサポートするらしい。Sagittariusは上記の通り、SRFI 159とSRFI 160を除くR7RS-largeをサポートする。(ひょっとしたらSRFI 160もサポートするかもしれないが、今の所その予定はない。理由は愚痴から推測して)

ここから愚痴。
SRFI 159とSRFI 160は正直微妙だなぁと思っている。SRFI 159はよりSchemeっぽいformatを提供するライブラリなのだが、正直formatの方がいいなぁと思ったり。使い慣れてるし。さらにはR7RS-largeに入ったことでSRFIの議論が再開されたりしていて、なんか泥沼感が出ているし。
SRFI 160に関してはそもそもファイナルにすらなっていない。つまり、議論の途中なのに議長権限でリストに入れたとも言える。鶴の一声、鳴り物入りとか言えばいいのかもしれないが、どうにも唸り声が出てしまう。

2019-01-02

(My) best practice of conditions

I've been writing portable/non-portable Scheme libraries for a rather long time and kind of getting my best practice of how to make conditions for libraries. So let me share the opinion.

Disclaimer

This is not community approved best practice nor it can be applied to the latest standard (R7RS). So I don't have any responsibility for your implementation can't handle or claims that nobody is writing this type of code :p

Basics

Condition system

R6RS has a very nice, (yet it was very controversial), the feature called condition system. It is built on top of, again very controversial, record type system. The basic ideas are:
  1. Conditions are inheritable (the absolute base is &condition)
  2. Conditions are compoundable. (using condition procedure)
These 2 concepts make the condition system very beautiful compare with, say, Java's exception.

How to use

The very basic usage is like this:
(define-condition-type &foo &error
  make-foo-error foo-error?)
This defines a condition type of &foo. Then you can signal the condition with raise or raise-continuable procedure.

My practices

Currently, I'm using conditions with the following rules, which I think the best at this moment.
  1. Should create at least one library specific condition
    If you are creating a library named foo, then the library should have a specific condition such as &foo unless the library provides only utilities. (e.g. (srfi :1) provides only list utilities).
  2. Must not use the error procedure
    If you see the standard error, then it's a bad sign. The standard conditions are good for general purposes but not good for a library specific error signalling.
  3. Should split conditions per phases
    If a library has several phases, then the conditions should be split. For example, (text json jmespath) has compilation and evaluation phases. So the condition should be split into 2, one for compilation time, the other one for evaluation time.
  4. Must not put too many fields
    Conditions are records, thus users can put as many as fields onto it. A condition must contain minimum information or resources. If you need more information, then use &irritants
  5. Should use composite then inheritance
    Conditions are records (I'm saying it twice because it's important), means you can only inherit one base condition. However, sometimes you want to put meta information such as &i/o. In this case use the condition procedure instead of creating a new condition type which inherits &i/o.
    For example, suppose you have &foo condition, which inherits &error. Now your library should also signale &i/o when an I/O operation failed. Theoretically, you have the following 2 options:
    1. Composite &i/o instance
    2. Create a new condition type which inherits &i/o
    As long as your base condition is not a subtype of &i/o, then you should use option number 1. In this manner, library users can handle the error situation easier by just adding a guard clause with foo-error? (suppose your condition predicate of &foo is foo-error?). And users can still check I/O error with i/o-error?

Conclusion

I'm quite happy with the above rules whenever I use the libraries constructed with it (sort of dogfooding).

2018-12-20

(usocket): R6RS portable socket library

Motivation

When I wrote the MongoDB client library in R6RS portable manner, I have included socket procedures inside of the library. Now, I want to write Redis client, then I've noticed that it's very inconvenient that if there's no R6RS portable socket library. We have SRFI 106 for a socket library, however, it's not widely implemented especially on R6RS implementations. So I've decided to make it and it's here.

Portable R6RS socket library

Example

The library supports TCP and UDP client and server sockets. Most of the time, I only need TCP client, but it's nice to have in case it's needed. The very basic HTTP request call using this library would look like this:
(import (rnrs)
        (usocket))

(define client (make-tcp-client-usocket "google.com" "80"))
(put-bytevector 
 (client-usocket-output-port client)
  (string->utf8 "GET / HTTP/1.1\r\n\r\n"))

(utf8->string (get-bytevector-n (client-usocket-input-port client) 1024))
;; -> response from the server

(usocket-shutdown! client *usocket:shutdown-read&write*)
(usocket-close! client)
For portability, we don't provide any socket specific operation other than shutdown and close. Everything else needs to be done via input or output port.

Supporting implementations

The library supports the following implementation:
  • Sagittarius (0.9.4 or later)
  • Chez Scheme (v9.5)
  • Larceny (1.3)
Chez and Larceny require PFFI and psystem as their dependencies and they can only run POSIX environment (not on Windows, PR is always welcome :) ).

Who is using this?

As I mentioned above, I'm using this library to create R6RS portable Redis client. It's at least good enough to implement the client.