2020年7月26日日曜日

SBCLのハッシュテーブルに対するハック

SBCLのハッシュテーブルに対して、長さ$N$の列で${O}(N^2)$の時間がかかるようなものを作るメモ。

組み込みハッシュ関数の特性を生かしてキーを衝突させる

ハッシュテーブルの標準の4つのtestに対しては、それぞれハッシュ関数が用意されている:

CL-USER> (sb-impl::eq-hash 123456789)
123456789
NIL
CL-USER> (sb-impl::eql-hash 123456789)
123456789
NIL
CL-USER> (sb-impl::equal-hash 123456789)
1193941381175482768
NIL
CL-USER> (sb-impl::equalp-hash 123456789)
1193941381175482768
NIL

fixnumに対するeq、eqlのハッシュ関数はsb-kernel:pointer-hashそのものなので、（非負なら）整数がそのままハッシュ値になる。equal、equalpについてはsxhashが適用される。

どれも単純なハッシュ関数だが、これらがハッシュテーブルの中でそのまま使われるわけではなく、常にprefuzz-hashという変換を通る:

(defun prefuzz-hash (hash)
  ;; We're using power of two tables which obviously are very
  ;; sensitive to the exact values of the low bits in the hash
  ;; value. Do a little shuffling of the value to mix the high bits in
  ;; there too. On 32-bit machines, the result is is a positive fixnum,
  ;; but on 64-bit, we use 2 more bits though must avoid conflict with
  ;; the unique value that that denotes an address-based hash.
  (ldb (byte #-64-bit 29 #+64-bit 31 0)
       (+ (logxor #b11100101010001011010100111 hash)
          (ash hash -3)
          (ash hash -12)
          (ash hash -20))))

(defun mask-hash (hash mask)
  (truly-the index (logand mask hash)))

ハッシュ関数の返すハッシュ値はprefuzz-hashで31ビットのハッシュ値に変換される。さらに、このハッシュ値はmask-hashでマスクされ、ハッシュテーブルの内部に保持されている配列のサイズ$L$に応じて$L$未満のインデックスが対応する。（このサイズは常に2の累乗で、ハッシュ値の下位ビットを残すだけで求まる。）

まとめると、オブジェクトに対応するアドレスが計算されるまでの流れは

  1. ハッシュ関数: オブジェクトに対するハッシュ値を決定する（ユーザー定義可能）
  2. prefuzz-hash: ハッシュテーブル内部でハッシュ値を変換する
  3. mask-hash: ハッシュ値から内部のインデックスを決定する

となる。さて、prefuzz-hashのコメントで書かれている通り、この実装全体の明らかな欠点として、上位ビットの変化に鋭敏でないというのがある:

CL-USER> (prefuzz-hash #b10101011101110111011101110111011101110111011101110111011101110)
691516418
CL-USER> (prefuzz-hash #b10111011101110111011101110111011101110111011101110111011101110)
691516418

prefuzz-hashでは$31$ビットでマスクする前に右シフトを複数入れて混ぜることでこの問題をある程度解消しているが、$-20$くらいだと上位11ビットの変化をまったく検知しないことになる。また、実際にはmask-hashでさらにビットが捨てられるので、検知できない範囲はもっと大きくなる。

これを利用して敵対的な入力を作ってみる:

(defun make-killer-sequence (length)
  (labels ((power-of-two-floor (x) ; x以下の最大の2の累乗を返す
             (ash 1 (- (integer-length x) 1))))
    (let* ((min (power-of-two-floor (floor #.(expt 2 62) length))))
      (loop for i from 1 to length
            collect (* min i)))))


(let ((list (make-killer-sequence 200000))
      (table (make-hash-table)))
  (time (dolist (x list)
          (setf (gethash x table) t)))
  table)
;; Evaluation took:
;;   42.093 seconds of real time
;;   42.031250 seconds of total run time (42.015625 user, 0.015625 system)
;;   99.85% CPU
;;   88,248,012,450 processor cycles
;;   22,735,232 bytes consed

(let ((list (loop repeat 200000
                  collect (random most-positive-fixnum)))
      (table (make-hash-table)))
  (time (dolist (x list)
          (setf (gethash x table) t)))
  table)
;; Evaluation took:
;;   0.031 seconds of real time
;;   0.031250 seconds of total run time (0.031250 user, 0.000000 system)
;;   100.00% CPU
;;   82,863,249 processor cycles
;;   22,741,968 bytes consed

ランダムな入力と比べて遅くなっていることがわかる。

乱択で衝突するキーを探す

ハッシュ関数の特性を考えなくても、SBCLの実装をそのまま再現して衝突するキーを探すことは当然できる。（ただし、探索時間はそれなりにかかる）

(defun make-killer-sequence2 (length)
  (declare (optimize (speed 3))
           ((integer 0 #.most-positive-fixnum) length))
  (assert (= 1 (logcount length))) ; 2の累乗
  (let* ((hash-fn (sb-impl::hash-table-hash-fun (make-hash-table :test #'eql)))
         (table (make-hash-table))
         (mask (- length 1)))
    (dotimes (i length)
      (loop
        (let* ((x (random most-positive-fixnum))
               (hash-value (prefuzz-hash (the (integer 0 #.most-positive-fixnum)
                                              (funcall hash-fn x))))
               (masked-value (logand mask hash-value)))
          (when (or (< (hash-table-count table) 2)
                    (gethash masked-value table))
            (push x (gethash masked-value table))
            (return)))))
    (loop for values being each hash-value of table
          append values)))

(let ((list (make-killer-sequence2 262144))
      (table (make-hash-table)))
  (time (dolist (x list)
          (setf (gethash x table) t)))
  table)
;; Evaluation took:
;;   32.281 seconds of real time
;;   32.281250 seconds of total run time (32.281250 user, 0.000000 system)
;;   100.00% CPU
;;   67,652,819,010 processor cycles
;;   32,850,480 bytes consed

(let ((list (loop repeat 262144
                  collect (random most-positive-fixnum)))
      (table (make-hash-table)))
  (time (dolist (x list)
          (setf (gethash x table) t)))
  table)
;; Evaluation took:
;;   0.100 seconds of real time
;;   0.109375 seconds of total run time (0.093750 user, 0.015625 system)
;;   [ Run times consist of 0.031 seconds GC time, and 0.079 seconds non-GC time. ]
;;   109.00% CPU
;;   202,079,224 processor cycles
;;   32,815,008 bytes consed

対応方法など

[少し追記]

1つ目のハックはこの実装特有の問題と言え、もう少しビットシフトを追加すれば難しくなりそうだが、2つ目は決定的ハッシュ全般の問題なので、決定的であることをやめる必要がある。たとえば、ハッシュを求める際にロード時（またはコンパイル時、実行時など）に生成した乱数を使うなどが考えられる。以下はロード時に決定する例[1]:

(declaim ((mod #.most-positive-fixnum) *mask*))
(sb-ext:define-load-time-global *mask* (random most-positive-fixnum))

(defun my-hash (x)
  (declare (optimize (speed 3))
           ((integer 0 #.most-positive-fixnum) x))
  (let ((x (sxhash x)))
    (ldb (byte 62 0) (+ *mask* x (ash x -28) (ash x -36)))))

(make-hash-table :test #'eql :hash-function #'my-hash)

これも「自分には明らかなハックが思いつかない」程度のもので、fixnum以外に対するsxhashはたぶん安全ではないとか、そもそもビットシフトを適当に入れてXORを取るだけで十分なのかわからない、などいろいろ問題はありそう。ちゃんとしたやつについてはこの記事が参考になった。

  1. ただし、起動時の*random-state*そのものが決定的なことに注意。時刻等から適当にシードを与えるか (sb-ext:seed-random-state t) を使う必要がある。 ↩︎

投稿者