Reading a smart card with Sagittarius

If you are a lisp user (whichever your preference is), you would already know S-expression is the best way to write DSL. I have been writing a library which allows you to read (in future write) a smart card via winscard or PCSC (it's not tested, though). You can download it from here. It's still under development state so be aware the APIs or commands might be changed in future.

The simple use of this library is really simple, you only need to write a Scheme script and run it with load.scm contained in the library. Let me introduce a simple script.

(import (rnrs)
        (pcsc operations control) ;; for apdu-pretty-print
        (pcsc shell commands)
        (pcsc dictionary gp)
        (srfi :39))

(establish-context)
(card-connect)
;; transmit a select command without any parameter
(select)

(define key #xFFFFFFFFFFFFFFFFFFFFFF) ;; your key must be here
(channel :security *security-level-mac* 
         :option #x55
         :enc-key key
         :mac-key key
         :dek-key key)

(parameterize ((*tag-dictionary* *gp-dictionary*))
  (print "applications")
  (apdu-pretty-print (strip-return-code
                      (invoke-command get-status applications))))

(card-disconnect)
(release-context)

Looks really a Scheme code right? The commands are influenced by GPShell, so if you know it, it would be familiar for you. The result would be like this;

$ sash.exe -Lsrc -Lcontrib load.scm -f status.scm
applications
[Tag] E3: GlobalPlatform Registry related data
  [Tag] 4F: AID
    [Data] �0��: A0 00 00 00 30 80 00 00 00 04 A6 00 01
  [Tag] 9F70: Life Cycle State
    [Data] 07 01
  [Tag] C5: Privileges
    [Data] 00 00 00
  [Tag] EA: TS 102 226 specific template
    [Tag] 80
      [Data]
  [Tag] C4: Application's Executable Load File AID
    [Data] A0 00 00 00 30 80 00 00 00 04 A6 00
  [Tag] CC: Associated Security Domain AID
    [Data] A0 00 00 01 51 00 00 00

... so on if you've got any result

The Sagittarius version must be 0.4.2 (current HEAD version) otherwise apdu-pretty-print raises an error. The document is not really done yet. There are 2 ways to refer which command does what, 1 is looking up the code, the other one is starting the REPL and type (help 'command) like this;

$ sash.exe -Lsrc -Lcontrib start.scm
pcsc> (help 'select)
select :key aid

Sends select command.
;; If you evaluate (help), the it will show all defined commands.
pcsc> (help)
help [command]
Show help message.
When [command] option is given, show the help of given command.
Following commands are defined:
    card-connect
    card-disconnect
    card-readers
    card-status
    channel
    close-channel
    establish-context
    exit
    get-status
    help
    load-script
    release-context
    select
    send-apdu
    set-keys!
    trace-off
    trace-on

Note: even though it shows the help string, it is better to look up the code when you really want to understand for now. I will write the document later.

There are a lot of missing features such as DELETE commands or LOAD, INSTALL etc. I will add those eventually.

Again, it's still under development state, so your feedback and contribution are always welcome :-)

evalとdatum->syntax

packとunpackの実装をしていて、実行時にbytevector-**-native-ref/set!系の手続きを生成してごにょごにょしようかなぁと思ってこんなのが有効かちょっと試してみた。別にR6RSな処理系コンパチにする必要はないだけど、なんとなく。以下がちょっとしたテスト用スクリプト：

(import (except (rnrs) string-copy) (rnrs eval)
        (for (only (rnrs) bytevector-u16-native-ref) (meta -1))
        (only (srfi :13) string-index-right))

(define (->native sym)
  (define (finish sym) (datum->syntax #'->native sym))
  (let* ((s (symbol->string sym))
         (i (string-index-right s #\-)))
    (finish
     (string->symbol
      (string-append (substring s 0 i) "-native" 
                     (substring s i (string-length s)))))))

(display (eval `(,(->native 'bytevector-u16-ref) #vu8(1 0) 0)
               (environment)))
(newline)

動作確認はいつもの処理系、Chez、Mosh、NMosh、Racket、Ypsilon。Sagittariusはenvironment手続きにバグがあって、0.4.1までは0引数を受け付けなかった。HEADでは修正済み。後、ChezはSRFIが(恐らく)一切使えないので、実行する際は、string-index-right周りをごっそり削って、datum->syntaxの第二引数にbytevector-u8-native-refを直接渡すようにした。

以下は結果
予定通り動いた処理系：NMosh、Racket、Sagittarius
何かしらエラーな処理系：Chez、Mosh、Ypsilon

正直なところ上記のスクリプトがR6RS的にValidなのかすら自信がないのは確かなのだが、 psyntax的にはアウトみたいである。Ypsilonはなんでだろう？NMoshとRacketはフェーズを明に指定してやる必要がある処理系なのだが、それらではOKだった。関係があるかは謎(多分あるはず)。SagittariusがOKなのは分かっていたことなので省略。

この手ではコンパチにできないっぽいので、まぁやるならどうせその辺りの手続きは(rnrs)にあると割り切ってenvironment手続きに明に指定してやるというものになるだろう。

pack for Sagittarius

I have committed the pack library. The implementation is influenced Industria's (weinholt struct pack) library. The string format, procedure/macro names and idea for optimisation during macro expansion are taken from it. And I have added indefinite length argument format. But don't look at the code ;-)

The basic use is like this;

(import (binary pack))
;; pack makes bytetevector
;; Fixed length
(pack "4C" 1 2 3 4)  ;; => #vu8(1 2 3 4)
;; (pack "4C" 1 2)   ;; => &syntax

;; Indefinite length
(pack "*C" 1 2 3 4)  ;; => #vu8(1 2 3 4)
(pack "*C" 1 2)      ;; => #vu8(1 2)
;; It can only be allowed for the format position.
;; (pack "*C*S" 1 2) ;; => &syntax

;; pack! sets destructively
(let ((bv (make-bytevector 8)))
  (pack! "*C" bv 0 #xFF #xFF #xFF) ;; => #vu8(255 255 255 0 0 0 0 0)
  ;; the third argument is the offset
  (pack! "*S" bv 4 1 2)            ;; => #vu8(255 255 255 0 1 0 2 0)
  ;; #\x is padding, #\! put next data as big endian
  (pack! "6x!S" bv 0 3)            ;; => #vu8(0 0 0 0 0 0 0 3)
)

Both pack and pack! are macro however it can be passed to apply. (Thanks to R6RS).

I still need to make unpack though...

補助構文の挙動

バグの調査を兼ねていろいろな処理系の補助構文を調べている。といってもmosh、nmosh、Ypsilon、Chezの4種類だけだけど。とりあえず、以下のようなファイルを用意する。ライブラリの名前が変なのは気にしない。

;; named prob.scm or so.
(library (prob)
    (export printer this) ;; this line might be modified for testing
    (import (rnrs))
  (define-syntax this (syntax-rules ())) ;; here as well.
  (define-syntax printer
    (syntax-rules (this)
      ;;((_ bit x) (display (list 'this x))) ;; 間違ってた
      ((_ this x) (display (list 'this x)))
      ((_ x)     (display x))))

  (display 'loaded) (newline)
  )

次に、以下のようなスクリプトを用意する。

(import (prefix (rnrs) rnrs.) (prefix (prob) prob:))
(rnrs.define (print . args) (rnrs.for-each rnrs.display args) (rnrs.newline))
;; should this work?
(prob:printer this      123)
(prob:printer prob:this 456)

(rnrs.define-record-type (pare kons pare?)
  (rnrs.fields 
   (rnrs.mutable a kar set-kar!)
   (rnrs.mutable d kdr ser-kdr!)))
;; somehow nmosh doesn't allow me to call this. why?
(print (kons 1 2))

準備完了。とりあえず、この状態なら全ての処理系で動作する。(Ypsilon除く、多分HEADは動作する)。気になっているのは(prob)からexportされているthisは名前が変わっているはずだが全ての処理系で動く。いいのか？

次に、最初の(prob)ライブラリのexport句のthisをコメントアウトする。 やはり全ての処理系で動く。

さらにthisの定義をコメントアウトする。全ての処理系で動く。ということは、補助構文(というか、syntax-caseもしくはsyntax-rulesのリテラル)はその辺関係ないのかなぁ？と結論付けたいところだが、define-record-typeの中の(なんでもいいんだけど)、rnrs.mutableをmutableに変更するとmosh、Chezが怒る。意味不明である。psyntax組みか？nmoshはOKだった。

さて、どの挙動が正しいのだろうか？
指摘が入ってテストスクリプトを修正。上記のコメントは全部無効になりました。つまり、全処理系(除Sagittarius)予定通りに動く。

pack

Sagittarius currently doesn't have pack procedure (or macro). That's simply because I wrote specific procedures to handle binary packing each time. However it's better to have generic one.

Then I need to consider its interface. I was thinking something similar with Industrial's pack however I have re-read this tweet (it's in Japanese):

Sagittarius scheme には pack ないのか。 サイズが一定ならバイトベクタを確保して並べるのも手間っていう程ではないのだが、不定長になると一気に面倒くさくなるんだよなぁ。
— (32) 齊藤敦志さん (@SaitoAtsushi) 1月 22, 2013

Does it handle indefinte size?

I actually have 2 problems to implement: Firstly, I'm not good with pack stuff. Even when I was still using Perl, pack is only for hex to ascii or other way around (you can easily guess what is for :-) ). Secondly, if we support indefinate length, what would be the better solution?

The first thing, I just need to learn so it just takes fine time. The second one, I don't have much use cases so all what I can is guessing. There are, I think, 2 ways to implement indefinate length. One is like Perl way using some keyword inside of the format string (* or +?). The other one is providing a procedure to pre-compute the given data and generate format string. So it must be like this;

;; #\C is u8
(let ((fmt (generate-format-string #\C indefinite-bv)))
  (pack fmt indefinte-bv))
#|
Let's say indefinite-bv has 8 bytes then format string would be "CCCCCCCC".
Or if we use #\L as a bace character then format string would be "LL"
|#

The problem of this is that we can't optimise it in macro. So it always needs to be computed in runtime. I don't think this will be a big problem, though.

Ah, wait, format string can have indefinite marker if I check it macro expansion time. Hmm, which way is better?

デバッグしづらいバグ

(多分)マクロ周りの識別子問題なのだが、非常にデバッグしづらいバグの報告を受けた。とりあえず、考えうる限りもっとも小さいと思われる再現コードは以下

(import (rnrs))
(define-syntax foo
  (lambda (x)
    (syntax-case x ()
      ((_)
       (let ()
         ;; こいつが問題。syntax-rulesでも起きるけど
         ;; syntax-caseの方が通常はデバッグが楽なので
         (define-syntax prob
           (lambda (x)
             (syntax-case x ()
               ((_) #'ok))))
         #t)))))

要するにsyntax-caseのテンプレート部分で局所的マクロを定義すると&compileが投げられるという不具合。

エラーのメッセージは局所変数.varが参照されているけど、その定義がIForm上で見つからないというもの。 .varはマクロ展開器がパターン変数等を参照するために自動でつけられるものなのだが、この場合だとfooとprobの両方が持っている。

何がこの不具合をデバッグしづらくしているかというと、(デバッガがないというのは置いておいて)probがコンパイル時にコンパイルされるのでどんな感じの中間コードになっているかというのが出力できないこと。コンパイラはいくつかのステップを踏んでVMコードを出力するのだが、このパターンはどのステップで不具合が入るのかとか、なんで入るのかというのを全て推測するしかないのが辛い。

なんとなく推測としてある不具合の原因としては、prob側で参照されている.varがfoo側で定義されたものになってるんだろうなぁ、くらいのものである。(恐らく正しいはず)

さて、なんでこんなことが起きるんだ？

なんとなく分かってきた(昨日の続き)

いろいろ動作確認をChezでしているうちになんとなくどうあるべきかが分かってきた。

基本的にはマクロが定義されたライブラリ内にあるシンボルはそこで、展開時のライブラリにあるシンボルはそこでという感じで定義時のコンテキストを使って識別子を変換すればいいような気がする。

問題になるのは、シンボル自体はなんの情報も持たないのでそのシンボルが実際にどこで出現したかを確認する術がないことだろう。Sagittariusではマクロ展開時にsyntax構文の展開が行われるのでどちらの場合も補足している環境的には同じものに見えるのだ。

こうなってくると展開時ではなく、syntax構文のコンパイル時にシンボルから識別子に変換してしまった方がいいような気がする。そうすれば、少なくとも補足時には識別子になっているので、このような混乱が起きることもない。ちょっとこの方法を試してみるか。

マクロがスコープを壊していた

まぁ、マクロ周りは完全とは言いがたいと分かってはいたのだがこうも立て続けに不具合が出てくるとは・・・

Google code上でIssueを発行したのだけど、まぁ前回のマクロの不具合とばっちり関連している、というかそれの延長線上である。

Vicareの中の人が報告してくれたIssue 84と今発行したIssue 85はちょうど真逆の動作をするのだけど、原因する場所及びその原因は全く一緒。どちらもシンボルから識別子へ変換する部分の処理が正しいライブラリを見つけることができていないのが問題になっている。怪しいなぁとは思っていたのだけどこんなにも怪しかったとは思っていなかった。完全にその部分の理解が間違っていたということになる。

どうあるべきなのか？
問題はこれである。今のところ考えがまとまっていないので、どうあるべきかすらわかっていない。一番大元で(たぶん正しく)理解しているのは、基本的に字面上参照できないものは参照できない、ということ。その逆もしかり。84の方は後者になり、85の方は前者になる。ここで、字面上というのは、コードから読み取れる情報上という意味。(蛇足)
この大元だけが分かっていても、いくつかの要因が複雑に絡み合うと全く分からなくなる。だれだよ、こんな複雑な仕組み作ったの！正直な話、あまり複雑に考えなくてもいいはずなのだ。

ふと、後者の問題はVMをいじれば解決できることに気づいた。マクロ展開の問題なんだけど、解決をランタイム(しかもVMレベル)まで遅らせれば解決できる。ただ、これは本質的な解決じゃないので、どこかで破綻する気がしているのと、本質的な解決じゃないのはあまり入れたくない。

あぁ、待てよ、マクロ展開時とマクロ補足時の環境は取れてるんだからVMレベルまで遅らせる必要はなく分かってるよな？となると、問題となるのはIssue 25のパターンを無理やり何とかしようとしているところか。具体的には以下ようなコード：

(library (foo)
  (export bar)
  (import (rnrs))

  (define (problem) (display 'ok) (newline))

  (define-syntax bar
    (lambda (x)
      (define (dummy)
        `(,(datum->syntax #'bar 'problem)))
      (syntax-case x ()
        ((k) (dummy)))))
  )

(import (rnrs) (foo))
(bar)

barがへんてこな風に解決しないと&assertionを投げるのだけど、これ何とかならないかな？ちょっと考えよう。

Sagittarius 0.4.1リリース

Sagittarius Scheme 0.4.1がリリースされました。今回のリリースはメンテナンスリリースです。ダウンロード

修正された不具合

• 同名の内部defineが存在した場合にASSERTで落ちる不具合が修正されました
• sqrt手続きにBignumを渡すとASSERTで落ちる不具合が修正されました
•  bitwise-bit-count及びfxbit-countに0を渡すと不正な値を返す不具合が修正されました

改善点

• ODBCライブラリを探すプロセスがiODBCにも対応するようになりました(Linux)
• SRFI42がR6RSモードでも動くように改善されました

新たに追加された機能

• pointer->bytevector手続きが(sagittarius ffi)に追加されました
• import、library及びdefine-libraryのみがデフォルトで使用可能になる起動オプション-tが追加されました

新たに追加されたライブラリ

• TLVデータライブラリ(tlv)が追加されました

winscardを使ってみる

仕事柄最近UICC(SIM)を扱うことが多い。まぁ、基本的には中にインストールされているアプリケーションを覗いたり、APDUを実行したりするだけではあるのだが。

こういった作業をするツールとしてGPShellというものがあるのだが、いかんせんドキュメントが少ない上に今一使い勝手が悪い。内製のツールもあるのだがドキュメントが無いためAPDUのショートカットコマンドがよく分からない。

ということで、簡単に作れそうなら作ってしまおうかなぁと思いちょっと実験してみた。まぁ、FFIの実験ということでもあるのだが。とりあえずインストールされているカードリーダの一覧を取得するところから始めてみた。以下がコード。

#!read-macro=sagittarius/regex
(import (rnrs) (sagittarius ffi) (sagittarius control) (sagittarius regex)
        (srfi :13))

(define win-scard-library (open-shared-library "winscard.dll"))
(define-syntax define-c-function
  (lambda (x)
    (define (scheme-name->c-name name suffix)
      (let1 items (string-split (symbol->string name) #/-/)
        (string->symbol
         (string-append
          (string-concatenate (map (^s (string-titlecase s)) items))
          suffix))))
    (syntax-case x ()
      ((_ ret-value name arguments ...)
       (symbol? (syntax->datum #'ret-value))
       #'(define-c-function "" ret-value name arguments ...))
      ((_ suffix ret-value name arguments ...)
       (and (symbol? (syntax->datum #'name))
            (symbol? (syntax->datum #'ret-value))
            (string? (syntax->datum #'suffix)))
       (with-syntax ((c-name (scheme-name->c-name (syntax->datum #'name)
                                                  (syntax->datum #'suffix))))
         #'(define name (c-function win-scard-library ret-value c-name
                                    (arguments ...))))))))

(define-c-typedef void* SCARDCONTEXT)

(define-c-function long s-card-establish-context short void* void* void*)
(define-c-function long s-card-release-context SCARDCONTEXT)

(define-c-function "A" long s-card-list-readers SCARDCONTEXT char* char* void*)
(define-c-function long s-card-free-memory SCARDCONTEXT char*)

(let* ((hSC (empty-pointer))
       (r   (s-card-establish-context 0 null-pointer null-pointer hSC))
       (readers (empty-pointer))
       (cch (integer->pointer -1)))
  (s-card-list-readers hSC "" (address readers) (address cch))
  (for-each print (string-split (utf8->string (pointer->bytevector 
                                               readers 
                                               (pointer->integer cch)))
                                #/\x00/))
  (s-card-free-memory hSC readers)
  (s-card-release-context hSC)
)

pointer->bytevectorは割りと汎用的かなと思い追加(0.4.1から使用可能)。とりあえずこれを実行するとなんとなく登録されているカードリーダが列挙される。ある程度満足のいくものになったら別モジュールとしてGitHubに登録するかもしれない。

マクロ(戦争)は続くよどこまでも

Vicareの中の人からバグ報告があって、まぁマクロ周りだろうということまで判明していた。っで、実際に問題が起きるコードを見てみると、「あぁ、やっぱりこのコードはバグを含んでいたか」というまさにドンピシャの部分のバグであった。実際のコード(Sagittariusのマクロ展開器側)に多分これはおかしくてバグの匂いがするってコメントまで書いてある。学習した自分を見ている感じだ(以前はこんなの残さなかった)。

件のコード片は以下の感じ。

(define expand-syntax
  (lambda (vars template ranks p1env)
    ...
    ;; wrap the given symbol with current usage env frame.
    (define (wrap-symbol sym)
      (define (finish new) (add-to-transformer-env! sym new))
      ;; To handle this case we need to check with p1env
      ;; other wise mac-env is still the same as use-env
      ;; (define-syntax foo
      ;;  (let ()
      ;;    (define bar #'bzz)
      ;;    ...
      ;;    ))
      (let* ((mac-lib (vector-ref p1env 0))
             (use-lib (vector-ref use-env 0))
             (g (find-binding mac-lib sym #f))
             ;; if the symbol is binded locally it must not be
             ;; wrapped with macro environment.
             (lv (p1env-lookup use-env sym LEXICAL)))
        ;; Issue 25.
        ;; if the binding found in macro env, then it must be wrap with
        ;; macro env.
        ;; FIXME: it seems working but I smell something wrong with
        ;;        this solution. The point of the issue was inside
        ;;        of the macro it refers to the macro itself but the
        ;;        expansion did not occure until it really called.
        ;;        that causes library difference even though it's in
        ;;        the macro defined library.
        (if (and (identifier? lv)
                 (not (eq? mac-lib use-lib))
                 g (eq? (gloc-library g) mac-lib))
            (let ((t (make-identifier sym '() mac-lib)))
              (finish (make-identifier t (vector-ref mac-env 1) mac-lib)))
            (let ((t (make-identifier sym '() use-lib)))
              (finish (make-identifier t (vector-ref use-env 1) use-lib))))))
    ...
  ))

まぁ、見事にFIXMEなんて書いてある部分がそれにあたる。問題になったコードは以下で見える。
https://github.com/marcomaggi/r6rs-sofa/blob/master/lib/sofa/compat.sagittarius.sls
同様にFIXMEと書いてある部分が問題になる。多分、問題は2つあって、c-functionが何かしらおかしなことになっているのと、define-c-functionの展開系からはffi.int等が見えなくなる問題である。

後者の問題がコメントに書いてある部分の不具合に当たる(はず)。出力されるエラーを見ると、ffi.intがuserライブラリの識別子となっているが、これは誤りで、正しくは(sofa compat)にならなければならない。上記のコード片はその辺りの変換を行っているのである。

なぜ起きるか？
もちろん書いてあるコードがおかしいので起きるのだが、シンボルから識別子に変換する際のマクロ展開時とマクロ捕捉時の環境の選別がうまく出来ていないことに起因している。上記のコードではどうも厳しすぎるみたいである。

とりあえず、現在の識別子変換の考え方を整理する。
マクロ展開時に生のシンボルが表れた際、識別子へと変換する。その際に使われる環境の選別は以下のように行われる。

• シンボルはマクロ捕捉時環境で束縛されている
• シンボルはマクロ展開時環境で未束縛である
• マクロ捕捉時とマクロ展開時ではライブラリが異なる
• 束縛されているシンボルはマクロが捕捉されたライブラリで束縛されている

上記全てを満たした場合のみマクロ捕捉時環境を使って識別子へと変換される。今回問題になっているのは最後の項目である。ただ、このチェックを外すと全く動かなくなる。

ちょっと難航しそうな感があるので、0.4.2以降で直すことにする。

2013年始動

あけましておめでとうございます(遅

日本にいた3週間はブログ、コードともにほとんど何もしないという快挙(？)を達成したのでそろそろ始動しないと鈍るなぁと思い開始します。

About Sagittarius
直近は今週か、来週末当たりに0.4.1をリリースする予定。前回のEnbug修正とTLVライブラリの追加しかないです。(微妙に起動オプションが足されてたりするけど)
R6RS、R7RSともにかなり準拠度が上がったのと、仕事で使う範囲だと結構カバーされているので開発状況が多少倦怠期的なものに入ったかなぁとも思っているので、(もしあれば)要望などを受付中です。(使ってくれている人いるのかなぁ・・・)
MoshがAndroidで動くなんてのを見てちょっと触発されつつあるので、(現在仕事で使っている)BlackBerryで動くようにするなんてのを目指すかもしれません(超未定)。
なんにしろ、今年は緩やかに進行するような気がしてます。月一でリリースするつもりでは一応いるけど・・・

その他
鋭意転職活動中です、興味があれば連絡ください。勤務地がオランダかイギリスあたりだとフットワーク軽めです。
6月にスペインでELSがあるらしいけど、行こうか迷い中。

今年こそ腹筋を6つに割りたい。
ギターの練習をもう少し頻度を上げる。